#######################################################################
# 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 CONTAINS VARIOUS FUNCTIONS USED BY DODO.                #
# Allows fingerpriinters to collate plates of clones and issue prep   #
# requests on those clones                                            #
#                                                                     #
#######################################################################
package Cloneplate;
#use lib '/nfs/disk65/bsw/DODO-Ver-P01/';
use dodo_SL_P005;
use dodo_utilities;
use dodo_postscript;
use vars qw(@ISA);
use NewBrowseEntry;
use FileHandle;
use Tk;

@ISA = qw(Selector Postscript Utilities);

sub new
{
my $pkg = shift;
my $i;
my $setup= {};


warn " +++++++++++ This is CP 2 ++++++++++++++";

$setup->{Contents} = [];
$setup->{Platename} = "";
$setup->{Plate}= "NEW";
$setup->{Choice} = ["","",""];
$setup->{Mainwin} = "";

$setup->{Description} = "SEQC_";
@{$setup->{Cells}} = (0..95);



$setup->{ListSQL} = "	SELECT	CD.SPECIESNAME, CD.CHROMOSOME 
			FROM 	CHROMOSOMEDICT CD, PROJECT_STATUS PS, CLONE_PROJECT CP, 
				CLONE C, PROJECT P
			WHERE 	CD.ID_DICT		= C.CHROMOSOME
			AND	C.CLONENAME		= CP.CLONENAME
			AND	CP.PROJECTNAME		= P.PROJECTNAME
			AND	P.PROJECTNAME		= PS.PROJECTNAME
			AND	PS.ISCURRENT		= 1
			AND	PS.STATUS		= 2
			AND	C.SEQUENCED_BY		= 5
			GROUP BY CD.SPECIESNAME, CD.CHROMOSOME";

$setup->{ResultSQL} = "	SELECT 	C.CLONENAME, CD.SPECIESNAME, PS.STATUSDATE, SD.DESCRIPTION, CD.CHROMOSOME
			FROM	CLONE C, CHROMOSOMEDICT CD, SEQREASONDICT SD, PROJECT_STATUS PS, 
				CLONE_PROJECT CP, ORGANISATION O
			WHERE	CD.CHROMOSOME		= 'VAR1'
			AND	CD.SPECIESNAME		= 'VAR2'
			AND	SD.ID_DICT		= C.SEQ_REASON
			AND	CD.ID_DICT		= C.CHROMOSOME
			AND	PS.STATUS		= 2
			AND	PS.ISCURRENT		= 1
			AND	PS.PROJECTNAME		= CP.PROJECTNAME
			AND	CP.CLONENAME		= C.CLONENAME
			AND	C.SEQUENCED_BY		= O.ID_ORG
			AND	O.ID_ORG		= 5
			ORDER BY C.CLONENAME, SD.DESCRIPTION ";
# used by pop up
$setup->{Displaychoice}	= 'Seq Reason'; 
%{$setup->{Displayopts}}	= (	'Seq Reason'		=> 3,
					'Species    '		=> 1,
					'Chromosome '		=> 2);

				
$setup->{Columnheaders} = "Clone";
while(length($setup->{Columnheaders}) < 22)
	{$setup->{Columnheaders} = "$setup->{Columnheaders} ";}
	
$setup->{Columnheaders} = "$setup->{Columnheaders} | Seq Reason";
while(length($setup->{Columnheaders}) < 38)
	{$setup->{Columnheaders} = "$setup->{Columnheaders} ";}


$setup->{Columnheaders} = "$setup->{Columnheaders} | Species";
while(length($setup->{Columnheaders}) < 54)
	{$setup->{Columnheaders} = "$setup->{Columnheaders} ";}
	
$setup->{Columnheaders} = "$setup->{Columnheaders} | Chr";
while(length($setup->{Columnheaders}) < 61)
	{$setup->{Columnheaders} = "$setup->{Columnheaders} ";}
	
	
$setup->{Columnheaders} = "$setup->{Columnheaders} | Date Picked";
while(length($setup->{Columnheaders}) < 78)
	{$setup->{Columnheaders} = "$setup->{Columnheaders} ";}

$setup->{Columnheaders} = "$setup->{Columnheaders} ";
while(length($setup->{Columnheaders}) < 99)
	{$setup->{Columnheaders} = "$setup->{Columnheaders} ";}	

	
$setup->{Columnheaders} = "$setup->{Columnheaders}|";
# [a,b] a = content array index, b = width of field to display -1
$setup->{Column} = [	[0,20,'Clonename'],
			[3,14,'Seq Reason'],
			[1,14,'Species'],
			[4,5,'Chr'],
			[2,15,'Date Picked'],
			[5,18,'Resend']];





bless $setup, $pkg;
return $setup;
}


