#######################################################################
# 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
#
# The user enters a clone name hits return and a list of ligations for
# that clone is displayed along with info needed to choose the number
# of plates needed.
#
# They enter each plate request and hit Add. The request is shown in a 
# list box at the bottom of the screen. They are able to remove requests
# by clicking on one of them and hitting the delete button. When they press
# Done it will show them the same list and ask them if they want to add more,
# don't add any or add these request.
#
# Starting autonaming off has been added to this program. If autonaming has not
# been started this program will suggest a plate name but allow the user to
# change it.
#
# $Id: LemurRequestPlate.pm,v 1.31 2006/01/24 13:20:33 mdf Exp $
#

package LemurRequestPlate;

require Exporter;

use strict;
use WrapDBI;
use LemurUtils;
use Tk::Dialog;
use Date::Manip;
use Data::Dumper;
use platetrack_general;
use Show_Plates;
use Kill_Equus;
use LemurShowExistingRequests;

#require "/nfs/galyep/pjm/badger-bin/LemurShowExistingRequests.pm";

&Date_Init("DateFormat=nonUS"); # so 12/10/1999 is oct 12, not dec 10

my $debug = 0; # set to 1 to get print out on whats module is up to.

sub new {
    my ($type, $dbUser, $sessionID) = @_;

    my $self = {
	dbUser           => $dbUser,
	session_id       => $sessionID,
        fixed_width_font =>
            '-misc-fixed-medium-r-normal--20-200-75-75-c-100-iso8859-1',
    };
    bless($self, $type);

    $self->{user} = getpwuid($<);

    if( $dbUser eq 'dev1' ){
        print "User = dev1\n";
    }

    $self->getData();
    $self->prepare_sql();
    $self->createWindow();

    return $self;
}

#

