#!/usr/local/bin/perl5.6.1

package so_proto_api;


use strict;
use sql_engine;
use Carp;
use Data::Dumper;
#require "/nfs/team71/psg/dn1/badger-bin/BarcodeRevised_V2_0.pm";
#use Checkbarcode;
use Time::HiRes qw(gettimeofday);
#use Mail::Mailer;


#################
# See POD at end
#################

# Include this in our object
#my $STATEMENTS;



###############################
# Externally accessed routines
###############################


######################################################################################
# A container for physical_entities; ie. from here we can make them and retrieve them
# A container may contain multiple entities ?
######################################################################################

sub dump {
    my ($self) = @_;

    print STDOUT Data::Dumper::Dumper($self);

}


sub rollback_changes {
    my ($self) = @_;
    #warn "----------------------------------\n";
    #warn "Rolling back\n";
    #warn "----------------------------------\n";
    $self->{gtr_database}->{DBH}->rollback;
}


sub commit_changes {
    my ($self) = @_;
    #warn "----------------------------------\n";
    #warn "Commiting\n";
    #warn "----------------------------------\n";
    $self->{gtr_database}->{DBH}->commit;
}


sub new {
    my ($class, $gtr_db, $id_role, $benchmark) = @_;

    croak "so_proto_api.pm new method ERROR No GTR WrapDBI user id supplied !" unless (defined $gtr_db);
    croak "so_proto_api.pm new method ERROR No GTR WrapDBI id_role supplied !" unless (defined $id_role);
    croak "so_proto_api.pm new method ERROR No benchmark level supplied !" unless (defined $benchmark);


    
    unless ($benchmark eq 'NB' || $benchmark eq 'BM' || $benchmark eq 'BMS'){
	croak "so_proto_api.pm new method ERROR Benchmark level must be one of NB, BM or BMS";
    }
    
    if ($benchmark eq 'NB'){
	$benchmark = 0;
    } elsif ($benchmark eq 'BM') {
	$benchmark = 1;
	print STDOUT "Benchmarking activated.\n";
    } else {
	$benchmark = 2;
    }


    # Create the object
    my $self = {};
    bless $self, $class;


    #################################################
    # Limit certain roletypes to certain actions ???
    #################################################
    $self->{id_role} = $id_role;


    ######################################################
    # Register valid subroutines for SeqObject population
    # Note that unregistered 'new' entries will default
    # to &pop_seqobject_new
    ######################################################
    my $valid_population_subs = { 
	'Organism' => {'new' => \&pop_seqobject_new, 
		       #'pre_existing' => \&pop_Organism_pre_populate
		   },
    };
    $self->{valid_population_subs} = $valid_population_subs;
    


    #############################
    # Handle database connection
    #############################
    #############################################################
    # Limit dev release to the appropriate development databases
    #############################################################
    # TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO 
    if ($gtr_db ne 'so_proto_api'){
    	croak "This is a test version of so_proto_api.pm WrapDBI user should be so_proto_api !\n";
    }
    
    if ($benchmark == 1){ 
	$self->start_timer("connection to DB and preparing so_proto_1.sql_lib::all");
    };
    $self->{gtr_database} = statements->new("$gtr_db") || die;
    $self->{gtr_database}->default_sql_lib_path('/nfs/team71/psg/dn1/badger-bin/platetrack/');
    $self->{gtr_database}->load_sql_lib(["so_proto_1.sql_lib::all"]);
    #$STATEMENTS = $self->{gtr_database};
    if ($benchmark == 1){ 
	$self->stop_timer;
    };


    
    #########################################################
    # What are the allowable SEQOBJECT_TYPES we can create ?
    #########################################################

    my ($allowable_seqobjects, $allowable_seqobjects_by_id);
    my $ret_allow_seqobjects =  $self->{gtr_database}->get('so_proto_1.sql_lib::allowable_seqobjects_by_description');
    #warn Data::Dumper::Dumper($ret_allow_seqobjects);
    foreach my $m (@$ret_allow_seqobjects){
	$allowable_seqobjects->{$m->[0]} = $m->[1];
    }
    #warn Data::Dumper::Dumper($allowable_seqobjects);
    


    my $ret_allow_seqobjects_by_id =  $self->{gtr_database}->get('so_proto_1.sql_lib::allowable_seqobjects_by_id');
    #warn Data::Dumper::Dumper($ret_allow_seqobjects_by_id);
    foreach my $m (@$ret_allow_seqobjects_by_id){
	$allowable_seqobjects_by_id->{$m->[0]} = $m->[1];
    }
    #warn Data::Dumper::Dumper($allowable_seqobjects_by_id);


    $self->{allowable_seqobjects} = $allowable_seqobjects;
    $self->{allowable_seqobjects_by_id} = $allowable_seqobjects_by_id;

    
    return $self;
}



