#
# $Id: LemurEnterBatchOfJobs.pm,v 1.27 2004/04/27 09:47:23 mdf Exp $
#
package LemurEnterBatchOfJobs;

require Exporter;

use     strict;
use     WrapDBI;
use     Mail;

use     Tk;
use TempFiles;
use EquusDatabaseInterface; # EDI

use     Data::Dumper;
use     MyWaitBox;

#use     EnterNewClone;

#########################################
# The old BrowseEntry.pm doesn't support
# deletes. Let's try the new one instead
#########################################

require NewBrowseEntry;
#require "/nfs/disk68/dn1/badger-bin/gull/NewBrowseEntry.pm";
#require "/nfs/weka2/pjm/work/library-making/NewBrowseEntry.pm";





#my $dbuser = 'dev2';                      # for testing purposes only

##########################################
# CONSTANTS
# i use emacs - leave space after '\' char
# so colour parser works!
##########################################

*MAIN::BITMAP_DIR      = \ "$ENV{'BADGER'}/lib/finch/bitmaps";
*MAIN::EQUUS_TEMP_DIR  = \ '/nfs/sids/equus/tmp_files/';

##########################################
# GLOBALS
##########################################


my $debug = 0;
my $bug_mail;

if( $debug == 1 ){
    $bug_mail = 'pjm';
}
else {
    $bug_mail = 'bug-real';
}


my %recoveryMethodHash;   # quick look up so only one access to database needed


my %fragMethodHash;       # Different Fragmentation methods
my %fragSizeHash;         # Each values from abouve Hash has array entry here
                          # for possible frag sizes.
my @bandsRecovered;
my @ligationNum;


################################################################################
# create Fragment & Ligation  window.
#
# args;
#      $type               type of this object
#      $parentWindow       guess...
#      $requested_db_user  example - 'dev1'
#      $new_batch          true or false value
#      $session_id         a session number created when Library Menu started
#
################################################################################

sub new {
    my ($type,
	$parentWindow,
	$requested_db_user,
	$new_batch,
	$session_id,
	$pathogen_mode)        = @_;
    my $dbUser;


    if( defined($requested_db_user) && ($requested_db_user eq '') ) {
	$dbUser   = 'dev1';  # safe default
        $bug_mail = 'pjm';
    }
    else {
	$dbUser   = $requested_db_user;
        $bug_mail = 'pjm' if $dbUser eq 'dev1';
    }

#    warn "new_batch = $new_batch\n\n" if $debug;

    my $realUserName = getpwuid($<);

    my $self = {
	dbUser        => $dbUser,
	newBatch      => $new_batch,
	session_id    => $session_id,
	pathogen_mode => $pathogen_mode,
	realUserName  => "$realUserName",
    };

    bless($self, $type);

    $self->{todaysDate} =  (localtime)[3]."/".
	                  ((localtime)[4] + 1)."/".
	                  ((localtime)[5] + 1900);

    # set up hash tables, so do all DB access in one. Only one connection
    # is made.

    $self->setupHashTables;

    $self->createWindow($parentWindow);

    return $self;
}

sub createWindow {
    my ($self, $parentWindow)  = @_;

    $self->{mw} = $parentWindow->Toplevel();

    $self->{mw}->protocol('WM_DELETE_WINDOW' => sub { 
	$self->hide();
    });

    $self->{mw}->bind('<Delete>', 'Backspace');

    my $b1 = $self->{mw}->Balloon('-state' => 'balloon');
    $self->{balloon} = $b1;

    # destroy the balloons when main window destroyed:
    $self->{mw}->OnDestroy(sub { $b1->destroy; });

    my $dataType;  # "Batch" or "Job"


    $dataType = "Job";

    if( $self->{newBatch} ) {
	$self->{mw}->title("New $dataType Details");
	$self->{mw}->Label(-width  => 30)->pack;
	$self->{mw}->Label(font    => 
			       '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
			   text    => "Enter New $dataType Details",
			   height  => 1,
			   bg          => 'white',
			   relief      => 'groove',
			   borderwidth => '3',
			   )->pack(-side => 'top');
	$self->{mw}->Label()->pack;
    }
    else {
	$self->{mw}->title("Append Details to Existing $dataType");
	$self->{mw}->Label(font    => 
			       '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
			   text    => "Append Details to Existing $dataType",
			   height  => 2,
			   width   => 30
			   )->pack(-side => 'top');
    }

    $self->{holderF}     = $self->{mw}->Frame();

    my $batchF = $self->{holderF}->Frame(-relief => 'raised');
    $self->createBatchFrame($batchF);


    $self->{cloneF}      = $self->{holderF}->Frame(-relief      => 'raised');
    $self->{experimentF} = $self->{holderF}->Frame(-relief      => 'raised');
    $self->{bandsF}      = $self->{holderF}->Frame(-relief      => 'groove');
    $self->{ligationF}   = $self->{holderF}->Frame(-relief      => 'raised');

    # fill the 4 frames/tabs with widgets.

    $self->createCloneFrame(     $self->{cloneF}     );
    $self->createExperimentFrame($self->{experimentF});
    $self->createBandsFrame(     $self->{bandsF}     );
    $self->createLigationFrame(  $self->{ligationF}  );

    # Add  buttons - dummy lable used to create space above buttons.

    my $buttF = $self->{mw}->Frame(-relief => 'groove');

    $buttF->Label(-height=>1)->grid(-row    => 3,
				    -column => 1,
				    -sticky => 'nw');

    my $okAndNextFrame = $buttF->Frame(-relief      => 'groove');

    $okAndNextFrame->Button(-width    => 10,
			    -text     => 'Add',
			    -command  => sub {$self->nextPressed}
			    )->pack( -side => 'left');

    $okAndNextFrame->Label(width    => 10)->pack(-side => 'right');

    $okAndNextFrame->grid(-row    => 4,
			  -column => 0,
			  -sticky => 'nw');

    $buttF->Button(-width    => 10,
		   -text     => 'Done',
		   -command => \ sub { $self->done_pressed(); },
		   )->grid(-row    => 4,
			   -column => 2,
			   -sticky => 'ne');

    # put all Frames onto grid ############################################
    if( defined($batchF) ) {
	$batchF->pack(-side => 'top',# -anchor => 'nw'
		      );
    }

    $self->{cloneF}->pack     (-side => 'top', -anchor => 'n');
    $self->{experimentF}->pack(-side => 'top', -anchor => 'n');
    $self->{bandsF}->pack     (-side => 'top', -anchor => 'n');
    $self->{ligationF}->pack  (-side => 'top', -anchor => 'n');

    $self->{holderF}->pack(-side  => 'top',
			   -padx  => 10,
			   -pady  => 5,
			   -ipadx => 5);

    $buttF->pack(-side => 'bottom');
}

sub done_pressed {
    my ($self) = @_;
    my $hash   = $self->{ligNumsAdded};

    # you can guess what this line does...
    $self->print_lig_labels();

    # output to screen and a normal printer the ligations added
    print "\nLigations added:\n";

    if( scalar(keys %{$hash}) == 0 ){
        print "  None.\n";
    }
    else {
        open FILE, ">/tmp/$self->{PrealUserName}_print_ligs" 
            or die "could not open print file\n";

        print FILE "Ligations added by $self->{realUserName}\n\n";

        foreach my $lig ( sort keys %{$hash} ){
            my $clone = $self->{clone_for_job}->{$hash->{$lig}};
            my $s     = "  Ligation $lig added for job $hash->{$lig}, ".
                        "clone $clone\n";
            print FILE $s;
            print $s;
        }

        close FILE;

        `lpr /tmp/$self->{PrealUserName}_print_ligs`;

        unlink "/tmp/$self->{PrealUserName}_print_ligs"
            or print "Could not delete tmp print file!\n";


        LemurUtils->showInfo($self->{mw},
                             "Please collect you labels and printout ".
                             "from the printers");
    }

    print "\n";
    $self->disconnect;
    $self->hide();
}

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

    $self->{mw}->deiconify();
}

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

    $self->{mw}->withdraw();
}

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

    $self->{dbi}->disconnect if $self->{dbi};
    $self->{dbi} = undef;
}


################################################################################
#
################################################################################

