#######################################################################
# 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.                #
# These functions display an interface for DNA reception to streak,   #
# prepare, make and return to Finger printers for checking.           #            
#                                                                     #
#######################################################################

package DNAprep;
use strict;
use dodo_postscript;
use dodo_utilities;
use dodo_ST_P001;
use dodo_PR_P001;
use dodo_PU_P001;
use dodo_SL_P001;
use dodo_QC_P001;
use Tk;
use vars qw(@ISA);
use NewBrowseEntry;
use FileHandle;

use dodo_RA_P001;


@ISA = qw(Selector Utilities Streak Prepare Made Quality Postscript Reassign);

sub new
{

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

$setup->{Contents} 		= [];
$setup->{DNAprep} 		= "";
$setup->{Request}		= "NEW";
$setup->{Choice} 		= ["","",""];
$setup->{ListSQL} 		= "";
$setup->{ResultSQL} 		= "";			
$setup->{Button1Label}		= '--- ? ---';
$setup->{Duplicatecheck} 	= 0;
$setup->{Command}		= '';
$setup->{Datalock}		= '';

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

sub Addtooptions
{
my $pkg = shift;
$pkg->{Options}->delete(0,'end');

$pkg->{Options}->insert('end',keys %{$pkg->{Displayopts}});

}


	
sub Display
{	
my $pkg = shift;
my $title = "DODO Clone Preparation";
my $pad;
my $i;
my $j;
my $sql;
my @cells;
if(@_){$title = shift;}
# For Status window

my $frame = $pkg->{Mainwin}->Frame(	-width 			=> -1,
					-relief 		=> "ridge",
					-bg 			=> "gray85",
					-borderwidth 		=> 2
				)->grid(-row 			=> 4,
					-column 		=> 1, 
					-sticky 		=> 'we');

my $frame2 = $pkg->{Mainwin}->Frame(	-width 			=> -1,
					-bg 			=> "gray85",
					-relief 		=> 'ridge',
					-borderwidth 		=> 2
				)->grid(-row			=> 3,
					-column 		=> 1,
					-sticky 		=> 'n');
					
my $frame3 = $pkg->{Mainwin}->Frame(	-height 		=> 100,
					-relief 		=> "flat",
					-bg 			=> "grey85",
				)->grid(-row 			=> 1,
					-column 		=> 1,
					-sticky			=> 'we',
					-columnspan		=> 1);	
								
my $frame4 = $frame2->Frame(		-width 			=> -1,
					-bg 			=> "gray85",
					-relief 		=> 'groove',
					-borderwidth 		=> 2
				)->grid(-row 			=> 4,
					-columnspan 		=> 4,
					-column 		=> 1,
					-sticky			=> 'we');
				
# One of the inherited classes must have a Display method. Use it.
$pkg->SUPER::Display($frame);
$pkg->{Title} = $frame3->Label(		-font 			=> '-schumacher-clean-bold-r-normal--14-140-75-75-c-80-iso8859-1',
					-width			=> 103,
					-anchor			=> 'w',
					-bg			=> 'white',
					-fg			=> 'blue1',
					-text			=> "Operator : $pkg->{Who}\tRole Type : $pkg->{Roletype}",
				)->grid(-row			=> 2, 
					-column 		=> 1,
					-columnspan		=> 8, 
					-sticky 		=> 'we');
					

									
								
$frame2->Label(				-fg 			=> 'black',
					-bg 			=> 'grey85',
					-height			=> -1,
					-width 			=> 70,
					-text 			=> "Selected Clones",
					-font 			=> '-schumacher-clean-bold-r-normal--14-140-75-75-c-80-iso8859-1',				
					-anchor 		=> 'nw'
				)->grid(-row 			=> 2, 
					-column 		=> 1,
					-columnspan 		=> 5,
					-sticky 		=> 'we');
					
$frame2->Label(				-fg 			=> 'blue1',
					-font 			=> '-schumacher-clean-bold-r-normal--14-140-75-75-c-80-iso8859-1',
					-bg 			=> 'grey85',
					-height			=> -1,
					-width 			=> 70,
					-textvariable 		=> \$pkg->{Columnheaders},
					-anchor 		=> 'nw',
					-borderwidth		=> 2,
					-relief			=> 'groove'
			)->grid(	-row 			=> 3, 
					-column 		=> 1, 
					-columnspan 		=> 5,
					-sticky 		=> 'we');
								
															
$pkg->{DNAprep} = $frame4->Listbox( 	-width 			=> 100,
					-selectmode 		=> 'multiple',
					-fg 			=> 'black',
					-bg 			=> 'lightblue',
					-selectbackground 	=> 'green',
					-font			=> '-schumacher-clean-bold-r-normal--14-140-75-75-c-80-iso8859-1',
					-height 		=> 14,
					-borderwidth 		=> 0
				)->grid(-row 			=> 1,
					-columnspan 		=> 1,
					-column 		=> 1,
					-sticky			=> 'we');
					
my $scroll = $frame2->Scrollbar(	-width 			=> 12,
					-command 		=> ['yview',$pkg->{DNAprep}]
				)->grid(-row 			=> 4,
					-column 		=> 5, 
					-sticky 		=> 'ns');	
								
$pkg->{DNAprep}->configure(-yscrollcommand => ['set', $scroll]);
$pkg->{DNAprep}->bind('<ButtonPress-1>', 	[\&Edititem,	$pkg,0]);
$pkg->{DNAprep}->bind('<Button-2>', 		[\&Edititem, 	$pkg,1]);
$pkg->{DNAprep}->bind('<Shift-Motion>', 	[sub{ 	
							my $hit;
							if(($_[1]%17 > 7)&&($_[1]%17 <11))
							{
							my $i = int($_[1]/17); 
							{$pkg->{DNAprep}->selection('set' => $i);}
							
							}
							},Ev('y')]);	

# display buttons
$frame2->Button(		-fg 				=> 'black',
				-bg 				=> 'grey85',
				-width				=> 15,
				-textvariable 			=> \$pkg->{Button1Label},
				-anchor 			=> 'center',
				-height 			=> 1,
				-state 				=> 'normal',
				-font 				=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground 		=> 'green',
				-command 			=> sub {$pkg->Dnaprep(1);},
				-relief 			=> 'raised'
		)->grid(	-row 				=> 5, 
				-column 			=> 2,
				-padx				=> 120,
				-pady				=> 3,  
				-sticky 			=> 'w');	
$pkg->{Counter} = 0;
$frame2->Label(			-font 				=> '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-width				=> 3,
				-anchor				=> 'center',
				-bg				=> 'white',
				-fg				=> 'blue1',
				-textvariable			=> \$pkg->{Counter}
		)->grid(	-row				=> 5,
				-padx				=> 10,
				-pady				=> 3, 
				-column 			=> 3);



$frame2->Button(		-fg 				=> 'black',
				-bg 				=> 'grey85',
				-width 				=> 15,
				-text 				=> "Reject",
				-anchor 			=> 'center',
				-height 			=> 1,
				-state 				=> 'normal',
				-font 				=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground 		=> 'red',
				-activeforeground		=> 'lemonchiffon1',
				-command 			=> sub {$pkg->Dnaprep(0);},
				-relief 			=> 'raised'
		)->grid(	-row 				=> 5, 
				-column 			=> 4,
				-padx				=> 70,
				-pady				=> 3, 
				-sticky 			=> 'e');
			
				
my $c;				
				
my $fet  =$frame3->Button(	-width 				=> 10,
				-text 				=> "FETCH",
				-anchor 			=> 'center',
				-height 			=> 1,
				-state 				=> 'normal',
				-bg				=> 'grey85',
				-fg 				=> 'black',
				-font 				=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
				-activeforeground		=> 'black',
				-activebackground 		=> 'lemonchiffon1',
				-relief 			=> 'raised'
		)->grid(	-row 				=> 1, 
				-column 			=> 1,
				-columnspan 			=> 1,
				-padx				=> 1,
				-pady				=> 3, 
				-sticky 			=> 'w');
$fet->configure(		-command 			=> sub {if($c){$$c->configure(	-bg => 'grey85',);}
									$c = \$fet;
									$$c->configure(		-bg => 'palegreen');
									$pkg->Streak::Initialiseobject();});
				
				

my $pre = $frame3->Button(	-width 				=> 10,
				-text 				=> "PREPARE",
				-anchor 			=> 'center',
				-height 			=> 1,
				-state 				=> 'normal',
				-bg				=> 'grey85',
				-fg 				=> 'black',
				-font 				=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
				-activeforeground		=> 'black',
				-activebackground 		=> 'lemonchiffon1',
				-relief 			=> 'raised'
		)->grid(	-row 				=> 1, 
				-column 			=> 2,
				-columnspan 			=> 1,
				-padx				=> 1,
				-pady				=> 3, 
				-sticky 			=> 'w');
$pre->configure(		-command 			=> sub {if($c){$$c->configure(	-bg => 'grey85',);}
									$c = \$pre;
									$$c->configure(		-bg => 'palegreen');
									$pkg->Prepare::Initialiseobject();});
				
my $mad = $frame3->Button(	-width 				=> 10,
				-text 				=> "MADE",
				-anchor 			=> 'center',
				-height 			=> 1,
				-state 				=> 'normal',
				-bg				=> 'grey85',
				-fg 				=> 'black',
				-font 				=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
				-activeforeground		=> 'black',
				-activebackground 		=> 'lemonchiffon1',
				-relief 			=> 'raised'
		)->grid(	-row 				=> 1, 
				-column 			=> 3,
				-columnspan 			=> 1,
				-padx				=> 1,
				-pady				=> 3, 
				-sticky 			=> 'w');
$mad->configure(		-command 			=> sub {if($c){$$c->configure(	-bg => 'grey85',);}
									$c = \$mad;
									$$c->configure(		-bg => 'palegreen');
									$pkg->Made::Initialiseobject();});
									
									
my $qcc = $frame3->Button(	-width 				=> 10,
				-text 				=> "QC CHECK",
				-anchor 			=> 'center',
				-height 			=> 1,
				-state 				=> 'normal',
				-bg				=> 'grey85',
				-fg 				=> 'black',
				-font 				=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
				-activeforeground		=> 'black',
				-activebackground 		=> 'lemonchiffon1',
				-relief 			=> 'raised'
		)->grid(	-row 				=> 1, 
				-column 			=> 4,
				-columnspan 			=> 1,
				-padx				=> 1,
				-pady				=> 3, 
				-sticky 			=> 'w');
$qcc->configure(		-command 			=> sub {if($c){$$c->configure(	-bg => 'grey85',);}
									$c = \$qcc;
									$$c->configure(		-bg => 'palegreen');
									$pkg->Quality::Initialiseobject();});
				
				
				
				
				

$frame3->Button(		-width 				=> 12,
				-text 				=> "LAB REPORTS",
				-anchor 			=> 'center',
				-height 			=> 1,
				-state 				=> 'normal',
				-bg				=> 'grey85',
				-fg 				=> 'black',
				-font 				=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
				-activeforeground		=> 'black',
				-activebackground		=> 'lemonchiffon1',
				-command 			=> sub {system "labreport ";},
				-relief 			=> 'raised'
		);#->grid(	-row 				=> 1, 
			#	-column 			=> 5,
				#-columnspan 			=> 1,
				#-padx				=> 1,
				#-pady				=> 3, 
				#-sticky 			=> 'w');

												
$frame3->Button(		-width 				=> 10,
				-text 				=> "Send E-Mail",
				-anchor 			=> 'center',
				-height 			=> 1,
				-state 				=> 'normal',
				-bg				=> 'grey85',
				-fg 				=> 'black',
				-font 				=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
				-activeforeground		=> 'black',
				-activebackground		=> 'lemonchiffon1',
				-command 			=> sub {$pkg->email("Message :\n","DNAprep Email Editor");},
				-relief 			=> 'raised'
		)->grid(	-row 				=> 1, 
				-column 			=> 5,
				-columnspan 			=> 1, 
				-padx				=> 1,
				-pady				=> 3,
				-sticky 			=> 'e');
				
my $reas = $frame3->Button(	-width 				=> 10,
				-text 				=> "REASSIGN",
				-anchor 			=> 'center',
				-height 			=> 1,
				-state 				=> 'normal',	
				-bg				=> 'grey85',
				-fg 				=> 'black',
				-font 				=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
				-activeforeground		=> 'black',
				-activebackground 		=> 'lemonchiffon1',
				-relief 			=> 'raised'
		)->grid(	-row 				=> 1, 
				-column 			=> 6,
				-padx				=> 1,
				-pady				=> 3,);	
				
$reas->configure(		-command 			=> sub {if($c){$$c->configure(	-bg => 'grey85',);}
									$c = \$reas;
									$$c->configure(		-bg => 'palegreen');
									my $chk;
									
									$pkg->radiocheck(\$chk,'Use Preps In Storage','Preps From Evening Preppers');
									$pkg->{Mainwin}->waitVariable(\$chk);
									if($chk !~ /\D/)
									{
										$$c->configure(	-bg => 'grey85',);
										return;
									}
									
									if($chk =~ /^Use Preps/)
										{$pkg->Reassign::Initialiseobject(1);}
									else
										{$pkg->Reassign::Initialiseobject(2);}	
									
									});									
$frame3->Button(		-width 				=> 10,
				-text 				=> "EXIT",
				-anchor 			=> 'center',
				-height 			=> 1,
				-state 				=> 'normal',
				-bg				=> 'grey85',
				-fg 				=> 'red',
				-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 			=> 7,
				-columnspan 			=> 1,
				-padx				=> 1,
				-pady				=> 3, 
				-sticky 			=> 'w');
}

sub Getlock
{
my $pkg = shift;
my $sql;

	if($pkg->{Button1Label} eq 'Streak Clones')
	{	
		$sql = $pkg->Streak::Lock();
		
	}
	elsif($pkg->{Button1Label} eq 'Prepare Clones')
	{	
		$sql = $pkg->Prepare::Lock();
	}
	elsif($pkg->{Button1Label} eq 'Accept & Progress')
	{	
		$sql = $pkg->Made::Lock();
	}
	elsif($pkg->{Button1Label} eq 'QC Check')
	{	
		$sql = $pkg->Quality::Lock();
	}

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

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->{Query1} = "Another User Is Accessing $pkg->{Query1} Try Again Later";
	undef @{$pkg->{Data}};
	return;}
if($@)
{
	print STDERR "$@ \n";
}

}