###########################################################################
# Register a new SeqObject into the container
#
# Supply type of SeqObject we are talking about
# Supply creation method required
#   - make a new one from scratch
#   - populate from pre-existing entry in the database
# Optionally supply a referenced SeqObject from which this one is derived
###########################################################################
sub seqobject {
    my ($self, $seqobject_type, $creation_type, $ref_seqobject) = @_;

    ###############################################
    # Store information about this physical entity
    ###############################################
    my $this_seqobject = {};

    ######################
    # Required parameters
    ######################
    croak "so_proto_api.pm seqobject method ERROR No seqobject_type parameter supplied !" unless (defined $seqobject_type);
    croak "so_proto_api.pm seqobject method ERROR No creation_type parameter supplied !" unless (defined $creation_type);
    
    ################
    # creation_type
    ################
    # new;                 create a new entity of this type
    # pre_existing;        create a pre-existing entity of this type
    my $allowable_creation = 
    { 
	"new" => 1, 
	# TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO 
	#"pre_existing" => 1
    };
    
    #warn Data::Dumper::Dumper($allowable_creation);
    unless ( defined ($allowable_creation->{$creation_type}) ){
	croak "so_proto_api.pm physical_entity method ERROR creation_type parameter $creation_type invalid !";
    }


    unless ( defined ($self->{allowable_seqobjects}->{$seqobject_type}) ){
	croak "so_proto_api.pm seqobject method ERROR seqobject_type parameter $seqobject_type invalid !";
    }


    $this_seqobject->{seqobject_type} = $seqobject_type;
    $this_seqobject->{creation_type} = $creation_type;

    
    ##########################################################################
    # If we are supplied a reference to a SeqObject, check that the ID exists
    # in our datastructure
    ##########################################################################
    # TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO 
    # Note that the referenced seqobject may exist in the database rather than in
    # the datastructure; we need to check here too (SEQOBJECT.ID_SEQOBJECT) !

    if ($ref_seqobject) {
	unless (defined $self->{seqobjects}->{$ref_seqobject}){
	    croak "so_proto_api.pm seqobject method ERROR Cannot reference unknown SeqObject Id $ref_seqobject !";
	} else {
	    $this_seqobject->{from_seqobject} = $ref_seqobject;
	}
	
    }

    #####################################################
    # We need an identifier for this new physical entity
    #
    # - Need a sequence for SeqObjects; SEQ_SEQOBJECT
    #
    #####################################################
    my $this_seqobject_id =  $self->{gtr_database}->get('so_proto_1.sql_lib::get_seqobject_id');
    #warn "-----> $this_seqobject\n";
    $this_seqobject_id = $this_seqobject_id->[0]->[0];

    #warn Data::Dumper::Dumper($this_seqobject_id);
    
    ######################################
    # Load our new entity into our object
    ######################################
    $self->{seqobjects}->{$this_seqobject_id} = $this_seqobject;

    return ($this_seqobject_id);
    
}




################################################################################################################
# How we populate our structure depends on the pre-defined SeqObject type and the predefined creation type
################################################################################################################
sub populate {
    my ($self, $so_id, $seqobject_name, $seqobject_info) = @_;

    ####################################################################
    # To populate a SeqObject, an ID for the SeqObject must be supplied
    ####################################################################
    croak "so_proto_api.pm populate method ERROR No SeqObject Id supplied !" unless (defined $so_id);
    

    #################################################################
    # Does the supplied SeqObject actually exist in our collection ?
    #################################################################
    unless (defined $self->{seqobjects}->{$so_id}){
	croak "so_proto_api.pm update method ERROR SeqObject Id $so_id supplied is not known !";
    }

    

    ###########################################################################################
    # If the creation_type is 'new' then we must be supplied seqobject_name and seqobject_info
    ###########################################################################################
    my $creation_type = $self->{seqobjects}->{$so_id}->{creation_type};
    if ($creation_type eq 'new'){
	croak "so_proto_api.pm populate method ERROR No SeqObject Name supplied !" unless (defined $seqobject_name);
	# The info must come in a specific datastructure ... need to check this
	# TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO 
	croak "so_proto_api.pm populate method ERROR No SeqObject Info supplied !" unless (defined $seqobject_info);
    }
    
    #############################################################################
    # Seqobject_type info from the object in question
    #############################################################################
    my $seqobject_type = $self->{seqobjects}->{$so_id}->{seqobject_type};
    my $seqobject_type_id = $self->{allowable_seqobjects}->{$self->{seqobjects}->{$so_id}->{seqobject_type}};

    #########################################################################
    # Can we populate the given creation_type and seqobject_type combination
    # Work out which subroutine to call
    #########################################################################
    unless (defined ($self->{valid_population_subs}->{$seqobject_type}->{$creation_type})){
	
	if ($creation_type eq 'new'){
	    &pop_seqobject_new($self, $so_id, $seqobject_name, $seqobject_info, $seqobject_type_id);
	} else {
	    croak "so_proto_api.pm populate method ERROR no valid populate method exists for seqobject_type $seqobject_type and creation_type $creation_type !";
	}

    } else {
    
	my $subroutine = "pop_" . "$seqobject_type" . "_" . "$creation_type";
	#warn "Calling subroutine $subroutine\n";
    
	&{$self->{'valid_population_subs'}->{$seqobject_type}->{$creation_type}}   ($self, $so_id, $seqobject_name, $seqobject_info, $seqobject_type_id);
    }
}