sub createWindow {
    my ($self) = @_;
    my $mw     = new MainWindow;

    $mw->protocol('WM_DELETE_WINDOW' => sub { 
	$self->finish_sql();
        $self->{dbi}->disconnect() if $self->{dbi};
        $self->{mw}->destroy();
    });

    $mw->title('Request Plates');
    $mw->Label(width   => 40)->pack;

    my $b = 
	$mw->Button(-font        => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
		    -text        => 'Request Plates',
		    -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;
    });

    $mw->Label(width   => 35)->pack;

    $self->{mw} = $mw;
    my $frame1  = $mw->Frame(-relief => 'raised',);
    my $top_left_f = $frame1->Frame()->grid(-row  => 1,
                                            -column => 1,
                                            -columnspan => 2,
                                            -sticky => 'nw');

    # CLONE NAME & AUTONAMING
    $top_left_f->Label(-text => "Clone Name", -anchor => 'w',
                       -width => 19,
                       )->grid(-row  => 1, -column => 1,
                               -sticky => 'nw');
    $self->{cloneNameWidget} =
	$top_left_f->BrowseEntry(
			     -width    => 16,
			     -relief   => 'sunken',
			     -variable => \$self->{cloneName},
			     -browsecmd => sub {
				 $self->getLigations();
			     },
			     )->grid(-row  => 1, -column => 2, -sticky => 'nw');


    LemurUtils->setBrowseEntryLemon($self->{cloneNameWidget});

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

    $self->{cloneNameWidget}->bind('<KeyPress-Return>', sub { 
	$self->searchForCloneName;
    });

    $top_left_f->Button(-text => 'Show existing requests...',
                        -command => sub {
                            LemurUtils->setWait([$mw]);
                            LemurShowExistingRequests->new(
                                           {clone_name    => $self->{cloneName},
                                            parent_window => $mw});
                            LemurUtils->unSetWait([$mw]);
                        },
                        )->grid(-row  => 4, -column => 2, -columnspan => 2);

    # AUTONAMING
    my $an_f = $frame1->Frame(-borderwidth => 3,
                              -relief => 'groove')->grid(-row    => 1,
                                                        -column => 3,
                                                        -sticky => 'nw');
    $self->{autonaming_w} =
	$an_f->Checkbutton(-text     => 'Autonaming off',
#                             -width    => 16,
			     -variable => \$self->{autonaming},
                             -command  => sub {
                                 $self->set_autonaming($self->{autonaming},
                                                       $self->{auto_root_name},
                                                       $self->{auto_next_num});
                             },
			     )->grid(-row    => 1,
                                     -column => 3,
                                     -sticky => 'nw', -columnspan => 2);
    
    $self->{auto_root_lw} =
        $an_f->Label(-text  => 'Root',
                     -width => 10,
                     -anchor => 'w',
                     )->grid(-row  => 2, -column => 3,-sticky => 'nw');
    $self->{auto_root_ew} =
        $an_f->Entry(-width => 16,
                     -textvariable => \$self->{auto_root_name},
                     )->grid(-row  => 2, -column => 4,-sticky => 'nw');

    $self->{auto_next_num_lw} =
        $an_f->Label(-text  => 'Next Num',
                     -width => 10,
                     -anchor => 'w',
                     )->grid(-row  => 3, -column => 3,-sticky => 'nw');
    $self->{auto_next_num_ew} =
        $an_f->Entry(-width => 16,
                     -textvariable => \$self->{auto_next_num},
                     )->grid(-row  => 3, -column => 4,-sticky => 'nw');
    $an_f->Button(-text => 'Show existing plates...',
                  -command => sub {
                      LemurUtils->setWait([$mw]);
                      Show_Plates->new( {clone_name    => $self->{cloneName},
                                         parent_window => $mw});
                      LemurUtils->unSetWait([$mw]);
                   },
                  )->grid(-row  => 4, -column => 3, -columnspan => 2);

    # HEADINGS FOR LIST
    my $txt = sprintf("%-8s %-12s %-3s", 'Ligation', 'Vector', 'SIL');

    $frame1->Label(-text => $txt,
		   -font => $self->{fixed_width_font},
		   )->grid(-row  => 2, -column => 2,-sticky => 'nw');

    # LIST OF LIGATIONS
    $frame1->Label(-text => "Ligations for clone",
                   -width => 19,
                   -anchor => 'w',
		   )->grid(-row  => 3, -column => 1,-sticky => 'nw');
    $self->{ligationsListWidget} =
	$frame1->ScrlListbox(-font            => $self->{fixed_width_font},
			     -width           => 25,
                             -height          => 6,
			     -scrollbars      => 'e',
			     -selectmode      => 'single',
			     -exportselection => 0
			     )->grid(-row => 3, -column => 2,-sticky => 'nw');

    $self->{ligationsListWidget}->bind('<1>', 
				       [ sub{ $self->ligationPicked()} ]);

    # NEXT TO LISTBOX
    my $f3 = $frame1->Frame(-borderwidth => 3,
                            -relief => 'groove',
                            -height => 5)->grid(-row    => 3,
                                                       -column => 3,
                                                       -sticky => 'nw');

    $f3->Label(-text   => 'Sequence length ',
		-width  => 19,
		-anchor => 'w'
		)->grid(-row  => 1, -column => 1,-sticky => 'nw');

    $f3->Label(-textvariable => \$self->{sequence_length},
                -anchor       => 'w'
		)->grid(-row  => 1, -column => 2,-sticky => 'nw');

    $f3->Label(-text   => '~ Topup 96 well LPs',
               -width  => 18,
               -anchor => 'w'
               )->grid(-row  => 2, -column => 1,-sticky => 'nw');

    $f3->Label(-textvariable  => \$self->{topup_lp_needed},
                -width        => 8,
                -anchor       => 'w'
		)->grid(-row  => 2, -column => 2,-sticky => 'nw');
    
    $f3->Label(-text   => 'Ligation size ',
		-width  => 18,
		-anchor => 'w'
		)->grid(-row  => 3, -column => 1,-sticky => 'nw');

    $f3->Label(-textvariable => \$self->{frag_size},
                -width        => 8,
                -anchor       => 'w'
		)->grid(-row  => 3, -column => 2,-sticky => 'nw');


    # FRAMEs to put all of the widgets under Listbox ($ul), on each line
    my $ul1 = $frame1->Frame();
    my $ul2 = $frame1->Frame();

    # NUMBER OF PLATES line
    $frame1->Label(-text => "Number of plates"
		   )->grid(-row  => 4, -column => 1,-sticky => 'nw');
    $ul1->Entry(-width => 4,
		-bg   => 'LemonChiffon2',
		-textvariable => \$self->{num_of_plates},
		)->grid(-row  => 1, -column => 1,-sticky => 'nw');

    $ul1->Label(-width => 5)->grid(-row  => 1, -column => 2,-sticky => 'nw');


    # DATE WANTED BY line

    $frame1->Label(-text => "Wanted By"
		   )->grid(-row => 5, -column => 1,-sticky => 'nw');
    $ul2->Entry(-width => 10,
		-bg    => 'LemonChiffon2',
		-textvariable => \$self->{date_wanted},
		)->grid(-row  => 2, -column => 1,-sticky => 'nw');


    $ul1->grid(-row => 4, -column => 2,-sticky => 'nw');
    $ul2->grid(-row => 5, -column => 2,-sticky => 'nw');
    $ul2->Label()->grid(-row => 6, -column => 1);




    # BUTTONS
    my $frame2  = $mw->Frame(-relief => 'raised',);

    $frame2->Button(-text => 'Add',
		    -command => sub {
			$self->addPressed();
		    },
		    )->grid(-row  => 1, -column => 1, -sticky => 'nw');

    $frame2->Label(-width => 13)->grid(-row  => 1, -column => 2);

    $frame2->Button(-text => 'Reports',
		    -command => sub {
			system 'Reports -prog gull/Subclone_Plates &';
		    },
		    )->grid(-row  => 1, -column => 3);

    $frame2->Label(-width => 13)->grid(-row  => 1, -column => 4);

    $frame2->Button(-text => 'Done',
		    -command => sub { $self->done_pressed() },
		    )->grid(-row  => 1, -column => 5, -sticky => 'ne');

    # Listbox
    # Frame 3
    my $frame3  = $mw->Frame(-relief => 'raised',);

    $self->{list_widget} =
        $frame3->Scrolled('Listbox',
                          -width  => 59,
                          -height => 10,
                          -relief => 'groove',
                          -font   => $self->{fixed_width_font},
                          )->pack();
    $frame3->Button(-text =>'Delete',
                    -command => sub { $self->delete_request(); },
                    )->pack();

    $frame1->pack();
    $frame2->pack();
    $frame3->pack();
}



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

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

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

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

