#######################################################################
# 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 change the scores on a ligation. Subcloner enters basic
# details about a ligation but will not know the scores till the next
# day, hence this module. Volume and frag size can also be changed.
# 
# If the ligation came from a prep, the slice & frag box are now
# required entries, unless it is for Pathogens. They don't store anything,
# but they can if they want.
#
# $Id: LemurUpdateLigs.pm,v 1.33 2001/01/08 11:02:25 pjm Exp $
#

require Exporter;

use     strict;
use     WrapDBI;
use     Mail;

use     Tk;

use TempFiles;
use Sys::Hostname;
use EquusDatabaseInterface;

#require "/nfs/weka2/pjm/badger-bin/EquusDatabaseInterface.pm";


# use     Data::Dumper;


#########################################
# 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";


package LemurUpdateLigs;


##########################################
# 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 = 'pjm';
#my $bug_mail = 'bug';

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

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

    if( defined($requested_db_user) && ($requested_db_user eq '') ) {
	$dbUser = 'dev1'; # safe default
	print "\$dbUser set to $dbUser, the default: no user ".
	     "supplied as args" if $debug;
    }
    else {
	$dbUser = $requested_db_user;
    }

    $pathogens = 0 unless defined $pathogens;

    my $realUserName = getpwuid($<);

    my $self = {
	dbUser         => $dbUser,
	session_id     => $session_id,
	realUserName   => "$realUserName",
        pathogens      => $pathogens,
        write_to_equus => 0, # 1 will turn on writing to Equus
    };

    bless($self, $type);

    $self->createMainWindow($parentWindow);

    return $self;
}

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


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


    $self->{mw}->title("Update Ligations");
    $self->{mw}->Label(width   => 30)->pack;

    my $b = 
	$self->{mw}->Button(-font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
                            -text        => "Update Ligations",
                            -height      => 1,
                            -bg          => 'white',
                            -relief      => 'groove',
                            -borderwidth => '3',
                            )->pack(-side => 'top');
    
    $b->bindtags(['EggButton',$b->toplevel,'all']);
    $b->bind('EggButton', '<Control-Button-2>', sub{ 
	warn "\$debug was $debug, setting to 1\n";
	$debug = 1;
    });

    $self->{mw}->Label()->pack;
    push @{$self->{all_widgets}}, $self->{mw};

    my $ligationF = $self->{mw}->Frame;
    my $buttonF   = $self->{mw}->Frame;
    my $feedbackF = $self->{mw}->Frame;

    $self->createLigationFrame($ligationF);
    $self->createButtonFrame(   $buttonF);

    $feedbackF->Label(-width        => 44,
                      -relief       => 'sunken',
                      -anchor       => 'w',
                      -textvariable => \$self->{feed_back}
                      )->pack();

    $ligationF->pack;
    $buttonF->pack;
    $feedbackF->pack;

    return $self;
}

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

    $self->{feed_back} = $message;
    $self->{mw}->update();
}

