
#######################################################################
# 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.                      #
#######################################################################
#
# This module shows DNApreps that have been completed. You can assign
# a subcloner to clones/preps and print of a work sheet for that person
# to use in there notes. Labels for Gel Slice and 10xd's are also
# printed out now. The fragment sizes are hard coded in. To change,
# search for "FRAG SIZE LABELS" and alter the array to what ever you
# need.
#
# $Id: LemurGetDNAPreps.pm,v 1.54 2006/09/18 10:51:29 gjc Exp $

package LemurGetDNAPreps;

require Exporter;

use strict;
use WrapDBI;
use File::Basename;
use ChoosePrinter;
use Benchmark;

use Data::Dumper;

@DNAPreps::ISA    = qw(Exporter);
#@DNAPreps::EXPORT = qw(DNAPreps);


##########################################
# CONSTANTS
# i use emacs - leave space aftre '/' char
# would be good to have number of columns here...
##########################################

*LemurGetDNAPreps::NUM_ROWS    = \24;
*LemurGetDNAPreps::BITMAP_DIR  = \ "$ENV{'BADGER'}/lib/finch/bitmaps";

##########################################
# GLOBALS
# yes, this is bad. FORMATS at bottom of
# file need globals!
##########################################

my $debug         = 0;     # can be set to 1 by CTRL-middle mouse button
my $bug_mail      = "bug"; # change to your name during testing

my $instanceCount = 0;

my $cursor = 0;          # first cell in array displayed in table of labels
my @widgets;             # a 2D array of the widgets in the 'table'.

my $name;                # These variables are used in the
my $clone;               # report generated off the Generate Work Sheets button
my $organism;
my $chromosome;
my $date;
my $prep;
my $priority;


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

    ++$instanceCount;

    if( $instanceCount > 1 ) {
	my $message = "A Get DNA Preps window is already open.";
	my $dialog  = $parentWindow->Dialog(title          => "Error",
					    text           => "$message",
					    default_button => '1',
					    buttons        => ['OK']);
	$dialog->Show();
	return undef;
    }

    my $realUserName = getpwuid($<);
    my $date         =  (localtime)[3]."/".
	               ((localtime)[4] + 1)."/".
	               ((localtime)[5] + 1900);

    my $month = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
                 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[(localtime)[4]];

    my $todaysMonthYear = (localtime)[3]."-".$month."-".((localtime)[5] + 1900);


    my $self = {
	dbUser            => $requested_db_user,
	session_id        => $session_id,
	notAlreadyChecked => 1,
        date              => $date,
        realUserName      => $realUserName,
        todaysMonthYear   => $todaysMonthYear,
        chromoToSearch    => 1,
        printer           => $ENV{PRINTER},
    };
    bless($self, $type);

    $self->setupHashTables();
    $self->createWindow($parentWindow);

    $self->{clone_details} = CloneDetails->new($self->{mw}, # will hide itself
                                               $self->{dbUser});

    return $self;
}

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

    my $mw = $parentWindow->Toplevel();
    $mw->title('Get DNA preps');

    my $top_frame = $mw->Frame(-relief      => 'groove',
                               -borderwidth => '1'
                               )->pack(-expand => 1,
                                       -fill   => 'x');
    $mw->Label(width   => 40)->pack;

if( 0 ){
    my $b = 
	$top_frame->Button(-font        =>
                               '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
                           -text        => 
                              "Assign people to clones to generate work sheets",
                           -height      => 1,
                           -bg          => 'white',
                           -relief      => 'groove',
                           -borderwidth => '3',
                           )->pack(-side => 'right');

    $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} = $mw;

    # MENU
    my $ref = [['command' => 'Select printer',
                -command  => sub { $self->select_printer(); } ],
               ];

    my $menu = $top_frame->Menubutton(-text      => 'File',
                                      -menuitems => $ref
                                      )->pack(-side => 'left');


    # mf : masterFrame , which contains;
    #   tf : Table Frame 
    #   upDownFrame
    
    my $mf = $mw->Frame(-relief => 'raised', -borderWidth => '20');
    my $tf = $mf->Frame(-relief => 'raised', -borderWidth => '20');

    $self->createTableFrame($tf);

    $tf->pack(-side => 'right');

    #
    # create buttons on the bottom of the window
    #
    my ($upButton, $downButton, $makeWorkButton);
    my ($upDownFrame);


    $upDownFrame = $mf->Frame();

    # Make an 'up-button';
    $mw->Bitmap('up',
		-file     => "$LemurGetDNAPreps::BITMAP_DIR/uarrw.xbm",
		-maskfile => "$LemurGetDNAPreps::BITMAP_DIR/uarrw.xbm"
	       );

    $upButton = $upDownFrame->Button(-image   => 'up',
				     -command => sub { $self->pressedUp; }); 
    $upButton->pack(-side => 'top');

    # Make an 'down-button';
    $mw->Bitmap('down',
		-file     => "$LemurGetDNAPreps::BITMAP_DIR/darrw.xbm",
	       	-maskfile => "$LemurGetDNAPreps::BITMAP_DIR/darrw.xbm"
		);
    
    $downButton = $upDownFrame->Button(-image   => 'down',
			               -command => sub { $self->pressedDown; });
    $downButton->pack(-side => 'bottom');

    $upDownFrame->pack(-side => 'left');
    $mf->pack(-side => 'top');

    # Generate Work and Cancel button

    my ($buttonFrame, $cancelButton, $dummyLabel, $workToggButt); 

    $buttonFrame    = $mw->Frame(-relief => 'raised', -borderWidth => '20');

    $makeWorkButton = $buttonFrame->Button(-text    => 'Generate Work',
					   -width   => 20,
					   -command => sub{
					       $self->pressedMakeWork;
					   });

    my $pageNum = 
	$buttonFrame->Label(-text         => 'Page 1',
			    -textvariable => \$self->{pageNumLabel},
			    -width        => 30,
			    );

    $workToggButt   =
	$buttonFrame->Checkbutton(-text     => 'Show clones already printed',
				  -width    => 38,
				  -variable =>
				      \$self->{showAllClones},
				  -command => sub{
				      LemurUtils->setWait([$mw]);
				      $self->getData( $self->{showAllClones},
                                                      $self->{chromoToSearch} );
				      LemurUtils->unSetWait([$mw]);
				  },
				  );

    $cancelButton   = $buttonFrame->Button(-text    => 'Done',
					   -width   => 12,
					   -command => sub {
#					       $mw->DESTROY;
					       $self->hide();
					   });

    $makeWorkButton->grid(-row => 1, -column => 1);
    $pageNum->grid       (-row => 1, -column => 2);
    $workToggButt->grid  (-row => 1, -column => 3);
    $cancelButton->grid  (-row => 1, -column => 4);

    $buttonFrame->pack(-side => 'bottom');

    $self->getData( $self->{showAllClones}, $self->{chromoToSearch} );
}

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

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

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

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

################################################################################
# 
# When trying to set the BrowseEntry widget to 
#     -variable => \$self->{dataStore}->[$x]->[6]
# it did not work correctly. This maybe due to an old Tk version. I have now
# given up on trying to make it work!
################################################################################