sub delete_request {
    my ($self)   = @_;
    my $index    = $self->{list_widget}->curselection();

    return if $index < 2; # index starts a 0

    $self->{list_widget}->get($index) =~ /^\s+(\w+)\s+(\w+)\s+(\w+)/;
    my $clone    = $1;
    my $ligation = $2;

    my $last_indices = $#{$self->{request}};

    for(my $x = $index - 2; $x < $last_indices; ++$x){
        $self->{request}->[$x] = $self->{request}->[$x + 1];
    }

    pop @{$self->{request}};

    $self->show_requests();
}


################################################################################
# connects to DB and handles any errors.
################################################################################

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

    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->{id_person} = $dbh->fetch_scalar("
            select ID_PERSON
            from   PERSON
            where  EMAIL = '$self->{user}'");
    };

    if ($@) {
	if ($DBI::err) {
	    $self->expire("$DBI::errstr: $@ Occured in getData()");
	} else {
	    $self->expire("$@: Occured in getData()");
	}
    }

#    $dbh->disconnect if $dbh;
}

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

    $self->{sth_get_clone_names} = 
        $dbh->prepare(q[select c.CLONENAME, ps.STATUS
                        from   CLONE c, CLONE_PROJECT cp, PROJECT_STATUS ps
                        where  c.CLONENAME like ?
                        and    c.CLONENAME = cp.CLONENAME
                        and    cp.PROJECTNAME = ps.PROJECTNAME
                        and    ps.STATUS    not in (24, 26)
                        and    ps.ISCURRENT   = 1
                        order by CLONENAME  ]);


    $self->{sth_get_ligations} =
        $dbh->prepare(q[select  l.ID_LIGATION, vs.VECTORNAME,
                                l.POSITIVE, l.NEGATIVE
                        from    LIGATION l, LIGATION_STATUS ls, 
                                LIGATION_BATCH lb, VECTORSITE vs,
                                VECTORSITE_ENZYME vse
                        where   l.CLONENAME      = ?
                        and     l.ID_LIGBATCH    = lb.ID_LIGBATCH
                        and     l.ID_LIGATION    = ls.ID_LIGATION
                        and     ls.STATUS        = 5
                        and     ls.ISCURRENT     = 1
                        and     lb.SEQ_VECTOR    = vs.ID_VECTORSITE
                        and     vs.ID_VECTORSITE = vse.ID_VECTORSITE
                        order by ID_LIGATION ]);

    $self->{sth_get_clone_status} =
        $dbh->prepare(q[select c.CLONENAME, psd.DESCRIPTION
                        from   CLONE c, CLONE_PROJECT cp,
                               PROJECT_STATUS ps, PROJECTSTATUSDICT psd
                        where  c.CLONENAME      = ?
                        and    c.CLONENAME      = cp.CLONENAME
                        and    cp.PROJECTNAME   = ps.PROJECTNAME
                        and    ps.ISCURRENT     = 1
                        and    ps.STATUS        = psd.ID_DICT ]);

    $self->{sth_get_id_job}  =
        $dbh->prepare(q[select ID_JOB
                        from   LIGATION l, FRAGMENTATION_BAND fb, SIL_JOB sj
                        where  l.ID_LIGATION = ?
                        and    l.ID_FRAGBAND = fb.ID_FRAGBAND
                        and    fb.ID_FRAG    = sj.ID_FRAG  ]);

    $self->{sth_sequence_length} =
        $dbh->prepare(q[select cc.SEQUENCE_LENGTH_KB
                        from   CLONE_CONTIG cc
                        where  cc.CLONENAME  = ? ]);

    $self->{sth_get_frag_size} =
        $dbh->prepare(q[select fb.SIZE_FROM_KB, fb.SIZE_TO_KB
                        from   FRAGMENTATION_BAND fb, LIGATION l
                        where  l.ID_LIGATION = ?
                        and    l.ID_FRAGBAND = fb.ID_FRAGBAND ]);

    $self->{sth_insert_transform_request} = 
        $dbh->prepare(q[insert into TRANSFORM_REQUEST
                        values (?, ?, ?, ?, SYSDATE,
                                to_date(?, 'dd/mm/yyyy'))  ]);

    $self->{sth_insert_tr_status} =
        $dbh->prepare(q[insert into TR_STATUS
                        values (?, ?, SYSDATE, ?, ?, 'LemurRequestPlate', ?) ]);

    $self->{sth_get_autoname_stuff} = 
        $dbh->prepare(q[select CLONENAME, ROOT, NEXT_VAL
                       from AUTOBOXNAME where CLONENAME = ? ]);

}

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

    $self->{sth_get_clone_names}->finish();
    $self->{sth_get_ligations}->finish();
    $self->{sth_get_clone_status}->finish();
    $self->{sth_get_id_job}->finish();
    $self->{sth_sequence_length}->finish();
    $self->{sth_get_frag_size}->finish();
    $self->{sth_insert_transform_request}->finish();
    $self->{sth_insert_tr_status}->finish();
    $self->{sth_get_autoname_stuff}->finish();
}

