#######################################################################
# 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 allow the DNA reception to inform the database that #
# they have made a preparation.                                       #
#                                                                     #
#######################################################################
package Made;
use strict;

sub new
{
my $pkg = shift;
my $setup = {};
$setup->{Contents} = [];
bless $setup,$pkg;
}



sub Initialiseobject
{
my $pkg = shift;
# pull out speciesname and chromosome name of all clones that have been actioned.

#Role IDS of evening Preppers
#	10746 ha1
#     	14921 ks2
#     	14922 lmb
#     	14923 sdm
#	14924 sm2

my $evening_preppers = '13381,10746,14921,14922,14923,14924';
my $email = "'ha1','ks2','lmb','sdm','sm2','cs3','bsw'";


if(!$pkg->{Query1}){$pkg->{Query1} = 'ALL';}

if(index($email,$pkg->{Who},0) == -1){$email = "'$pkg->{Who}'";} 



$pkg->{ListSQL} = "	SELECT 	UNIQUE CD.SPECIESNAME,CD.CHROMOSOME 
			FROM 	CHROMOSOMEDICT CD, CLONE C, DNAPREP DP, DNAPREP_STATUS DS, 
				TEAM_PERSON_ROLE T, PERSON P
			WHERE	CD.ID_DICT 		= C.CHROMOSOME		
			AND	C.CLONENAME		= DP.CLONENAME
			AND	DS.STATUS 		IN (1,31)
			AND	DS.ISCURRENT		= 1
			AND	DS.ID_PREP		= DP.ID_PREP
			AND	DP.OPERATOR		= T.ID_ROLE
			AND	T.ID_PERSON		= P.ID_PERSON
			AND	P.EMAIL			= '$pkg->{Who}'";


$pkg->{ResultSQL} ="	SELECT	C.CLONENAME, 
				DS.STATUSDATE, 
				DP.ID_PREP, 
				P.EMAIL,
				CC.ID_REQUEST, 
				CP.PRIORITY - 1, 
				PD.DESCRIPTION,
				DP.PREP_NUMBER
			FROM	DNAPREP DP, DNAPREP_STATUS DS, CLONE C, CLONE_PRIORITY CP,
				CHROMOSOMEDICT CD, CLONE_CULTURE CC, TEAM_PERSON_ROLE T,
				PERSON P, DNAPREPTYPEDICT PD
			WHERE	CD.CHROMOSOME 		LIKE 'VAR1'
			AND	CD.SPECIESNAME 		LIKE 'VAR2'
			AND	CD.ID_DICT 		= C.CHROMOSOME
			AND	CP.IS_CURRENT		= 1
			AND	CP.CLONENAME		= C.CLONENAME		
			AND	C.CLONENAME		= DP.CLONENAME
			AND	CC.ID_CULTURE		= DP.ID_CULTURE
			AND	PD.ID_DICT		= DP.PREP_TYPE
			AND	DS.STATUS 		IN (1,31)
			AND	DS.ISCURRENT		= 1
			AND	DS.ID_PREP		= DP.ID_PREP
			AND	DP.OPERATOR		= T.ID_ROLE
			AND	T.ID_PERSON		= P.ID_PERSON
			AND	P.EMAIL 		= '$pkg->{Who}'
			ORDER BY P.EMAIL, DP.CLONENAME, DP.PREP_NUMBER";


$pkg->{Button1Label}	= "Accept & Progress";
$pkg->{Duplicatecheck} 	= 2;

$pkg->{Columnheaders} = "Clone";				
while(length($pkg->{Columnheaders}) < 17)
	{$pkg->{Columnheaders} = "$pkg->{Columnheaders} ";}
	
$pkg->{Columnheaders} = "$pkg->{Columnheaders} | Prep";
while(length($pkg->{Columnheaders}) < 25)
	{$pkg->{Columnheaders} = "$pkg->{Columnheaders} ";}


$pkg->{Columnheaders} = "$pkg->{Columnheaders} | By";
while(length($pkg->{Columnheaders}) < 33)
	{$pkg->{Columnheaders} = "$pkg->{Columnheaders} ";}
	
$pkg->{Columnheaders} = "$pkg->{Columnheaders} | Method";
while(length($pkg->{Columnheaders}) < 55)
	{$pkg->{Columnheaders} = "$pkg->{Columnheaders} ";}
	
$pkg->{Columnheaders} = "$pkg->{Columnheaders} | Start Date";
while(length($pkg->{Columnheaders}) < 70)
	{$pkg->{Columnheaders} = "$pkg->{Columnheaders} ";}
	
$pkg->{Columnheaders} = "$pkg->{Columnheaders}|";
# [a,b] a = content array index, b = width of field to display -1
# Internal column headings = sum b + 2 end one + 3
$pkg->{Column} = [[0,15,'Clone'],[7,6,'Prep'],[3,6,'By'],[6,20,'Method'],[1,12,'Start Date']];					
					
				
undef $pkg->{Selection};

$pkg->Addtobrowse();
undef @{$pkg->{Contents}};
$pkg->Refresh();
$pkg->{Title}->configure(-text => "Operator : $pkg->{Who}\tRole Type : $pkg->{Roletype}\t\tCOMPLETE DNAprep (DNA Made) ");


}