sub createTableFrame {

    my ($self, $tf) = @_;
    my ($x, $y);
    my $width;

    # Used to clear $self->{assignTo}->[$x] to '' when <nobody> is selected on
    # BrowseEntry widget.
    sub subby {
        my $self = shift;
        my $x    = shift;

        return sub {
            if( $self->{assignTo}->[$x] eq '<nobody>' ) {
                $self->{assignTo}->[$x] = '';
            }
        }
    }

    # x and y are the wrong way round here - y is on x axis....

    for($x = 0; $x <= $LemurGetDNAPreps::NUM_ROWS; $x++) {
	# create 5 label widgets
	for($y = 0; $y < 8; $y++){
            if(    $y == 4 ) { $width = 10; }
            elsif( $y == 5 ) { $width = 19; }
            elsif( $y == 6 ) { $width = 13;  }
            elsif( $y == 7 ) { $width = 7;  }
            else { $width = 12; }

            if( $y != 0 ){
                $widgets[$x][$y] = $tf->Label(-relief => 'sunken',
                                              -width  => $width,
                                              -bg     => 'lightblue');

                $widgets[$x][$y]->grid(-row => $x+1, -column => $y);
            }
            else {
                $widgets[$x][$y] = $tf->Label(-relief => 'sunken',
                                              -width  => $width,
                                              -bg     => 'lightblue',
                                              );

                $widgets[$x][$y]->grid(-row => $x+1, -column => $y);
 
                my $widget = $widgets[$x][$y];
                my $down   = $x; # how far down the page the clone is

                # if click in the Label, pops up info on preps
                $widgets[$x][$y]->bind('<ButtonPress-1>', sub {

                    my $pages =
                        ($self->{pageNum} - 1) * $LemurGetDNAPreps::NUM_ROWS;

                    my $entry = $pages + $down - 1;
                    my $clone = $self->{dataStore}->[$entry]->[0];

                    return if $clone eq '';

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

                    if(defined($self->{lastClone}) &&
                       $self->{lastClone} ne ''){

                        my $old_widget = $self->{lastClone}->[0];
                        my $old_entry  = $self->{lastClone}->[1];

                        $old_widget->configure(-bg => 'lightblue');
                        $self->{dataStore}->[$old_entry]->[9] = 0;
                    }

                    $widget->configure(-bg => 'green');

                    $self->{dataStore}->[$entry]->[9] = 1;
                    $self->{lastClone} = [$widget, $entry];

                    $self->{clone_details}->showClone($clone);

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

	# Entry gadget - who will do the ligations for this DNA Prep.
        # Make sure create label for column heading only.
	if( $x == 0 ) {
	    $widgets[$x][$y] = $tf->Label(-text   => "Make Work",
                                          -relief => 'sunken',
					  -width  => 18,
                                          -bg     => 'lightblue');
	}
	else {
	    # weirdness here with '-variable => \$self->{assignTo}->[$x]'. 
	    # See above comment
	    $widgets[$x][$y] =
		$tf->BrowseEntry(-width    => 16,
				 -relief   => 'sunken',
				 -state    => 'readonly',
				 -variable => \$self->{assignTo}->[$x],
				 -choices  => 
				     [ sort keys %{$self->{operatorHash}} ],
				 -browsecmd => $self->subby("$x"), );
	}

        $widgets[$x][$y]->grid(-row    => $x + 1, 
			       -column => $y);
    }

    # put in column headings
    $widgets[0][0]->configure(text => 'Clone',
                              bg   => 'grey');
    $widgets[0][1]->configure(text => "Species",
                              bg   => 'grey');
    $widgets[0][2]->configure(text => "Chromosome",
                              bg   => 'grey');
    $widgets[0][3]->configure(text => "Date Act",
                              bg   => 'grey');
    $widgets[0][4]->configure(text => "Prep Num",
                              bg   => 'grey');
    $widgets[0][5]->configure(text => "Prep Type",
                              bg   => 'grey');

    $widgets[0][6]->configure(text => "Seq Reason",
                              bg   => 'grey');
    $widgets[0][7]->configure(text => "Priority",
                              bg   => 'grey');

    $widgets[0][8]->configure(text => "Assign to:",
                              bg   => 'grey');

    # Search widgets
    my $cloneSearchW = $tf->Entry(-width        => 12,
                                  -relief       => 'sunken',
                                  -textvariable => \$self->{cloneToSearch},
                                  );
    my $clearCloneW = $tf->Button(-text => 'Clear',
                                  -command => sub {
                                      $self->clearHighlighedClones()
                                  },
                                  );
    my $chromoSearchW = $tf->Entry(-width        => 12,
                                   -relief       => 'sunken',
                                   -textvariable =>
                                   \$self->{chromoToSearch},
                                   );
    my $clearChromoW = $tf->Button(-text => 'Clear',
                                   -command => sub {
                                       $self->{chromoToSearch} = '';
                                       $self->orderByChromo();
                                   },
                                   );
    my $not_ready_butt = $tf->Button(-text => 'Email me preps not ready',
                                     -command => sub {
                                         $self->email_preps_not_ready();
                                     },
                                     );
    my $print_ready_butt = $tf->Button(-text => 'Print preps ready',
                                       -command => sub {
                                           $self->print_out_clones_ready();
                                       },
                                       );

    my $last_row = $LemurGetDNAPreps::NUM_ROWS + 2; # header text + 1

    $cloneSearchW->grid(  -row => $last_row, -column => 0);
    $clearCloneW->grid(   -row => $last_row, -column => 1, -sticky => 'w');
    $chromoSearchW->grid( -row => $last_row, -column => 2);
    $clearChromoW->grid(  -row => $last_row, -column => 3, -sticky => 'w');
    $not_ready_butt->grid(-row => $last_row, -column => 4, -sticky => 'w',
                          -columnspan => 2);
    $print_ready_butt->grid(-row => $last_row, -column => 6, -sticky => 'w',
                            -columnspan => 2);


    $cloneSearchW->bind('<KeyPress-Return>', sub {
        $self->searchByClone();
    });
    $chromoSearchW->bind('<KeyPress-Return>', sub {
        $self->orderByChromo();
    });

    $self->{chromoSearchW} = $chromoSearchW;
}

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

    $self->{cloneToSearch} =~ s/^\s+//; # remove leading & trailing whitespace
    $self->{cloneToSearch} =~ s/\s+$//;

    my $clone = $self->{cloneToSearch};

    return if $clone eq '';
    return if scalar(@{$self->{dataStore}}) == 0; # no Preps shown

    my $index     = 0;
    my $row_count = 1;
    my $page_num  = 1;
    my $found     = 0;

    foreach my $row ( @{$self->{dataStore}} ){

	if( $row_count > $LemurGetDNAPreps::NUM_ROWS ){
            $page_num++;
            $row_count = 1;
        }

        if( $row->[0] eq $clone ){
            $found = 1;
            last;
        }

        $index++;
        $row_count++;
    }

    unless( $found ){
        LemurUtils->showError($self->{mw}, "$clone wasn't in the list.");
    }
    else {
        warn "$clone is on page $page_num, index = $index\n" if $debug;
        $self->{dataStore}->[$index]->[7] = 1;
        $self->gotoPage($page_num);
    }
}

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

    foreach my $row ( @{$self->{dataStore}} ){
        $row->[7] = 0;
    }

    $self->redrawScreen();
}

sub orderByChromo {
    my ($self) = @_;
    my $mw = $self->{mw};

    $self->{chromoToSearch} =~ s/^\s+//; # remove leading & trailing whitespace
    $self->{chromoToSearch} =~ s/\s+$//;
    
    warn "orderByChromo: $self->{chromoToSearch}\n" if $debug;

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

    $self->getData( $self->{showAllClones}, $self->{chromoToSearch} );

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

    return if $self->{chromoToSearch} eq '';

    # They have been ordered by chromosome, take user to starting page

    my $index     = 0;
    my $row_count = 1;
    my $page_num  = 1;
    my $found     = 0;

    foreach my $row ( @{$self->{dataStore}} ){

	if( $row_count > $LemurGetDNAPreps::NUM_ROWS ){
            $page_num++;
            $row_count = 1;
        }

        if( $row->[2] eq $self->{chromoToSearch} ){
            $found = 1;
            last;
        }

        $index++;
        $row_count++;
    }

    unless( $found ){
        LemurUtils->showError($self->{mw},
                              "Chromosome $self->{chromoToSearch} wasn't in ".
                              "the list.");
    }
    else {
        warn "$clone is on page $page_num, index = $index\n" if $debug;
        $self->gotoPage($page_num);
    }
}

################################################################################
# This is basically an eval{} rapper around really_get_data() and handles
# emailing bug, truncating large error messages if need be.
#
# . get the data
# . display the data
# . set the page number
################################################################################

sub getData {
    my ($self, $getPrepsPrinted, $orderByChromo) = @_;

    $self->clearEverything();

    eval {
        $self->really_get_data($getPrepsPrinted, $orderByChromo);
    };

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

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

        if( length($error) >  500 ){
            $error = "MESSAGE TRUNCATED: ".substr($error, 1, 500);
        }

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

    $self->redrawScreen();

    my $numPages  = scalar(@{$self->{dataStore}}) / $LemurGetDNAPreps::NUM_ROWS;
    $numPages     =~ s/(\.\d+)$//;
    ++$numPages if $1;

    $self->{numberOfPages} = $numPages;
    $self->setPageNum( 1 );
}

# All gadgets have been created
#
# Get DNAPreps that are 'ready' for library making;
#    'DNAPREP_STATUS.STATUS    = 7'
# a status of 15 means it has already been assigned to a subcloner/printed out.
# By default it orders stuf by chromosome and priority. This is so Matt can 
# make sure he meets his quotas for each chromo/team
#
# The main query returns 1 prep per row so 1 clone may have 2 preps and hence
# 2 rows. This info gets squashed together.
#
# The actioned date has to be gotten for each prep sperately from the main query
# as this is the created status date, not the date complete (status 7).
#
# If a digest has been done for a prep it will get a '*' put after it's number
# to signify this
#
sub really_get_data {
    my ($self, $getPrepsPrinted, $orderByChromo) = @_;
    my $dbh;
    my $ref_rows;
    my $prepsWanted;
    my %prepsNotReadyFor;
    my $chromo_order= '';

    my $timer1 = new Benchmark();
    my ($timer2, $timer3, $timer4, $timer5, $timer6, $timer7);
    my $diff;

    print "\n";

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

    unless( $getPrepsPrinted ) {
        $prepsWanted = 
            "and    dps.STATUS     = 7"; # not assigned to subcloner
    }
    else {
        $prepsWanted =
            "and    (    dps.STATUS     = 7
                     OR dps.STATUS     = 15)"; # 15 = assigned to subcloner
	}
    
    if( $orderByChromo ){
        $chromo_order = 'c.chromosome ASC,';
    }

    # get preps that have not had ligs entered against them
    #     who are in a project not passed Library Made (ASSIGN ORDER 11)
    #     whos project is not in  (Cancelled, On Hold)

    $ref_rows =
        $dbh->fetch_all(qq[
                           select dp.CLONENAME,   c.SPECIESNAME,
                                  cd.CHROMOSOME,  dp.PREP_NUMBER,
                                  cpr.PRIORITY,    dps.STATUSDATE,
                                  dptd.DESCRIPTION, srd.DESCRIPTION
                           from   DNAPREP dp, DNAPREP_STATUS dps,
                                  CLONE   c,  CHROMOSOMEDICT cd,
                                  DNAPREPTYPEDICT dptd, CLONE_PROJECT cp,
                                  PROJECT_STATUS ps, PROJECTSTATUSDICT psd,
                                  CLONE_PRIORITY cpr, SEQREASONDICT srd
                           where  dp.ID_PREP     = dps.ID_PREP
                           and    dps.ISCURRENT  = 1
                           $prepsWanted
                           and    NOT EXISTS (
                                     select 'X'
                                     from   DNAPREP_STATUS dpsx, DNAPREP dpx
                                     where  dpsx.ISCURRENT = 1
                                     and    dpsx.STATUS    < 7
                                     and    dpsx.ID_PREP   = dpx.ID_PREP
                                     and    dpx.CLONENAME  = dp.CLONENAME )
                           and    dp.CLONENAME   = c.CLONENAME
                           and    dp.CLONENAME   = cp.CLONENAME
                           and    dp.PREP_TYPE   = dptd.ID_DICT
                           and    cp.PROJECTNAME = ps.PROJECTNAME
                           and    dp.CLONENAME   = cpr.CLONENAME
                           and    cpr.IS_CURRENT = 1
                           and    c.CHROMOSOME   = cd.ID_DICT
                           and    c.SEQ_REASOn   = srd.ID_DICT
                           and    ps.STATUS      = psd.ID_DICT
                           and    ps.ISCURRENT   = 1
                           and    psd.ID_DICT   not in (24, 26)
                           order by  $chromo_order cpr.PRIORITY DESC,
                                     dps.STATUSDATE,
                                     dp.CLONENAME, dp.PREP_NUMBER
                           ]);

    $timer2 = new Benchmark();
    $diff   = timediff($timer2, $timer1);

    print "Got ", scalar(@{$ref_rows}), " DNA preps                 - it took ",
          timestr($diff), "\n";

    ######################################
    # For each DNA Prep, store its details
    ######################################
    my ($i);
    my $row;
    my $x = 0;

    foreach $row (@$ref_rows) {
	my $cloneName   = $row->[0];
        my $speciesName = $row->[1];
        my $chromosome  = $row->[2];
	my $prepNumber  = $row->[3];
        my $priority    = $row->[4];
	my $statusDate  = $row->[5];
        my $prep_type   = $row->[6];
        my $seq_reason  = $row->[7];

	# only add clone to dataStore if not already ligated.
        # getCloneInfo() returns: 0: cloneName, 1: speciesName, 2: chromosome
        # numbers represent index in datastore.

        push( @{$self->{dataStore}->[$x]} , $cloneName    ); # 0
        push( @{$self->{dataStore}->[$x]} , $speciesName  ); # 1
        push( @{$self->{dataStore}->[$x]} , $chromosome   ); # 2

        push( @{$self->{dataStore}->[$x]} , "$statusDate" ); # 3
        push( @{$self->{dataStore}->[$x]} , $prepNumber );   # 4
        push( @{$self->{dataStore}->[$x]} , $priority   );   # 5
        push( @{$self->{dataStore}->[$x]} , '');   # 6: Assign to: xyz
        push( @{$self->{dataStore}->[$x]} , '');   # 7: Highlight clone flag
        push( @{$self->{dataStore}->[$x]} , $prep_type);  # 8: prep_type
        push( @{$self->{dataStore}->[$x]} , '');          # 9: prep flag
        push( @{$self->{dataStore}->[$x]} , $seq_reason); #10: seq reason
        $x++;
    }

    $timer3 = new Benchmark();
    $diff   = timediff($timer3, $timer2);

    print "Preps entered into dataStore      - it took ", timestr($diff), "\n";

    ################################################
    # get restriction digest info
    ################################################

    $self->get_digested_finger_info($dbh);

    $timer4 = new Benchmark();
    $diff   = timediff($timer4, $timer3);
    print "Got Digest info                   - it took ",timestr($diff), "\n";


    ##################################################
    # now sort the dataStore. Squash all DNA Prep Nums
    # into one row of text, so only 1 clone per line
    ##################################################
    my $numRecs;

    unless( defined($self->{dataStore}) ) {
	warn "no records found\n" if $debug;
    }
    else {
	$numRecs = scalar(@{$self->{dataStore}});
    }

    for(my $x = 0; $x < $numRecs; $x++) {

	for(my $y = $x + 1; $y < $numRecs; $y++) {

	    if($self->{dataStore}->[$x]->[0] eq $self->{dataStore}->[$y]->[0]){

		$self->{dataStore}->[$x]->[4] .= 
		    ",$self->{dataStore}->[$y]->[4]";

		for(my $z = $y; $z < $numRecs; $z++) {
		    $self->{dataStore}->[$z] = $self->{dataStore}->[$z + 1];
		}

		pop @{$self->{dataStore}};
 
		$numRecs--;
		$y--;       # yes, decrement the loop variable cos squashed
                            # array.
	    }
	}
    }

    $timer5 = new Benchmark();
    $diff   = timediff($timer5, $timer4);

    print "'Squashed' preps together         - it took ", timestr($diff), "\n";

    ################################################
    # get actioned date of the lowest numbered prep
    ################################################

    $self->get_actioned_dates_in_blocks($dbh);

    $timer6 = new Benchmark();
    $diff   = timediff($timer6, $timer5);
    print "Got actioned dates for first prep - it took ",timestr($diff), "\n";

    ###############################################
    # Get rid of prepared SQL & disconect from db
    ###############################################
    delete($self->{sql}->{fetch_actioned_date});
    $dbh->disconnect if $dbh;
}

# I'm not sure how big a an SQL statement you can send to Oracle - this is
# designed to break it into sections.
#
sub get_actioned_dates_in_blocks {
    my ($self, $dbh) = @_;
    my $count  = 0;
    my @clones;
    my %clone_prep_num;

    foreach my $row_ref (@{$self->{dataStore}}){

        ++$count;

        if( $count > 510 ){ # 507 works, dunno how hight this number can go...

            push @clones, "'$row_ref->[0]'";

            $self->get_prep_dates($dbh, \%clone_prep_num, @clones);

            @clones = ();
            $count  = 0;
        }
        else {
            push @clones, "'$row_ref->[0]',";
        }
    }

    if( @clones ){
        $clones[$#clones] =~ s/,$//;

#        print "LAST bit, adding clones @clones\n";

        $self->get_prep_dates($dbh, \%clone_prep_num, @clones);
    }

    # get the lowest prep number (sort it then get element 0)
    
    foreach my $row_ref (@{$self->{dataStore}}){
        my $clone_name   = $row_ref->[0];
        my $preps_string = $row_ref->[4];
        my @preps_array  = split(',', $preps_string);
        my @preps_array  = sort @preps_array;
        my $first_prep   = $preps_array[0];
        $first_prep      =~ s/\+//g;
        $row_ref->[3]    = $clone_prep_num{$clone_name." ".$first_prep};
    }
}

sub get_prep_dates {
    my ($self, $dbh, $hash_ref, @clones) = @_;

    my $ref =
        $dbh->fetch_all(qq[select dp.CLONENAME, dp.PREP_NUMBER, dps.STATUSDATE
                           from   DNAPREP dp, DNAPREP_STATUS dps
                           where  dp.CLONENAME    in (@clones)
                           and    dp.ID_PREP      = dps.ID_PREP
                           and    dps.STATUS      = 1 ]);

    foreach my $row (@{$ref}){
        if( defined $hash_ref->{$row->[0]." ".$row->[1]} ){
 #           print "$row->[0] $row->[1] already has date ",
 #           $hash_ref->{$row->[0]." ".$row->[1]}, "\n";
        }
        else {
            $hash_ref->{$row->[0]." ".$row->[1]} = $row->[2];
        }

#        print "$row->[0] $row->[1] = $row->[2]\n";
    }
}

#
# NOTE: This should be called BEFORE datastore gets squashed
#
sub get_digested_finger_info {
    my ($self, $dbh) = @_;

    my $count  = 0;
    my @clones;
    my %clone_digested;

    foreach my $row_ref (@{$self->{dataStore}}){

        ++$count;

        if( $count > 510 ){ # 507 works, dunno how hight this number can go...

            push @clones, "'$row_ref->[0]'";

            $self->get_digest_finger_for_clones($dbh, \%clone_digested,
                                                @clones);

            @clones = ();
            $count  = 0;
        }
        else {
            push @clones, "'$row_ref->[0]',";
        }
    }

    if( @clones ){
        $clones[$#clones] =~ s/,$//;

#        print "LAST bit, adding clones @clones\n";

        $self->get_digest_finger_for_clones($dbh, \%clone_digested, @clones);
    }

    # get the lowest prep number (sort it then get element 0)
    
    foreach my $row_ref (@{$self->{dataStore}}){
        my $clone_name   = $row_ref->[0];
        my $prep         = $row_ref->[4];

        if( $clone_digested{$clone_name." ".$prep} ){
            $row_ref->[4] = $row_ref->[4]."+";
        }
    } 
}

# This also gets FINGERPRINTED status at the request of Matt Jones
#
sub get_digest_finger_for_clones {
    my ($self, $dbh, $ref_to_hash, @clones) = @_;

    my $ref = $dbh->fetch_all(qq[ select dp.CLONENAME, dp.PREP_NUMBER
                                  from   DNAPREP dp, DNAPREP_STATUS dps
                                  where  dp.CLONENAME in (@clones)
                                  and    dp.ID_PREP    = dps.ID_PREP
                                  and    dps.STATUS    in (4, 33) ]);
    foreach my $row (@{$ref}){
        $ref_to_hash->{$row->[0]." ".$row->[1]} = $row->[1];
    }
}


# return the actioned date for the specified prep
#
sub get_actioned_date_for {
    my ($self, $dbh, $clone_name, $prep_number) = @_;

    if( $self->{sql}->{fetch_actioned_date} ){

        $self->{sql}->{fetch_actioned_date}->execute($clone_name, $prep_number);
        my $row = $self->{sql}->{fetch_actioned_date}->fetch();
        my $date = $row->[0];

        return $date;
    }
    else {
        $self->{sql}->{fetch_actioned_date} = 
            $dbh->prepare(qq[
                             select dps.STATUSDATE
                             from   DNAPREP dp, DNAPREP_STATUS dps
                             where  dp.CLONENAME    = ?
                             and    dp.PREP_NUMBER  = ?
                             and    dp.ID_PREP      = dps.ID_PREP
                             and    dps.STATUS      = 1 ]);

        $self->{sql}->{fetch_actioned_date}->execute($clone_name, $prep_number);
        my $row = $self->{sql}->{fetch_actioned_date}->fetch();
        my $date = $row->[0];

        return $date;
    }
}

# dump out list of preps that we show in the main window.
# Tag on the bottom the preps we're waiting on.
# 
# This is used by Matt Jones when seeing what should and shoudn't be in the
# freezer, prep wise
#
#        push( @{$self->{dataStore}->[$x]} , $cloneName    ); # 0
#        push( @{$self->{dataStore}->[$x]} , $speciesName  ); # 1
#        push( @{$self->{dataStore}->[$x]} , $chromosome   ); # 2

#        push( @{$self->{dataStore}->[$x]} , "$statusDate" ); # 3
#        push( @{$self->{dataStore}->[$x]} , $prepNumber );   # 4
#        push( @{$self->{dataStore}->[$x]} , $priority   );   # 5
#        push( @{$self->{dataStore}->[$x]} , '');   # 6: Assign to: xyz
#        push( @{$self->{dataStore}->[$x]} , '');   # 7: Highlight clone flag
#        push( @{$self->{dataStore}->[$x]} , $prep_type);  # 8: prep_type
#        push( @{$self->{dataStore}->[$x]} , '');          # 9: prep flag
#        push( @{$self->{dataStore}->[$x]} , $seq_reason); #10: seq reason

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

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

    open FILE, ">/tmp/DNApreps_completed" or die "could not open file\n";

    my $s = sprintf "%-15s %-10s %-10s %9s %-10s %-1s", 'Clone', 'Species',
               'Chromosome', 'Date Act ', 'Prep Num', 'Priority';
    print FILE "$s\n";

    foreach my $row (@{$self->{dataStore}}){
        my $clone      = $row->[0];
        my $species    = $row->[1];
        my $chromosome = $row->[2];
        my $act_date   = $row->[3];
        my $prep_nums  = $row->[4];
        my $priority   = $row->[5];

        my $s = sprintf "%-15s %-10s %-10s %9s %-10s %-1s", $clone, $species,
               $chromosome, $act_date, $prep_nums, $priority;

        print FILE "$s\n";
    }
    print FILE "\nTotal = ", scalar @{$self->{dataStore}}, "\n\n";

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

        $ref = $self->fetch_preps_not_ready($dbh);
    };

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

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

    $dbh->disconnect if $dbh;

    foreach my $row (@{$ref}){
        print FILE "Waiting on prep ".$row->[0].
                         ", prep: ".$row->[1].
                         ", Status: ".$row->[2]."\n";
    }

    close FILE;

    `lpr /tmp/DNApreps_completed`;

    unlink "/tmp/DNApreps_completed" or print "Could not delete tmp file!\n";

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


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

    my $timer1 = new Benchmark();
    my ($timer2, $timer3);
    my $diff;


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

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

        $ref = $self->fetch_preps_not_ready($dbh);
    };

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

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

        if( length($error) >  500 ){
            $error = "MESSAGE TRUNCATED: ".substr($error, 1, 500);
        }

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

    $dbh->disconnect() if $dbh;

    if( $ref ){
        my @lines;

        foreach my $row (@{$ref}){
            push @lines, "Prep not ready for ".$row->[0].
                         ", prep: ".$row->[1].
                         ", Status: ".$row->[2];
        }

        if( @lines ){ 

            my $m = "Dear ".$self->{realUserName}.", \n\n".
                    "preps are ready but are waiting on;".
                     "\n\n".
                     join("\n", @lines)."\n\n".
                     "thanks,\nLemur\n";

            Mail::sendMail( -to      => $self->{realUserName},
                            -subject => "Lemur: Preps not ready", 
                            -message => $m);   
        }
    }

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

    $timer2 = new Benchmark();
    $diff   = timediff($timer2, $timer1);
    print "Emailed ".$self->{realUserName}." - it took ",timestr($diff), "\n";

}