sub update {
     my ($self, $so_id) = @_;

     ####################################################################
     # To create a SeqObject, an ID for the SeqObject must be supplied
     ####################################################################
     croak "so_proto_api.pm update method ERROR No SeqObject Id supplied !" unless (defined $so_id);
     
     #################################################################
     # Does the supplied SeqObject actually exist in our collection ?
     #################################################################
     unless (defined $self->{seqobjects}->{$so_id}){
	 croak "so_proto_api.pm update method ERROR SeqObject Id $so_id supplied is not known !";
     }
     
     #################################################
     # Has the SeqObject in question been populated ?
     #################################################
     unless (defined ($self->{seqobjects}->{$so_id}->{seqobject_name})){
	 croak "so_proto_api.pm update method ERROR SeqObject $so_id has not been populated!";
     }

     #################################################################
     # creation_type new -> insert pre_existing -> possible update
     #################################################################
     my $creation_type = $self->{seqobjects}->{$so_id}->{creation_type};
     if ($creation_type eq 'new'){
	 $self->create_new_seqobject($so_id);
     } else {
	 die "Unhandled creation type !\n";
     }

}


# -----------------------------------------------------------------------------------------------------------------
# -----------------------------------------------------------------------------------------------------------------


###############################
# Internally accessed routines
###############################

######################
# Population routines
######################

sub pop_seqobject_new {
    my ($self, $so_id, $seqobject_name, $seqobject_info, $seqobject_type_id) = @_;

    my ($pack, $file, $line) = caller;
    unless ($pack eq __PACKAGE__ && $file eq __FILE__){
	croak "so_proto_api.pm pop_seqobject_new method ERROR Invalid access to subroutine from $pack";
    }

    
    ################################################################################
    # Need to check that we have populated our Seqobject with all the required info
    # Check that we are not populating with unsuitable information for this
    # entity type
    ################################################################################
    # What is the required info ?
    my $info_requirements =  $self->{gtr_database}->get('so_proto_1.sql_lib::required_seqobject_info_by_type_required', [$seqobject_type_id, 1]);
    warn "Required Info\n";
    warn Data::Dumper::Dumper($info_requirements);
    
    # What is the allowed info ?
    my $info_allowed =  $self->{gtr_database}->get('so_proto_1.sql_lib::allowed_seqobject_info_by_type', [$seqobject_type_id]);
    warn "Allowed Info\n";
    warn Data::Dumper::Dumper($info_allowed);

    
    # yarg
    # TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO 
    # Check that we have no unallowed info_types and all required info_types

    # The meta-data we are sanity checking
    warn "Checking ... \n";
    warn Data::Dumper::Dumper($seqobject_info);



    ###################################################################
    # Build our data structure for this Seqobject according
    # to the provided information
    ###################################################################
    $self->{seqobjects}->{$so_id}->{seqobject_name} = $seqobject_name;
    $self->{seqobjects}->{$so_id}->{seqobject_info}  = $seqobject_info;

}