sub createBatchFrame {

    my ($self, $bF) = @_;

    # Vector
    my $vector_enzyme_list = $self->getVectorList();

    $bF->Label(
	       -text   => 'Vector', 
	       -anchor => 'w'
	       )->grid(-row    => 1,
		       -column => 1,
		       -sticky => 'nw');

    my $v =
	$bF->BrowseEntry(-width     => 18,
			 -relief    => 'sunken',
			 -variable  => \$self->{pickedVector},
			 -choices   => $vector_enzyme_list,
			 -state     => 'readonly',
			 -browsecmd => sub {
			     shift;
			     $self->getLigBatchNow( shift );
			 },
			 )->grid(-row    => 1, 
				 -column => 2, 
				 -sticky => 'nw');

    $self->{balloon}->attach($v,
			     -balloonmsg => "The vector the ligation(s) are in",
			     );

    # Batch ID - only show if entering details for an old batch.

    unless( $self->{newBatch} ) {
	$bF->Label(
		   -text   => ' Batch ID', 
		   )->grid(-row    => 2,
			   -column => 1,
			   -sticky => 'nw');

	$self->{batchIDWidget} = 
	    $bF->BrowseEntry(-width     => 10,
			     -relief    => 'sunken',
			     -variable  => #\$self->{pickedBatchID},
			         \$self->{ligBatch},
			     -browsecmd => sub {
				 shift;
				 $self->{id_ligbatch}->{$self->{pickedVector}} =
				     shift;
			     },
			     )->grid(-row    => 2, 
				     -column => 2, 
				     -sticky => 'nw');
    }
    else {
	$bF->Label(-text  => 'Batch No. ',
		   )->grid(-row    => 2,
			   -column => 1,);
	$bF->Label(#-width        => 8,
		   -textvariable => \$self->{batchNumberToSee},
		   )->grid(-row    => 2,
			   -column => 2,);
    }
}


################################################################################
# createCloneFrame
#
# Arguments;
#           cloneF  - Frame to put gadgets in
################################################################################

sub createCloneFrame {

    my ($self, $cloneF) = @_;
    my $cf = $cloneF->Frame(-relief => 'groove', -borderwidth => 3);

    # Search gadgets.
    $cf->Label(-width  => 13,
	       -text   => 'Request Num.',
	       -anchor => 'w'
	       )->grid(-row    => 1,
		       -column => 1,);

    $self->{requestWidget} =
	$cf->BrowseEntry(-width     => 18,
			 -relief    => 'sunken',
			 -variable  => \$self->{requestValue},
			 )->grid(-row    => 1,
				 -column => 2,
				 -sticky => 'nw');

    $self->{requestWidget}->bind('<KeyPress-Return>', sub {
				 $self->searchForRequest($self->{requestValue});
			     });
    $self->{requestWidget}->bind('<KeyPress-Tab>', sub {
				 $self->searchForRequest($self->{requestValue});
			     });


    # grid centres the frame in the middle of the page, pack() does not...
    $cf->grid(-row    => 1,
	      -column => 1,
	      -pady   => 5,
	      -ipady  => 10);
}


################################################################################
# createExperimentFrame
#
# Arguments;
#           experimentF  - Frame to put gadgets in
################################################################################

sub createExperimentFrame {

    my ($self, $experimentF) = @_;
    my $temp;  # ASSIGNED BrowseEntry WIDGETS SO CAN DO INSERTS

    my $ef = $experimentF->Frame(-relief => 'groove', -borderwidth => '3');

    # Frag method

    $ef->Label (#-width  => 16,
		-height => 1,
		-text   => 'Fragmentation',
		-anchor => 'w'
		)->grid(-row    => 2,
			-column => 1,
			-sticky => 'nw');

    $ef->BrowseEntry(-variable  => \$self->{fragMethod},
		     -width     => 18,
		     -state     => 'readonly',
#		     -browsecmd => sub {
#			 $self->changeFragMethod;
#		     },
		     -choices   => [keys %fragMethodHash]
		     )->grid(-row    => 2,
			     -column => 2,
			     -sticky => 'nw');

    if( $fragMethodHash{Sonication} ) {
	$self->{fragMethod} = 'Sonication';  # default frag method
    }

    # Recovery Method
    $ef->Label (# -width  => 16,
		-text   => 'Recovery',
		-anchor => 'w'
		)->grid(-row    => 3,
			-column => 1,
			-sticky => 'nw');

    $ef->BrowseEntry(-variable  =>  \$self->{recoveryMethod},
		     -width     => 18,
		     -state     => 'readonly',
		     -choices   => [keys %recoveryMethodHash]
		     )->grid(-row    => 3,
			     -column => 2,
			     -sticky => 'nw');

    if( $recoveryMethodHash{"Agarace and Phenol"} ) {
	$self->{recoveryMethod} = "Agarace and Phenol"; #default recovery method
    }

    # was Restriction Disgest / Enzyme at  ** 4,2 **

    # Operator
    $ef->Label (# -width  => 16,
		-text   => 'Operator', 
		-anchor => 'w'
		)->grid(-row    => 5,
			-column => 1,
			-sticky => 'nw');

    $temp = $ef->BrowseEntry(-variable  => \$self->{operator},
			     -width     => 18,
			     -state     => 'readonly',
			     -choices   => [sort keys %{$self->{operatorHash}}],
			     )->grid(-row    => 5,
				     -column => 2);

    # Date Done. Get todays date from localtime and put into dd/mm/yyyy format
    $self->{dateDone} =  (localtime)[3]."/".
	                ((localtime)[4] + 1)."/".
	                ((localtime)[5] + 1900);

    $ef->Label (# -width  => 16,
		-text   => 'Date Done',
		-anchor => 'w'
		)->grid(-row    => 6,
			-column => 1,
			-sticky => 'nw');

    my $e = $ef->Entry(-width        => 17,
		       -relief       => 'sunken',
		       -bg           => 'lemonchiffon2',
		       -textvariable => \$self->{dateDone},
		       )->grid(-row    => 6,
			       -column => 2,
			       -padx   => 6,
			       -sticky => 'nw');

    $e->bind('<KeyPress-Return>', \ sub { 
	$self->isGoodDateEntered;
    } );

    $ef->grid(-row    => 1,
	      -column => 1,
	      -pady   => 5,
	      -ipady  => 10);
}


################################################################################
# createBandsFrame
#
# Arguments;
#           bandsF  - Frame to put gadgets in
################################################################################

sub createBandsFrame {

    my ($self, $bandsF)   = @_;
    my $variableBandSizeF = $bandsF->Frame(-relief => 'groove',
					   -borderwidth => '3');
    my $gadget;

    $self->{variableBandUsed} = 0;

    # @fromToArray is a 2D array for the Entry gadgets. Starts at [1][0]
    # for row 1, not [0][0].

    my @fromToArray;
    $self->{variableBandsArray} = \@fromToArray;

    $variableBandSizeF->Label (-width  => 5,
			       -text   => 'From',
			       -anchor => 'w',
			       )->grid(-row    => 0,
				       -column => 2,);

    $variableBandSizeF->Label (-width  => 5,
			       -text   => ' To ',
			       )->grid(-row    => 0,
				       -column => 3);
    # FRAGMENT_BAND records

#    $fromToArray[1][0] = "1.4";
#    $fromToArray[1][1] = "2";

    $variableBandSizeF->Label (-width  => 14,
			       -text   => "Band 1",
			       -anchor => 'w',
			       )->grid(-row    => 1,
				       -column => 1,
				       -sticky => 'nw');

    $gadget = $variableBandSizeF->Entry(-width    => 5,
					-relief   => 'sunken',
					-bg       => 'lemonchiffon2',
					-textvariable => \$fromToArray[1][0],
					)->grid(-row    => 1,
						-column => 2,
						-sticky => 'nw');

    $gadget = $variableBandSizeF->Entry(-width    => 5,
					-relief   => 'sunken',
					-bg       => 'lemonchiffon2',
					-textvariable => \$fromToArray[1][1],
					)->grid(-row    => 1,
						-column => 3,
						-sticky => 'nw',
						-padx   => 6);

    $variableBandSizeF->Label(-text => 'Kb')->grid(-row    => 1,
						   -column => 4,
						   -sticky => 'nw');
    # DUMMY label
    $variableBandSizeF->Label()->grid(-row    => 5,
				      -column => 1,
				      -sticky => 'nw');

    # Slice Box Num - user may not store a slice 

#    $variableBandSizeF->Label (# -width  => 13,
#			       -text   => 'Slice Box',
#			       -anchor => 'nw'
#			       )->grid(-row    => 6,
#				       -column => 1,
#				       -sticky => 'nw');

#    $variableBandSizeF->Entry(-width    => 12,
#			      -relief   => 'sunken',
#			      -bg       => 'lemonchiffon2',
#			      )->grid(-row    => 6,
#				      -column => 2,
#				      -sticky => 'nw',
#				      -columnspan => 2);

    $variableBandSizeF->Label (# -width  => 13,
			       -text   => 'Frag Box',
			       -anchor => 'nw'
			       )->grid(-row    => 7,
				       -column => 1,
				       -sticky => 'nw');

    $variableBandSizeF->Entry(-width        => 12,
			      -relief       => 'sunken',
			      -textvariable => \$self->{fragBox},
			      )->grid(-row    => 7,
				      -column => 2,
				      -sticky => 'nw',
				      -columnspan => 2);

    $variableBandSizeF->grid(-row    => 1,
			     -column => 1,
			     -pady   => 5,
			     -ipady  => 10);
}


################################################################################
# createLigationFrame
#
# Arguments;
#           ligationF  - Frame to put gadgets in
################################################################################