# This is called by 2 subs();
#      email_preps_not_ready()
#      print_out_clones_ready()
sub fetch_preps_not_ready {
    my ($self, $dbh) = @_;

    return $dbh->fetch_all(qq[
                      select dp.CLONENAME, dp.PREP_NUMBER,
                             dpsd.DESCRIPTION
                      from   DNAPREP dp, DNAPREP_STATUS dps,
                             DNAPREPSTATUSDICT dpsd
                      where  dp.ID_PREP     = dps.ID_PREP
                      and    dps.STATUS     < 7
                      and    dps.ISCURRENT  = 1
                      and    EXISTS (select dp.CLONENAME
                                     from   DNAPREP_STATUS dpsx, DNAPREP dpx
                                     where  dpsx.ISCURRENT = 1
                                     and    dpsx.STATUS    = 7
                                     and    dpsx.ID_PREP   = dpx.ID_PREP
                                     and    dpx.CLONENAME  = dp.CLONENAME )
                      and    dps.STATUS     = dpsd.ID_DICT ]);
}


sub setPageNum {
    my ($self, $page_num) = @_;

    my $total = scalar(@{$self->{dataStore}});

    $self->{pageNum}       = $page_num;
    $self->{pageNumLabel}  =
        "Page $self->{pageNum} of $self->{numberOfPages}  ($total Clones)";
}

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

    $self->{pageNum}++;
    $self->setPageNum( $self->{pageNum} );
}

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

    $self->{pageNum}--;
    $self->setPageNum( $self->{pageNum} );
}