sub Addplatenames
{

my $pkg = shift;
my $sql;

$sql = "	SELECT  	CLONEPLATE.ID_CLONEPLATE, PERSON.EMAIL, CLONEPLATESTATUSDICT.DESCRIPTION 
		FROM		CLONEPLATE, CLONEPLATE_STATUS, CLONEPLATESTATUSDICT, TEAM_PERSON_ROLE, PERSON
		WHERE		(PERSON.ID_PERSON = TEAM_PERSON_ROLE.ID_PERSON)				AND
				(TEAM_PERSON_ROLE.ID_ROLE = CLONEPLATE.CREATOR)				AND
				(CLONEPLATE.ID_CLONEPLATE = CLONEPLATE_STATUS.ID_CLONEPLATE)	AND
				(CLONEPLATESTATUSDICT.ID_DICT = CLONEPLATE_STATUS.STATUS)		AND
				(CLONEPLATE_STATUS.STATUS = 1)						AND
				(CLONEPLATE_STATUS.ISCURRENT = 1)
		ORDER BY 	(CLONEPLATE.ID_CLONEPLATE)";



my $results = $pkg->Querydb($sql);

$pkg->{Platename}->delete(0,'end');
$pkg->{Platename}->insert('end',"NEW");
foreach(@$results)
	{$pkg->{Platename}->insert('end',"$_->[0] (Created By $_->[1])");} 
}