sub createLigationFrame {

    my ($self, $ligationF) = @_;
    my @refsToPages;

    my $lf = $ligationF->Frame(-relief      => 'groove',
			       -borderwidth => 3);

    # ligation number
	
#    $lf->Label(-width  => 16,
#	       -text   => 'Ligation Number',
#	       -anchor => 'nw'
#	       )->grid(-row    => 3,  
#		       -column => 0 ,
#		       -sticky => 'nw');

#    $lf->Entry(-width        => 11,
#	       -relief       => 'sunken',
#	       -bg           => 'lemonchiffon2',
#	       -textvariable => \$self->{ligNum},
#	       )->grid(-row    => 3,  
#		       -column => 1,
#		       -sticky => 'nw');

    # Ligation Prefix used to go here, hence widget at  4, 1  missing


    # volume used
    $lf->Label (-width  => 16,
		-text   => 'Fragment Volume', 
		-anchor => 'nw'
		)->grid(-row => 5,  
			-column => 0, 
			    -sticky => 'nw');
    $lf->Entry(-width        => 20,
	       -relief       => 'sunken',
	       -bg           => 'lemonchiffon2',
	       -textvariable => \$self->{volumeUsed}
	       )->grid(-row    => 5,  
		       -column => 1,);

    # Clear/Positive
    $lf->Label (-width    => 16,
		-text     => 'Clear/Positive', 
		-anchor => 'nw'
		)->grid(-row    => 6,  
			-column => 0, 
			-sticky => 'nw');

    $lf->Entry(-width        => 20,
	       -relief       => 'sunken',
	       -bg           => 'lemonchiffon2',
	       -textvariable => \$self->{clear},
	       )->grid(-row    => 6, 
		       -column => 1, );
    
    $self->{clear} = -1;

    # Blue/Negative
    $lf->Label (-width  => 16,
		-text   => 'Blue/Negative',
		-anchor => 'nw'
		)->grid(-row    => 7,  
			-column => 0, 
			-sticky => 'nw');

    $lf->Entry(-width         => 20,
	       -relief        => 'sunken',
	       -bg            => 'lemonchiffon2',
	       -textvariable  => \$self->{blue},
	       )->grid(-row     => 7, 
		       -column  => 1, );

    $self->{blue} = -1;

    # Ligation Box num
    $lf->Label (-width  => 16,
		-text   => 'Ligation Box Num ',
		-anchor => 'nw'
		)->grid(-row    => 9,  
			-column => 0, 
			-sticky => 'nw');

    $lf->Entry(-width    => 20,
	       -relief   => 'sunken',
#	       -bg       => 'lemonchiffon2',
	       -textvariable => \$self->{ligBoxNum},
	       )->grid(-row    => 9, 
		       -column => 1, );

    $lf->pack(-side => 'bottom', -padx => 10, -pady => 5);  # ligation frame

    return;
}


################################################################################
# try to be nice to the sub-cloners who always do M13 and pUC's - put
# these 2 vectors at the top of the list (if the exist).
################################################################################

sub getVectorList {
    my ($self)         = @_;
    my (@vector_list)  = sort keys %{$self->{vectorsWithEnzymes}};

    my $x = 0;

    foreach (@vector_list) {
	if( $_ eq 'm13mp18 (SmaI)' ) {
	    my $temp = splice(@vector_list, $x, 1);
	    unshift(@vector_list, $temp);
	    last;
	}
	++$x;
    }

    $x = 0;

    foreach (@vector_list) {
	if( $_ eq 'puc18 (SmaI)' ) {
	    my $temp = splice(@vector_list, $x, 1);
	    unshift(@vector_list, $temp);
	    last;
	}
	++$x;
    }

    return \@vector_list;
}


################################################################################
# connects to DB and handles any errors. Calls various subroutines to setup
# hash tables with data from dictionaries.
################################################################################

sub setupHashTables {
    my ($self) = @_;
    my ($dbh)  = $self->{dbi};

    eval {
	unless ($dbh) {
	    $dbh         = WrapDBI->connect($self->{dbUser}, {RaiseError => 1});
	    $self->{dbi} = $dbh;
	}

	if( !defined $dbh ) {
	    $self->{dbi} = '';
	    $self->expire("Could not connect to database") ;
	}

	$dbh->{AutoCommit} = 0;

	$self->getRecoveryMethods($dbh);
	$self->getFragMethods    ($dbh);
	$self->getOperators      ($dbh);
	$self->getVectors        ($dbh);
	$self->getLigBatches     ($dbh);
	$self->getVectorsWithEnzymes($dbh);
    };

    if ($@) {
	$self->expire("$@ : Occured in setupHashtables()");
    }
}


################################################################################
# setup  '%recoveryMethodHash'
################################################################################