################################################################################
#  blow away old stuff - could be re-displaying data
################################################################################

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

    delete $self->{dataStore};
    $cursor = 0;

    foreach my $i ( 1..$LemurGetDNAPreps::NUM_ROWS ) {
	$widgets[$i][0]->configure(text => "");
        $widgets[$i][0]->configure(-bg => 'lightblue');
	$widgets[$i][1]->configure(text => "");
	$widgets[$i][2]->configure(text => "");
	$widgets[$i][3]->configure(text => "");
	$widgets[$i][4]->configure(text => "");
	$widgets[$i][5]->configure(text => "");
	$widgets[$i][6]->configure(text => "");
	$widgets[$i][7]->configure(text => "");

	$widgets[$i][8]->configure(-state => 'disabled');

	$widgets[$i][0]->configure(fg => 'black');
	$widgets[$i][1]->configure(fg => 'black');
	$widgets[$i][2]->configure(fg => 'black');
	$widgets[$i][3]->configure(fg => 'black');
	$widgets[$i][4]->configure(fg => 'black');
        $widgets[$i][5]->configure(fg => 'black');
        $widgets[$i][6]->configure(fg => 'black');
        $widgets[$i][7]->configure(fg => 'black');

	$self->{assignTo}->[$i] = '';
    }
}


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

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

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

	$self->getOperators($dbh);

    };

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

    $dbh->disconnect if $dbh;
}