sub createLigationFrame {

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

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

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

    my $tf = $lf->Frame(); # temp frame
    my $t = 
	$tf->Entry(-width        => 8,
		   -relief       => 'sunken',
		   -bg           => 'lemonchiffon2',
		   -textvariable => \$self->{ligNum},
		   )->grid(-row    => 1,  
			   -column => 1,
			   -sticky => 'nw');

    $t->bind('<KeyPress-Return>', sub {
	$self->getLigationDetails($self->{ligNum});
    });

    $self->{ligNumWidget} = $t;

    push @{$self->{all_widgets}}, $t;

    # CLONE NAME
    $tf->Label (-width  => 16,
		-text   => '', 
		-anchor => 'nw',
		-textvariable => \$self->{cloneName},
		)->grid(-row    => 1,
			-column => 2,
			-sticky => 'nw');

    # SIZE_FROM..TO_KB (band size ligation was made from)
    my $bandF = $tf->Frame();

    my $t2 = 
        $bandF->Entry(-width  => 3,
                      -textvariable => \$self->{size_from_kb},
                      )->grid(-row    => 1,
                              -column => 1,
                              -sticky => 'ne');
    $bandF->Label(-width  => 3,
                  -text   => '-',
                  )->grid(-row    => 1,
                          -column => 2,);

    my $t3 =
        $bandF->Entry(-width  => 3,
                      -textvariable => \$self->{size_to_kb},
                      )->grid(-row    => 1,
                              -column => 3,
                              -sticky => 'nw');

    $bandF->grid(-row    => 2,
                 -column => 2,
                 -sticky => 'nw');

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


    push @{$self->{all_widgets}}, $t2;
    push @{$self->{all_widgets}}, $t3;


    # SLICE BOX
    $lf->Label (-width  => 16,
                -text   => 'Slice Box', 
                -anchor => 'nw'
                )->grid(-row => 5,  
                        -column => 0, 
                        -sticky => 'nw');
    $self->{slice_box_widget} =
        $lf->Entry(-width        => 24,
                   -relief       => 'sunken',
                   -textvariable => \$self->{slice_box},
                   -bg           => 'lemonchiffon2',
                   )->grid(-row    => 5,  
                           -column => 1,-sticky => 'nw');

    # FRAG BOX
    $lf->Label (-width  => 16,
                -text   => 'Frag Box', 
                -anchor => 'nw',
                )->grid(-row => 6,  
                        -column => 0, 
                        -sticky => 'nw');

    $self->{frag_box_widget} =
        $lf->Entry(-width        => 24,
                   -relief       => 'sunken',
                   -textvariable => \$self->{frag_box},
                   -bg           => 'lemonchiffon2',
                   )->grid(-row    => 6,  
                           -column => 1,-sticky => 'nw');

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


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

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

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

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

    # Comments

    $lf->Label (-width  => 16,
		-text   => 'Comments ',
		-anchor => 'nw'
		)->grid(-row    => 10,  
			-column => 0, 
			-sticky => 'nw');

    $lf->Entry(-width    => 24,
	       -relief   => 'sunken',
	       -bg       => 'lemonchiffon2',
	       -textvariable => \$self->{comments},
	       )->grid(-row    => 10, 
		       -column => 1,-sticky => 'nw' );

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

sub createButtonFrame {
    my ($self, $buttonF) = @_;

    if( $self->{pathogens} ){

        my $pass_fail_F = $buttonF->Frame()->grid(-row        => 1,
                                                  -column     => 1,
                                                  -columnspan => 3);

        $self->{pass_fail_F} = $pass_fail_F;

        $pass_fail_F->Radiobutton(-variable => \$self->{pass_fail},
                                  -text     => 'Pass',
                                  -value    => 'Pass',
                                  -anchor   => 'e',
                                  )->grid(-row    => 1,
                                          -column => 1);

        $pass_fail_F->Radiobutton(-variable => \$self->{pass_fail},
                                  -text     => 'Fail',
                                  -value    => 'Fail',
                                  -anchor   => 'w',
                                  )->grid(-row    => 1,
                                          -column => 3);

        # To start with unmap these widgets
        $pass_fail_F->bind ("<Map>", sub {
                                $self->{pass_fail_F}->UnmapWindow();
                            } );
        $pass_fail_F->UnmapWindow();

        # DEFAULT STATUS
        $self->{pass_fail} = 'Pass';


        # How many labels?
        my $labels_F = $buttonF->Frame()->grid(-row        => 2,
                                               -column     => 1,
                                               -columnspan => 3);

        $self->{labels_F} = $labels_F;

        $labels_F->Label(-text => 'Num Plates',
                         -width => 14,
                         )->grid(-row    => 1,
                                 -column => 1);

        $labels_F->Entry(width          => 3,
                         -relief        => 'sunken',
                         -textvariable  => \$self->{num_labels},
                         )->grid(-row     => 1, 
                                 -column  => 2, -sticky => 'nw' );

        $labels_F->bind ("<Map>", sub {
                                $self->{labels_F}->UnmapWindow();
                            } );
        $labels_F->UnmapWindow();
        
    }

    $buttonF->Button(-width    => 10,
		     -text     => 'Change',
		     -command  => sub { $self->changePressed(); },
		     )->grid(-row    => 3,
			     -column => 1,
			     -sticky => 'ne');
 
    $buttonF->Label(-width    => 10,
		    )->grid(-row     => 3,
			     -column => 2,
			     -sticky => 'ne');

    $buttonF->Button(-width    => 10,
		     -text     => 'Done',
		     -command => \ sub {
			 $self->disconnect();
			 $self->{mw}->destroy;
		     }
		     )->grid(-row    => 3,
			     -column => 3,
			     -sticky => 'ne');
}


# checks ligNum is a valid positive integer first, then gets
# ligation details for $ligNum and set variables to populate window.
#
# NOTE: a ligation could be part of standard shotgun so it can be linked to
# a DNAPrep. If it is part of a SIL for a finisher it will be linked to a 
# SIL_REQUEST. Might have to traverse both before getting the clone name.

sub getLigationDetails {
    my ($self, $ligNum) = @_;

    if( ! ($self->{ligNum} =~ /^\d+$/)) {
	LemurUtils->showError($self->{mw},
			      "You must entera valid ligation number.");
	return;
    }

    LemurUtils->setWait( $self->{all_widgets} );
    $self->set_feed_back("Getting details...");

    my @row;
    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;

	# try shotgun first.
	@row =
            $dbh->fetch_row(qq[
                               select  l.VOLUME, l.POSITIVE, l.NEGATIVE,
                                       l.COMMENTS, dp.CLONENAME,
                                       fb.SIZE_FROM_KB, fb.SIZE_TO_KB,
                                       fb.FRAGMENT_BOX, f.SLICE_BOX,
                                       dp.ID_CULTURE
                               from    LIGATION l, FRAGMENTATION_BAND fb, 
                                       DNAPREP_FRAG dpf,
                                       DNAPREP dp,
                                       FRAGMENTATION f
                               where   ID_LIGATION   = $ligNum
                               and     l.ID_FRAGBAND = fb.ID_FRAGBAND
                               and     fb.ID_FRAG    = dpf.ID_FRAG
                               and     fb.ID_FRAG    = f.ID_FRAG
                               and     dpf.ID_PREP   = dp.ID_PREP
                               ]);

        $self->{source} = 'DNA Prep';
        $self->{slice_box_widget}->configure(-bg => 'lemonchiffon2');
        $self->{frag_box_widget}->configure( -bg => 'lemonchiffon2');

        if( ! defined($row[9]) ){
            my $status = 
                $dbh->fetch_scalar(qq[
                                      select STATUS
                                      from   LIGATION_STATUS
                                      where  ID_LIGATION = $ligNum
                                      and    ISCURRENT   = 1
                                      ]);

            if( $status == 5 ){
                $self->{pass_fail} = 'Pass';
            }
            elsif( $status == 9 ){
                $self->{pass_fail} = 'Fail';
            }
            else {
                $self->{pass_fail} = 'Pass';
            }
        }

	if( scalar(@row) == 0 ){
	    # might be for a SIL
	    print "ligation was _not_ related to a DNAPREP\n" if $debug;

	    @row = $dbh->fetch_row("
	    select  l.VOLUME, l.POSITIVE, l.NEGATIVE, l.COMMENTS, sds.CLONENAME,
                    fb.SIZE_FROM_KB, fb.SIZE_TO_KB, fb.FRAGMENT_BOX, f.SLICE_BOX
            from    LIGATION l, FRAGMENTATION_BAND fb, FRAGMENTATION f,
                    SIL_JOB sj, SIL_REQUEST sr, SIL_DNASOURCE sds
            where   ID_LIGATION   = $ligNum
            and     l.ID_FRAGBAND = fb.ID_FRAGBAND
            and     fb.ID_FRAG    = sj.ID_FRAG
            and     fb.ID_FRAG    = f.ID_FRAG
            and     sj.ID_REQUEST = sr.ID_REQUEST
            and     sr.ID_SOURCE  = sds.ID_SOURCE");

            $self->{source} = 'Job';
            $self->{slice_box_widget}->configure(-bg => 'white');
            $self->{frag_box_widget}->configure( -bg => 'white');

            # last try. This could have been entered via the Equus to Oracle
            # program, so it's not from a DNAPREP or SIL_JOB
            # The $self->{source} var can equal 'Job'
            #

            if( scalar(@row) == 0 ){
                print "Ligation did not come from a prep or job.\n" if $debug;

                @row =
                    $dbh->fetch_row(qq[
                                       select  l.VOLUME, l.POSITIVE, l.NEGATIVE,
                                               l.COMMENTS, l.CLONENAME,
                                               fb.SIZE_FROM_KB, fb.SIZE_TO_KB,
                                               fb.FRAGMENT_BOX, f.SLICE_BOX
                                       from    LIGATION l,
                                               FRAGMENTATION_BAND fb,
                                               FRAGMENTATION f
                                       where   ID_LIGATION   = $ligNum
                                       and     l.ID_FRAGBAND = fb.ID_FRAGBAND
                                       and     fb.ID_FRAG    = f.ID_FRAG ]);
            }

	}
	else {
	    print "ligation _was_ related to a DNAPREP\n" if $debug;
	}
    };

    if( $@ ){
        my $error = $@;

        LemurUtils->unSetWait( $self->{all_widgets} );
        $self->set_feed_back("");

	$self->expire("$error : LemurUpdateLigs, getLigationsDetails()");
    }

    if( scalar(@row) == 0 ){
	LemurUtils->showInfo($self->{mw},
			     "No ligation exists for $self->{ligNum}");
	$self->clearVariables();
    }
    else {
	$self->{volumeUsed}   = $row[0];
	$self->{clear}        = $row[1];
	$self->{blue}         = $row[2];
	$self->{comments}     = $row[3];
	$self->{cloneName}    = $row[4];
        $self->{size_from_kb} = $row[5];
        $self->{size_to_kb}   = $row[6];
        $self->{frag_box}     = $row[7];
        $self->{slice_box}    = $row[8];
        $self->{id_culture}   = $row[9];

        $self->{seq_vector} =
            $dbh->fetch_scalar(qq[ select VECTORNAME
                                   from   VECTORSITE vs, LIGATION_BATCH lb,
                                          LIGATION l
                                   where  l.ID_LIGATION = $self->{ligNum}
                                   and    l.ID_LIGBATCH = lb.ID_LIGBATCH
                                   and    lb.SEQ_VECTOR = vs.ID_VECTORSITE ]);
    }

    # show/hide  pass/fail widgets depending on the DNAPREP having a ID_CULTURE
    # entry (if lemur created the record it won't have one, thus pathogen)

    if( defined($self->{pathogens}) && $self->{pathogens} ){

        if(  (defined($self->{id_culture}) && $self->{id_culture})
           || scalar(@row) == 0  ){

            $self->{pass_fail_F}->bind ("<Map>", sub {
                $self->{pass_fail_F}->UnmapWindow();
            } );
            $self->{pass_fail_F}->UnmapWindow();

            $self->{labels_F}->bind ("<Map>", sub {
                $self->{labels_F}->UnmapWindow();
            } );
            $self->{labels_F}->UnmapWindow();
            
        }
        else {
            $self->{pass_fail_F}->bind("<Map>", sub {});
            $self->{pass_fail_F}->MapWindow();

            $self->{labels_F}->bind("<Map>", sub {});
            $self->{labels_F}->MapWindow();
        }
    }

    LemurUtils->unSetWait( $self->{all_widgets} );
    $self->set_feed_back("");
}

#
#
#

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

    $self->set_feed_back("Connecting to Oracle...");

    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->set_feed_back("Validating input");

	unless($self->isValidInput($dbh)) {
	    die "everythings cool\n";
	}

	if( $self->areYouSure eq 'Yes' ) {
            LemurUtils->setWait([$self->{mw}]);

	    $self->writeLigationDetails($dbh);
	    $self->clearVariables();
	    $self->{ligNumWidget}->focus();

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

    if ($@ && ! ($@ =~ "everythings cool")) {
        my $error = $@;
        LemurUtils->unSetWait([$self->{mw}]);
        $self->set_feed_back("");
        $dbh->disconnect(); # if record locked, this should unlock it
        $dbh = undef;
	$self->expire("$error : LemurUpdateLigs::writeLigationsDetails()");
    }

    $self->{dbi}->commit;
    LemurUtils->unSetWait([$self->{mw}]);
    $self->set_feed_back("");
}

#
#
#

sub isValidInput {
    my ($self, $dbh)      = @_;
    my $mustEnter         = "You must enter ";
    my $originalMustEnter = "You must enter ";
    my $good_ligation     = 0;

    if( $self->{ligNum} eq '' ){
	$mustEnter .= "a ligation number, ";
    }
    elsif( ! ($self->{ligNum} =~ /^\d+$/)) {
	$mustEnter .= "a valid ligation number, ";
    }
    else {
	my $t = $dbh->fetch_scalar("
            select ID_LIGATION
            from   LIGATION
            where  ID_LIGATION = $self->{ligNum}");

	if( $t != $self->{ligNum} ) {
	    $mustEnter .= "a valid ligation number, ";
	}
        else {
            # if it got here it is a valid ligation number
            $good_ligation = 1;
        }
    }

    # Remove leading & trailing spaces
    $self->{size_from_kb} =~ s/^\s*//;
    $self->{size_from_kb} =~ s/\s*$//;
    $self->{size_to_kb}   =~ s/^\s*//;
    $self->{size_to_kb}   =~ s/\s*$//;

    # FRAG SIZE (From - To)
    if( $self->{size_from_kb} eq '' ){
        $mustEnter .= "the fragment size from (in KB), ";
    }
    elsif( ! LemurUtils->isValidNumber($self->{size_from_kb}) ){
        $mustEnter .= "a valid number for \"Fragment size From\" (in KB), ";
    }

    if( $self->{size_to_kb} eq '' ){
        $mustEnter .= "the fragment size To (in KB), ";
    }
    elsif( ! LemurUtils->isValidNumber($self->{size_to_kb}) ){
        $mustEnter .= "a valid number for \"Fragment size To\" (in KB), ";
    }

    # 
    # For a SIL, nothing will be stored in a slice or frag box. Pathogens
    # _may_ store stuff but may not. Human stuff i.e. everything else MUST have
    # a slice & frag box entry
    #
    if( $self->{source} eq 'DNA Prep' && ! ( $self->{pathogens}) ){

        # SLICE BOX slice_box
        if( $self->{slice_box} eq '' ){
            $mustEnter .= "the slice box number, ";
        }

        # FRAG BOX
        if( $self->{frag_box} eq '' ){
            $mustEnter .= "the frag box number, ";
        }
    }

    # Make sure if human or pathogen stuff entered, correct values
    if( $self->{slice_box} ){
        if( $self->{slice_box} !~ /^-?\d{1,6}$/ ){
            $mustEnter .= "a valid slice box number, ";
        }
    }
     
    if( $self->{frag_box} ){
        if( $self->{frag_box} !~ /^-?\d{1,6}$/ ){
            $mustEnter .= "a valid frag box number, ";
        }
    }

    # fragment volume
    if( $self->{volumeUsed} eq '' ) {
        $mustEnter .= "a fragment volume, ";
    }
    elsif( ! (LemurUtils->isValidNumber($self->{volumeUsed})) ){
        $mustEnter .= "a valid number for fragment volume";
    }
    elsif( $self->{volumeUsed} == 0 || $self->{volumeUsed} > 9999 ){
        $mustEnter .= "a fragment volume between 0.1 and 9999, ";
    }

    # clear
    if( $self->{clear} eq '' ) {
	$mustEnter .= "the number of clear, ";
    }
    elsif( ! LemurUtils->isValidNumber($self->{clear}) ){
	$mustEnter .= "the number of clear as a number, ";
    }

    # blue
    if( $self->{blue} eq '' ) {
	$mustEnter .= "the number of blue, ";
    }
    elsif( ! LemurUtils->isValidNumber($self->{blue}) ){
	$mustEnter .= "the number of blue as a number, ";
    }

    # Check the ligation picked IS FOR PATHOGENS if this window has been fired
    # off for !

    if( defined($self->{pathogens}) &&
        $self->{pathogens}          && 
        $good_ligation                ){

        my $result = $self->prep_was_entered_via_lemur($dbh, $self->{ligNum});

        print "result = $result\n" if $debug;

        if( $result eq 'no' ){
            print "Prep entered via Dodo\n" if $debug;
        }
        else {
            print "Prep entered via LEMUR!!!\n" if $debug;
        }
    }

    # return 0 for bad, 1 for good.
    if( $mustEnter ne $originalMustEnter ) {
	$mustEnter =~ s/,\s$/./;           # strip off ', ' at end
	LemurUtils->showError($self->{mw}, $mustEnter);
	return 0;
    }

    return 1;
}

# trace up the tables from LIGATION to see if a CLONE_CULTURE record exists
# If it was entered via Lemur, it wont have one, hence return 'yes'. If entered
# via Dodo will return 'no'
#
sub prep_was_entered_via_lemur {
    my ($self, $dbh, $ligation) = @_;

    my $id_culture =
        $dbh->fetch_scalar(qq[
                               select dp.ID_CULTURE
                               from   LIGATION l, FRAGMENTATION_BAND fb,
                                      DNAPREP_FRAG dpf, DNAPREP dp
                               where  l.ID_LIGATION = $ligation
                               and    l.ID_FRAGBAND = fb.ID_FRAGBAND
                               and    fb.ID_FRAG    = dpf.ID_FRAG
                               and    dpf.ID_PREP   = dp.ID_PREP
                               ]);

    if( $id_culture ){
        return 'no';
    }
    else {
        return 'yes';
    }
}


#
# Tries to lock ligation record before update.
#

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

    unless( defined($self->{ligNum}) && $self->{ligNum} ){
        print "Internal error: trying to update an 'empty' ligation number!\n";
        die "everythings cool"; # don't output error message, just clear everything
    }

    eval {
	my $s = qq[select l.ID_LIGATION, fb.FRAGMENT_BOX
                   from   LIGATION l, FRAGMENTATION_BAND fb
                   where  ID_LIGATION   = ?
                   and    l.ID_FRAGBAND = fb.ID_FRAGBAND
                   for update nowait ];

	my $sth = $dbh->prepare($s)    || die "ERROR:$DBI::errstr";
	$sth->execute($self->{ligNum}) || die "ERROR:$DBI::errstr";
	$sth->finish;  
    };

    if ($@ =~ /ORA-00054: resource busy and acquire with NOWAIT specified/){

	LemurUtils->showError($self->{mw},
			      "Sorry, the entry for ligation $self->{ligNum} ".
			      "is locked by someone else. Try again later.");
	    
	die "everythings cool\n";
    }
    elsif($@) {
	die "$@";
    }

    $self->set_feed_back("Updating LIGATION table");

    if( $debug ){
        print "About to update ligation\n";
        print "  lig num     = $self->{ligNum}\n";
        print "  volume used = $self->{volumeUsed}\n";
        print "  clear       = $self->{clear}\n";
        print "  blue        = $self->{blue}\n";
    }

    my $sth_update_lig = $dbh->prepare(q[update LIGATION
                                         set    VOLUME   = ?,
                                                POSITIVE = ?,
                                                NEGATIVE = ?,
                                                COMMENTS = ?
                                         where  ID_LIGATION = ?]);

    $sth_update_lig->execute($self->{volumeUsed},
                             $self->{clear},
                             $self->{blue},
                             $self->{comments},
                             $self->{ligNum});
    $sth_update_lig->finish();

    # If pathogen, create Pass or Fail status record
    if( defined($self->{pathogens}) && $self->{pathogens} ){
        my $status;

        if( $self->{pass_fail} eq 'Pass' ){
            $status = 5;
        }
        else{
            $status = 9; # Fail
        }

        my $sth_update_lig_is_zero = $dbh->prepare(q[UPDATE ligation_status
                                                     SET    iscurrent  = 0
                                                     WHERE  id_ligation = ?
                                                     AND    iscurrent   = 1]);

        $sth_update_lig_is_zero->execute($self->{ligNum});
        $sth_update_lig_is_zero->finish();

        my $sth_insert_lig_status =
            $dbh->prepare(q[insert into LIGATION_STATUS
                                   (ID_LIGATION,
                                    STATUS,
                                    STATUSDATE,
                                    ISCURRENT,
                                    SESSIONID,
                                    PROGRAM,
                                    OPERATOR)
                            values (?, ?, SYSDATE, 1,
                                    ?, 'LemurUpdateLigs', ?)]);

        $sth_insert_lig_status->execute($self->{ligNum},
                                        $status,
                                        $self->{session_id},
                                        $self->{realUserName});
        $sth_insert_lig_status->finish();
    }

    # if SIL, won't store fragment & slice. Pathogens _may_
    #

    print "Looking up fragband for lig: $self->{ligNum}\n" if $debug;

    my $sth_get_frag_band = 
        $dbh->prepare(q[select fb.ID_FRAG, fb.ID_FRAGBAND
                        from   FRAGMENTATION_BAND fb, LIGATION l
                        where  l.ID_LIGATION = ?
                        and    l.ID_FRAGBAND = fb.ID_FRAGBAND  ]);

    $sth_get_frag_band->execute($self->{ligNum});
    my ($id_frag, $id_fragband) = $sth_get_frag_band->fetchrow_array();
    $sth_get_frag_band->finish();

    print "Got fragband: id_frag = $id_frag, id_fragband , ".
        "$id_fragband\n" if $debug;
    
    $self->set_feed_back("Updating FRAGMENT details");

    unless( $self->{frag_box} ){
        $self->{frag_box} = "";
    }

    unless( $self->{slice_box} ){
        $self->{slice_box} = "";
    }

    my $sth_update_frag_band =
        $dbh->prepare(q[update FRAGMENTATION_BAND fb
                        set    FRAGMENT_BOX = ?,
                               SIZE_FROM_KB = ?,
                               SIZE_TO_KB   = ?
                        where  ID_FRAGBAND  = ?  ]);

    my $sth_update_fragmentation =
        $dbh->prepare(q[update FRAGMENTATION
                        set    SLICE_BOX = ?
                        where  ID_FRAG   = ?  ]);

    $sth_update_frag_band->execute($self->{frag_box},
                                   $self->{size_from_kb},
                                   $self->{size_to_kb},
                                   $id_fragband);
    $sth_update_fragmentation->execute($self->{slice_box},
                                       $id_frag);
    $sth_update_frag_band->finish();
    $sth_update_fragmentation->finish();
    
    # reset these var back to empty string - this is what user sees after all!
    if( $self->{frag_box} eq "''" ){
        $self->{frag_box} = '';
    }

    if( $self->{slice_box} eq "''" ){
        $self->{slice_box} = '';
    }

    if( $self->{write_to_equus} ){
        $self->set_feed_back("Updating Equus");

        # if this ligation exists in Equus, update it.
        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 $x    = $self->{variableBandUsed}; # range 1..4 - frag sizes
        my $from = $self->{variableBandsArray}->[$x][0];
        my $to   = $self->{variableBandsArray}->[$x][1];

        #    $self->{dateDone} =~ /(\d+)\/(\d+)\/(\d+)/;
        #    my $ACEdate       = "$3-$2-$1";

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

        my $clone       = $self->{cloneName};
        my $ligation    = $self->{ligNum};
        my $date        = '';
        my $minSize     = '';
        my $maxSize     = '';
        my $volume      = $self->{volumeUsed};
        my $blue        = $self->{blue};
        my $clear       = $self->{clear};
        my $fragmentBox = $self->{frag_box};
        my $remark      = $self->{comments};

        if( $db->checkExists('Ligation', $ligation) ) {

            # @paths will probably get '' as the first element.
            # If something goes wrong it may get something different.
            my @paths = $db->updateLigation($clone,
                                            $ligation,
                                            $date,
                                            $vector,
                                            $minSize,
                                            $maxSize,
                                            $volume,
                                            $blue,
                                            $clear,
                                            $fragmentBox,
                                            $remark);

            $db->commit;
            print "Equus commit complete (EnterBatchOfLigs)\n" if $debug;
        }
        else {
            print "\nWARNING: Ligation $ligation did not exist in Equus\n\n";
        }
    }
    
    $self->print_labels($dbh); # will only work in pathogen mode
}

sub areYouSure {
    my ($self)  = @_;
    my $message = 'Are you sure you wish to commit these changes to the '.
	          'database?';

    my $dialog = $self->{mw}->Dialog (
				      -title          => "Are You Sure?",
				      -text           => "$message",
				      -default_button => 'No',
				      -buttons        => ['Yes', 'No']);
    my $answer = $dialog->Show();
    return $answer;
}

#
# This is for Pathogens only - sometimes they don't go through the 
# Transformation people.
#
sub print_labels {
    my ($self, $dbh) = @_;
    
    # $self->{num_labels} will be unset for human, thus will return
    if( $self->{num_labels} eq ''       ||
        $self->{num_labels} !~ /^\d+$/    ){
        return;
    }

    print "print_labels called\n";

    my $label = Barcode->new();

    $label->Printer('d336bc2');
    $label->Type('SP'); # Subclone Plate - this sets the label format

    my $cloneName   = $self->{cloneName};
    my $id_ligation = $self->{ligNum};
    my $vector      = $self->{seq_vector};
    my $num_plates  = $self->{num_labels};
    my $teamName    = 53; # hard coded bad :(
    my $job_num     = LemurUtils->get_job_num_for_ligation($dbh, $id_ligation);
    my $name;

    if( $job_num ){
        $name = $job_num;
    }
    else{
        $name = $cloneName;
    }

    foreach my $plateNum ( 1..$num_plates ){

        print "Printing plate $plateNum of $num_plates\n";

        $label->Barcode($id_ligation);
        $label->Name(   $name);
        $label->Project("Lig $id_ligation-$plateNum");
        $label->Suffix( $vector);
        $label->Owner(  "T$teamName");

        $label->Labellist(); # 'commit' label so can start fresh on next
    }
        
#    $label->Break(); # blank label

    # Now print the labels.
    eval{ $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);
    }
    else {
        LemurUtils->showInfo($self->{mw},
                             "Please collect your labels from the printer");
    }
}