################################################################################
# bound to <Return> key press on Clone Entry widget.
################################################################################

sub searchForCloneName {

    my ($self) = @_;
    my $goodCloneName = 1;
    my $arrayOfArrays;
    my $searchValue = $self->{cloneName};

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

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

    eval {
        $self->{sth_get_clone_names}->execute("%$searchValue%");
        $arrayOfArrays = $self->{sth_get_clone_names}->fetchall_arrayref();

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

	foreach my $array ( @$arrayOfArrays ) {
	    $self->{cloneNameWidget}->insert('end', (@$array)[0]);
#            $self->{clones_proj_status}->{$array->[0]} = $array->[1];
	}

        if( scalar @{$arrayOfArrays} == 0 ){
            # see if clone exists but project status not Library Made yet

            $self->{sth_get_clone_status}->execute($searchValue);
            my @row = $self->{sth_get_clone_status}->fetchrow_array();

            if( scalar(@row) > 0 ){
                LemurUtils->showInfo($self->{mw},
                                     "Clone $searchValue is at the project ".
                                     "stage of $row[1]");
            }
            else {
                LemurUtils->showInfo($self->{mw},
                                     "Not a valid clone name (or project on ".
                                     "hold/cancelled).");
            }

            $self->{sth_get_clone_status}->finish();
        }

	# display the drop down window. 
        # Note: BtnDown is not a 'public' method.

        if( scalar(@{$arrayOfArrays}) > 0 ){
            if($self->{cloneNameWidget}->{"popped"}){
                $self->{cloneNameWidget}->BtnDown;
            }
            $self->{cloneNameWidget}->BtnDown;
        }
    };

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

    # Let user know  if anything bad happened while accessing the database.

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

    $self->{sth_get_clone_names}->finish();

#    $dbh->disconnect if $dbh;
}