################################################################################
# setup '%operatorHash' - all subcloners
################################################################################

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

    $arrayOfArrays =
        $dbh->fetch_all(qq[
                           select p.ID_PERSON, p.FORENAME,
                                  p.SURNAME
                           from   PERSON p, TEAM_PERSON_ROLE tpr
                           where  tpr.ROLETYPE  = 'Subcloning' 
                           and    tpr.ID_PERSON = p.ID_PERSON
                           and    tpr.ISCURRENT = 1
                           and    p.ISCURRENT   = 1
                           ]); 
 
    foreach $arrayRef (@$arrayOfArrays) {
	$operatorHash{(@$arrayRef[1]." ".@$arrayRef[2])} = @$arrayRef[0];
    }

    $operatorHash{"<nobody>"} = '';

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


################################################################################
# for a given cloneName, returns
#
#    cloneName
#    speciesName
#    chromosome
#
# as a reference to an array contain the above.
################################################################################

sub getCloneInfo {
    my ($self,$cloneName ,$dbh) = @_;
    my (@ref_clone);

    if( ! defined($cloneName) || ! defined($dbh)) {
	$self->expire("Missing or undefined args to getCloneInfo()".
		      "clonename = $cloneName, dbh = $dbh",
		      $dbh);
    }

    # get clone data
    eval {
	my $stmt1 = "
            select CLONE.CLONENAME, CLONE.SPECIESNAME, CHROMOSOMEDICT.CHROMOSOME
            from   CLONE, CHROMOSOMEDICT
            where  CLONE.CLONENAME  = '$cloneName'
            and    CLONE.CHROMOSOME = CHROMOSOMEDICT.ID_DICT";

	@ref_clone = $dbh->fetch_row($stmt1);
    };

    # check eval executed correctly
    if ($@) {
	if ($DBI::err) {
	    $self->expire("$DBI::errstr", $dbh);
	} else {
	    $self->expire("$@", $dbh);
	}
    }

    return \@ref_clone;
}

################################################################################
# show the last $NUM_ROWS of data above the current 'position'
################################################################################

sub pressedUp {
    my ($self)     = @_;
    my $cursorToBe;
    my $lastIndex  = $#{$self->{dataStore}};

    if( $cursor <= 1 ) { 
	return; 
    }

    $self->decPageNum();

    # Save the data entered before scrolling up

    my $i = 1;
    my $x;

    foreach $x ($cursor .. $cursor + $LemurGetDNAPreps::NUM_ROWS - 1) {
	last if( ! defined($self->{dataStore}->[$x]) );

	$self->{dataStore}->[$x]->[6] = $self->{assignTo}->[$i];
	$i++;
    }

    # if NUM_ROWS == 1, this won't work.
    if( ($cursor - $LemurGetDNAPreps::NUM_ROWS) <= 1 )  {
        $cursor = 0;
    }
    else {
        $cursor = $cursor - $LemurGetDNAPreps::NUM_ROWS;
    }

    $self->redrawScreen();
}

################################################################################
# show the next $NUM_ROWS of data below the current position
################################################################################

sub pressedDown {
    my ($self)    = @_;
    my $lastIndex = $#{$self->{dataStore}};
    my $i         = 1;  # starts at one 'cos BrowseEntry widget starts there.
    my $x         = 0;

    if( ($cursor + $LemurGetDNAPreps::NUM_ROWS) < ($lastIndex + 1)) {

	# Save operator names to $self->{dataStore}
	foreach $x ($cursor .. $cursor + $LemurGetDNAPreps::NUM_ROWS - 1) {
	    $self->{dataStore}->[$x]->[6] = $self->{assignTo}->[$i];
	    $i++;
	}

	$cursor += $LemurGetDNAPreps::NUM_ROWS;
    }
    else {
	return;
    }

    $self->incPageNum();
    $self->redrawScreen();
}

sub gotoPage {
    my ($self, $page_num) = @_;

    $cursor = $LemurGetDNAPreps::NUM_ROWS * ($page_num - 1);
    $self->setPageNum( $page_num );
    $self->redrawScreen();
}

# redisplay the the data from cursor to cursor + NUM_ROWS
# loop for each member in the dataStore.
#
sub redrawScreen {
    my ($self)  = @_;
#    my $widgets = $self->{widgets};
    my $i       = 0;
    my $x;

    foreach $x ($cursor .. ($cursor + $LemurGetDNAPreps::NUM_ROWS - 1)) {

	++$i;

	if( ! defined($self->{dataStore}->[$x]) ){
	    $widgets[$i][0]->configure(text => "");
            $widgets[$i][0]->configure(bg   => 'lightblue'); # prep details
	    $widgets[$i][1]->configure(text => "");
	    $widgets[$i][2]->configure(text => "");
	    $widgets[$i][3]->configure(text => "");
	    $widgets[$i][4]->configure(text => "");
            $widgets[$i][5]->configure(text => "");
            $widgets[$i][6]->configure(text => "");
            $widgets[$i][7]->configure(text => "");
	    $widgets[$i][8]->configure(-state => 'disabled');
	    $self->{assignTo}->[$i] = "";

	    next;
	}

	$widgets[$i][0]->configure(text => "$self->{dataStore}->[$x]->[0]");
	$widgets[$i][1]->configure(text => "$self->{dataStore}->[$x]->[1]");
	$widgets[$i][2]->configure(text => "$self->{dataStore}->[$x]->[2]");
	$widgets[$i][3]->configure(text => "$self->{dataStore}->[$x]->[3]");
	$widgets[$i][4]->configure(text => "$self->{dataStore}->[$x]->[4]");
	$widgets[$i][5]->configure(text => "$self->{dataStore}->[$x]->[8]");
	$widgets[$i][6]->configure(text => "$self->{dataStore}->[$x]->[10]");
	$widgets[$i][7]->configure(text => "$self->{dataStore}->[$x]->[5]");


	if( $self->{dataStore}->[$x]->[7] == 1 ){    # user has highlighted it
	    $widgets[$i][0]->configure(fg => 'blue');
	    $widgets[$i][1]->configure(fg => 'blue');
	    $widgets[$i][2]->configure(fg => 'blue');
	    $widgets[$i][3]->configure(fg => 'blue');
	    $widgets[$i][4]->configure(fg => 'blue');
            $widgets[$i][5]->configure(fg => 'blue');
            $widgets[$i][6]->configure(fg => 'blue');
            $widgets[$i][7]->configure(fg => 'blue');
	}
        elsif( $self->{dataStore}->[$x]->[5] > 1){  # priority clone
	    $widgets[$i][0]->configure(fg => 'red');
	    $widgets[$i][1]->configure(fg => 'red');
	    $widgets[$i][2]->configure(fg => 'red');
	    $widgets[$i][3]->configure(fg => 'red');
	    $widgets[$i][4]->configure(fg => 'red');
            $widgets[$i][5]->configure(fg => 'red');
            $widgets[$i][6]->configure(fg => 'red');
            $widgets[$i][7]->configure(fg => 'red');
        }
        elsif( $self->{dataStore}->[$x]->[5] == 0){  # priority clone
	    $widgets[$i][0]->configure(fg => 'purple');
	    $widgets[$i][1]->configure(fg => 'purple');
	    $widgets[$i][2]->configure(fg => 'purple');
	    $widgets[$i][3]->configure(fg => 'purple');
	    $widgets[$i][4]->configure(fg => 'purple');
            $widgets[$i][5]->configure(fg => 'purple');
            $widgets[$i][6]->configure(fg => 'purple');
            $widgets[$i][7]->configure(fg => 'purple');
        }
	else {                                       # normal
	    $widgets[$i][0]->configure(fg => 'black');
	    $widgets[$i][1]->configure(fg => 'black');
	    $widgets[$i][2]->configure(fg => 'black');
	    $widgets[$i][3]->configure(fg => 'black');
	    $widgets[$i][4]->configure(fg => 'black');
            $widgets[$i][5]->configure(fg => 'black');
            $widgets[$i][6]->configure(fg => 'black');
            $widgets[$i][7]->configure(fg => 'black');
	}

        # check flag (element 9 in dataStore) to see if user is viewing the
        # details of this clone & its preps
        if( $self->{dataStore}->[$x]->[9] == 1 ){
            $widgets[$i][0]->configure(bg => 'green');
        }
        else {
            $widgets[$i][0]->configure(bg => 'lightblue');
        }

	$self->{assignTo}->[$i] = $self->{dataStore}->[$x]->[6];
	$widgets[$i][8]->configure(-state => 'normal');
    }
}


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

    print "select_printer() has been called (was $self->{printer})\n";

    my $default_printer = $ENV{PRINTER};

    my $printer = ChoosePrinter->new($self->{mw},
                                     $self->{printer},
                                     'bw');

    if( $printer ) {
        $self->{printer} = $printer; # one nearest Matt Jones.
	print "Using printer '$printer' \n";
    }
}