sub Dnaprep
{
my ($pkg, $opt) = @_;
my $chk;
my $class;
my $sql;

if (!defined $pkg->{Contents}[0])
{
	$pkg->Message("Select A Clone First !",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	return();
}

$pkg->{DNAprep}->selection('set' => 0, 'end');


if($opt == 0)
{	
$pkg->{DNAprep}->configure(-selectbackground => 'red');
$pkg->Message("Are you sure you want To Reject These clones At This Stage?", \$chk,0);
$pkg->{Mainwin}->waitVariable(\$chk);
$pkg->{DNAprep}->selectionClear(0, 'end');
if($chk == 0)
	{
	$pkg->{DNAprep}->configure(-selectbackground => 'green');
	return;}
	if($pkg->{Button1Label} eq 'Streak Clones')
	{
		$pkg->Streak::Killprep();
		return;
	}

	if($pkg->{Button1Label} eq 'Prepare Clones')
	{	
		$pkg->Prepare::Killprep();
		return;
	}	
	
	if($pkg->{Button1Label} eq 'Accept & Progress')
	{	
		$pkg->Made::Killprep();
		return;
	}
	
	if($pkg->{Button1Label} eq 'QC Check')
	{	
		$pkg->Quality::Killprep();
		return;
	}
	
	if($pkg->{Button1Label} eq 'Re Assign')
	{	
		$pkg->Reassign::Killprep();
		return;
	}
	
	
	
	
	
}
else
{$pkg->{DNAprep}->configure(-selectbackground => 'green');
$pkg->Message("Are you sure you want To Process These clones At This Stage?", \$chk,0);
$pkg->{Mainwin}->waitVariable(\$chk);
$pkg->{DNAprep}->selectionClear(0, 'end');
if($chk == 0)
	{
	$pkg->{DNAprep}->configure(-selectbackground => 'green');
	return;}
	if($pkg->{Button1Label} eq 'Streak Clones')
	{
		$pkg->Streak::Action();
		return;
	}
	
	if($pkg->{Button1Label} eq 'Prepare Clones')
	{
		$pkg->Prepare::Action();
		return;
	}
	
	if($pkg->{Button1Label} eq 'Accept & Progress')
	{
		$pkg->Made::Action();
		return;
	}

	if($pkg->{Button1Label} eq 'QC Check')
	{
		$pkg->Quality::Action();
		return;
	}
	
	if($pkg->{Button1Label} eq 'Re Assign')
	{
		$pkg->Reassign::Action();
		return;
	}
}





	
	

}








sub Edititem
{
my ($evnt,$pkg,$action) = @_;
# Default usely gets overloaded by daughter method
my $cell;
if((grep /^[Tk::Listbox]/,ref $evnt) == 0)
{$action = $pkg; $pkg = $evnt;}

if ($action == 0)
{
	$pkg->Getchoice();
	while ($pkg->{Choice}->[0] ne "")
	{
	$pkg->Insertitem();
	$pkg->Getchoice();
	}
}
elsif (($action == 1)&&($pkg->{DNAprep}->index('end') > 0))
{#Double click

	$cell = $pkg->{DNAprep}->curselection();
	while (defined $cell)
	{
	splice(@{$pkg->{Contents}},$cell,1);
	$pkg->{DNAprep}->delete($cell);
	$cell = $pkg->{DNAprep}->curselection();
	$pkg->{Counter}--;
	}
}


}




sub Insertitem
{

my $pkg = shift;
my $cell;
my $i;
my $pad;
my @list;
my $chk;


$cell = @{$pkg->{Contents}};

# Use request to prevent duplicate records
for($i = 0; $i < @{$pkg->{Contents}}; $i++)
{
	if ($pkg->{Contents}->[$i][$pkg->{Duplicatecheck}] eq $pkg->{Choice}->[$pkg->{Duplicatecheck}])
	{
		
		@list = $pkg->{DNAprep}->curselection();
		
		foreach (@list)
		{$pkg->{DNAprep}->selectionClear($_);} 
		
		$pkg->{DNAprep}->selection('set' => $i);
		$pkg->{DNAprep}->see($i);
		$pkg->{Choice} = ["","",""];
	return;
	}
}
$pkg->{Counter}++;
$pkg->{Contents}[$cell] = [@{$pkg->{Choice}}];
$pad = "";

my $limit = 0;
foreach (@{$pkg->{Column}})
{	
	my $sub = substr($pkg->{Contents}[$i][$_->[0]],0,$_->[1]);
	$pad = "$pad$sub";
	$limit = $limit + $_->[1] + 2;
	
	while(length($pad) < $limit)
	{$pad = "$pad ";}
	
	$pad = "$pad | ";
	
	
}
$pkg->{DNAprep}->insert('end',$pad);
$pkg->{Choice} = ["","",""];
@list = $pkg->{DNAprep}->curselection();
	
foreach (@list)
{$pkg->{DNAprep}->selectionClear($_);}
	
$pkg->{DNAprep}->selection('set' => $pkg->{DNAprep}->index('end'));
$pkg->{DNAprep}->see('end');

}




sub Refresh
{
my $pkg = shift;
my $i;
$pkg->{DNAprep}->delete(0,'end');
$pkg->{Counter} = 0;
foreach (@{$pkg->{Contents}})
{
	$pkg->{DNAprep}->insert('end',$_->[0]);
}

}




1;

