#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################
#
# author: pjm
# description;
#
# Used to Pass or Fail individual ligations. Currently the project status
# is not set (code to do so is commented out).
#
require Exporter;

use     strict;
use     WrapDBI;
use     Mail;
use     Tk;
use     Data::Dumper;

require NewBrowseEntry;

# The old BrowseEntry.pm doesn't support deletes. Let's try the new one instead
#require "/nfs/disk68/dn1/badger-bin/gull/NewBrowseEntry.pm";


package LemurPassLigations;

$| = 1;

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

my $bug_mail    = 'bug-real';
#my $bug_mail    = 'pjm';
my $debug       = 0;          # set this to 0 so no rubbish output
my $digest_mail = 'mcj, kar';
#my $digest_mail = 'pjm';

################################################################################
# create Fragment & Ligation  window.
#
################################################################################

sub new {

    my ($type, $parentWindow, $dbUser, $session_id) = @_;

    my $self = {
	dbUser      => $dbUser,
	session_id  => $session_id,
    };

    bless($self, $type);

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

    # create new window
    $self->{mw} = $parentWindow->Toplevel();

    $self->{mw}->title('Pass/Fail Ligations');
    $self->{mw}->Label(width   => 30)->pack;
    $self->{mw}->Label(font    => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
		       text    => "Set Ligations to Pass or Fail",
		       height  => 1,
		       -bg          => 'white',
		       -relief      => 'groove',
		       -borderwidth => '3',
		       )->pack(-side => 'top');
    $self->{mw}->Label()->pack;

    # make it look pretty - put widgets in a groovey frame
    my $mf = $self->{mw}->Frame(-relief      => 'groove',
				-borderwidth => '3',);

    $self->{batchHList} = $mf->Scrolled('HList',
					-scrollbars => 'w',
					-columns    => 7,
					-indent     => '10m',
					-itemtype   => 'text',
					-width      => 95,
					-height     => 28,
					-selectmode => 'multiple',

					-browsecmd  => sub {
					    my $selected = shift;
					    $self->ligSelected($selected);
					},
					-command    => sub {
					    my $selected = shift;
					    $self->showHideBatch($selected);
					},
					)->pack(-side   => 'left',
                                                -expand => 'y',
                                                -fill   => 'both');

    my $bf = $mf->Frame;

    $bf->Button(-width    => 6,
		-text     => 'Ok',
		-command  => sub{ $self->okPressed();
				  $self->{mw}->destroy;
			      },
		)->pack;

    $bf->Button(-width    => 6,
		-text     => 'Update',
		-command  => sub{ $self->okPressed();

				  $self->{passedLigs}            = undef;
				  $self->{failedLigs}            = undef;
                                  $self->{prep_status_for_batch} = undef;
                                  
				  $self->{batchHList}->delete('all');
				  $self->getLigations();
				  $self->display_batch();
			      },
		)->pack;

    $bf->Button(-width    => 6,
		-text     => 'Cancel',
		-command  => sub{ $self->{mw}->destroy;  },
		)->pack;

    $bf->Label()->pack;


    $bf->Button(-width    => 6,
		-text     => 'Pass',
		-command  => sub {$self->passPressed},
		)->pack;

    $bf->Button(-width    => 6,
		-text     => 'Fail',
		-command  => sub {$self->failPressed},
		)->pack;

    $bf->Button(-width    => 6,
		-text     => 'Blank',
		-command  => sub {$self->blankPressed},
		)->pack;

    $bf->pack(-side => 'right', -anchor => 'nw');
    $mf->pack(-padx => 10, -expand => 'y', -fill => 'both');

    $self->getLigations();
    $self->display_batch();
}


################################################################################
# gets the ligations that have a status of XXXX.
################################################################################