sub create_new_seqobject {
    
    my ($self, $so_id) = @_;

    my ($pack, $file, $line) = caller;
    unless ($pack eq __PACKAGE__ && $file eq __FILE__){
	croak "so_proto_api.pm create_new_seqobject method ERROR Invalid access to subroutine from $pack";
    }

    
    ######################################################################
    # SeqObjects will always need entries for SEQOBJECT, SEQOBJECT_STATUS
    # The requirements SEQOBJECT_INFO will depend on the entity-type but
    # the database inserts will be the same
    ######################################################################

    ###################
    # Make a SEQOBJECT
    ###################
    #warn "---------------------------------------------------------------------------------------------\n";
    #warn "Calling make_seqobject with ...\n";
    #warn "ID_SEQOBJECT ... $so_id\n";
    #warn "ID_SEQOBJECT_TYPE ... $self->{allowable_seqobjects}->{$self->{seqobjects}->{$so_id}->{seqobject_type}}\n";
    #warn "NAME ... $self->{seqobjects}->{$so_id}->{seqobject_name}\n";
    #warn "---------------------------------------------------------------------------------------------\n";


    
    if ($self->{seqobjects}->{$so_id}->{seqobject_name}){
	
	eval {

	    $self->{gtr_database}->do('so_proto_1.sql_lib::make_seqobject_ref', [
										 $so_id,
										 $self->{allowable_seqobjects}->{$self->{seqobjects}->{$so_id}->{seqobject_type}},
										 $self->{seqobjects}->{$so_id}->{seqobject_name},
										 $self->{seqobjects}->{$so_id}->{from_seqobject}
										 ]);

	};
	if ($@ ne ''){
	    warn $@;
	    croak "Problems calling make_seqobject_ref !\n";
	}
	
	
    } else {

	eval {

	    $self->{gtr_database}->do('so_proto_1.sql_lib::make_seqobject', [
									     $so_id,
									     $self->{allowable_seqobjects}->{$self->{seqobjects}->{$so_id}->{seqobject_type}},
									     $self->{seqobjects}->{$so_id}->{seqobject_name},
									     ]);                  
	};
	if ($@ ne ''){
	    warn $@;
	    croak "Problems calling make_seqobject !\n";
	}

    }

    ##########################
    # Make a SEQOBJECT_STATUS
    ##########################
    warn "---------------------------------------------------------------------------------------------\n";
    warn "Calling make_seqobject_status with ...\n";
    warn "ID_SEQOBJECT ... $so_id\n";
    

    ###########################################################################################
    # Can we find the id_status value for a seqobject of this type of description 'Created' ?
    ###########################################################################################
    my $status = $self->{gtr_database}->get('so_proto_1.sql_lib::get_created_status_by_type', [
											       $self->{allowable_seqobjects}->{$self->{seqobjects}->{$so_id}->{seqobject_type}}
											       ]);
    $status = $status->[0]->[0];
    croak "gt_proto_api.pm create_new_seqobject method ERROR Cannot determine a Created status for seqobject type $self->{allowable_seqobjects}->{$self->{seqobjects}->{$so_id}->{seqobject_type}}" unless (defined $status);


    warn "ID_STATUS ... $status\n";
    warn "ID_ROLE ... $self->{id_role}\n";
    warn "---------------------------------------------------------------------------------------------\n";

#     ID_SEQOBJECT, ID_STATUS, ID_ROLE

    eval {

	$self->{gtr_database}->do('so_proto_1.sql_lib::make_seqobject_status', [
										$so_id,
										$status,
										$self->{id_role}
										]); 
    };
    if ($@ ne ''){
	warn $@;
	croak "Problems calling make_seqobject_status !\n";
    }



    ########################
    # Make a SEQOBJECT_INFO
    ########################
    # Go through the provided array of hashes and make seqobject_info entries

    ######################################################################
    # Where is the data to be attached to this seqobject ?
    # $self->{seqobjects}->{$so_id}->{seqobject_info}  = $seqobject_info;
    ######################################################################

    #warn "Go through the provided array of hashes and make seqobject_info entries\n";
    foreach my $this (@{$self->{seqobjects}->{$so_id}->{seqobject_info}}){
	foreach my $that (keys %$this){
	    #warn "$that ---> $this->{$that}\n";


	    #warn "---------------------------------------------------------------------------------------------\n";
	    #warn "Calling make_seqobject_info with ...\n";
	    #warn "ID_SEQOBJECT ... $so_id\n";
	    #warn "ID_INFO ... $this->{$that}\n";
	    #warn "ID_INFO_TYPE ... $that\n";
	    #warn "---------------------------------------------------------------------------------------------\n";


	    eval {
		$self->{gtr_database}->do('so_proto_1.sql_lib::make_seqobject_info', [
										      $so_id,
										      $this->{$that},
										      $that
										      ]); 
	    };
	    if ($@ ne ''){
		warn $@;
		croak "Problems calling make_contents_info !\n";
	    }
	    

	}
	
    }

#    warn "----------------------------------\n";
#    warn "commiting\n";
#    warn "----------------------------------\n";
#    $self->{gtr_database}->{DBH}->commit;

}



sub start_timer {
    my ($self, $phrase) = @_;

    my ($pack, $file, $line) = caller;
    unless ($pack eq __PACKAGE__ && $file eq __FILE__){
	croak "so_proto_api.pm start_timer method ERROR Invalid access to subroutine from $pack";
    }

    print STDERR "Started $phrase\n";
    $self->{start_timer} = gettimeofday;
    return;
}


sub stop_timer {
    my ($self) = @_;

    my ($pack, $file, $line) = caller;
    unless ($pack eq __PACKAGE__ && $file eq __FILE__){
	croak "so_proto_api.pm.pm stop_timer method ERROR Invalid access to subroutine from $pack";
    }

    $self->{stop_timer} = gettimeofday;

    my $total = ( ($self->{stop_timer}) - ($self->{start_timer}) );
    print STDERR "Finished $total\n";

    return;
}



1;