################################################################################
# work down the 'Assign To' column and look for a persons name not in the hash
# %alreadyAssigned. If not, look for more occurances and push details of each
# clone/prep number onto @workForPerson.
#
# When the end of the list is found it writes everything stored in 
# @workForPerson to the printer via genscript (to get landscape mode).
#
# It repeats the whole process for the next person.
################################################################################

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

    my %alreadyAssigned;
    my $firstIndex     = 0;
    my $printer        = $self->{printer};
    my $workSheetCount = 0;

    # set the number of lines on a page to a Very Large Number
    # let genscript sort out how to print it
    $= = 500;

    # Save operator names to $self->{dataStore}
    my ($x, $i);
    $i = 1;

    foreach $x ($cursor .. $cursor + $LemurGetDNAPreps::NUM_ROWS - 1) {
	$self->{dataStore}->[$x]->[6] = $self->{assignTo}->[$i];
	$i++;
    }

    if( $printer eq '' ) {
        $printer = "d324bw"; # one nearest Matt Jones.
	warn "Using default printer 'd324bw' \n";
    }
    else {
	warn "Using printer '$printer'\n";
    }

    my ($dbh);

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

	# get clones to fragment. If a person has been assigned to a clone,
	# collect all the others he has been assigned.

	foreach my $cloneArray (@{$self->{dataStore}}) {

	    my $person = @$cloneArray->[6];
	    my @workForPerson;

	    # if person not already been assigned work already, get all work
	    # for other clones that his name is against.

	    my $first = 0;

	    if( ($alreadyAssigned{$person} == 0) && ($person ne '') ) {
		my $rowArray;

		for(my $x = $firstIndex;
		    $x < scalar(@{$self->{dataStore}});
		    ++$x  ) {

		    $rowArray = @{$self->{dataStore}}->[$x];

		    if( $person eq @$rowArray->[6] ) {
			push @workForPerson, $rowArray;
		    }
		}

		$alreadyAssigned{$person} = 1;
	    }

	    if( scalar(@workForPerson) > 0 ) {
                my @clones;

                foreach my $temp ( @workForPerson ) {
                    push @clones, $temp->[0];
                }

                warn "$person has been assigned ", join(', ', @clones), "\n"
                    if $debug;

                my $question = AssignClonesToSubcloner->new($self->{mw},
                                                            $person,
                                                            @clones);
                my $answer   = $question->ask();

                if( $answer eq 'No' ){
                    next;
                }
            }
            else {
                next;
            }

	    # print a report for this person if he has work assigned.

	    select(WORKSHEET);
#	    select(STDOUT);

            open(WORKSHEET,
                 "| genscript --landscape -P$printer ".
                 "-f Courier8 ".
                 "-b 'Work for: $person       ".
                 "Date assigned: $self->{date}'");
            $- = 0;

            foreach my $tempCloneName ( @workForPerson ) {
                $clone      = @$tempCloneName[0];
                $organism   = @$tempCloneName[1];
                $chromosome = @$tempCloneName[2];
                $date       = @$tempCloneName[3];
                $prep       = @$tempCloneName[4];
#                $prep       =~ s/\+//g;
                $priority   = @$tempCloneName[5];
                $name       = @$tempCloneName[6];

                warn "$clone $chromosome\n" if $debug;

                if( $priority > 1 ){ $priority = '*';}
                else{                $priority = ''; }
		    
                write WORKSHEET;

                $self->updateDNAPrepStatus($dbh, $clone, $person);

#	        write STDOUT;
            }

            close(WORKSHEET);
            ++$workSheetCount;
	    ++$firstIndex;

            # this was a bizarre attempt to produce gel slice labels before
            # we actually know the mass... let them write it in
            $self->createLabels( $dbh, \@workForPerson );
	}
    };

    # check eval executed correctly
    if( $@ ){
        my $error = $@;  # if another error $@ will be overwritten.

        Mail::sendMail( -to      => "pjm",
                        -subject => "Lemur Error, Generating Work", 
                        -message => $error);           

	LemurUtils->showError($self->{mw}, "$error\n");
	$dbh->rollback;
    }
    else {
	$dbh->commit if $dbh;
    }

    $dbh->disconnect if $dbh;

    if( $workSheetCount ){
        print "Printing complete\n";
        LemurUtils->showInfo($self->{mw},
                             "Printing complete. Please collect ".
                             "$workSheetCount work sheet(s) from the printer ".
                             "and labels from the barcode printer.");

        LemurUtils->setWait([$self->{mw}]);
        $self->getData( $self->{showAllClones}, $self->{chromoToSearch} );
        LemurUtils->unSetWait([$self->{mw}]);
    }
}

# new status of 15 to DNAPREP_STATUS (work sheet generated)
# It would be better to add a status to the clone not multiple DNAPreps - easier
# in this section of the DB, not messing with CLONE stuff