# The user has picked a clone from the browse entry widget, now get the
# ligations created for it. See if it has been setup for autonaming too
#
sub getLigations {
    my ($self) = @_;
    my ($arrayOfArrays);

    warn "getLigations\n" if $debug;

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

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

    eval {
        $self->get_and_set_autonaming();

        $self->get_topup_figures();

        $self->{frag_size} = '';

	# DISPLAY LIGATION DETAILS
        $self->{sth_get_ligations}->execute($self->{cloneName});
        $arrayOfArrays = $self->{sth_get_ligations}->fetchall_arrayref();

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

	if( scalar(@{$arrayOfArrays}) == 0 ){
            # try sucking any ligations out of Oracle...
            # try_add_ligations_for_clone will return 1 if it didn't explode !
            #
            my ($EDI, $equus_db) = Kill_Equus::openEquus('randomUser');

            if( Kill_Equus::try_add_ligations_for_clone($equus_db, $EDI, $dbh,
                                                        $self->{cloneName}) ){
                # try again
                $self->{sth_get_ligations}->finish();
                $self->{sth_get_ligations}->execute($self->{cloneName});
                $arrayOfArrays =
                    $self->{sth_get_ligations}->fetchall_arrayref();

                $dbh->commit();
            }

            $EDI->quit();
        }

        if( scalar(@{$arrayOfArrays}) == 0 ){

	    LemurUtils->showError($self->{mw},
				  "No ligations have been entered for this ".
				  "clone or the clone name is incorrect");
	}
	else {
	    foreach my $array ( @{$arrayOfArrays} ) {
                # The array returned will be size 0 or 1.
                $self->{sth_get_id_job}->execute($array->[0]);
                my $SIL = $self->{sth_get_id_job}->fetchrow_array();

                if( $SIL ){ $SIL = '*'; }
                else {      $SIL = '';  }

		my $txt = sprintf("%-8s %-12s %-2s",
                                  $array->[0], $array->[1], $SIL); 

		warn "txt = $txt\n" if $debug;

		$self->{ligationsListWidget}->insert('end', $txt);
	    }

	    $self->{sequence_length} = $self->getSequenceLength($dbh);
	}
    };

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

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





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

    # Is clone setup for AUTONAMING?
    $self->{sth_get_autoname_stuff}->execute($self->{cloneName});
    my @row = $self->{sth_get_autoname_stuff}->fetchrow_array();
    $self->{sth_get_autoname_stuff}->finish();

    if( @row ){
        $self->set_autonaming(1, $row[1], $row[2]);
        $self->configure_widgets('disabled');
        $self->{auto_naming_already_on} = 1;
    }
    else {
        $self->{auto_naming_already_on} = 0;
        $self->set_autonaming(0);
        $self->configure_widgets('normal');

        my ($chromosome, $species) = get->clone_info($self->{dbi},
                                                     $self->{cloneName});
        my $a_info = check->autonaming_status($self->{dbi}, $self->{cloneName});

        if (($species eq 'Human')||($species eq 'Mouse')||($species eq 'Zebrafish')){
            $self->{auto_root_name} = "$chromosome"."$self->{cloneName}"."-";
            $self->{auto_next_num}  = '';
        } else {
            $self->{auto_root_name} = "$chromosome"."$self->{cloneName}"."-";
            $self->{auto_next_num}  = '';
        }
    }
}

sub set_autonaming {
    my ($self, $value, $root, $start_num)  = @_;
    $self->{autonaming} = $value;

    if( $self->{autonaming} ){
        $self->{autonaming_w}->configure(-text => 'Autonaming on');

        $self->{auto_root_name} = $root;
        $self->{auto_next_num}  = $start_num;
    }
    else {
        $self->{autonaming_w}->configure(-text => 'Autonaming off');

#        $self->{auto_root_name} = '';
#        $self->{auto_next_num}  = '';
    }
}

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

    $self->{auto_root_name} = '';
    $self->{auto_next_num}  = '';
    $self->set_autonaming(0);
}

sub configure_widgets {
    my ($self, $state) = @_;

    $self->{autonaming_w}->configure(-state => $state);
#    $self->{auto_root_lw}->configure(-state => $state);
    $self->{auto_root_ew}->configure(-state => $state);
#    $self->{auto_next_num_lw}->configure(-state => $state);
    $self->{auto_next_num_ew}->configure(-state => $state);
    
}

# If a project has a status of selected for topup
sub get_topup_figures {
    my ($self) = @_;

    my $output = `topup_reads $self->{cloneName}`;

    my ($num)  = ($output =~ /(\d+) x 96 well plates/g);
    $self->{topup_lp_needed} = $num;
}

sub ligationPicked {
    my ($self) = @_;
    my $l      = $self->{ligationsListWidget};
    my $index  = $l->curselection();

    $l->get($index) =~ /^(\w+)\s+(\w+)\s+(\w+)/;
    my $ligation = $1;
    my $vector   = $2;
    my $SIL      = $3;

    unless( defined $SIL && $SIL eq '*' ){
        $l->get($index) =~ /^(\w+)\s+(\w+)/;
        $ligation = $1;
        $vector   = $2;
    }

    return if $ligation eq 'Ligation'; # line to be removed?
    return unless $ligation;

    warn "ligation: $ligation\n" if $debug;
    warn "vector  : $vector\n"   if $debug;
    warn "SIL     : $SIL\n\n"    if $debug;

    # get SEQUENCE_LENGHT_KB from CLONE_CONTIG
    #     FROM_KB & TO_KB    from FRAGMENTATION_BAND

    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->{frag_size} = $self->getFragSize($dbh, $ligation);
	warn "frag size: $self->{frag_size} \n" if $debug;
    };

    if ($@) {
	$self->expire("$@");
    }