sub getLigations {
    my ($self) = @_;
    my ($dbh, $arrayOfArrays);
    my @orderedListOfLigsNums;

    eval {
	$dbh = WrapDBI->connect($self->{dbUser}, {RaiseError => 1});
	$self->expire("Could not connect to database") if !defined $dbh;

	$dbh->{AutoCommit} = 0;

	# get ligations entered and store in $self->{ligations}
	$arrayOfArrays = $dbh->fetch_all("
            select l.ID_LIGATION, l.ID_LIGBATCH, l.POSITIVE, l.NEGATIVE,
                   ls.OPERATOR, l.CLONENAME, vs.VECTORNAME, l.COMMENTS
            from   LIGATION l, LIGATION_STATUS ls,
                   LIGATION_BATCH lb, VECTORSITE vs
            where  l.ID_LIGATION = ls.ID_LIGATION
            and    ls.STATUS     = 1
            and    ls.ISCURRENT  = 1
            and    l.ID_LIGBATCH = lb.ID_LIGBATCH
            and    lb.SEQ_VECTOR = vs.ID_VECTORSITE
            order by l.ID_LIGBATCH, l.ID_LIGATION");

        # Get status for prep used to create lig.
        my @lig_nums = map {$_->[0]} @{$arrayOfArrays};
        my $first    = 0;
        my $ref_to_hash;
        
        foreach my $last (500, 1000, 1500, 2000, 2500){
            my $real_last = $last;

            if( $last >= $#lig_nums ){
                $real_last = $#lig_nums;
            }

            # print "first to last: $first to $real_last\n";

            $self->get_prep_status_for_ligs($ref_to_hash,
                                            $dbh,
                                            @lig_nums[$first..$real_last]);

            last if $last >= $#lig_nums;
            $first = $last;
        }


	foreach my $row (@$arrayOfArrays) {

	    push @orderedListOfLigsNums, $row->[0];

	    my @tempArray = @{$row}[1..7];

            if( defined $self->{status_for_lig}->{$row->[0]} ){
                push @tempArray, $self->{status_for_lig}->{$row->[0]};
            }

	    $self->{ligations}->{$row->[0]} = \@tempArray;
	}
    };

    if ($@) {
	my $error = $@;
	$dbh->rollback if $dbh; 
	$self->expire("$error: Occured in setupHashtables()");
    }

    $self->{orderedListOfLigsNums} = \@orderedListOfLigsNums;

    $dbh->disconnect if $dbh;
}

# See if the prep used to create each ligation has been 
#
#    Fingerprinted
#    Passed Digest Check
#    Failed 
#
# It does not look for any other statuses. Dunnu if need to...
#
sub get_prep_status_for_ligs {
    my ($self, $ref_to_hash, $dbh, @lig_nums) = @_;

    return unless @lig_nums;

    my $ligations = "'".join("', '", @lig_nums)."'";
    $ligations    =~ s/, '$//; #'

#    print "ligations = $ligations\n";
    my $prep_statuses =
        $dbh->fetch_all(qq[select l.ID_LIGATION, dpsd.DESCRIPTION,
                                  l.id_ligbatch
                           from   LIGATION l, FRAGMENTATION_BAND fb,
                                  DNAPREP_FRAG dpf, DNAPREP dp,
                                  DNAPREP_STATUS dps, DNAPREPSTATUSDICT dpsd
                           where  l.ID_LIGATION in ($ligations)
                           and    l.ID_FRAGBAND  = fb.ID_FRAGBAND
                           and    fb.ID_FRAG     = dpf.ID_FRAG
                           and    dpf.ID_PREP    = dp.ID_PREP
                           and    dp.ID_PREP     = dps.ID_PREP
                           and    dps.STATUS    in (4, 33, 9)
                           and    dps.STATUS     = dpsd.ID_DICT
                           order by l.ID_LIGATION, dps.STATUSDATE ]);

    foreach my $row_ref (@{$prep_statuses}){
        $self->{status_for_lig}->{$row_ref->[0]} = $row_ref->[1];

        if( defined $row_ref->[1] && $row_ref->[1] ){
            $self->{prep_status_for_batch}->{$row_ref->[2]} = 1;
        }
#        print "$row_ref->[0] = $row_ref->[1]\n";
    }
}


################################################################################
# populate batchHList gadget with the ligaiton info.
#
# The HList widget's callback is &ligSelected. It knows what has been clicked on
# because the gadget sends it values such as 1.0, 2.1. etc.
# To relate this to a ligation number we remember entryPath by setting the
# hash table '$self->{HList_entries}->{key}'.
################################################################################

sub display_batch {

    my ($self)       = @_;
    my $ligationHash = $self->{ligations};

    # before loop, get very first ligation info

    my $temp_array = $ligationHash->{$self->{orderedListOfLigsNums}->[0]};
    my $id_batch   = @{$temp_array}[0];
    my $operator   = @{$temp_array}[3];
    my $vector     = @{$temp_array}[5];
    my $from       = $self->{orderedListOfLigsNums}->[0];
    my $to         = "";

    # foreach Ligation Number, see if it belongs to the current batch. If not,
    # add the last batch number to the gadget and set variables.

    foreach my $key ( @{$self->{orderedListOfLigsNums} } ) {

	my $temp_array = $ligationHash->{$key};

	if( @{$temp_array}[0] != $id_batch ) {

            my $thingy = '#' if $self->{prep_status_for_batch}->{$id_batch};

            if( $to eq "" || $from eq $to){
                $self->{batchHList}->add($id_batch, -text =>
                                         "Batch $id_batch, ($from) $vector ".
                                         "$thingy");
            }
            else {
                $self->{batchHList}->add($id_batch, -text =>
                                         "Batch $id_batch, ($from - $to) ".
                                         "$vector $thingy");
            }
	    $id_batch = @{$temp_array}[0];
	    $operator = @{$temp_array}[3];
            $vector   = @{$temp_array}[5];
	    $from     = $key;
	    $to       = "";
	}
        else {
	    $to = $key;
	}
    }

    if( $id_batch ) {
	$self->{batchHList}->add($id_batch, -text =>
                                 "Batch $id_batch, ($from - $to) $vector");
    }
}


################################################################################
# callback on HList widget (-browsecmd, so button down AND button up. This is
# why set currentSelected... if the same as before, returns).
################################################################################

sub ligSelected {

    my ($self, $entryPath) = @_;
    my ($ligNum)           = $self->{HList_entries}->{$entryPath};


#    if( $entryPath =~ /\d*\.\d*/ ) {
#	$self->{batchHList}->selection('clear', $entryPath, $entryPath);
#    }

    return unless($ligNum);
    return unless($self->{currentSelected} != $ligNum);

    # got here so not a heading like "Batch 2" or it's the Button Up event.

    $self->{currentSelected} = $ligNum;
}


################################################################################
# If the next entry after the one clicked on 
# Returns if user not clicked on a 'Batch X'
################################################################################

sub showHideBatch {

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


     return if( $entryPath =~ /\d*\.\d*/ );

     if($self->{batchHList}->info('exists', $entryPath)){
	 # toggle batch state. (next is either '2', '2.1' or '')
	 my $next_entry = $self->{batchHList}->info('next', $entryPath);

	 if( $next_entry =~ /^\d*$/) {
	     # display ligations for batch $entryPath
	     $self->add_batch_contents($entryPath);
	 }
	 else {
	     # delete ligations
	     $self->{batchHList}->delete('offsprings', $entryPath);
	 }
     }
}


################################################################################
# user has double clicked on a 'Batch X' entry and its children (ligations)
# are not shown. This looks for ligations belonging to 'Batch X' and shows them.
#
################################################################################

sub add_batch_contents {
    my ($self, $parentPath) = @_;

    my ($ligationHash) = $self->{ligations};

    my $temp_array = $ligationHash->{$self->{orderedListOfLigsNums}->[0]};
    my $id_batch   = $temp_array->[0];
    my $ligType    = "";
    my $foundBatch = 0;
    my $child      = 0;

    foreach my $key ( @{$self->{orderedListOfLigsNums}}  ) {

	# look see if we have a new batch/parent

	my $temp_array = $ligationHash->{$key};

	if( @{$temp_array}[0] != $id_batch ) {

	    last if $foundBatch; # have already added ligs for this batch

	    $id_batch = @{$temp_array}[0];
	}

	if( $id_batch == $parentPath ) {
	    my $state = ''; # default value

	    if( $self->{passedLigs}->{$key} ) {
		$state = ' Pass ';
	    }
	    elsif( $self->{failedLigs}->{$key} ) {
		$state = ' Fail ';
	    }

	    my $entryPath = 
		$self->{batchHList}->addchild($id_batch,
					      -text =>
					          "$ligationHash->{$key}->[4]",
					      );

	    $self->createHListCols($self->{batchHList},
				   $entryPath,
				   [$state,
				    "Lig Num  $key",
				    "Blue  $ligationHash->{$key}->[2]",
                                    "Clear  $ligationHash->{$key}->[1]",
                                    "$ligationHash->{$key}->[7]",
                                    "$ligationHash->{$key}->[6]"],
				    );

	    $self->{HList_entries}->{$entryPath} = $key;
	    $foundBatch = 1;
	}
    }
}


################################################################################
# Loops around the array of text elements passed in and creates a new column
# for each for the $entryPath on the gadget $HList.
#
# it would be nice to subclass the HList widget to implement this method so;
#
#     $HListWidget->createColumns($entryPath, ['col1', 'col1']);
#
# but i can't be bothered.
################################################################################

sub createHListCols {

    my ($self, $HList, $entryPath, $columns)     = @_;

    my $colNumber = 1; # when addchild() called, col 0 used.

    foreach my $col ( @{$columns} ) {
	$HList->item("create",
		     $entryPath,
		     $colNumber,
		     -text => "   ".$col,
		     );

	++$colNumber;
    }
}


################################################################################
# coverts the entry paths (1.1, 2.0 etc) into ligation numbers (@ligNumbers)
# Adds 'Pass' to text in HList
################################################################################

sub passPressed {

    my ($self)     = @_;
    my @selection  = $self->{batchHList}->info('selection');
    my ($ligationHash) = $self->{ligations};
    my @ligNumbers;

    foreach (@selection) {

	# if not a batch
	if( $self->{HList_entries}->{$_} ) {

	    my $ligNum     = $self->{HList_entries}->{$_};
	    my $temp_array = $ligationHash->{$ligNum};
	    my $text       =
		sprintf("Clone %10s\t(%6d) \tPass\t".
			"Blue\t%4d\tClear %4d",
			$temp_array->[4],
			$ligNum,
			$temp_array->[1],
			$temp_array->[2]);

	    $self->createHListCols($self->{batchHList},
				   $_,
				   ['Pass',
				    "Lig Num  $ligNum",
				    "Blue  $ligationHash->{$ligNum}->[2]",
                                    "Clear  $ligationHash->{$ligNum}->[1]",],
				    );

	    push @ligNumbers, $ligNum;
       }
    }

    $self->addPassLigations(\@ligNumbers) if scalar(@ligNumbers);
}


################################################################################
# coverts the entry paths (1.1, 2.0 etc) into ligation numbers (@ligNumbers)
# adds 'Fail' to text in HList
################################################################################

sub failPressed {

    my ($self)     = @_;
    my @selection  = $self->{batchHList}->info('selection');
    my ($ligationHash) = $self->{ligations};
    my @ligNumbers;

    foreach (@selection) {

	# if not a batch
	if( $self->{HList_entries}->{$_} ) {

	    my $ligNum     = $self->{HList_entries}->{$_};
	    my $temp_array = $ligationHash->{$ligNum};
	    my $text = sprintf("Clone %10s\tLig %6d\tFail\t".
			       "Blue\t%4d\tClear %4d",
			       $temp_array->[4],
			       $ligNum,
			       $temp_array->[1],
			       $temp_array->[2]);

	    $self->createHListCols($self->{batchHList},
				   $_,
				   ['Fail',
				    "Lig Num  $ligNum",
				    "Blue  $ligationHash->{$ligNum}->[2]",
                                    "Clear  $ligationHash->{$ligNum}->[1]",],
				    );

	   push @ligNumbers, $self->{HList_entries}->{$_};
       }
    }

    $self->addFailLigations(\@ligNumbers) if scalar(@ligNumbers);
}

################################################################################
# coverts the entry paths (1.1, 2.0 etc) into ligation numbers (@ligNumbers)
# removes any text in HList for ligation selected.
################################################################################

sub blankPressed {

    my ($self)       = @_;
    my @selection    = $self->{batchHList}->info('selection');
    my $ligationHash = $self->{ligations};
    my @ligNumbers;

    foreach (@selection) {

	# if not a batch
	if( $self->{HList_entries}->{$_} ) {

	    my $ligNum = $self->{HList_entries}->{$_};

	    $self->createHListCols($self->{batchHList},
				   $_,
				   ['',
				    "Lig Num  $ligNum",
				    "Blue  $ligationHash->{$ligNum}->[2]",
                                    "Clear  $ligationHash->{$ligNum}->[1]",],
				    );

	   push @ligNumbers, $self->{HList_entries}->{$_};
       }
    }

    # remove lig numbers from passed and failed lig hashes

    foreach my $ligNum (@ligNumbers) {
	delete $self->{failedLigs}->{$ligNum};
	delete $self->{passedLigs}->{$ligNum};
    }
}


################################################################################
# The following 2 subroutines updates the passedLigs & failedLigs hashes stored
# in $self.
################################################################################

sub addPassLigations {

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

    foreach my $ligNum (@{$ligNumbers}) {
	$self->{passedLigs}->{$ligNum} = 1;

	delete $self->{failedLigs}->{$ligNum};
    }

    if( $debug) {
	warn "\n";
	warn "Passed: ", join(', ', keys %{$self->{passedLigs}} ), "\n";
	warn "failed: ", join(', ', keys %{$self->{failedLigs}} ), "\n\n";
    }
}

#
# addFailLigations
#

sub addFailLigations {
    my ($self, $ligNumbers)  = @_;

    foreach my $ligNum (@{$ligNumbers}) {
	$self->{failedLigs}->{$ligNum} = 1;

	delete $self->{passedLigs}->{$ligNum};
    }

    if( $debug) {
	warn "\n";
	warn "Passed: ", join(', ', keys %{$self->{passedLigs}} ), "\n";
	warn "failed: ", join(', ', keys %{$self->{failedLigs}} ), "\n\n";
    }
}

################################################################################
# Write LIGATION_STATUS records out for passed and failed ligation records
#
# call gull_add only on Passed Ligations.
################################################################################

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

    my $user         = $self->{realUserName};
    my $ligationHash = $self->{ligations};
    my $goodGullMsg  = "New current status for project";
    my ($dbh);

    eval {
	$dbh = WrapDBI->connect($self->{dbUser}, {RaiseError => 1});
	$self->expire("Could not connect to database") if !defined $dbh;
	$dbh->{AutoCommit} = 0;

	if( $debug) {
	    warn "\nPassed ligations: ", 
	         join(', ', keys %{$self->{passedLigs}} ),
	         "\n\n";
	}

	foreach my $ligNum (sort keys %{$self->{passedLigs}}) {

	    my $prepNum = $dbh->fetch_scalar("
                select dp.ID_PREP
                from   DNAPREP            dp,
                       DNAPREP_FRAG       dpf,
                       FRAGMENTATION      f ,
                       FRAGMENTATION_BAND fb,
                       LIGATION l
                where  l.ID_LIGATION = $ligNum
                and    l.ID_FRAGBAND = fb.ID_FRAGBAND
                and    fb.ID_FRAG    = f.ID_FRAG
                and    f.ID_FRAG     = dpf.ID_FRAG
                and    dpf.ID_PREP   = dp.ID_PREP");

            unless( defined($prepNum) ){ # unlikely, happens in Dev though
                die "No DNA prep found for ligation $ligNum\n";
            }

	    $self->{passedLigs}->{$ligNum} = 1; # was clone name...

	    $dbh->do("
                update LIGATION_STATUS
                set    ISCURRENT   = 0
                where  ID_LIGATION =  $ligNum");

	    $dbh->do("
                insert into LIGATION_STATUS
                      (ID_LIGATION,
                       STATUS     ,
                       STATUSDATE ,
                       ISCURRENT  ,
                       SESSIONID  ,
                       PROGRAM    ,
                       OPERATOR    )   
                values($ligNum,
                       5,
                       sysdate,
                       1,
                       $self->{session_id},
                       'PassLigations',
                       '$user')");
                        

	    print "   ligNum = $ligNum, prep_id = $prepNum, ".
		  "clone = $self->{passedLigs}->{$ligNum}\n" if $debug;

	    # need to get the project name for this clone for gullAdd

	    my $cloneName    = $ligationHash->{$ligNum}->[4];

	    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];
		}
	    }

            # DON'T CALL gulladd FOR NOW
            if( 0 ){ # SET TO 1 IF gulladd IS TO RUN
                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      => 'bug',
                                       -subject => " gullAdd problem.", 
                                       -message => "$returnMsg \n".
                                                   "clone = $cloneName, ".
                                                   "project = $pName");
                    }
                }
	    }
 
           # get digest info.
 
            my $digest_details = $self->getDigestionInfo($dbh, $cloneName);
            
            $ligationHash->{$ligNum}->[10] = $digest_details;
            print "ligation $ligNum;\n ",
                  Data::Dumper::Dumper($ligationHash->{$ligNum}),
                  "\n" if $debug;  
	}

        $self->mail_project_info($dbh, $ligationHash, $self->{passedLigs});

	if( $debug ) {
	    warn "\nFailed: ", join(', ', keys %{$self->{failedLigs}} ), "\n\n";
	}

	foreach my $ligNum (sort keys %{$self->{failedLigs}}) {

	    my $prepNum = $dbh->fetch_scalar("
                select dp.ID_PREP
                from   DNAPREP            dp,
                       DNAPREP_FRAG       dpf, 
                       FRAGMENTATION      f ,
                       FRAGMENTATION_BAND fb,
                       LIGATION l
                where  l.ID_LIGATION = $ligNum
                and    l.ID_FRAGBAND = fb.ID_FRAGBAND 
                and    fb.ID_FRAG    = f.ID_FRAG
                and    f.ID_FRAG     = dpf.ID_FRAG
                and    dpf.ID_PREP   = dp.ID_PREP");

	    $self->{passedLigs}->{$ligNum} = $dbh->fetch_scalar("
                select gs.CLONENAME
                from   GLYSTOCK gs, CLONE_CULTURE cc, DNAPREP dp
                where  dp.ID_PREP     = $prepNum
                and    dp.ID_CULTURE  = cc.ID_CULTURE
                and    cc.ID_GLYSTOCK = gs.ID_GLYSTOCK");


	    $dbh->do("
                update LIGATION_STATUS
                set    ISCURRENT   = 0
                where  ID_LIGATION =  $ligNum");

	    $dbh->do("
                insert into LIGATION_STATUS
                      (ID_LIGATION,
                       STATUS     ,
                       STATUSDATE ,
                       ISCURRENT  ,
                       SESSIONID  ,
                       PROGRAM    ,
                       OPERATOR    )   
                values($ligNum,
                       9,
                       sysdate,
                       1,
                       $self->{session_id},
                       'PassLigations',
                       '$user')");
                        

	    warn "   ligNum = $ligNum, prep_id = $prepNum, ".
		 "clone = $self->{passedLigs}->{$ligNum}\n" if $debug;
	}

# DEBUG
#die "just testing\n";

    };

    if( $@ ){
        my $error = $@; # it will get blown away by calling LemurUtils stuff
        $self->{digest_prepare} = undef;
        $dbh->rollback   if $dbh;
	$dbh->disconnect if $dbh;

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

        if( $error !~ /just testing/ ){
            $self->expire("$error : Occured in okPressed()");
        }
    }
    else {
        $self->{digest_prepare} = undef;
        $dbh->disconnect if $dbh;
    }
}

sub getDigestionInfo {
    my ($self, $db, $clone) = @_;

    unless( defined $self->{digest_prepare} ){

        $self->{digest_prepare} = $db->prepare(qq[
                      select a.lane, 
                             a.analysis_date, 
                             a.unix_path, 
                             a.insert_size_bp, 
                             a.isgood, 
                             c.id_rdrequest,
                             c.sample_ref,
                             c.id_confirm,
                             d.enzymename,
                             e.id_rdgel,
                             e.gelname, 
                             e.unix_path,
                             f.email
                      from   rdgel_lane_image a, 
                             rdgel_lane b, 
                             rdrequest c, 
                             rdrequest_enzyme d, 
                             rdgel e,
                             person f
                      where  a.id_rdgel = b.id_rdgel and a.lane = b.lane 
                             and b.id_rdrequest = c.id_rdrequest
                             and c.id_rdrequest = d.id_rdrequest
                             and b.id_rdgel     = e.id_rdgel
                             and a.operator     = f.id_person
                             and a.isgood       = 1
                             and c.clonename    = ?
                      order  by d.enzymename, 
                             a.analysis_date
                      ]);
    }

    $self->{digest_prepare}->execute($clone);

    my $fetchRef = $self->{digest_prepare}->fetch();
    my @rows;

    while( $fetchRef ) {
	my ($lane,$date,$path,$size,$good,$reqID,$sample,$confirmID,$enz,
            $gelID,$gel,$project,$op) =  @{$fetchRef};

	$sample = "<?>" if ! defined $sample;

	push @rows,
             sprintf("%-8s %s %7d %1s %s %s %s %s %s %s.%s.%s.%s.%s.* : %s", 
                     $enz, $date, $size, $good ? "+" : "-", 
                     $reqID, $sample, defined $confirmID ? $confirmID : "-1",
                     $op, $gelID,
                     $clone, $enz, $project, $gel, $lane, 
                     $path
                     );
        $fetchRef = $self->{digest_prepare}->fetch();
    }

    return \@rows;
}

# shows clones that have/have not been digested.
# should sort ligs like;
#
# pUC,   M13  & digested       {pUC, M13}
# pUC OR M13, & digested       {pUC} OR {M13}
# pUC OR M13 and NOT digested 
#
sub mail_project_info {
    my ($self, $dbh, $ligationHash, $passedLigs) = @_;
    my (%digest_done, %digest_not_done, %vectors_for, %vectors1, %vectors2);

    $| = 0;

    if( !defined($ligationHash) || ! defined($passedLigs) ){
        $self->expire("mail_project_info was not passed enough args.\n");
    }

    unless( scalar(keys %{$passedLigs}) ){
        return;
    }

    $| = 0; # turned on again at bottom of sub

    foreach my $lig_num (sort keys %{$passedLigs}){
        my $digest_info = $ligationHash->{$lig_num}->[10];
        my $clone_name  = $ligationHash->{$lig_num}->[4];
        my $vector      = $ligationHash->{$lig_num}->[5];

        if( scalar @{$digest_info} ){
            # get first lig num only, if more than 1 for this clone
            unless( defined($digest_done{$clone_name}) ){
                $digest_done{$clone_name} = $lig_num;
            }

            # ignore 2 pUCs on same clone, only want to know if 1 has been done
            unless( defined $vectors_for{$clone_name} ){
                $vectors_for{$clone_name} = [];
            }

            unless( grep @{$vectors_for{$clone_name}}, $vector ){
                push @{$vectors_for{$clone_name}}, $vector;
            }
        }
        else {
            $digest_not_done{$clone_name} = 1;
        }
    }

    my @output;
    push @output, "\nDigests Done\n------------\n\n";


    # get vectors used in ligations for this clone, store clone name against
    # the vector names i.e. {m13, puc18} => ['Clone1', 'Clone2']
    foreach my $clone_name (sort keys %digest_done){

        my $vectors = join(', ', $self->get_vectors_from_clone($dbh,
                                                               $clone_name));

        push @{$vectors1{$vectors}}, $clone_name;
    }

    # for each set of vectors, output the clone name
    foreach my $cloning_vectors (sort keys %vectors1){

        push @output, "clones with ligations for: ".$cloning_vectors."\n";

        foreach my $clone (@{$vectors1{$cloning_vectors}} ){
            push @output, $clone."\n";
        }

        push @output, "\n";
    }

    if( scalar(keys %digest_not_done) ){

        push @output, "\nDigests NOT Done\n----------------\n";

        foreach my $clone_name (sort keys %digest_not_done){
            my $vectors =
                join(', ', $self->get_vectors_from_clone($dbh,
                                                         $clone_name));

            push @{$vectors2{$vectors}}, $clone_name;
        }

        foreach my $cloning_vectors (sort keys %vectors2){

            push @output, "clones with ligations for: ".$cloning_vectors."\n";

            foreach my $clone (@{$vectors2{$cloning_vectors}} ){
                push @output, $clone."\n";
            }

            push @output, "\n";
        }
    }

    print @output, "\n";

    Mail::sendMail(-to      => $digest_mail,
                   -subject => "Digest info - $self->{date}",
                   -message => join(' ', @output)
                   );
    
    $| = 1;
}

# give it a clone name, it will find all the ligations, hence vectors used.
# will return a list of vectors.
#
sub get_vectors_from_clone {
    my ($self, $dbh, $clone_name) = @_;
    my @vectors;

    my $rows = $dbh->fetch_all(qq[
                       select unique VECTORNAME
                       from   LIGATION l, LIGATION_BATCH lb, VECTORSITE vs
                       where  l.CLONENAME   = '$clone_name'
                       and    l.ID_LIGBATCH = lb.ID_LIGBATCH
                       and    SEQ_VECTOR    = vs.ID_VECTORSITE
                       ]);

    foreach my $row (@{$rows}){
        push @vectors, $row->[0];
    }

    return @vectors;
}

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

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

    Mail::sendMail( -to      => $bug_mail,
                    -subject => "Lemur: Error Passing Ligations.",
                    -message => $message);
    die "$message\n";
}


#######
# EOF
#######
1;