sub getRecoveryMethods {
    my ($self, $dbh, $args) = @_;
    my ($arrayOfArrays, $arrayRef);

    $arrayOfArrays = $dbh->fetch_all(
        "select ID_DICT, DESCRIPTION
         from   FragRecoveryDict");

    foreach $arrayRef (@$arrayOfArrays) {
	$recoveryMethodHash{@$arrayRef[1]} = @$arrayRef[0];
    }
}


################################################################################
# setup '%fragMethodHash'
#        %FragSizeDict      (hash to a list)
################################################################################

sub getFragMethods {
    my ($self, $dbh, $args) = @_;
    my ($arrayOfArrays, $arrayRef);;

    $arrayOfArrays = $dbh->fetch_all(
        "select ID_DICT, DESCRIPTION
         from   FragMethodDict");

    foreach $arrayRef (@$arrayOfArrays) {
	$fragMethodHash{@$arrayRef[1]} = @$arrayRef[0];
    }

    foreach my $method (keys %fragMethodHash) {
	my @temp;

	$arrayOfArrays = $dbh->fetch_all(
	    "select SIZE_FROM_KB, SIZE_TO_KB
             from   FragSizeDict
             where  ID_FragMethod = $fragMethodHash{$method}");

	foreach my $row (@$arrayOfArrays) {
	    push @temp, "@$row[0] - @$row[1]";
	}

	$fragSizeHash{$method} = \@temp;
    }
}


################################################################################
# setup operator hash
# if the users name matches the email address of someone in this team
# it sets the operator value to that person.
################################################################################

sub getOperators {
    my ($self, $dbh) = @_;
    my ($arrayOfArrays, $arrayRef);

    $arrayOfArrays = $dbh->fetch_all(
         "select TEAM_PERSON_ROLE.ID_ROLE, 
                 PERSON.FORENAME, PERSON.SURNAME, PERSON.EMAIL
          from   PERSON, TEAM_PERSON_ROLE
          where  TEAM_PERSON_ROLE.ID_PERSON = PERSON.ID_PERSON
          and    TEAM_PERSON_ROLE.ROLETYPE  = 'Subcloning'
          and    TEAM_PERSON_ROLE.ISCURRENT = 1"); 
 
    foreach $arrayRef (@$arrayOfArrays) {

	my $fullName = @$arrayRef[1]." ".@$arrayRef[2];
	$self->{operatorHash}->{$fullName} = @$arrayRef[0];

	$self->{email_id_of}->{$fullName} = @$arrayRef[3];

	if($self->{realUserName} eq @$arrayRef[3]) {
	    $self->{operator} = @$arrayRef[1]." ".@$arrayRef[2];
	}
    }
}


################################################################################
# setup %vectorHash
################################################################################

sub getVectors {
    my ($self, $dbh) = @_;
    my ($arrayOfArrays, $arrayRef);
    my ($arrayOfArraysLigNum, $arrayRefLigNum);
    my %vectors;

    $arrayOfArrays = $dbh->fetch_all(
         "select VECTORNAME
          from   VECTOR"); 
 
    foreach $arrayRef (@$arrayOfArrays) {

	$arrayOfArraysLigNum = $dbh->fetch_all("
           select ID_LIGBATCH
           from   LIGATION_BATCH, VECTORSITE
           where  SEQ_VECTOR            = ID_VECTORSITE
           and    VECTORSITE.VECTORNAME = '@$arrayRef[0]'"); 

	my @ligNumArray;

	foreach $arrayRefLigNum (@$arrayOfArraysLigNum) {
	    push @ligNumArray, @$arrayRefLigNum[0];
	}

	$vectors{@$arrayRef[0]} = \@ligNumArray;
    }

    $self->{vectors} = \%vectors;
}

################################################################################
# setup $self->{vectorsWithEnzymes} hash table.
# only gets the vectors with entries in the VECTORSITE_ENZYME table
#
# glues vector name to enzyme, which becomes then lookups return the 
# ID_VECTORSITE e.g.
#
#    $self->{vectorsWithEnzymes}->{"puc18 (HindIII)"  => 1,
#                                  "mp13mp18 (BamHI)" => 2}
#
################################################################################

sub getVectorsWithEnzymes {

    my ($self, $dbh) = @_;
    my ($arrayOfArrays, $arrayRef);
    my %vectors;
    my ($arrayOfArraysLigNum, $fetchRef, $arrayRefLigNum);

    $arrayOfArrays = $dbh->fetch_all("
        select v.VECTORNAME, ve.ENZYMENAME, v.ID_VECTORSITE
        from   VECTORSITE v, VECTORSITE_ENZYME ve
        where  v.ID_VECTORSITE = ve.ID_VECTORSITE");

    my $ligh = $dbh->prepare(q[ select ID_LIGBATCH
                                from   LIGATION_BATCH
                                where  SEQ_VECTOR =  ?
				order by ID_LIGBATCH]);
 
    foreach $arrayRef (@$arrayOfArrays) {

	$ligh->execute($arrayRef->[2]);
	$fetchRef = $ligh->fetch();

	my @ligNumArray;

	while( $fetchRef ) {
	    push @ligNumArray, $fetchRef->[0];
	    $fetchRef = $ligh->fetch();
	}

	my $name = "$arrayRef->[0] ($arrayRef->[1])";

	$vectors{$name}->{ID_VECTORSITE} = $arrayRef->[2];
	$vectors{$name}->{ligations}     = \@ligNumArray;
    }

    $self->{vectorsWithEnzymes} = \%vectors;
}

################################################################################
# bound to <return> or <tab> when user enters Request Num.
# updated so if request number is for a Oligo Screening or Clone PCR it will
# ask the user if the job is done. There are no ligations for these types of 
# jobs
################################################################################

sub searchForRequest {
    my ($self, $reqNum) = @_;
    my ($dbh)           = $self->{dbi};
    my $arrayOfArrays;
    my @row;
    my $return = 0; # if set, will not drop down search box

    LemurUtils->setWait([$self->{mw}]);

    eval {
	unless( $dbh ) {
	    $dbh         = WrapDBI->connect($self->{dbUser}, {RaiseError => 1});
	    $self->{dbi} = $dbh;
	}

	if( !defined $dbh ) {
	    $self->{dbi} = '';
	    $self->expire("Could not connect to database");
	}

	$dbh->{AutoCommit} = 0;

	$arrayOfArrays = $dbh->fetch_all("
            select ID_REQUEST, SIL_TYPE
            from   SIL_REQUEST
            where  ID_REQUEST like '%$reqNum%'
            order by ID_REQUEST");

	@row = $dbh->fetch_row("
            select ID_REQUEST, SIL_TYPE
            from   SIL_REQUEST
            where  ID_REQUEST = '$reqNum'
            order by ID_REQUEST");

        warn "request num, sil type:  ", join(', ', @row), "\n" if $debug;

        # see if this is a job type that has no ligations
        if( scalar(@row) > 0 ){
            if( $row[1] == 4 || $row[1] == 7 ){
                my $job_type = $dbh->fetch_scalar(qq[
                                                     select DESCRIPTION
                                                     from   SILTYPEDICT
                                                     where  ID_DICT = $row[1]
                                                     ]);
                my $answer   = LemurUtils->yesNo($self->{mw},
                                                 "This job was a $job_type. ".
                                                 "Has it been completed?");
                if( $answer eq 'Yes' ){
                    $self->setJobToCompleted($row[0], $dbh);
                    $return = 1;
                }
                else {
                    $return = 1;
                }
            }
        }
    };

    LemurUtils->showError($self->{mw}, "$@") if $@;

    # don't drop down window wi job numbers, just leave it be.
    if( $return == 1 ){
        LemurUtils->unSetWait([$self->{mw}]);
        $self->{requestWidget}->BtnDown if ($self->{requestWidget}->{"popped"});

        return;
    }

    $self->{requestWidget}->delete(0, 'end');

    foreach my $array (@{$arrayOfArrays}) {
	$self->{requestWidget}->insert('end',
				       $array->[0]);
    }

    # display the drop down window. 
    # Note: BtnDown is not a 'public' method. MAY NOT WORK in future
    # versions but v. nice to have.

    $self->{requestWidget}->BtnDown if ($self->{requestWidget}->{"popped"});
    $self->{requestWidget}->BtnDown;

    LemurUtils->unSetWait([$self->{mw}]);
}

sub setJobToCompleted {
    my ($self, $id_request, $dbh) = @_;

    warn "setting job $id_request to done.\n" if $debug;

    $dbh->do(qq[
                update SILREQUEST_STATUS
                set    ISCURRENT  = 0
                where  ID_REQUEST = $id_request
                ]);

    $dbh->do(qq[
                insert into SILREQUEST_STATUS
                values ($id_request,
                        3,
                        SYSDATE,
                        1,
                        $self->{session_id},
                        'LemurEnterBatchJob',
                        '$self->{realUserName}')
                ]);
    $dbh->commit();
}

sub isGoodRequestNumber {
    my ($self, $reqNum, $dbh) = @_;

    my $count;

    $count = $dbh->fetch_scalar("
            select count(*)
            from   SIL_REQUEST
            where  ID_REQUEST = $reqNum");

    return $count;
}

###############################################################################
# Callback on Frag Method Optionmenu. The fragmentation method used 
# determines the sizes of the fragments that are obtained.
#
# $self->{fragmethod} is the global textvariable for the frag method 
# Optionmenu.
#
###############################################################################

sub changeFragMethod {
    my ($self) = @_;
    my @list;

warn "\n" if $debug;

    @list = @{$fragSizeHash{$self->{fragMethod}}};
    my $fromToArray = $self->{variableBandsArray};



    foreach my $x (0..3) {
	$list[$x] =~ /^(\d+\.?\d*|\.\d+) - (\d+\.?\d*|\.\d+)$/;
	my $from = $1;
	my $to   = $2;

warn "changeFragMethod :: $list[$x]  :: $from - $to\n" if $debug;

	$fromToArray->[$x+1][0] = $from;
	$fromToArray->[$x+1][1] = $to;
    }

    if( $self->{fragMethod}    eq 'Sonication' ) {
        $self->{variableBandUsed} = 2;
    }
    elsif( $self->{fragMethod} eq 'Needle-shear' ) {
        $self->{variableBandUsed} = 2;
    }
    else {
	$self->{variableBandUsed} = 0;
    }
}


################################################################################
# if isGoodDate returns 0, tells user date is bad.
################################################################################

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

    unless( $self->isGoodDate($self->{dateDone}) ) {
 
	if( ! ( $self->{dateDone} =~ m|(\d{1,2})/(\d{1,2})/(\d{4})$|) ) {
	    LemurUtils->showError($self->{mw},
				  "Date is not valid. Is it in dd/mm/yyyy ".
				  "format?");
	}else {
	    LemurUtils->showError($self->{mw}, "Date is not valid.");
	}

	return 0;
    }

    return 1;
}

################################################################################
# is Good Date
#
# 1. check format is correct dd/mm/yyyy
# 2. check year > 1999
# 3. get num days for month from hash. If not in hash, invalid.
#    Feb is a specail case, check for leaps years etc.
#
# RETURNS:  1 if date is good, 0 otherwise.
################################################################################

sub isGoodDate {
    my ($self, $date) = @_;
    my $dateOK        = 1;

    if( $date =~ m|(\d{1,2})/(\d{1,2})/(\d{4})$| ) {

	my $day   = $1;
	my $month = $2;
	my $year  = $3;

	# check year

	if($year < 1999) { # year this program was first written
	    $dateOK = 0;
	}else {

	    # check month/days in month

	    my @month30  = [9, 4, 6, 11];
	    my @month31  = [1, 3, 5, 7, 8, 10, 12];
	    my @monthFeb = [2];

	    my %monthHash = (1  => 31,  #
			     3  => 31,  # feb specail case.
			     4  => 30,
			     5  => 31,
			     6  => 30,
			     7  => 31,
			     8  => 31,
			     9  => 30,
			     10 => 31,
			     11 => 30,
			     12 => 31);

	    if( $month == 2 ) {
		# feb specail case, leaps years etc.

		my $feb = 28;

		if( ($year % 400) == 0) {
		    # year 2000 or this program has lasted bloody well.
		    $feb = 29;
		}elsif( ($year % 4) == 0) {
		    $feb = 29;
		}else{
		    $feb = 28;
		}

		if( $day > $feb ) {
		    $dateOK = 0;
		}

	    }else {
		my $maxDays = $monthHash{$month};
		
		if($maxDays == undef() || $day > $maxDays) {
		    $dateOK = 0;
		}
	    }
	}
    } else {
	$dateOK = 0;
    }

    return $dateOK;
}


################################################################################
# 
################################################################################

sub pickedVector {
    my ($self, $selected) = @_;

    return  if( $self->{vectorPicked} eq $selected );

    $self->{vectorPicked} = $selected;

    $self->getLigBatchNow($selected);
}


################################################################################
# setup $self->{vectors}->{myVectorName}->[array of batch numbers]
#
# Loop through doing SQL for each vector.
# Store batch numbers for each one in an array. Use array as the value with
# the key as the vector name
################################################################################

sub getLigBatches {
    my ($self) = @_;
    my ($arrayOfArrays, $arrayRef);


    my ($dbh) = $self->{dbi};

    eval {
	unless( $dbh ) {
	    $dbh         = WrapDBI->connect($self->{dbUser}, {RaiseError => 1});
	    $self->{dbi} = $dbh;
	}

	if( !defined $dbh ) {
	    $self->{dbi} = '';
	    $self->expire("Could not connect to database") if !defined $dbh;
	}
	$dbh->{AutoCommit} = 0;

	# loop for each vector name

	foreach my $vectorName (keys %{$self->{vectors}}) {

	    $arrayOfArrays = $dbh->fetch_all("
                select ID_LIGBATCH
                from   LIGATION_BATCH lb, VECTORSITE vs
                where  lb.SEQ_VECTOR        = vs.ID_VECTORSITE
                and    lower(vs.VECTORNAME) = lower('$vectorName')");

	    # loop for each row retrieved for $vectorName, add to array

	    my $x = 0;
	    my (@ligBatches);

	    foreach $arrayRef (@$arrayOfArrays) {
		$ligBatches[$x] = $arrayRef->[0];
		++$x;
	    }

	    $self->{vectors}->{$vectorName} = \@ligBatches;
	}
    };
    
    if($@) {
	$self->expire("$@");
    }
}


################################################################################
# Get the array reference holding the possible batch numbers for this ligation.
# Give this to the browse entry widget as the list of choices. The array can
# be empty.
################################################################################

sub getLigBatchNow {
    my ($self, $selection) = @_;
    my $arrayRef;

    unless($self->{batchIDWidget} ) {

	$self->{batchNumberToSee} = 
	    $self->{id_ligbatch}->{$self->{pickedVector}};
    }

    return unless($self->{batchIDWidget}); # Entering new Batch ID, no widget.

    $arrayRef = $self->{vectorsWithEnzymes}->{$selection}->{ligations};

    $self->{batchIDWidget}->configure(-choices => $arrayRef);
    $self->{ligBatch} = '';
}


################################################################################
# just gets the next number in the sequence for the LIGATION_BATCH table.
################################################################################

sub getNewLigationBatchNumber {
    my ($self) = @_;
    my ($id_ligation_batch);

    my ($dbh) = $self->{dbi};

    eval {
	unless( $dbh ) {
	    $dbh = WrapDBI->connect($self->{dbUser}, {RaiseError => 1});
	    $self->{dbi} = $dbh;
	}

	if( !defined $dbh ) {
	    $self->{dbi} = '';
	    $self->expire("Could not connect to database");
	}

	$dbh->{AutoCommit} = 0;

	$id_ligation_batch = $dbh->fetch_scalar("
             select seq_ligbatch.nextval
             from   dual");
    };
    
    if($@) {
	$dbh->rollback if $dbh;
	$self->expire("$@");
    }

    # display number to user
    my $selected = $self->{chooseVector}->info('selection');

    LemurUtils->showInfo($self->{mw},
			 "The new Batch number for $selected is\n ".
			 "$id_ligation_batch");

    # add number to BrowseEntry widget.
    $self->{ligBatchWidget}->insert('end', "$id_ligation_batch");
    $self->{ligBatch} = $id_ligation_batch;
}


################################################################################
# if the value isn't supplied it defaults to zero.
################################################################################

sub setupProgressMeter {
    my ($self, $from, $to) = @_;

 return;

    $self->{wd} = 
	$self->{mw}->WaitBox(-title => 'Please wait...',
			     -cancelroutine => sub {
				 ################################
				 # Need to stop things gracefully
				 ################################
				 $self->{wd}->unShow;
			     }
			     );
	
    $self->{wd}->wm('minsize', 400, 80);
    $self->{wd}->wm('maxsize', 400, 80);
    my $f = $self->{wd}->Frame(-height => 80, -width => 400);
    $f->pack();
    $self->{wd}->withdraw;
    $self->{mw}->idletasks();
    $self->{wd}->packPropagate(0);
    $f->packForget();
    $self->{wd}->configure(-txt1 => "Checking data...");

    $self->{u} = $self->{wd}->Frame()->pack(side => 'top', fill => 'x');
    #$u->Label(-textvariable => \$utxt)->pack(-expand => 1, -fill => 'both');

    $self->{base} = $self->{u}->Frame(-background  =>'gray',
				      -relief      => 'sunken',
				      -borderwidth => 2,
				      -height      => 20
				      )->pack(-side   => 'left',
					      -anchor => 'w',
					      -expand => 1,
					      -fill   => 'both');

    $self->{bar} = $self->{base}->Frame(-borderwidth => 2,
					-relief      => 'raised',
					-height      => 20,
					-width       => 0,
					-background  => 'lemonchiffon2'
					)->pack(-fill => 'y',
						-side => 'left');

    $self->{wd}->configure(-canceltext => 'Cancel plot'); # default is 'Cancel'

    $self->{scale_value} = 0;

    $self->{wd}->Show();
}

#
# if the value isn't supplied it defaults to ten
#

sub incProgressMeter {
    my ($self, $value) = @_;

return;

    unless( $value ) {
	$self->{scale_value} += 7;
    }
    else {
	$self->{scale_value} += $value;
    }

    $self->{bar}->configure(-width => $self->{scale_value} );

    my $old_width = $self->{base}->Width;

    # 100 could be the number of times this would be called....
    # arbitary number now

warn "\n*** incProgressMeter $self->{scale_value} / 100 * $old_width ***\n\n";

    my $new_width = int($self->{scale_value} / 100 * $old_width);
    $self->{bar}->configure(-width => $new_width );

    $self->{mw}->update('idletasks');
}

#
#
#

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

return;

    $self->{wd}->unShow();
}



################################################################################
# basically do a commit if createRecords returns true
################################################################################

sub okPressed {
    my ($self)       = @_;
    my $everythingOk = 1;

    $self->setupProgressMeter(1, 100);

    my ($dbh) = $self->{dbi};

    eval {
	unless( $dbh ){
	    $dbh         = WrapDBI->connect($self->{dbUser}, {RaiseError => 1});
	    $self->{dbi} = $dbh;
	}

	if( !defined $dbh ){
	    $self->{dbi} = '';
	    $self->expire("Could not connect to database");
	}

	$dbh->{AutoCommit} = 0;

	if( $self->createRecords($dbh) ) {
	    warn "dbh         == $dbh\n"         if $debug;
	    warn "self->{dbi} == $self->{dbi}\n" if $debug;
	    warn "\n"                            if $debug;

#	    if( $self->writeToEquus($dbh) ) {
            if( 1 ){ # take this away when everything works - added 8 Sept 2000
		$dbh->commit();
		warn "done Oracle commit\n" if $debug;
	    }
	    else {
		$dbh->rollback();
		$everythingOk = 0;
		warn "done Oracle rollback\n" if $debug;
	    }
	}
	else {
	    $dbh->rollback();
	    $everythingOk = 0;
	    warn "Oracle rollback done.\n" if $debug;
	}
    };

    $self->expire("$@") if( $@ ) ;
   
    $dbh->disconnect if $dbh;
    $self->{dbi}  = '';

    $self->hideProgressMeter();




    # tell users lig number. ($self->{ligNum})
    # cache lib numbers against request num + clone

    # when press done, print out nice sheet for them?

    if( $everythingOk ){
        print "Ligation $self->{ligNum} added for request ".
              "$self->{requestValue}\n";

	LemurUtils->showInfo($self->{mw},
			     "For Request $self->{requestValue}, ligation ".
			     "\n\n".
			     "$self->{ligNum}\n\n".
			     "has been added.");
	$self->{ligNumsAdded}->{$self->{ligNum}} = $self->{requestValue};
    }

    return $everythingOk;
}


#
# gets clone name from SIL_DNASOURCE via SIL_REQUEST.ID_REQUEST and uses that
# to work out the project name.
#

sub gullAdd {
    my ($self, $dbh) = @_;
    # need to get the project name for this clone for gullAdd

    my $goodGullMsg = "New current status for project";
    my $requestNum  = $self->{requestValue};
    my $ligationNum = $self->{ligNum};

    my $cloneName   = $dbh->fetch_scalar("
        select CLONENAME
        from   SIL_DNASOURCE, SIL_REQUEST
        where  SIL_REQUEST.ID_REQUEST = $requestNum
        and    SIL_REQUEST.ID_SOURCE  = SIL_DNASOURCE.ID_SOURCE");

    my $pName = $dbh->fetch_scalar("
                select PROJECTNAME
                from   PROJECT
                where  PROJECTNAME = '$cloneName'");

    if( $pName eq '' ) {
	my $projects = $dbh->fetch_all("
                    select PROJECTNAME
                    from   CLONE_PROJECT
                    where  CLONENAME = '$cloneName'");

	if( scalar(@{$projects}) == 0 ) {
	    LemurUtils->showError($self->{mw},
				  "$cloneName does not belong to a ".
				  "project. Please contact bug");
	}
	elsif( scalar(@{$projects}) > 1 ) {
	    LemurUtils->showError($self->{mw},
				  "'$cloneName' belongs to more than 1 ".
				  "project and no project called ".
				  "'$cloneName' exists. Please use Gull to ".
				  "set the correct project");
	}
	else {
	    $pName = $projects->[0]->[0];
	}
    }

    unless( $pName eq '' ) {		
	my $returnMsg =
	    `gullAdd -type project -name $pName -status 'Library made'`;

	unless( $returnMsg =~ $goodGullMsg ) {
	    LemurUtils->showError($self->{mw}, "GullAdd returned: $returnMsg");
		    
	  Mail::sendMail( -to      => 'pjm',
			  -subject => "LemurEnterBatchOfJobs: gullAdd ".
			              "problem.", 
			  -message => "$returnMsg \n".
			              "clone = $cloneName, project = $pName");
	}
    }
}


################################################################################
# The next button does the same as the OK button but does not hide the 
# window. It clears the contents, ready for the next clone.
################################################################################

sub nextPressed {

    my ($self)    = @_;

    LemurUtils->setWait([$self->{mw}]);

    if( $self->okPressed() ) {

	warn "okPressed() returned TRUE value\n" if $debug;

	# If got to here, data entered by user was good. 
        # Records in DB have been created.

	$self->{DNAPrepNum}   = '';
	$self->{ligNum}       = undef;
	$self->{requestValue} = undef;

	$self->{volumeUsed}   = undef;
	$self->{ligBoxNum}    = undef;

	$self->{clear}        = -1;
	$self->{blue}         = -1;
    }

    LemurUtils->unSetWait([$self->{mw}]);
}


################################################################################
# Need to validate input from user. If ok, save away to Oracle.
#
# Returns;
#         0 - if bad data
#         1 - if good data.
################################################################################

sub createRecords {
    my ($self, $dbh) = @_;
    
    my $reqNum    = $self->{requestValue};
    my $dataOK    = 1;        # boolean. If ever set to 0, some data is invalid.
    my $mustEnter = "You must enter ";

    # if they haven't even choosen a Vector, show error and return

    unless( $self->{pickedVector} ) {
	LemurUtils->showError($self->{mw}, "You must choose a Vector.");
	return 0;
    }

    if( $reqNum eq '' ) {
	$mustEnter .= "a Request number, ";
	$dataOK     = 0;
    }
    elsif( ! $self->isGoodRequestNumber($reqNum, $dbh) ) {
	LemurUtils->showError($self->{mw},
			      "The request '$reqNum' does not exist in ".
			      "the database.");
	$dataOK = 0;
    }

    # report if Date Done ok or not.
    unless( $self->isGoodDate($self->{dateDone}) ) {
	$mustEnter .= "a valid Date, ";
	$dataOK     = 0;
    }

    # check User selected some Bands Recovered #


    unless($self->{variableBandsArray}->[1][0] &&
	   $self->{variableBandsArray}->[1][1]   ) {

	unless( $self->{fragMethod} eq 'No Fragmentation Done' ) {

	    $mustEnter .= "the band size, ";
	    $dataOK = 0;
	}
    }

    if($self->{volumeUsed} eq '' ) {
	$mustEnter .= "the Volume Used, ";
	$dataOK = 0;
    }
    elsif( $self->{volumeUsed} > 999 ){
	$mustEnter .= "a valid Volume Used, ";
	$dataOK = 0;
    }

    if($self->{clear}      eq '' ) {
	$mustEnter .= "the number of Clear, ";
	$dataOK = 0;
    }

    if($self->{blue}       eq '' ) {
	$mustEnter .= "the number of Blue, ";
	$dataOK = 0;
    }

#    if($self->{ligBoxNum}  eq '' ) {
#	$mustEnter .= "the ligation Box Number, ";
#	$dataOK = 0;
#    }


    # CHECKING DONE. If it was valid data, throw it into some tables.
    if( $dataOK ) {
	$self->incProgressMeter();
	$dataOK = $self->createRecordInDB;

	if( $dataOK ) {
	    $self->{batchNumberToSee} = 
		$self->{id_ligbatch}->{$self->{pickedVector}};
	}
    }
    else {
	unless( $mustEnter =~ /^You must enter $/ ) {
	    $mustEnter =~ s/,\s$/./;           # strip off ', ' at end
	    LemurUtils->showError($self->{mw}, $mustEnter);
	}
    }

    return $dataOK;
}


################################################################################
# get data inputted into widgets and insert into various tables
#
# records created are: Fragmentation, 
#                      FragmentationBand (x 4 usually)
#                      Ligations         (x 2 usually - M13mp18 & pUC18)
#
# Returns;
#         1 if created the records OK.
#         0 if error occured. (will display MessageBox to show user the error).
################################################################################

sub createRecordInDB {

    my ($self) = @_;
    my $dataOK = 1;
    my ($id_frag, $id_fragBand);

    my $dbh = $self->{dbi};

    eval {
	unless( $dbh ) {
	    $dbh = WrapDBI->connect($self->{dbUser}, {RaiseError => 1});
	    $self->{dbi} = $dbh;
	}

	if( !defined $dbh ) {
	    $self->{dbi} = '';
	    $self->expire("Could not connect to database");
	}

	$dbh->{AutoCommit} = 0;

	warn "\n********* started creating records *********\n\n" if $debug;


	$id_frag = $self->createFragmention($dbh);
	$self->incProgressMeter();
	warn "created Fragment, id_frag = $id_frag\n"             if $debug;


	$self->create_SIL_JOB($dbh, $id_frag);

	warn "created SIL_JOB\n" if $debug;


	$id_fragBand = $self->createFragmentBand($dbh, $id_frag);
	$self->incProgressMeter();
	warn "created FrgamentBand, id_fragBand = $id_fragBand\n" if $debug;

	$self->createLigations($dbh, $id_fragBand);
	$self->incProgressMeter();
	warn "created Ligation(s)\n"                              if $debug;
    };
    
    if($@) {
	$dbh->rollback if $dbh;

	if( $@ =~  /Bad Data From User/  or $@ eq "\n") {
	    # message already displayed.
	    warn "done Oracle rollback\n" if $debug;
	    $dataOK = 0;
	} else {
	    LemurUtils->showError($self->{mw}, "$@");
	    $dataOK = 0;
	}
    }

    return $dataOK;
}


################################################################################
# using the data the user has input, gets the details needed to fill in a 
# Fragement record and inserts it. 
#
# NOTE: although this is called 'createFragmentation' it may not actually create
#       anything. The user may have inputted details of this part of the 
#       experiment for a previous vector. If this is the case, it just returns
#       the ID of the correct FRAGMENTATION.
#
# Arguments;
#           dbh     - database handle
# Returns;
#           ID_FRAG - ID of fragmentation record created.
################################################################################

sub createFragmention {

    my ($self, $dbh, $args) = @_;

    my $team_p_role_id    = $self->{operatorHash}->{$self->{operator}};
    my $id_recoveryMethod = $recoveryMethodHash{$self->{recoveryMethod}};
    my $id_fragMethod     = $fragMethodHash{$self->{fragMethod}};

    my $id_frag = 
	$dbh->fetch_scalar("select seq_fragmentation.nextval from dual");

    warn "
           insert into FRAGMENTATION
                  (ID_FRAG, ,
                   RECOVERY_METHOD,
                   FRAG_METHOD,
                   OPERATOR)
           values ($id_frag,
                   $id_recoveryMethod,
                   $id_fragMethod,
                   '$team_p_role_id')\n"
		       if $debug;

    $dbh->do("
       insert into FRAGMENTATION
              (ID_FRAG,
               RECOVERY_METHOD,
               FRAG_METHOD,
               OPERATOR)
       values ($id_frag,
               $id_recoveryMethod,
               $id_fragMethod,
               $team_p_role_id)");

    return $id_frag;
}


################################################################################
# creates he linking table between a SIL_REQUEST and the FRAGMENTATION
################################################################################

sub create_SIL_JOB {

    my ($self, $dbh, $id_frag) = @_;


    my $id_job =
	$dbh->fetch_scalar("select SEQ_JOB.nextval from dual");

warn "
        insert into SIL_JOB
        values ($id_job,
                $self->{requestValue},
                $id_frag)\n" if $debug;

    $dbh->do("
        insert into SIL_JOB
        values ($id_job,
                $self->{requestValue},
                $id_frag)");
}


################################################################################
# Creates a fragmentation band record for each band recovered.
#
# Arguments;
#           dbh     - database handle
#           id_frag - id of Fragment record created before this sub called
#
# Returns;
#           ID_FRAGBAND - id of the fragmentation band used for ligation
################################################################################

sub createFragmentBand {
    my ($self, $dbh, $id_frag, $args) = @_;

    my ($fragIndexUsed) = 0;
    my ($id_fragband);
    my ($return_id_fragBand);

    my $id_fragMethod =	$dbh->fetch_scalar(
       "select ID_DICT 
        from   FragMethodDict 
        where  Description = '$self->{fragMethod}'");

    my @bands;

    $fragIndexUsed = $self->{variableBandUsed};
    my $refToArray = $self->{variableBandsArray};
    my ($from, $to);

    if( $refToArray->[1][0] && $refToArray->[1][1]) {

	$from = $refToArray->[1][0];
	$to   = $refToArray->[1][1];

	$id_fragband = $dbh->fetch_scalar("
                select seq_FRAGBAND.nextval from dual");

	if( $debug ) {
	    warn "
                insert into FRAGMENTATION_BAND
                       (ID_FRAGBAND,
                        ID_FRAG,
                        SIZE_FROM_KB,
                        SIZE_TO_KB,
                        FRAGMENT_BOX)
                values ($id_fragband,
                        $id_frag,
                        $from,
                        $to,
                        $self->{fragBox})\n";
	}

	$dbh->do("
                insert into FRAGMENTATION_BAND
                       (ID_FRAGBAND,
                        ID_FRAG,
                        SIZE_FROM_KB,
                        SIZE_TO_KB,
                        FRAGMENT_BOX)
                values ($id_fragband,
                        $id_frag,
                        $from,
                        $to,
                        '$self->{fragBox}')");
    }
    else {
	# this is pure paranoia... should be validated already
	warn "Not a complete frag size found in createFragmentBand()\n";
	warn "From = $refToArray->[1][0], To = $refToArray->[1][1]\n";
	die "Internal error: Not a complete frag size found in ".
	    "createFragmentBand()";
    }

    return $id_fragband;
}


################################################################################
#
# creates new batch_id if one has not been created before for the pickedVector
# creates LIGATION record
# creates LIGATION_STATUS record
#
#                Positive == Clear, Negative == blue.
#
#
################################################################################

sub createLigations {
    my ($self, $dbh, $id_fragBand, $args) = @_;
    my ($id_ligation);
    my ($vector_site);
    my $user = $self->{realUserName};


    if( $debug ) {
	warn "\ncreateLigations::user == $user\n";
    }

    # this is to make sure no one else can get lig nums at the same time
    # same code in LemurEnterBatchOfLigs.pm
    eval {
	$dbh->fetch_all("select ID_LIGBATCH from LIGATION_BATCH for update");
    };

    # create LIGATION_BATCH record. If no batch number exists for this vector
    # then get one and store it for next ligation. First it checks if the
    # value stored internally is valid - what is stored and what is in the DB
    # can be two different things if an error occured before when writting
    # to the DB!!

    if( $self->{id_ligbatch}->{$self->{pickedVector}} ) {
	my $id = $dbh->fetch_scalar("
            select ID_LIGBATCH
            from   LIGATION_BATCH
            where  ID_LIGBATCH = $self->{id_ligbatch}->{$self->{pickedVector}}
        ");

	if( $id eq "" ) {
	    delete $self->{id_ligbatch}->{$self->{pickedVector}};
	}
    }


    unless( $self->{id_ligbatch}->{$self->{pickedVector}} ) {

	my $vecEnz   = $self->{pickedVector};
	$vector_site = $self->{vectorsWithEnzymes}->{$vecEnz}->{ID_VECTORSITE};

	if( ! $vector_site ) {
	    warn "ERROR: Contact bug. Debug data to follow;\n";
	    warn "pickedVector was $self->{pickedVector}\n";
	    warn Data::Dumper::Dumper($self->{vectorsWithEnzymes});
	}

	$self->{id_ligbatch}->{$self->{pickedVector}} =
	    $dbh->fetch_scalar("select seq_ligbatch.nextval from dual");

	if( $debug ) {
	    warn "   creating new batch.\n";
	    warn "   vector_site = $vector_site\n";
	    warn "   id_ligbatch = ",
		 $self->{id_ligbatch}->{$self->{pickedVector}},"\n";
	}

        # HACK - if vector enzyme is "EZ-TN (NONE)" then this is an artificail
        # transposon, probably put into "puc18 (smaI)". Lets set SEQ_VECTOR2
        my ($field, $value);

        if( $vecEnz eq 'EZ-TN (NONE)' ){
            $field = ', SEQ_VECTOR2';
            $value = ', 127';
        }

	$dbh->do(qq[insert into LIGATION_BATCH
                           (ID_LIGBATCH, SEQ_VECTOR $field)
                    values ($self->{id_ligbatch}->{$self->{pickedVector}},
                            $vector_site $value) ]);
    }
    else {
	if( $debug ) {
	    warn "   batch already created.\n";
	    warn "   vector_site = $vector_site\n";
	    warn "   id_ligbatch = ",
		$self->{id_ligbatch}->{$self->{pickedVector}},"\n";
	}
    }

    my $cloneName = $dbh->fetch_scalar("
        select sds.CLONENAME
        from   SIL_DNASOURCE sds, SIL_REQUEST sr
        where  sr.ID_REQUEST = $self->{requestValue}
        and    sr.ID_SOURCE  = sds.ID_SOURCE");

    $self->{clone_for_job}->{$self->{requestValue}} = $cloneName;

    $self->{ligNum} = $dbh->fetch_scalar("
        select seq_LIGATION.nextval from dual");

    ###########################################################################
    # mail pjm - this is for debugging purposes.
    ###########################################################################
#    Mail::sendMail(-to      => "pjm",
#                   -subject => "id_ligation number got $self->{ligNum} (Job)", 
#                   -message => "id_ligation = $self->{ligNum} for job ".
#                                "$self->{requestValue}) : ".
#                                "Operator = $self->{realUserName}");
    ###########################################################################
    ###########################################################################

    eval {
	$dbh->do("
             insert into LIGATION
                    (ID_LIGATION,
                     ID_FRAGBAND,
                     ID_LIGBATCH,
                     VOLUME,
                     POSITIVE,
                     NEGATIVE,
                     CLONENAME)
             values ($self->{ligNum},
                     $id_fragBand,
                     $self->{id_ligbatch}->{$self->{pickedVector}},
                     $self->{volumeUsed},
                     $self->{clear},
                     $self->{blue},
                     '$cloneName')");
    };

    if($@) {
	if($@ =~ /\.FK\_LIGATION_BATCH\) violated/ ) {
	    LemurUtils->showError($self->{mw},
				  "Could not use batch number stored ".
				  "internally - was there an earlier problem? ".
				  "Please press Cancel and re-enter the batch");
	    die "\n";
	}
	elsif($@ =~ /\.PK\_LIGATION\) violated/ ) {
            my $message = "Has this ligation number been used before ".
                          "($self->{ligNum})? ".
                          "The details have not been added to the Database";

            Mail::sendMail( -to      => "$bug_mail",
                            -subject => "Lemur Error", 
                            -message => $message);

	    LemurUtils->showError($self->{mw},
				  "$message. Bug has been emailed.");
	    die "\n";
	}
	else {
	    die "$@";
	}
    }

    # create status record, status of 1 means 'created'
    # also create one wi status of 5  - LIGATIION GOES STRAIGHT TO PASSED

    my $dateDone = $self->{dateDone};

    $dbh->do(qq[insert into LIGATION_STATUS
                values ($self->{ligNum},
                        1,
                        to_date('$dateDone', 'dd/mm/yyyy'),
                        0,
                        $self->{session_id},
                        'EnterBatchOfJobs',
                        '$user') ]);

    $dbh->do(qq[insert into LIGATION_STATUS
                values ($self->{ligNum},
                        5,
                        to_date('$dateDone', 'dd/mm/yyyy'),
                        1,
                        $self->{session_id},
                        'EnterBatchOfJobs',
                        '$user') ]);

    $self->createSILStatus($dbh);

    # cache the info needed to print a ligation label

    $self->{pickedVector} =~ /^(\S*)\s/;
    my $vector_name = $1;
    my $job_num     = $self->{requestValue};

    $self->{cached_ligs}->{$self->{ligNum}} = [$vector_name, $job_num];
}

#
# This is called when the user presses done. It prints out labels for each
# ligation it has produced.
#
sub print_lig_labels {
    my ($self) = @_;

    # Create one barcode label for the ligation just enetered/created
    #

    return unless defined $self->{cached_ligs};

    print "About to print a label\n";

    my $lig_label = Barcode->new();
    $lig_label->Type('LG');        # Ligation
    $lig_label->User($self->{realUserName});

    foreach my $lig_num (sort keys %{$self->{cached_ligs}}){

        my $vector_name = $self->{cached_ligs}->{$lig_num}->[0];
        my $job_num     = $self->{cached_ligs}->{$lig_num}->[1];

        # print ligation barcode
        $lig_label->Barcode( $lig_num);
        $lig_label->Name(    $lig_num);
        $lig_label->Project( $lig_num);
        $lig_label->Suffix(  $vector_name);
        $lig_label->Owner(   $job_num);
        $lig_label->Date(    $self->{todaysDate} );

        $lig_label->Labellist();
    }

    eval{ $lig_label->Printlabel(); }; 

    if( $@ ){
        my $error = $@; # $@ will get blown away on module call

        LemurUtils->showError($self->{mw},
                              "$error");

        Mail::sendMail(-to      => $bug_mail,
                       -subject => "Error printing labels for subclone plates",
                       -message => $error);
    }
}

#
# creates SIL Request status to 'Job Done'
#

sub createSILStatus {
    my ($self, $dbh)  = @_;
    my $id_request    = $self->{requestValue};

    my $operator      = $self->{email_id_of}->{$self->{operator}};

    print "About to lock rows from SILREQUEST_STATUS\n" if $debug;

    $dbh->fetch_scalar("
         select *
         from   SILREQUEST_STATUS
         where  ID_REQUEST = $id_request
         for update nowait");

    print "Locked\n" if $debug;

    $dbh->do("
         update SILREQUEST_STATUS
         set    ISCURRENT  = 0
         where  ID_REQUEST = $id_request
         and    ISCURRENT  = 1");

    warn "
            insert into SILREQUEST_STATUS
                   (ID_REQUEST,
                    STATUS,
                    STATUSDATE,
                    ISCURRENT,
                    SESSIONID,
                    PROGRAM,
                    OPERATOR)
            values ($id_request,
                    3,
                    to_date('$self->{dateDone}', 'dd/mm/yyyy'),
                    1,
                    $self->{session_id},
                    'EnterBatchOfJobs',
                    '$operator')\n" if $debug;

    # if they enter more than 1 ligation for a request then this will
    # fail to be unique (on the same day). Just ignore error
    eval {
	$dbh->do("
            insert into SILREQUEST_STATUS
                   (ID_REQUEST,
                    STATUS,
                    STATUSDATE,
                    ISCURRENT,
                    SESSIONID,
                    PROGRAM,
                    OPERATOR)
            values ($id_request,
                    3,
                    to_date('$self->{dateDone}', 'dd/mm/yyyy'),
                    1,
                    $self->{session_id},
                    'EnterBatchOfJobs',
                    '$operator')");
    };
    
    if( $@  &&  ($@ !~
	/unique constraint \(\w+\.PK_SILREQUEST_STATUS\) violated/) ){
	die "$@";
    }
}

#
# returns 0 if did not work (should cause a rollback in calling function)
#         1 if ok
#

sub writeToEquus {
    my ($self, $dbh) = @_;

    warn "EnterBatchOfLigs::writeToEquus\n" if $debug;

    my $hostname  = Sys::Hostname::hostname();
    my $pid       = $$;
    my $prog      = $0;
    $prog         =~ s/^.*\///;
    my $temp_file = $prog."_".$hostname."_".$pid."LemurBatchLigs";

    my $tFiles = TempFiles->new(prefix => $temp_file,
				dir    => $MAIN::EQUUS_TEMP_DIR);

    my $db = EquusDatabaseInterface->new($tFiles,
					 $self->{dbUser},
					 $debug);
    my ($clone,
	$ligation,
	$date,
	$vector,
	$minSize,
	$maxSize,
	$volume,
	$blue,
	$clear,
	$fragmentBox,
	$remark);

    my $from = $self->{variableBandsArray}->[1][0];
    my $to   = $self->{variableBandsArray}->[1][1];

    $self->{dateDone} =~ /(\d+)\/(\d+)\/(\d+)/;

    $date        = "$3-$2-$1";
    $clone       = $dbh->fetch_scalar("
                       select CLONENAME
                       from   SIL_DNASOURCE, SIL_REQUEST
                       where  SIL_REQUEST.ID_REQUEST = $self->{requestValue}
                       and    SIL_REQUEST.ID_SOURCE  = SIL_DNASOURCE.ID_SOURCE
    ");

    # get 'vector' from 'vector (enzyme)'
    $self->{pickedVector} =~ /^(.+) \(.+?\)$/;
    $vector               =  $1;

    $ligation    = $self->{ligNum};
    $minSize     = $from;
    $maxSize     = $to;
    $volume      = $self->{volumeUsed};
    $blue        = $self->{blue};
    $clear       = $self->{clear};
    $fragmentBox = $self->{fragBox};
    $remark      = '';


warn "
    clone       $clone
    ligation    $ligation 
    date        $date 
    vector      $vector 
    minSize     $minSize 
    maxSize     $maxSize 
    volume      $volume  
    blue        $blue    
    clear       $clear   
    fragmentBox $fragmentBox 
    remark      $remark   
" if $debug;

    my @paths;

    if( $db->checkExists('Ligation', $ligation) ) {
	LemurUtils->showError($self->{mw},
			      "Ligation $ligation already exists in Equus");
	$db->rollback;
	warn "Equus rollback done (writeToEquus)" if $debug;
	return 0;
    }

    # eval just around Equus stuff, its more likely to screw up.

    my $return_val; # set inside eval, can't return from inside there

    eval {
        @paths = $db->addLigation($clone,
                                  $ligation,
                                  $date,
                                  $vector,
                                  $minSize,
                                  $maxSize,
                                  $volume,
                                  $blue,
                                  $clear,
                                  $fragmentBox,
                                  $remark);

        if( scalar(@paths) > 0) {
            $db->commit;
            warn "Equus commit complete (EnterSIL)" if $debug;
            $return_val = 1;
        }
        else {
            $db->rollback;
            warn "Equus rollback done (EnterSIL)" if $debug;
            $return_val = 0;
        }
    };

    if( $@ ){
        my $message = $@; # $@ will get clobbered.
        LemurUtils->showError($self->{mw},
			      "ERROR: $message");

        Mail::sendMail( -to      => "$bug_mail",
                        -subject => "Error entering Job(s) via Lemur.", 
                        -message => $message);

        $db->rollback;
        return 0;
    }
    else {
        return $return_val;
    }
}

################################################################################
# expire  :  send mail message and exit.
################################################################################

sub expire {
    my ($self, $message) = @_;

    warn "ERROR: $message";

    Mail::sendMail( -to      => "$bug_mail",
                    -subject => "Error entering Job(s) via Lemur.", 
                    -message => $message);
    die;
}


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

    $self->disconnect;
}

################################################################################
# EOF
################################################################################

1;
 
#
# $Log: LemurEnterBatchOfJobs.pm,v $
# Revision 1.27  2004/04/27  09:47:23  mdf
# updated bug to bug-real
#
# Revision 1.26  2000/10/05  16:51:36  pjm
# Now longer emails pjm with lig num got from sequence
#
# Revision 1.25  2000/10/04  13:42:19  pjm
# id_ligation now in subject of email to pjm
#
# Revision 1.24  2000/09/26  13:02:08  pjm
# added email to pjm for debugging - to be removed very soon !!!
#
# Revision 1.23  2000/09/08  14:04:38  pjm
# no longer calls writeToEquus() - ligations should be added by overnight cron
# running put_oracle_ligs_into_equus.pl
#
# Revision 1.22  2000/07/04  14:11:58  pjm
# hard coded code for EZ-Tn into LIGATION_BATCH, so puc18 (smaI) can be used
# as well.
#
# Revision 1.21  2000/07/04  13:47:54  pjm
# added (ID_LIGBATCH, SEQ_VECTOR) when inserting into LIGATION_BATCH
#
# Revision 1.20  2000/05/17  16:51:47  pjm
# creates a status record 'created' so reprint2 can use the status date on a
# label.
#
# Revision 1.19  2000/04/26  11:12:55  pjm
# added "select ID_LIGBATCH from LIGATION_BATCH for update" so if someone else
# is getting ligaton numbers this will wait.
#
# Revision 1.18  2000/04/13  16:55:51  pjm
# caches ligation info needed to print label when Done is pressed, not each time
# a ligation record is added.
#
# Revision 1.17  2000/04/13  11:41:09  pjm
# added done_pressed(); It prints out what ligation , job num and clone to
# a normal printer.
#
# Revision 1.16  2000/04/05  13:43:53  pjm
# changed PROGRAM from Fragments.pm to EnterBatchOfJobs
#
# Revision 1.15  2000/04/03  10:03:13  pjm
# added print message to say what the ligation number was. Made sure bug
# mail goes to pjm if using dev1
#
# Revision 1.14  2000/03/07  12:47:25  pjm
# took out redundant references to $interface.
# passes in pathogen_mode but does not yet use it.
#
# Revision 1.13  1999/12/08  14:33:50  pjm
# added barcode output for each ligation. It prints out each one individually
# so may get mixed up with other output from label printer - don't think it is an
# issue... If lig num is already used gives better error message and mails bug
#
# Revision 1.12  1999/10/06 14:44:49  pjm
# put eval around commiting to Equus.
# $bug_mail is set to pjm or bug depending on $debug being 0 or 1
#
# Revision 1.11  1999/10/06 12:59:05  pjm
# added "$self->{mw}->bind('<Delete>', 'Backspace');"
#
# Revision 1.10  1999/10/06 11:16:23  pjm
# used $0 to get prog name. Did not realise it gave full path to prog...
# stripped of path to get prog name.
#
# Revision 1.9  1999/08/31 14:14:29  pjm
# added 'sort' to  '-choices   => [sort keys %{$self->{operatorHash}}]'
# to display peoples names alphabetically.
#
# Revision 1.8  1999/08/26 16:45:43  pjm
# Lig Box Num field greyed out
# Band Size left blank
# Main change: when user enters job number it checks to see if it is a
# Clone PCR or Oligo Screening. These do not have ligations produced for them.
# It asks if they have been completed, Yes or No. If Yes, adds Done status
# record to SILREQUEST_STATUS.
#
#