sub Killprep
{
my $pkg = shift;
my $sql;
my @multisql;
my $radio;
my $ref;

$pkg->radiocheck(\$radio,'Method Failure','Selected By Mistake');
$pkg->{Mainwin}->waitVariable(\$radio);
if($radio !~ /\D/){return;}
if($radio =~ /^Method/)
	{$radio = 3;}			
else
	{$radio = 1;}


my $clones;		
foreach (@{$pkg->{Contents}})
{
$clones = "$clones\n$_->[0]";
eval{
	# Check to see how many completed preps on request 
	$sql = "SELECT 	COUNT(DNAPREP.ID_PREP)
		FROM 	DNAPREP, DNAPREP_STATUS, CLONE_CULTURE, DNAREQUEST_STATUS
		WHERE 	(DNAPREP_STATUS.STATUS		= 7)				AND
			(DNAPREP_STATUS.ISCURRENT	= 1)				AND
			(DNAPREP.ID_PREP 		= DNAPREP_STATUS.ID_PREP)	AND
			(CLONE_CULTURE.ID_CULTURE	= DNAPREP.ID_CULTURE)		AND
			(DNAREQUEST_STATUS.ID_REQUEST	= CLONE_CULTURE.ID_REQUEST)	AND
			(DNAREQUEST_STATUS.STATUS	= 2)				AND
			(DNAREQUEST_STATUS.ISCURRENT	= 1)				AND
			(DNAREQUEST_STATUS.ID_REQUEST	= $_->[4])";

	$ref = $pkg->Querydb($sql);
	
	my $completed = $ref->[0][0];
	
	# Check to see how many live preps on request Don't count succesfully completed
	$sql = "SELECT 	COUNT(DNAPREP.ID_PREP)
		FROM 	DNAPREP, DNAPREP_STATUS, CLONE_CULTURE, DNAREQUEST_STATUS
		WHERE 	(DNAPREP_STATUS.STATUS		IN (1,2,3,4,5,6,30,31))		AND
			(DNAPREP_STATUS.ISCURRENT	= 1)				AND
			(DNAPREP.ID_PREP 		= DNAPREP_STATUS.ID_PREP)	AND
			(CLONE_CULTURE.ID_CULTURE	= DNAPREP.ID_CULTURE)		AND
			(DNAREQUEST_STATUS.ID_REQUEST	= CLONE_CULTURE.ID_REQUEST)	AND
			(DNAREQUEST_STATUS.STATUS	= 2)				AND
			(DNAREQUEST_STATUS.ISCURRENT	= 1)				AND
			(DNAREQUEST_STATUS.ID_REQUEST	= $_->[4])";

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

	
	
	# SELECTED BY MISTAKE, NOT PREPARED AT ALL. SO REMOVE ALL PREP RECORDS
	if($radio == 1)
	{
	
		$sql = "DELETE FROM DNAPREP_STATUS WHERE ID_PREP = $_->[2]";
		push @multisql,$sql;
		$sql = "DELETE FROM DNAPREP WHERE ID_PREP = $_->[2]";
		# Change Status of request to re issue
		push @multisql,$sql;
	}
	else
	{
		$sql = "UPDATE 	DNAPREP_STATUS 
			SET 	ISCURRENT = 0 
			WHERE 	ISCURRENT = 1 AND ID_PREP = $_->[2]";
	
		push @multisql,$sql;
	# failed in dnaprep
		$sql = "INSERT INTO 	DNAPREP_STATUS	(ID_PREP, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
			VALUES				($_->[2] ,8,SYSDATE,1, $$, 'DODO','$pkg->{Who}')";
				
	push @multisql,$sql;
	
	
	# 1 is test because of the prep being rejected
	# This is the last live prep So Reissue assume agar dead by this time
	if($ref->[0][0] == 1)
	{
		$sql = "UPDATE 	DNAREQUEST_STATUS 
			SET 	ISCURRENT = 0 
			WHERE 	ISCURRENT = 1 AND ID_REQUEST = $_->[4]";
		
		push @multisql,$sql;

	if($completed == 0)
	{#Reissue
		$sql = "INSERT INTO 	DNAREQUEST_STATUS	(ID_REQUEST, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
			VALUES					($_->[4] , 3,SYSDATE,1, $$, 'DODO','$pkg->{Who}')";
	
		push @multisql,$sql;
	}
	else
	{# Complete request
		$sql = "INSERT INTO 	DNAREQUEST_STATUS	(ID_REQUEST, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
			VALUES					($_->[4] , 4,SYSDATE,1, $$, 'DODO','$pkg->{Who}')";
	
		push @multisql,$sql;
	}
	}
	}
	
	$pkg->MultiWritedb(@multisql);
	undef @multisql;
}	
	};if($@){print STDERR "Function	: MADE::Killprep\nRequest ID	: $_->[4]\nPrep ID	:$_->[2]\n\n$@\n";}

open (MAIL,"|/usr/bin/mail bsw");
print MAIL "From: Warning Prepper Has Failed A Clone       <>\n";
print MAIL "To: bsw\n";
print MAIL "Subject: Prepper Failing Clones !\n\n";
print MAIL "\nPrepper : $pkg->{Who} Has Failed The Following Clones\n\n$clones";
close(MAIL);


open (MAIL,"|/usr/bin/mail mcj");
print MAIL "From: Warning Prepper Has Failed A Clone       <>\n";
print MAIL "To: bsw\n";
print MAIL "Subject: Prepper Failing Clones !\n\n";
print MAIL "\nPrepper : $pkg->{Who} Has Failed The Following Clones\n\n$clones";
print MAIL "Please check why they have done this to prevent any unnecessary duplication\n";
close(MAIL);






undef @{$pkg->{Contents}};
$pkg->Refresh();
$pkg->Addtobrowse();
$pkg->Addtoresults();
}