#
#
sub clearVariables {
    my ($self) = @_;

    ($self->{ligNum},
     $self->{volumeUsed},
     $self->{clear},
     $self->{blue},
     $self->{comments},
     $self->{cloneName},
     $self->{size_from_kb},
     $self->{size_to_kb},
     $self->{source},
     $self->{slice_box},
     $self->{frag_box},
     $self->{id_culture},
     $self->{num_labels}) = @{[]};
}

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

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

    print "ERROR: $message\n";

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

    Mail::sendMail( -to      => $bug_mail,
                    -subject => "Error entering Fragment details.", 
                    -message => $message);

    $self->disconnect();

    die;
}

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

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

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

    $self->disconnect();
}

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

1;


#
# $Log: LemurUpdateLigs.pm,v $
# Revision 1.33  2001/01/08  11:02:25  pjm
# User could not enter "can't" because "'" messed up SQL. Did prepare execute
# instead.
#
# Revision 1.32  2000/11/01  17:31:09  pjm
# strips off spaces from the frag size from - to
#
# Revision 1.31  2000/07/24  16:26:01  pjm
# It was putting "''" into the slice & frag box if they were empty. Left over
# from non bind variable SQL...
#
# Revision 1.30  2000/07/21  10:15:46  pjm
# By default it no longer writes to Equus. A program like
# put_oracle_ligs_into_equus.pl should be used to transfer the data to Equus.
#
# Revision 1.29  2000/07/14  10:33:42  pjm
# change frag vol message to "...0.1 to 9999"
#
# Revision 1.28  2000/07/04  12:17:09  pjm
# Changing the frag size can be done by anybody.
# Changed SQL to prepare execute for FRAGMENTATION_BAND & FRAGMENTATION
#
# Revision 1.27  2000/06/13  13:16:28  pjm
# Main "label" on window is now a button. Click middle button and crtl to enable
# debug mode. More debug info gets spat out now. Some SQL statements have
# new lines removed from them.
#
# Revision 1.26  2000/06/07  17:16:39  pjm
# outputs error message if somehow it gets to writeLigationDetails and no
# lig num has been entered.
#
# Revision 1.25  2000/04/14  11:19:02  pjm
# commented out $label->Break();
#
# Revision 1.24  2000/04/14  10:22:29  pjm
# called LemurUtils->get_job_num_for_ligation() to see if lig came from a job,
# if so it rpints out the job number on the label, not the clone name.
#
# Revision 1.23  2000/03/01  14:48:59  pjm
# it was passing ligations if the DNAprep did not have an ID_CULTURE set.
# changed this so only if in pathogen mode will it write out a status record
#
# Revision 1.22  2000/02/18  17:45:16  pjm
# Added code to print subclone labels, but only for Pathogens.
#
# Revision 1.21  2000/02/18  11:26:05  pjm
# Pathogen can enter Frag & Slice boxes if they want.
#
# Revision 1.20  2000/02/15  16:23:53  pjm
# added another SQL statement to get lig info if it didn't come from a Job
# or a DNAPREP
#
# Revision 1.19  2000/01/31  15:59:37  pjm
# used LemurUtils->isValidNumber on the blue & clear values.
#
# Revision 1.18  2000/01/27  09:48:07  pjm
# set $debug to 0
#
# Revision 1.17  2000/01/26  14:42:14  pjm
# Added Pathogen stuff (like pass & fail buttons). Validation will ignore
# frag & slice box.
#
#