#    $dbh->disconnect if $dbh;    
}

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

    $self->{sth_sequence_length}->execute($self->{cloneName});
    my @row = $self->{sth_sequence_length}->fetchrow_array();
    $self->{sth_sequence_length}->finish();
    my $sequence_length = '';
    $sequence_length = $row[0].'KB' if @row ;

    return $sequence_length;
}

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

    $self->{sth_get_frag_size}->execute($ligation);
    my @row = $self->{sth_get_frag_size}->fetchrow_array();
    $self->{sth_get_frag_size}->finish();

    return "$row[0] - $row[1]";
}

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

    warn "\naddPressed\n" if $debug;

    return unless $self->isValidData();

    my $l           = $self->{ligationsListWidget};
    my $index       = $l->curselection();

    my ($clear, $blue);

    $l->get($index) =~ /^(\w+)\s+(\w+)\s+(\w+)/;
    my $ligation = $1;
    my $vector   = $2;
    my $SIL      = $3;

    unless( defined $SIL && $SIL eq '*' ){
        $l->get($index) =~ /^(\w+)\s+(\w+)/;
        $ligation = $1;
        $vector   = $2;
    }

    # Build array for this request
    my $array = [$self->{cloneName},
                 $ligation,
                 $vector,
                 $self->{num_of_plates},
                 $self->{date_wanted},
                 ];

    if( $self->{autonaming} && ($self->{auto_naming_already_on} == 0) ){
        push @{$array}, $self->{auto_root_name};
        push @{$array}, $self->{auto_next_num};
    }

    # Add this request to the others
    push @{ $self->{request} }, $array;

    $self->clearEverything();
    $self->show_requests();
}

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

    # show what they've done so far
    my @output;
    push @output, sprintf("%15s %8s %10s %10s %11s",
                          "Clone", "Ligation", "Vector",
                          "Num Plates", "Date Wanted" );
 
    push @output,
         "--------------- -------- ---------- ---------- -----------";

    foreach my $request (@{$self->{request}}){
        push @output,
             sprintf("%15s %8s %10s %10s %11s",
                     $request->[0], $request->[1],
                     $request->[2], $request->[3], $request->[4]);
    }

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

    foreach my $line (@output){
        $self->{list_widget}->insert('end', $line);
    }
}

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

    warn "\nadd_requests\n" if $debug;

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

    eval {
        foreach my $request ( @{$self->{request}} ){
            
            my $clone_name     = $request->[0];
            my $ligation       = $request->[1];
            my $vector         = $request->[2];
            my $num_of_plates  = $request->[3];
            my $date_wanted    = $request->[4];
            my $auto_root_name = $request->[5];
            my $auto_next_num  = $request->[6];

            # -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
            # start autonaming ?
            if( $auto_root_name && $auto_next_num ){
                # user could have 2 requests for same clone, both wi auto
                # set to on
                unless( defined($self->{clones_set_to_auto}->{$clone_name}) ){

                    upd->autoboxname_initially($dbh,
                                               $clone_name,
                                               $auto_root_name,
                                               $auto_next_num);

                    $self->{clones_set_to_auto}->{$clone_name} = 1;
                }
#                print "set autonaming for $clone_name\n";
            }
            # -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=


            my $request_num =
                $dbh->fetch_scalar(qq[
                                      select seq_TREQUEST.nextval from dual]);
            
            warn "
                insert into TRANSFORM_REQUEST
                values ($request_num,
                        $ligation,
                        $num_of_plates,
                        '$self->{id_person}',
                        SYSDATE,
                        to_date('$date_wanted', 'dd/mm/yyyy'))" if $debug;


            $self->{sth_insert_transform_request}->execute($request_num,
                                                           $ligation,
                                                           $num_of_plates,
                                                           $self->{id_person},
                                                           $date_wanted);

            $self->{sth_insert_tr_status}->execute($request_num,
                                                  1,
                                                  1,
                                                  $self->{session_id},
                                                  $self->{user});
        }
    };

    if( $@ ){
        my $error = $@;
        $dbh->rollback if $dbh;
        die $error;
    }

    $dbh->commit;
#    $dbh->rollback(); print "rollback() done.\n";
    LemurUtils->showInfo($self->{mw}, "Your request(s) have been added.");
}