sub Checkplate
{
my $pkg = shift;
my $chk;
my $plateindex;
my $dump;
my $i;

for ($i = 0 ; $i < @{$pkg->{Contents}};$i++)
{
if($pkg->{Contents}->[$i][0])
	{$i = 999}
}


if($i != 1000)
{
	$pkg->Message("You Cannot Save An Empty Plate\nPut Some Clones In It !",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	return;
}


($plateindex, $dump) = split(' ',$pkg->{Plate},2);



if ($plateindex eq "NEW")
{
	$pkg->Saveplate($plateindex,0)
}
else
{
	$pkg->Message("WARNING\n\nYou Are About To Over Write Existing Plate\nDo You Wish To Continue ?",\$chk,'save');
	$pkg->{Mainwin}->waitVariable(\$chk);
	if($chk == 0)
		{
		return;
		#Disabled to prevent duplicate clone entries		
		#$pkg->Saveplate("NEW");
		}
	elsif($chk == 1)
		{$pkg->Saveplate($plateindex);}				
}
}



sub Deleteitem
{

my ($evnt,$pkg, $wdgt) = @_;
my @position = $wdgt->placeInfo();
my $cell;

$cell = ((($position[1]+80) - 30)/80) + (((($position[5]) - 50)/22) *12) ;

undef $pkg->{Contents}[$cell-1];

$wdgt->configure(	-text	=> "", 
			-bg 	=> 'lemonchiffon1', 
			-fg 	=> 'black');

my ($plateindex, $dump) = split(' ',$pkg->{Plate},2);

$pkg->Setname($plateindex." (EDITED)");
}





	
sub Display
{
eval {	
my $pkg = shift;
my $i;
my $j;
my $sql;
# For Selector
my $frame = $pkg->{Mainwin}->Frame(		-width		=> 1000,
						-height 	=> 250,
						-relief 	=> "ridge",
						-bg 		=> "gray85",
						-borderwidth 	=> 2
					)->grid(-row		=> 3,
						-column		=> 1,
						-columnspan 	=> 2,);
#For Buttons
# was r = 2 col = 3
my $frame1 = $pkg->{Mainwin}->Frame(		-width 		=> 1000,
						-height 	=> 50,
						-bg 		=> "gray85",
						-borderwidth 	=> 2
					)->grid(-row 		=> 1,
						-column 	=> 1, 
						-columnspan 	=> 2,
						-sticky		=> 'w');

# For Plate
my $frame2 = $pkg->{Mainwin}->Frame(		-width 		=> 1000,
						-height 	=> 230,
						-relief 	=> "ridge",
						-bg 		=> "gray85",
						-borderwidth 	=> 2
					)->grid(-row 		=> 2,
						-column 	=> 1,
						-columnspan 	=> 2,
						-sticky 	=> 'we');







				
# One of the inherited classes must have a Display method. Use it.
$pkg->SUPER::Display($frame);



# for popup
my $listbox = $frame2->Text(			-width 		=> 30, 
						-height		=> 5, 
						-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1');

# Construct microtitre plate


$i = 0;
foreach (@{$pkg->{Cells}})
{
	$_ = $frame2->Label(		-fg 		=> 'black',
					-bg 		=> 'lemonchiffon1',
					-width 		=> 10,
					-anchor 	=> 'nw',					
					-height 	=> -1,
					-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1', 
					-relief 	=> 'sunken'
				)->place(	'-x' 	=> 30 + (80 * ($i%12)),
						'-y' 	=> 50 + (22 * int($i/12)));

	$_->configure(-text => "");
	$_->bind('<ButtonPress-3>', 			[\&Poplist,		$pkg,$_,$listbox	]	);
	$_->bind('<ButtonRelease-3>',			[\&Poplist,		$pkg,$_,$listbox	]	);
	$_->bind('<Button-1>',		 		[\&Editplate,		$pkg,$_			]	);
	$_->bind('<Control-ButtonRelease-1>',		[\&Deleteitem,		$pkg,$_			]	);
	$_->bind('<ButtonPress-2>',			[\&Setpriority,		$pkg,$_			]	);
	$i++;
}



for($i = 0; $i < 12; $i++)
{
	$frame2->Label(			-fg 		=> 'black',
					-bg 		=> 'lightblue',
					-font 		=>'-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-width 		=> 11,
					-text 		=> $i+1,
					-anchor 	=> 'n',
					-height 	=> -1,
					-relief 	=> 'flat'
			)->place(	'-y' 		=> 30 ,
					'-x' 		=> 22 + (80*$i));
}

$frame2->Label(				-width 		=> 3,
					-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-bg 		=> 'lightblue'
			)->place(	'-y' 		=> 30, 
					'-x' 		=> 1);

my $l = 'A';
for($i = 0; $i < 8; $i++)
{
	$frame2->Label(			-fg 		=> 'black',
					-bg 		=> 'lightblue',
					-width 		=> 3,
					-font 		=>'-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-text 		=> $l++,
					-anchor 	=> 'n',
					-height 	=> -1,
					-relief 	=> 'flat'
			)->place(	'-y' 		=> 50 + (22 * $i),
					'-x' 		=> 1);


}

$listbox->raise();
my $delete;

$frame2->Label(				-fg 		=> 'black',
					-bg 		=> 'grey85',
					-width 		=> -1,
					-font 		=>'-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-anchor 	=> 'ne',
					-height 	=> -1,
					-text 		=> 'Plate ID : ',
					-relief 	=> 'flat'
		)->place(	'-y' => 3,
				'-x' => 1);

$pkg->{Platename} = $frame2->BrowseEntry(-width 	=> 20,
					-browsecmd 	=> sub {$pkg->Retrieveplate(\$delete);},
					-font 		=>'-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-state 		=> 'readonly',
					-fg 		=> 'blue',
					-variable 	=> \$pkg->{Plate}
				)->place('-x' 		=> 60,
					'-y'		=> 1);
$pkg->{Platename}->Subwidget("slistbox")->Subwidget("listbox")->configure(-font =>'-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
									-fg 	=> 'blue',
									-height	=> 10);



my $en = $frame2->Entry(		-fg 			=> 'black',
					-bg 			=> 'lemonchiffon1',
					-selectforeground 	=> 'lemonchiffon1',
					-selectbackground 	=> 'black',
					-width 			=> 21,
					-font 			=>'-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-textvariable 		=> \$pkg->{Description},
					-state 			=> 'normal',
					-relief 		=> 'flat'
				)->place('-y'			=> 1,
					'-x' 			=> 815);
					

$en->bind('<Button-1>', sub {$en->icursor('end');});
$en->bind("<Key>",[sub {	my ($e,$x,$k) = @_; 
				if(($k == 102)||($k == 104))
				{
				my $p = $en->index('insert');
				$pkg->{Description} = $$x;
				$en->delete($p-1,$p);
				$en->icursor($p-1);
				}
				$$x = $pkg->{Description};
				;}, \$delete, Ev('k')]);


$frame2->Label(				-fg 			=> 'black',
					-bg 			=> "grey85",
					-width 			=> 20,
					-font 			=>'-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-anchor 		=> 'ne',
					-height 		=> -1,
					-text 			=> 'Plate Description',
					-relief			=> 'flat'
		)->place(		'-y' 			=> 1,
					'-x' 			=> 647);


$pkg->Addplatenames();
$pkg->Addtobrowse();

# display buttons

			
$frame1->Button(	-fg 			=> 'black',
			-bg 			=> 'grey85',
			-width 			=> 10,
			-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
			-activebackground	=> 'lemonchiffon1',
			-activeforeground 	=> 'black',
			-text 			=> "PRINT",
			-anchor 		=> 'n',
			-height 		=> -1,
			-command 		=> sub {$pkg->PrintPLATE();},
			-relief 		=> 'raised'
		)->grid(-row 			=> 1, 
			-column 		=> 1,
			-padx			=> 2,
			-pady			=> 3,
			-sticky			=> 'w');	
			

			
$frame1->Button(	-fg 			=> 'black',
			-bg 			=> 'grey85',
			-width 			=> 10,
			-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
			-activebackground	=> 'lemonchiffon1',
			-activeforeground 	=> 'black',
			-text 			=> "SAVE",
			-anchor 		=> 'n',
			-height 		=> -1,
			-command 		=> sub {$pkg->Checkplate();},
			-relief 		=> 'raised'
		)->grid(-row 			=> 1, 
			-column 		=> 2,
			-padx			=> 2,
			-pady			=> 3,);
			
$frame1->Button(	-fg 			=> 'black',
			-bg 			=> 'grey85',
			-width 			=> 10,
			-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
			-activebackground	=> 'lemonchiffon1',
			-activeforeground 	=> 'black',
			-text 			=> "ISSUE",
			-anchor 		=> 'n',
			-height 		=> -1,
			-command 		=> sub {$pkg->Querywindow(\$delete);},
			-relief 		=> 'raised'
		)->grid(-row 			=> 1, 
			-column 		=> 3,
			-padx			=> 2,
			-pady			=> 3,);
			
$frame1->Button(	-fg 			=> 'black',
			-bg 			=> 'grey85',
			-width 			=> 10,
			-text 			=> "Send E-Mail",
			-anchor 		=> 'center',
			-height 		=> 1,
			-state 			=> 'normal',
			-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
			-activebackground	=> 'lemonchiffon1',
			-activeforeground	=> 'black',
			-command 		=> sub {$pkg->email("Message :\n","DNAprep Email Editor");},
			-relief 		=> 'raised'
		)->grid(-row 			=> 1, 
			-column 		=> 4,
			-columnspan 		=> 1, 
			-padx			=> 2,
			-pady			=> 3,);			

				
$frame1->Button(	-fg 			=> 'black',
			-bg 			=> 'grey85',
			-width 			=> 10,
			-text 			=> "HELP",
			-anchor 		=> 'center',
			-height 		=> 1,
			-state 			=> 'disabled',	
			-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
			-activeforeground	=> 'black',
			-activebackground 	=> 'lemonchiffon1',
			-command 		=> sub {$pkg->Leaveprogram();},
			-relief 		=> 'raised'
		)->grid(-row 			=> 1, 
			-column 		=> 5,
			-padx			=> 2,
			-pady			=> 3,);
			
$frame1->Button(	-fg 			=> 'red',
			-bg 			=> 'grey85',
			-width 			=> 10,
			-text 			=> "EXIT",
			-anchor 		=> 'center',
			-height 		=> 1,
			-state 			=> 'normal',
			-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
			-activeforeground	=> 'red',
			-activebackground 	=> 'lemonchiffon1',
			-command 		=> sub {
					$pkg->WriteGlystockFile();
					$pkg->Leaveprogram();
					},
			-relief 		=> 'raised'
		)->grid(-row 			=> 1, 
			-column 		=> 6,
			-padx			=> 2,
			-pady			=> 3,);	
		
my ($chr, $chr) = split /[(]|[)]/,$pkg->{Query1};
$pkg->{Description} = "SEQC$chr"."_";
if($chr == 1){$pkg->{Description} = 'CHR1_SEQ_PLATE';}
if($chr == 10){$pkg->{Description} = 'CHR10_SEQ_';}
if($chr == 20){$pkg->{Description} = 'CHR20_SEQ_';}
$delete = $pkg->{Description};	
		
						
						
};if($@){print STDERR "Function : Display\n$@\n"};



}

sub Getlockplate
{
my $pkg = shift;
my $plate = shift;


my $sql = "	SELECT	P.ID_CLONEPLATE FROM CLONEPLATE P
		WHERE	P.ID_CLONEPLATE 	= $plate 
		FOR UPDATE NOWAIT";

eval{$pkg->Querydb($sql);};

if($@ =~ /ORA-00054:/)
{	my $chk;
	my $db = Database->new();
	$db->Initialisedb();
	$db->Userdb('reports');
	$db->Connect_To_DB();
	
	
	
	$sql = "SELECT 	UNIQUE
	rpad(PERSON.FORENAME,10)FORNAME,rpad(PERSON.SURNAME,15)SURNAME,PERSON.PHONE
		FROM 	V\$SESSION A, V\$LOCKED_OBJECT B, ALL_OBJECTS C, PERSON 
		WHERE 	PERSON.EMAIL	= A.OSUSER
		AND	A.TYPE 		= 'USER' 
		AND 	A.SID 		= B.SESSION_ID 
		AND 	B.OBJECT_ID 	= C.OBJECT_ID
		AND	C.OBJECT_NAME	= 'CLONEPLATE'";

	my $ref = $db->Querydb($sql);
	$ref->[0][0] =~ s/ //g;
	$ref->[0][1] =~ s/ //g;
	$ref->[0][2] =~ s/ //g;

	$pkg->Message("LOCK OUT\n\nData Currently Being Accessed By\n\n$ref->[0][0] $ref->[0][1] extn $ref->[0][2]\n\nContact Bug If Problem persists",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	$db->{dbh}->disconnect();
	#$pkg->{Query1} = "Another User Is Accessing $pkg->{Query1} Try Again Later";
	#undef @{$pkg->{Data}};
	return;}
if($@)
{
	print STDERR "$@ \n";
}
else
{
return 1;
}
}

sub Getlock {
my $pkg = shift;


# Determine whether to Display RESEND
foreach(@{$pkg->{Data}})
{
	$sql = "SELECT  COUNT(CLONENAME)
		FROM	GLYSTOCK, CLONEWELL, CLONEPLATE_STATUS
		WHERE	CLONEPLATE_STATUS.STATUS	= 3				AND
			CLONEPLATE_STATUS.ISCURRENT	= 1				AND
			CLONEPLATE_STATUS.ID_CLONEPLATE = CLONEWELL.ID_CLONEPLATE	AND
			CLONEWELL.ID_GLYSTOCK 		= GLYSTOCK.ID_GLYSTOCK		AND 
			GLYSTOCK.CLONENAME 		= '$_->[0]'";
			
	my $ref = $pkg->Querydb($sql);
	if($ref->[0][0] > 0)
	{push @{$_},"Resend Glycerol";}
	else
	{push @{$_}," ";}

}



}


sub PrintPLATE
{
my $pkg = shift;

my @plates;
my $i = 0;
my $priority;
my $chk;
my $clonelist = [];

$pkg->Setprinter("Select A Printer",\$chk);
$pkg->{Mainwin}->waitVariable(\$chk);

if($chk != 1)
	{return;}

foreach(@{$pkg->{Cells}})
{
if($pkg->{Contents}[$i][0])
	{
	
# Use the colour of the well to set priority
	$priority = 0;
	
	if($_->cget('fg') eq 'red')
		{$priority = 1;}
	$line = "$line \"$pkg->{Contents}[$i][0]\"";	
	
	push @plates,[$pkg->{Contents}[$i][0],$i+1,$priority];
	#push @{$clonelist},"\"$pkg->{Contents}[$i][0]\"";
	}
else
	{
	
	$line = "$line \"-\"";
	#push @{$clonelist},"\"-\"";
	}
if(($i+1)%12 == 0)
{
	$line = "$line \n"; 
	push @{$clonelist},$line; 
	$line ='';
}
$i++;
}

$pkg->Printplate($pkg->{Plate},$pkg->{Description}, $pkg->{Who},@plates);
$pkg->Textbox($clonelist);
undef @plates;
undef $clonelist;
}



sub Editplate
{
my ($evnt,$pkg,$wdgt) = @_;

my @position = $wdgt->placeInfo();
my $cell;
my @list;
my $h;
my $i;


$cell = ((($position[1]+80) - 30)/80) + (((($position[5]) - 50)/22) *12) ;



$pkg->Getchoice();
while (($pkg->{Choice}->[0]) && ($cell < 97))
{
$h = 0;

my $t = @{$pkg->{Contents}};


foreach(@{$pkg->{Contents}})
{
	if(($_->[0]) && ($_->[0] eq $pkg->{Choice}->[0]))
	{
		$pkg->{Choice} = ["","",""];
		$h = 1;
		last;
	}
}



#while (($pkg->{Contents}->[$cell-1][0])&&($h==0))
#{$cell++;}

if(($h == 0)&&($cell < 97))
{
	$pkg->{Contents}[$cell-1] = [@{$pkg->{Choice}}];
	$pkg->{Cells}->[$cell-1]->configure(-text => $pkg->{Contents}->[$cell-1][0]);
	$pkg->{Choice} = ["","",""];
	$cell++;	
}
$pkg->Getchoice();
}

my ($plateindex, $dump) = split(' ',$pkg->{Plate},2);

$pkg->Setname($plateindex." (EDITED)");
}



sub Poplist
{
my ($evnt,$pkg,$wdgt,$lst) = @_;
my $rel;
my @position;
my $frmt;
my $cell;

@position = $lst->placeInfo();
$wdgt->configure(-fg => $wdgt->cget('bg'), -bg => $wdgt->cget('fg'));

if(scalar @position != 0)
{
	$lst->placeForget();
	$lst->configure(-state => 'normal');
	$lst->delete('0.1','end');
	return();
}

@position = $wdgt->placeInfo();
$rel = 'n';

if ($position[5] > 94)
	{$rel = 's';}

if ($position[1] > 430)
	{$rel = $rel.'e';}
else
	{$rel = $rel.'w';}


$cell = ((($position[1]+80) - 30)/80) + (((($position[5]) - 50)/22) *12);


if(defined $pkg->{Contents}->[$cell-1][0])
{	
	foreach(keys %{$pkg->{Displayopts}})
	{
		$frmt = "$_\t: $pkg->{Contents}->[$cell-1]->[$pkg->{Displayopts}->{$_}]\n";
		$lst->insert('end',$frmt);
	}
	
	$lst->configure(-state => 'disabled');
	$lst->place('-x' => $position[1] + 40, '-y' => $position[5] + 15,-anchor => $rel);
}
}




sub Prepplate
{
eval{
my $pkg = shift;
my $win;
my $sql;
my @multisql;
my $ref;
my $glyindex;
my $cell;
my $priority;



	my ($plateindex, $dump) = split(' ',$pkg->{Plate},2); 

######################################################################################
	$sql = "SELECT 	'A' 
		FROM 	CLONEPLATE_STATUS C 
		WHERE 	STATUS 			= 3
		AND	ISCURRENT 		= 1
		AND	C.ID_CLONEPLATE 	= $plateindex";

	my $checker = $pkg->Querydb($sql);
	
	if($checker->[0][0]){warn "Caution : Plate $plateindex has already been issued \n\n";return;}
	
	
	
	
	
######################################################################################

	$sql = "	SELECT		GLYSTOCK.ID_GLYSTOCK, CLONEWELL.ID_MAP
			FROM		GLYSTOCK, CLONEWELL
			WHERE		(CLONEWELL.ID_CLONEPLATE = '$plateindex')			AND
					(CLONEWELL.ID_GLYSTOCK = GLYSTOCK.ID_GLYSTOCK)";

	$ref = $pkg->Querydb($sql);

	
	
	foreach(@$ref)
	{
	$glyindex = $_->[0];
	
	# Use the colour of the well to set priority
	$priority = 0;

	
	
	if($pkg->{Cells}[$_->[1]-1]->cget('fg') eq 'red')
	{$priority = 1;}
	
	
	$sql = "	INSERT INTO DNAPREP_REQUEST	(ID_REQUEST, ID_GLYSTOCK, REQUESTED_BY,REQUEST_DATE,IS_FASTTRACK)
			VALUES	(SEQ_DPREQUEST.NEXTVAL,$glyindex,'$pkg->{Role}',(SYSDATE+0.5),'$priority')";
	

	push @multisql, $sql;

	$sql = "	INSERT INTO DNAREQUEST_STATUS	(ID_REQUEST, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM)
			VALUES				(SEQ_DPREQUEST.CURRVAL,'1',SYSDATE,'1', $$, 'DODO')";
	

	push @multisql, $sql;

	}
	
	
	
	$sql = "	UPDATE 	CLONEPLATE_STATUS		
			SET		ISCURRENT 	= 0
			WHERE		(ID_CLONEPLATE 	= $plateindex)	AND
					(ISCURRENT 	= 1)";
	push @multisql, $sql;
	
	$sql =  "	INSERT INTO CLONEPLATE_STATUS	(ID_CLONEPLATE, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
			VALUES				($plateindex , 3,SYSDATE,1, $$, 'DODO','$pkg->{Who}')";

	push @multisql, $sql;
	
$pkg->MultiWritedb(@multisql);

##########################################
#Updating projectstatus with recieved tag
##########################################
$pkg->Projectstatus(3);

$pkg->Addtobrowse();
$pkg->Addtoresults();

open (MAIL,"|/usr/bin/mail bsw");
print MAIL "From: CLONEPLATE <>\n";
print MAIL "To: bsw\n";
print MAIL "Subject: Issued $plateindex\n\n";

print MAIL "$pkg->{Who} Has issued Plate $plateindex \n";
close MAIL;


};if($@){print STDERR "Function : Prepplate\n$@\n";}
}





sub Querywindow
{
my $pkg = shift;
my $delete = shift;
my $chk;
my $win;

# Test for saved plate
if (($pkg->{Plate} =~ /NEW/) or ($pkg->{Plate} =~ /EDITED/))
	{$pkg->Message("You must Save The Plate Before Issuing a Prep Request ");}
else
{

	$pkg->Prepplate();
	$pkg->Message("Do You Want To Print A Copy Of Your Requests ?",\$chk,"Prep Requests \n");	

	$pkg->{Mainwin}->waitVariable(\$chk);
	if($chk == 1)
	{
		undef $chk;
		$pkg->Setprinter("Printrequest",\$chk);
		$pkg->{Mainwin}->waitVariable(\$chk);
		if($chk == 0)
			{return;}
		$pkg->Printrequest();
		
	}

	undef $chk;
	$pkg->Message("Please Ensure that the Plate is in the DNAprep freezers within 24 hrs",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	$pkg->Setname("NEW");
	$pkg->Retrieveplate($delete);
	$pkg->Addplatenames();
}

}




sub Refresh
{
my $pkg = shift;
my $i;
for ($i = 0; $i < 96; $i++)
{
	$pkg->{Cells}[$i]->configure(	-text => $pkg->{Contents}->[$i][0], 
						-fg 	=> 'Black', 
						-bg 	=> 'lemonchiffon1');
}




}


sub Retrieveplate
{

my $pkg = shift;
my $delete = shift;
my $i;
my $sql;
my $cell;
my ($plateindex, $dump) = split(' ',$pkg->{Plate},2);

$pkg->{dbh}->commit;


#$pkg->Getlock($plateindex);
#$pkg->Resend();
eval
{
foreach(@{$pkg->{Contents}})
	{undef $_;}
	
#$pkg->{Query1} comes form the selector.
my ($chr, $chr) = split /[(]|[)]/,$pkg->{Query1};
$pkg->{Description} = "SEQC$chr"."_";
if($chr == 1){$pkg->{Description} = 'CHR1_SEQ_PLATE';}
if($chr == 10){$pkg->{Description} = 'CHR10_SEQ_';}
if($chr == 20){$pkg->{Description} = 'CHR20_SEQ_';}

if ($plateindex ne 'NEW')
{
if(!$pkg->Getlockplate($plateindex)){
					$pkg->{Plate} = 'NEW';
					$pkg->Refresh();
					return;}

$sql = "	SELECT 		CLONEWELL.ID_MAP, CLONE.CLONENAME, CLONE.SPECIESNAME,
				CLONE.CHROMOSOME, SEQREASONDICT.DESCRIPTION,
				CLONEPLATE.DESCRIPTION
		FROM 		CLONEWELL, GLYSTOCK, CLONE, CLONEPLATE, SEQREASONDICT
		WHERE 		(GLYSTOCK.ID_GLYSTOCK 		= CLONEWELL.ID_GLYSTOCK)	AND
				(SEQREASONDICT.ID_DICT 		= CLONE.SEQ_REASON)		AND  
				(CLONE.CLONENAME 		= GLYSTOCK.CLONENAME)		AND
				(CLONEWELL.ID_CLONEPLATE 	= CLONEPLATE.ID_CLONEPLATE)	AND
				(CLONEPLATE.ID_CLONEPLATE 	= $plateindex)";

	my $ref = $pkg->Querydb($sql);

	$pkg->{Description} = $ref->[0][5];


foreach(@{$ref})
{
	$cell = shift @{$_};
	if($cell)
	{
	$pkg->{Contents}[$cell-1] = $_;
	pop @{$pkg->{Contents}[$cell-1]};
	}
}
}


$pkg->Refresh();
};if($@ =~ /ORA-00054:/)
{	my $chk;my $db = Database->new();
	$db->Initialisedb();
	$db->Userdb('reports');
	$db->Connect_To_DB();
	
	my $tables = substr($sql,index($sql,'FROM'),index($sql,'WHERE') - index($sql,'FROM'));
	chomp $tables;
	$tables =~ s/ |\t|FROM|\n//g;
	$tables =~ s/,/','/g;
	$tables ="\'$tables\'";
	
	
	$sql = "SELECT 	UNIQUE
	rpad(PERSON.FORENAME,10)FORNAME,rpad(PERSON.SURNAME,15)SURNAME,PERSON.PHONE
		FROM 	V\$SESSION A, V\$LOCKED_OBJECT B, ALL_OBJECTS C, PERSON 
		WHERE 	PERSON.EMAIL	= A.OSUSER
		AND	A.TYPE 		= 'USER' 
		AND 	A.SID 		= B.SESSION_ID 
		AND 	B.OBJECT_ID 	= C.OBJECT_ID
		AND	C.OBJECT_NAME	in ($tables)";

	my $ref = $db->Querydb($sql);
	$ref->[0][0] =~ s/ //g;
	$ref->[0][1] =~ s/ //g;
	$ref->[0][2] =~ s/ //g;

	$pkg->Message("LOCK OUT\n\nData Currently Being Accessed By\n\n$ref->[0][0] $ref->[0][1] extn $ref->[0][2]\n\nContact Bug If Problem persists",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	$db->{dbh}->disconnect();
	
	#$pkg->{Plate} = "Another User Is Accessing $pkg->{Plate} Try Again Later";
	#undef @{$pkg->{Contents}};
	return;}
if($@){print STDERR "Function : Retrieveplate\n$@\n";}
$$delete = $pkg->{Description}
}




sub Setname
{
my $pkg = shift;
$pkg->{Plate} = shift;
}


sub Setpriority
{
my ($pkg, $evnt, $wdgt) = @_;

if ($wdgt->cget('fg') eq "red")
	{$wdgt->configure(-bg => "lemonchiffon1", -fg => 'black');}
else
	{$wdgt->configure(-fg => 'red' , -bg => 'lemonchiffon1');}
}



 


sub Saveplate
{
eval{
my ($pkg,$plateindex,$win) = @_;
my @multisql;
my $sql;
my $ref;
my $i;
my $j;


my $sqlz = "SELECT 	GLYSTOCK.CLONENAME, CLONEPLATE.ID_CLONEPLATE	
	FROM	CLONEWELL, CLONEPLATE, GLYSTOCK, CLONEPLATE_STATUS
	WHERE	GLYSTOCK.ID_GLYSTOCK		= CLONEWELL.ID_GLYSTOCK			AND
		CLONEWELL.ID_CLONEPLATE		= CLONEPLATE.ID_CLONEPLATE		AND
		CLONEPLATE.ID_CLONEPLATE	= CLONEPLATE_STATUS.ID_CLONEPLATE	AND
		CLONEPLATE_STATUS.STATUS	< 3					AND 
		CLONEPLATE_STATUS.ISCURRENT 	= 1";	

my $reff = $pkg->Querydb($sqlz);
my $mess ='';


foreach $i(@{$pkg->{Contents}})
{
	foreach $j(@{$reff})
	{
	if(($i->[0])&&($j->[0] eq $i->[0])&&($j->[1] ne $plateindex)){$mess = "$mess\nClone :	$j->[0]\tPlate :$j->[1]";last;}
	}
}	

if($mess)
{
my $chk;
$pkg->Message("CANNOT SAVE PLATE\n\nThe following clones are already in a plate !\nDelete the clones from the plate then resave.\n\n$mess\n",\$chk);
$pkg->{Mainwin}->waitVariable(\$chk);
return;
}
undef $sql;


$pkg->{Description} = substr($pkg->{Description},0,20);
$pkg->{Description} = uc($pkg->{Description});

if ($plateindex eq "NEW")
{

	# DETERMINE CURRENT MAX PLATE NO.
	$sql = "SELECT SEQ_CLONEPLATE.NEXTVAL FROM DUAL";

	$ref = $pkg->Querydb($sql);
	$plateindex = $ref->[0][0];
	
	$sql = "	INSERT INTO 	CLONEPLATE 	(ID_CLONEPLATE, CREATOR, FORMAT, DESCRIPTION)
			VALUES		($plateindex,'$pkg->{Role}','96','$pkg->{Description}')";

	push @multisql, $sql;

	# GO THROUGH EACH WELL THAT HAS A CLONE AND CREATE A GLYSTOCK

	# CREATE CLONEWELL
	
	for($i = 0 ; $i < 96; $i++)
	{
		if ($pkg->{Contents}[$i][0])
		{
	
	
		$sql = "	INSERT INTO GLYSTOCK	(ID_GLYSTOCK, CLONENAME)
				VALUES			(SEQ_GLYSTOCK.NEXTVAL,'$pkg->{Contents}[$i][0]')";
	
		push @multisql, $sql;
	
		$sql = "INSERT INTO CLONEWELL 	(ID_CLONEPLATE, ID_MAP, ID_GLYSTOCK)
			VALUES			($plateindex,'".($i+1)."',SEQ_GLYSTOCK.CURRVAL)";
		
		push @multisql, $sql;	
		
		}
	}
	
# Set a plate status of created
$sql = "	INSERT INTO CLONEPLATE_STATUS 	(ID_CLONEPLATE, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
		VALUES				($plateindex, 1,SYSDATE,1, $$, 'DODO','$pkg->{Who}')";



push @multisql, $sql;

$pkg->Setname("$plateindex (Created by $pkg->{Who}");
}
else
{
# for existing plates need to be able to handle additions and removals.
# go through each well, test to see if gly record exists - change, delete - add
# when delete used set clonename to VOID, possibility of multiple voids


	# retrieve all wells with a current value
	$sql = "	SELECT	ID_MAP, ID_GLYSTOCK
			FROM		CLONEWELL
			WHERE		(ID_CLONEPLATE = '$plateindex')";
			
	$ref = $pkg->Querydb($sql);	
	
	$sql	="	UPDATE CLONEPLATE
			SET DESCRIPTION 	= '$pkg->{Description}'
			WHERE  ID_CLONEPLATE 	= '$plateindex'";
	push @multisql, $sql;
	
	
	
	for($i = 0 ; $i < 96; $i++)
	{
	$sql = "";
	
	
		for ($j = 0; $j < @$ref; $j++)
		{
		# Test to see if  glystock already exists for this well and still has something to put in it
		if (($ref->[$j][0] == ($i+1))&&($pkg->{Contents}[$i][0]))
			{
			# re write gly records with new contents
			$sql	="	UPDATE GLYSTOCK
					SET CLONENAME = '$pkg->{Contents}[$i][0]'
					WHERE  ID_GLYSTOCK = '$ref->[$j][1]'";
			push @multisql, $sql;
			last;
			}
			elsif	(($ref->[$j][0] == ($i+1))&&(!defined $pkg->{Contents}[$i][0]))
			# Well did contain something, Get rid of it.
			{
			$sql	="	DELETE FROM CLONEWELL
					WHERE  	(ID_CLONEPLATE 		= '$plateindex')	AND
							(ID_MAP 	= '$ref->[$j][0]')	AND
							(ID_GLYSTOCK 	= '$ref->[$j][1]')";			push @multisql, $sql;
	
			# delete oracle records
			$sql	="	DELETE FROM GLYSTOCK
					WHERE  ID_GLYSTOCK = '$ref->[$j][1]'";
			push @multisql, $sql;
			last;
			}
	
		
		} # PREVIOUS CONTENTS CHECK ITERATIONS
	
	if (($sql eq "")&&($pkg->{Contents}[$i][0]))
	# new record
	{

		$sql = "	INSERT INTO GLYSTOCK	(ID_GLYSTOCK, CLONENAME)
				VALUES			(SEQ_GLYSTOCK.NEXTVAL,'$pkg->{Contents}[$i][0]')";

		push @multisql, $sql;
	
		$sql = "	INSERT INTO CLONEWELL 	(ID_CLONEPLATE, ID_MAP, ID_GLYSTOCK)
				VALUES			('$plateindex','".($i+1)."',SEQ_GLYSTOCK.CURRVAL)";
	
		push @multisql, $sql;
	
	}
	
	} # END OF WELL ITERATIONS


$pkg->Setname("$plateindex (Created by $pkg->{Who})");
}




$pkg->MultiWritedb(@multisql);
$pkg->Addplatenames();
splice @multisql;
};if($@){print STDERR "Function : Saveplate\n$@\n";}



}




1;