sub updateDNAPrepStatus {
    my ($self, $dbh, $clone, $person) = @_;

    warn "\nupdateDNAPrepStatus, clone $clone\n" if $debug;

    $person =~ /^(.{1,30})/; # make sure no more than 30 chars (for DB)
    $person = $1;

    my @preps;

    my $arrayOfArrays = $dbh->fetch_all("
            select dp.ID_PREP
            from   DNAPREP dp, DNAPREP_STATUS dps
            where  dp.CLONENAME       = '$clone'
            and    dp.ID_PREP         = dps.ID_PREP
            and    (    dps.STATUS    = 7
                     OR dps.STATUS    = 15)
            and    dps.ISCURRENT      = 1
            ");

    foreach (@{$arrayOfArrays}) {
	warn "id_prep = $_->[0]\n" if $debug;

	# A work sheet may have been printed out twice in one day, in which
	# case we will have to identical status records. Not really a problem
	# just ignore it - it has been recorded
        # UPDATE: SYSDATE should get around this, code left as is though...

	eval {
	    my $count = $dbh->fetch_scalar("
                select count(*)
                from   DNAPREP_STATUS
                where  ID_PREP    = $_->[0]
                and    STATUS     = 15
                and    STATUSDATE = SYSDATE");

	    next if $count > 0;

	    $dbh->do("
                update DNAPREP_STATUS
                set    ISCURRENT = 0
                where  ID_PREP   = $_->[0]");

	    $dbh->do("
                insert into DNAPREP_STATUS(ID_PREP,STATUS,STATUSDATE,ISCURRENT,SESSIONID,PROGRAM,OPERATOR)
                values ($_->[0],
                        15,
                        SYSDATE,
                        1,
                        $self->{session_id},
                        'DNAPreps',
                        '$person')");
	};

	if( $@ ) {
	    warn "DEBUG: $@" if $debug;
	    unless($@ =~ /unique constraint/) {
		die "$@";
	    }
	}
    }
}

sub createLabels {
    my ($self, $dbh, $refToArray) = @_;
    my $dbh2;

    if( ! $debug ){
        $dbh2 = WrapDBI->connect('dodo', {RaiseError => 1});
    }
    else {
        $dbh2 = WrapDBI->connect('dev1', {RaiseError => 1});
    }

    if( ! $dbh2 ){
        die "Could not connect to Oracle for printing labels";
    }

    my $gel_label = Barcode->new();
    $gel_label->Type('GS');        # Gel Slice

    $gel_label->Database(\$dbh2);
    $gel_label->User($self->{realUserName});

    # THIS IS THE ARRAY TO CHANGE TO GET DIFFERENT FRAG SIZE LABELS !!!!
  #  my @frag_sizes = ('1 - 1.4', '1.4 - 2', '2 - 4'); ##################
   my @frag_sizes = ('4-6', '6-9'); ##################
    foreach my $row (@{$refToArray}){

        $clone      = $row->[0];
        $organism   = $row->[1];
        $chromosome = $row->[2];
        $date       = $row->[3];
        $prep       = $row->[4];
        $prep       =~ s/\+//g;
        $priority   = $row->[5];
        $name       = $row->[6];

        foreach my $size (@frag_sizes){

            $gel_label->Name(    $clone); # on top (round) label
            $gel_label->Suffix(  $size);  # "  "      "     "
            $gel_label->Project( $size);  # on big label
            $gel_label->Owner(   $clone);
            $gel_label->Date(    $self->{todaysMonthYear} );

            $gel_label->Labellist();
        }

#
# The code below is commented out "for now" because the subcloners will not
# be producing 10xd's to speed things up. The may start doing it again in the
# future.....
#

        # Output label for each 10xd to be created for each prep
#        my @preps = split(',', $prep);

#        foreach my $prep (@preps){
#            my $actioned = $self->get_actioned_date_for($dbh, $clone, $prep);

#            unless( $actioned  ){
#                print STDERR "ERROR: Clone $clone, Prep $prep could not get ".
#                    "date\n";
#            }

#            $gel_label->Name(    $clone);        # on top (round) label
#            $gel_label->Suffix(  "  $prep");     # "  "      "     "
#            $gel_label->Project( "Prep $prep");  # on big label
#            $gel_label->Owner(   $clone);
#            $gel_label->Date(    $actioned );

#            $gel_label->Labellist();
#        }       
    }

    $gel_label->Printlabel();
}


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

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

    $dbh->disconnect if $dbh; 

    warn "ERROR: $message\n";

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


format WORKSHEET_TOP =
#format STDOUT_TOP =



  Clone          Organism Chromo Date         Prep    used/prep Slices/Frag Lig    Regrowth
  -------------- -------- ------ ------------ ------- ---- ---- ------ ---- ------ --------
.

format WORKSHEET =
#format STDOUT = 
@ @<<<<<<<<<<<<< @<<<<<<< @<<<<< @<<<<<<<<<<< @<<<<<<
$priority, $clone,    $organism, $chromosome, $date, $prep
  -------------- -------- ------ ------------ ------- ---- ---- ------ ---- ------ --------
.

################################################################################
# DESTROY !!!
################################################################################

DESTROY {
    my $self = shift;
    warn "Wrong type: LemurGetDNAPreps->DESTROY '$self'" unless ref $self;
    --$instanceCount;
}

package AssignClonesToSubcloner;

sub new {
    my ($type, $parent_window, $person, @lines) = @_;

    my $self = {
        parent_window => $parent_window,
        person        => $person,
        lines         => \@lines,
    };
    bless $self, $type;

    return $self;
}

# creates window.
# Only returns when user clicks Yes or No
sub ask {
    my ($self)  = @_;
    my ($person, @lines) = ($self->{person}, @{$self->{lines}});

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

    $mw->title("Yes/No");

    $mw->Label(-text   => "Do you want to assign $person the ",
               -width  => 40,
	       )->pack;
    $mw->Label(-text   => "following ".scalar(@lines)." clones?",
               -width  => 40,
	       )->pack;

    my $slb   = $mw->ScrlListbox(-width  => 40,
				 -height => 25,
				 )->pack;
    $self->{ScrlListbox} = $slb;

    $mw->Label(-width => 6)->pack(); # for spacing
    
    my $buttF = $mw->Frame();

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

    $buttF->Label(-width => 5)->pack(-side => 'left'); # for spacing

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

    $buttF->pack;

    my $dialog = $mw->Dialog(-www            => 'crap',
			     -text           => 'Assign Subcloner?',
			     -bitmap         => 'question',
			     -title          => 1, #'Save File Dialog',
			     -default_button => 'www',#'Yes',
			     -buttons        => '2'#[qw/Yes No Cancel/
                             );

    # insert clones ScrlListbox.
    foreach my $line ( @lines ){
	$slb->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};
}

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

package CloneDetails;

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

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

    $self->createWindow();
    $self->hide();

    return $self;
}

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

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

    $mw->title('Clone & Prep Details');

    my $clone_frame = $mw->Frame();
    $clone_frame->Label(-text        => 'Clone:  '
                        )->pack(-side => 'left');
    $clone_frame->Entry(-width        => 30,
                        -justify      => 'left',
                        -textvariable => \$self->{clone_name},
                        -state        => 'disabled',
                        )->pack(-side => 'right');
    $clone_frame->pack(-anchor => 'w');

    # PROJECT STATUS
    my $status_frame = $mw->Frame();

    $status_frame->Label(-text        => 'Status: '
                        )->pack(-side => 'left');
    $status_frame->Entry(-width        => 30,
                        -justify      => 'left',
                        -textvariable => \$self->{status},
                        -state        => 'disabled',
                        )->pack(-side => 'right');

    $status_frame->pack(-anchor => 'w');

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

    # PREP DETAILS
    $self->{list_widget} =
        $mw->Scrolled('Listbox',
                      -width  => 72,
                      -height => 10,
                      -relief => 'groove',
                      -font   =>
                 '-schumacher-clean-bold-r-normal--14-140-75-75-c-80-iso8859-1',
                      )->pack(-expand => 1,
                              -fill   => 'both');

    $mw->Button(-text    => 'Close',
                -command => sub{ $self->hide() },
                )->pack;
}

# get prep details for the given clone
# caches output for each clone.
#
sub showClone {
    my ($self, $clone_name) = @_;

    my $head1 =
        "Prep Status                                             By    Date";
    my $head2 =
      "---- -------------------------------------------------- ----- ---------";
    my @head  = ($head1, $head2);

    $self->{clone_name} = $clone_name;

    if( defined $self->{cache}->{$clone_name} ){
        $self->{status} = shift @{$self->{cache}->{$clone_name}};

        $self->{list_widget}->delete('0', 'end');
        $self->{list_widget}->insert('end', @head);
        $self->{list_widget}->insert('end', @{$self->{cache}->{$clone_name}});

        unshift @{$self->{cache}->{$clone_name}}, $self->{status};
    }
    else {
        eval {
            my $dbh;

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

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

            $dbh = $self->{dbh};

            my $status =
                $dbh->fetch_scalar(qq[
                                      select psd.DESCRIPTION
                                      from   PROJECT_STATUS    ps,
                                             PROJECTSTATUSDICT psd
                                      where  ps.PROJECTNAME = '$clone_name'
                                      and    ISCURRENT      = 1
                                      and    ps.STATUS      = psd.ID_DICT
                                      ]);

            my $preps =
                $dbh->fetch_all(qq[
                                   select dp.PREP_NUMBER, dpsd.DESCRIPTION,
                                          dps.OPERATOR, dps.STATUSDATE
                                   from   DNAPREP dp, DNAPREP_STATUS dps,
                                          DNAPREPSTATUSDICT dpsd
                                   where  CLONENAME  = '$clone_name'
                                   and    dp.ID_PREP = dps.ID_PREP
                                   and    dps.STATUS = dpsd.ID_DICT
                                   order by STATUSDATE, PREP_NUMBER
                                   ]);

            my (@output);
            
            foreach my $row (@{$preps}){
                my $line = sprintf "%4d %-50s %-5s %9s", $row->[0],
                                                        $row->[1],
                                                        $row->[2],
                                                        $row->[3];
                push @output, $line;
            }

            $self->{status} = $status;

            $self->{list_widget}->delete('0', 'end');
            $self->{list_widget}->insert('end', @head);
            $self->{list_widget}->insert('end', @output);

            unshift @output, $status;

            $self->{cache}->{$clone_name} = \@output;
        };

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

    $self->show();
}

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

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

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

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

###############
# END OF MODULE
###############
1;


#
# $Log: LemurGetDNAPreps.pm,v $
# Revision 1.54  2006/09/18  10:51:29  gjc
# *** empty log message ***
#
# Revision 1.53  2005/05/19  08:37:44  mdf
# Changed the fragment size to 4-6 and 6-9 at the request of mcj
#
# Revision 1.52  2004/01/26  15:26:44  mdf
# Allowed Minipreps to be entered.
#
# Revision 1.51  2001/02/09  11:27:22  holroyd
# *** empty log message ***
#
# Revision 1.50  2000/11/14  13:45:04  pjm
# Removed big "label" at the top and replaced it with a menu. Can now call
# ChoosePrinter to send output somewhere else.
#
# Revision 1.49  2000/08/11  11:12:19  pjm
# now does not show mini preps (and    dp.PREP_TYPE  != 4)
#
# Revision 1.48  2000/08/07  15:49:43  pjm
# gets finger printed status as well as digested status for a prep, so more '+'
# symbols by prep numbers now...
#
# Revision 1.47  2000/06/07  15:23:03  pjm
# took out "and    psd.ASSIGN_ORDER < 11" so clones that are being religated
# will be shown.
#
# Revision 1.46  2000/04/13  12:08:50  pjm
# added back in `ASSIGN_ORDER < 11` and printout of clones now shows most of
# the rows shown in the window
#
# Revision 1.45  2000/04/06  09:30:11  pjm
# again, took out `and    psd.ASSIGN_ORDER < 11`
#
# Revision 1.44  2000/04/05  17:46:24  pjm
# put `and    psd.ASSIGN_ORDER < 11` back into till WOP goes away.
#
# Revision 1.43  2000/04/05  15:35:37  pjm
# took out `and    psd.ASSIGN_ORDER < 11`
# We can not rely on the current proj status being less the Library Made
#
# Revision 1.42  2000/04/04  13:45:55  pjm
# Added a 'Print preps ready' button. Print out used to see what should be in
# the freezer and what shouldn't.
#
# Revision 1.41  2000/03/29  16:55:39  pjm
# now emails pjm if error generating work sheets/labels. Will email bug
# when sure it won'y mail bomb...
#
# Revision 1.40  2000/03/22  12:17:34  pjm
# removed code that had if(0){} around it.
# Main SQL now gets seq reason for clone.
# Added columns Seq Reason & priority, Preps have a '+' if it ever had a status
# of 33 (Passed Digest Check).
#
# Revision 1.39  2000/03/21  14:59:10  pjm
# rearranged getData(). sub is now an eval{} wrapper for really_get_data();
# Main SQL to get preps checks for other preps lagging behind now.
# Getting the actioned date is done in 1 big SQL query (x2 faster?)
# Benchmark output tarted up.
#
# Revision 1.38  2000/02/29  15:10:22  pjm
# added check to make sure project not on hold or cancelled
# added so benchmark timings to see where to speed up first
#
# Revision 1.37  2000/02/22  12:40:53  pjm
# show priority 0 clones as purple (for now).
#
# Revision 1.36  2000/02/15  15:25:58  pjm
# added '$= = 500' (Num lines on a page).
# ;.
#
# Revision 1.35  2000/02/15  13:10:54  pjm
# swaped "order by cpr.PRIORITY DESC, $chromo_order" for
#        "order by  $chromo_order cpr.PRIORITY DESC,"
#
# Revision 1.34  2000/02/14  14:18:41  pjm
# orders by chromo by default now. Was ordering by chromo then priority. Changed
# so Priority then chromo.
#
# Revision 1.33  2000/02/08  17:45:19  pjm
# It was not inserting thre session_id for DNAPREP_STATUS. It dow now.
#
# Revision 1.32  2000/02/03  13:17:27  pjm
# added "and    cpr.IS_CURRENT = 1"  - did not read table def correctly.
#
# Revision 1.31  2000/02/03  11:58:14  pjm
# look at CLONE_PRIORITY instead of DNAPREP.IS_PRIORITY
#
# Revision 1.30  2000/01/31  15:31:43  pjm
# Checks value of IS_PRIORITY is non zero rather than == 1. No longer binary
# priority.
#
# Revision 1.29  2000/01/25  10:48:13  pjm
# sm1 improved performance of main SQL statement in getData().
#
# Revision 1.28  2000/01/24  13:06:43  pjm
# correct variable now used in error message "couldn't get actioned date for]
# DNA prep"
#
# Revision 1.27  2000/01/07  10:13:17  pjm
# commented out code to proiduce 10xd labels. This may be uncommented if the
# subcloners start making 10xd's again....
#
# Revision 1.26  1999/12/14 17:52:32  pjm
# took out work around for printing labels wi right date.
#
# Revision 1.25  1999/12/14 11:34:16  pjm
# Barcode module has bug that means you have to call PrintLabel after every
# LabelList so dat gets printed out correctly.
# get_actioned_date improved, Barcode sent dbh2, not dbh;
#
# Revision 1.24  1999/12/08 12:03:49  pjm
# The date shown is the actioned date of the prep - what is shown on the label
# on the prep
#
# Revision 1.23  1999/12/02 12:36:53  pjm
# printed out labels for Gel Slices (1 for each frag size - sizes hard coded in)
# and 10xd's, 1 for each prep.
#
# Revision 1.22  1999/12/01 16:46:51  pjm
# check to make sure PERSON & TEAM_PERSON_ROLE ISCURRENT = 1
#
# Revision 1.21  1999/11/08 10:36:02  pjm
# was trying to write to WORKSHEET but did not uncomment code. pjm cockup!
#
# Revision 1.20  1999/11/05 09:57:10  pjm
# emails mcj (Matt Jones) with clones that are waiting for the other prep
#
# Revision 1.19  1999/11/02 10:09:00  pjm
# when looking for preps for the same clone, it was checking for a prep status
# of less than 4, not less than 7.
#
# Revision 1.18  1999/10/29 11:34:07  pjm
# bug mail goes to bug, not pjm. main SQL statement now gets species &
# chromosome.
#
# Revision 1.17  1999/10/28 17:22:20  pjm
# forgot to change 'pjm' to 'bug' for emails
#
# Revision 1.16  1999/10/28 17:18:35  pjm
# Font for worksheet now Courier8, instead of default Courier10.
# Window is not 24 clones 'deep' or shows 24 rows.
#
# Revision 1.15  1999/10/28 16:51:21  pjm
# Small tweaks to show Clone/Prep details. Shows prep details for a start
# and clicking on empty widget does nothing.
#
# Revision 1.14  1999/10/28 14:25:14  pjm
# working version of Clone/Prep details.
#
# Revision 1.13  1999/10/13 17:18:53  pjm
# does not set status of 15 to DNAPREP (sheet printed) if one of the preps
# has failed QC or whatever.
#
# Revision 1.12  1999/10/04 16:50:08  pjm
# changed word Preps to Clones eg: Page 1 of 2 (34 Clones)
#
# Revision 1.11  1999/10/04 11:12:04  pjm
# now shows how many preps there are to be assigned.
# setPageNum is now the only place the text for the 'page x of y'.
#
# Revision 1.10  1999/09/27 10:24:45  pjm
# Added a highlight facility for Clones, can order stuff by chromosome.
# One sub redrawScreen replaced 3 seperate bits of code.
# Added DNA Prep Type as a column.
# Before printing worksheet will ask user if they want Person to be assigned
# X amount of clones, presents list.
#
# Revision 1.9  1999/09/06 09:34:03  pjm
# now sorts by STATUSDATE too.
#
# Revision 1.8  1999/08/10 16:08:34  pjm
# removed \n from subject.
#
# Revision 1.7  1999/07/30 10:27:42  pjm
# removed showError etc, used LemurUtils.
#
# Revision 1.6  1999/07/29 16:01:09  pjm
# now show's & hides itself rather than destroying itself.
#