sub isValidData {
    my ($self)   = @_;
    my $goodData = 1;

    warn "validateData()\n" if $debug;


    # AUTONAMING
    if( $self->{autonaming} ){
        $self->{auto_next_num} =~ s/\s//g;

        unless( $self->{auto_next_num} ){
            LemurUtils->showError($self->{mw},
                                  "You must enter a next box number if wish ".
                                  "to start autonaming!");
        }
        elsif( $self->{auto_next_num} !~ /^\d+$/ ){
            LemurUtils->showError($self->{mw},
                                  "The next box number must be a number!");
            $goodData = 0;
        }
    }

    # LIGATION

    my $l        = $self->{ligationsListWidget};
    my $index    = $l->curselection();

    unless( defined($index) ){
	LemurUtils->showError($self->{mw}, "You must pick a ligation!");
	return;
    }

    # NUMBER OF PLATES
    if( $self->{num_of_plates} !~ /^\d+$/ ){
	LemurUtils->showError($self->{mw},
			      "You must enter a valid number of plates");
	$goodData = 0;
    }

    # DATE WANTED - check format and if "sensible" (not 2 months time)
    unless( LemurUtils->isGoodDate($self->{date_wanted}) ) {
 
	if( ! ( $self->{date_wanted} =~ m|^(\d{2,2})/(\d{2,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.");
	}

	$goodData = 0;
    }
    else {
        # is correct format, check date is sensible

        my $date_todays    = &ParseDate("today");
        my $date_entered   = &ParseDate("$self->{date_wanted}");
        my $err;
        my $diff           = &DateCalc($date_todays,
                                       $date_entered,
                                       \$err);
        if( $err ){
            die "ERROR: DateCalc returned error: err = $err\n\n";
        }

        # if enter todays date, it won't have a time so will default to midnight
        # (00:00:00) so will always be less than todays time...
        if( $diff =~ /^-/ ){
            LemurUtils->showError($self->{mw},
                                  "You can not enter a date of today ".
                                  "or older!");
            $goodData = 0;
        }
        else {
            $diff =~ /(.*?):(.*?):(.*?):(.*?):(.*?):(.*?):(.*?)/;
            my $weeks   = $3;
            my $days    = $4;
            my $hours   = $5;
            my $minutes = $6;
            my $seconds = $7;

            if( $weeks > 3 ){
                my $answer = 
                    LemurUtils->yesNo($self->{mw},
                                      "Are you sure the date you want the ".
                                      "plates for is $weeks weeks ".
                                      "into the furture?");
                $goodData = 0 if $answer eq 'No';
            }
        }
    }

    return $goodData;
}


sub clearEverything {
    my ($self, $clear_date_too) = @_;

    $self->{cloneName}       = '';
    $self->{num_of_plates}   = '';
    $self->{date_wanted}     = '' if $clear_date_too;
    $self->{sequence_length} = '';
    $self->{frag_size}       = '';
    $self->{ligationsListWidget}->delete('0', 'end');

    $self->{topup_lp_needed} = '';
    $self->set_auto_widgets_to_null();

    $self->{cloneNameWidget}->Subwidget("entry")->Subwidget("entry")->focus();
    
}
 
sub done_pressed {
    my ($self) = @_;
    my @output;

    warn "done_pressed()\n" if $debug;

    if( !defined $self->{request} || scalar( @{$self->{request}}) == 0 ){
        warn "No requests defined\n" if $debug;
        $self->finish_sql();
        $self->{mw}->destroy();
        return;
    }

    push @output, sprintf("%15s %8s %10s %10s %11s",
                          "Clone", "Ligation", "Vector",
                          "Num Plates", "Date Wanted" );
 
    push @output,
         "--------------- -------- ---------- ---------- -----------";

    foreach my $request (@{ $self->{request} }){
        push @output,
             sprintf("%15s %8s %10s %10s %11s",
                     $request->[0], $request->[1],
                     $request->[2], $request->[3], $request->[4]);
    }

    my $display = ShowRequests->new($self->{fixed_width_font});
    my $ans     = $display->ask($self->{mw}, @output);

    if( $ans eq 'Yes' ){
        $self->clearEverything(1); # clear date too
        $self->add_requests();
    }
    elsif( $ans eq 'Add more' ){
        return;
    }

    $self->finish_sql();
    $self->{mw}->destroy(); 
}

sub expire {

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

    $dbh->disconnect if $dbh; 
    warn "ERROR: $errorMsg\n";

    Mail::sendMail( -to      => 'pjm',
                    -subject => "Lemur: Error in Request Plates.",
                    -message => $errorMsg);

    die "\n";
}

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

    warn "LemurRequestPlate::DESTROY called\n" if $debug;

    unless( ref $self ){
	warn "Wrong type passed to LemurRequestPlate->DESTROY '$self'";
    }

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

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

package ShowRequests;

sub new {
    my ($type, $fixed_width_font) = @_;

    my $self = {
        fixed_width_font => $fixed_width_font,
    };
    bless($self, $type);

#    $self->createWindow(@requests);
#    $self->hide();

    return $self;
}

sub ask {
    my ($self,$parent_window,  @requests) = @_;

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

    $mw->title('Request Details');

    # BLANK SPACE
    $mw->Label()->pack();

    # BIG TITLE LABEL
    $mw->Label(-font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
               -text => 'Do you wish to submit these requests?',
               -bg   => 'white',
               )->pack();

    # BLANK SPACE
    $mw->Label()->pack();

    # REQUEST DETAILS
    $self->{list_widget} =
        $mw->Scrolled('Listbox',
                      -width  => 64,
                      -height => 16,
                      -relief => 'groove',
                      -font   => $self->{fixed_width_font},
                      )->pack(-expand => 1,
                              -fill   => 'both');

    # BLANK SPACE
    $mw->Label()->pack();

    # BUTTON FRAME
    my $buttF = $mw->Frame()->pack();

    $buttF->Button(-text    => 'No',
                   -command => sub{ $self->{button_pressed} = 'No'; },
                   )->pack(-side => 'left');

    $buttF->Label( -width => 16)->pack(-side => 'left');

    $buttF->Button(-text    => 'Yes',
                   -command => sub{ $self->{button_pressed} = 'Yes'; },
                   )->pack(-side => 'left');

    $buttF->Label( -width => 16)->pack(-side => 'left');

    $buttF->Button(-text    => 'Add More...',
                   -command => sub{ $self->{button_pressed} = 'Add more'; },
                   )->pack(-side => 'left');

    # POPULATE LISTBOX

    foreach my $line (@requests){
        $self->{list_widget}->insert('end', $line);
    }

    # make sure whole window appears on screen, not just the title.

    my $f = $self->{mw}->Frame(-width => 10, -height => 20);
    $f->pack(-side => 'top');
    $self->{mw}->idletasks();
    $self->{mw}->packPropagate(0);
    $f->packForget(); 

    # center window on screen

    my $x = int(($self->{mw}->screenwidth  - $self->{mw}->reqwidth)  / 2);
    my $y = int(($self->{mw}->screenheight - $self->{mw}->reqheight) / 2);
    
    $self->{mw}->geometry("+$x+$y");

    # grap focus and wait till the user has pressed one of the buttons

    $self->{mw}->raise();
    $self->{mw}->grab();
    $self->{mw}->waitVisibility;
    $self->{mw}->update;

    $self->{mw}->waitVariable(\$self->{button_pressed});
    $self->{mw}->grabRelease;
    $self->{mw}->withdraw;

    return $self->{button_pressed};
}

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

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

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

    warn "ShowRequests::DESTROY called\n" if $debug;
}


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


#
# $Log: LemurRequestPlate.pm,v $
# Revision 1.31  2006/01/24  13:20:33  mdf
# *** empty log message ***
#
# Revision 1.30  2006/01/24  10:40:20  mdf
# *** empty log message ***
#
# Revision 1.29  2002/11/07  12:10:47  mdf
# Removed the need for a project to be at librarymade to allow pathogen projects to go through
#
# Revision 1.28  2001/04/11  11:12:40  bsw
# *** empty log message ***
#
# Revision 1.27  2001/04/11  11:09:06  bsw
# Added Mouse and Zebrafish to autoboxname
#
# Revision 1.26  2001/04/10  13:17:44  pjm
# added "$self->{cloneNameWidget}->bind('<Delete>', 'Backspace');"
#
# Revision 1.25  2001/01/08  17:49:36  pjm
# Added the "Show existing requests" button.
#
# Revision 1.24  2000/08/09  15:27:52  pjm
# keeps tag of what it auto named so if user has 2 request for same clone it
# won't try to set autonaming to on twice.
#
# Revision 1.23  2000/08/03  16:08:49  pjm
# only adds to request array when autonaming on AND it was _already_ on
#
# Revision 1.22  2000/08/03  10:44:33  pjm
# added self->{auto_naming_already_on} var so know not to set autonaming to on
# clears auto & topup widgets when Add pressed.
#
# Revision 1.21  2000/08/03  09:55:10  pjm
# Added autonaming and topup reads functionality.
#
# Revision 1.20  2000/03/27  10:18:23  pjm
# it now calls try_add_ligations_for_clone() in module Kill_Equus if
# the clone name does not return any ligations from Oracle
#
# Revision 1.19  2000/03/22  17:04:18  pjm
# Added a list widget at bottom of window to display requests that have
# been added. Can click on a request and delete it.
#
# Revision 1.18  2000/02/14  14:48:35  pjm
# Date Wanted By now does not get set to '' unless the requests are added to
# the DB.
#
# Revision 1.17  2000/02/01  17:34:24  pjm
# taken away Clear & Blue scores, users may request too many plates.
# Show if ligations was made for a SIL
#
# Revision 1.16  1999/12/08  11:56:25  pjm
# child window ShowRequests gets passed in fixed width font. Uses it in list
# widget
#
#