sub Action
{
my $pkg = shift;
my $sql;
my @multisql;
my $ref;
my $i;
my $chk;
my $radio;


my $evening_preppers = {	'ha1' => 10746,
				'ks2' => 14921,
				'lmb' => 14922,
				'sdm' => 14923,
				'sm2' => 14924};
				
if($evening_preppers->{$pkg->{Who}})
{
	$pkg->Message("You are an evening prepper.\nYou only have to tell Oracle about preps that have failed.\n\nAny problems contact Bug",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	return;
}
		
				
# No longer needed
#$pkg->Bandquality(\$chk);
#$pkg->{Mainwin}->waitVariable(\$chk);
#if($chk == 0)
#{return;}

$pkg->radiocheck(\$radio,'Prep Successfully Made','Put Prep In Storage');
$pkg->{Mainwin}->waitVariable(\$radio);
if($radio !~ /\D/){return;}
if($radio =~ /^Prep/)
	{$radio = 2;}			
elsif($radio =~ /Storage/)
	{$radio = 30;}
else	{$radio = 31;}

# Set semi prepped status on assignment therefore not totally reliant on evening preppers


foreach (@{$pkg->{Contents}})
{	
	$sql = "UPDATE 	DNAPREP_STATUS
		SET 	ISCURRENT 	= 0
		WHERE	ISCURRENT 	= 1	AND
			ID_PREP 	= $_->[2]";
			
	push @multisql,$sql ;
	
	$sql = "INSERT INTO DNAPREP_STATUS	(ID_PREP, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
		VALUES				($_->[2] ,$radio,SYSDATE,1, $$, 'DODO','$pkg->{Who}')";
					
	push @multisql,$sql;
	
	# No longer needed
	#$sql = "UPDATE 	DNAPREP
	#	SET	BANDQUALITY 	= $pkg->{Bandquality}
	#	WHERE 	ID_PREP 	= $_->[2]";

	#push @multisql,$sql;


	eval{
	$pkg->MultiWritedb(@multisql);
	undef @multisql;
	};if($@){print STDERR "Function	: MADE::Action\nRequest ID	: $_->[4]\nPrep ID	: $_->[2]\n\n$@\n";}


}

if($radio == 2){$pkg->Projectstatus(5);}

undef @{$pkg->{Contents}};
$pkg->Refresh();
$pkg->Addtobrowse();
$pkg->Addtoresults();
}






sub Lock
{
my $pkg = shift;
my $sql;
if($pkg->{dbh}){$pkg->{dbh}->commit;}
# Causing indefinite locking
$sql = "	SELECT 	DNAPREP_REQUEST.ID_REQUEST 
		FROM 	DNAPREP_REQUEST, DNAREQUEST_STATUS, GLYSTOCK, CLONE_CULTURE, DNAPREP, DNAPREP_STATUS
		WHERE	(DNAPREP_STATUS.ID_PREP		= DNAPREP.ID_PREP)		AND
			(DNAPREP.ID_CULTURE		= CLONE_CULTURE.ID_CULTURE)	AND
			(CLONE_CULTURE.ID_GLYSTOCK	= GLYSTOCK.ID_GLYSTOCK)		AND
			(GLYSTOCK.ID_GLYSTOCK		= DNAPREP_REQUEST.ID_GLYSTOCK)	AND
			(DNAREQUEST_STATUS.ID_REQUEST	= DNAPREP_REQUEST.ID_REQUEST)	AND
			(";


$sql = "	SELECT	DNAPREP.ID_PREP
		FROM	DNAPREP, DNAPREP_STATUS
		WHERE	(DNAPREP_STATUS.ID_PREP = DNAPREP.ID_PREP)	AND
			(";





			
foreach(@{$pkg->{Data}})
{
	$sql = "$sql\nDNAPREP.ID_PREP  		= $_->[2] OR";
}
$sql = substr($sql,0,length($sql)-2);
$sql = "$sql\n)FOR UPDATE NOWAIT";
return $sql;

}









sub Bandquality
{
my ($pkg, $chk) = @_;
my $win;
my $sql;
my $ref;
my $i;
# Ask For What Quality Where the Bands

$win = $pkg->{Mainwin}->Toplevel;
$win->protocol('WM_DELETE_WINDOW', sub{$pkg->Killmessage($win);});
$win->geometry("+375+340");
$win->title('DODO');
$pkg->{Bandquality} = "Not Applicable (12)";
$pkg->{Replicates} = 2;


$win->Label(					-fg 		=> 'black',
						-bg 		=> 'lightblue',
						-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
						-text 		=> "Select Band Quality",
						-anchor 	=> 'e',
						-height 	=> -1,
						-width 		=> 25,
						-relief 	=> 'flat'
					)->grid(-row 		=> 1, 
						-column	 	=> 1,
						-sticky 	=> 'we');
						
my $bw = $win->BrowseEntry(			-width 		=> 20,
						-font 		=>'-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
						-state 		=> 'readonly',
						-fg 		=> 'blue',
						-variable 	=> \$pkg->{Bandquality},
						-browsecmd	=> sub {$win->grab();}
						)->grid(-row 	=> 1, 
						-column	 	=> 2,
						-sticky 	=> 'we'
						);
						
$bw->Subwidget("slistbox")->Subwidget("listbox")->configure(	-font 	=>'-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
								-fg 	=> 'blue',
								-height	=> 5);
								
								
# What methods are available								
$sql = "SELECT DESCRIPTION FROM BANDQUALITYDICT";
$ref = $pkg->Querydb($sql);
$i = 1;
foreach (@{$ref})
	{$bw->insert('end',$_->[0]." ($i)");$i++;}
							
							


$win->Button(			-fg 			=> 'black',
				-bg 			=> 'grey85',
				-width			=> 20,
				-text 			=> "OK",
				-anchor 		=> 'center',
				-state 			=> 'normal',
				-font 			=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground 	=> 'green',
				-command 		=> sub {	 
									$pkg->{Bandquality} =~ s/\D*//g;
									$$chk = 1;
									$pkg->Killmessage($win);
								},
				-relief 		=> 'raised'
				)->grid(	-row 	=> 3, 
						-column => 1, 
						-sticky => 'w');



$win->Button(			-fg 			=> 'black',
				-bg 			=> 'grey85',
				-width			=> 20,
				-text 			=> "Cancel",
				-anchor 		=> 'center',
				-state 			=> 'normal',
				-font 			=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground 	=> 'red',
				-command 		=> sub {$$chk = 0; $pkg->Killmessage($win);},
				-relief 		=> 'raised'
				)->grid(	-row 	=> 3, 
						-column => 2, 
						-sticky => 'w');

$win->grab();


}





1;

