package Fingerprint;
use strict;

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



sub Initialiseobject
{

my $pkg = shift;

# pull out speciesname and chromosome name of all clones that have been actioned.
$pkg->{ListSQL} = "	SELECT 	CHROMOSOMEDICT.SPECIESNAME,CHROMOSOMEDICT.CHROMOSOME 
			FROM 	CLONE, CHROMOSOMEDICT, GLYSTOCK, CLONE_CULTURE, DNAPREP_STATUS, DNAPREP, DNAPREP_REQUEST
			WHERE	(CHROMOSOMEDICT.ID_DICT = CLONE.CHROMOSOME)				AND
				(CLONE.CLONENAME	= GLYSTOCK.CLONENAME)				AND
				(GLYSTOCK.ID_GLYSTOCK	= DNAPREP_REQUEST.ID_GLYSTOCK)		AND
				(DNAPREP_REQUEST.ID_REQUEST	= CLONE_CULTURE.ID_REQUEST)	AND
				(CLONE_CULTURE.ID_CULTURE	= DNAPREP.ID_CULTURE)		AND
				(DNAPREP.ID_PREP		= DNAPREP_STATUS.ID_PREP)	AND
				(DNAPREP_STATUS.ISCURRENT	= 1)				AND
				(DNAPREP_STATUS.STATUS 		= 3)
			GROUP BY CHROMOSOMEDICT.SPECIESNAME,CHROMOSOMEDICT.CHROMOSOME ";



$pkg->{ResultSQL} ="	SELECT	CLONE.CLONENAME, 
				DNAPREP_REQUEST.ID_REQUEST, 
				DNAPREP.ID_PREP,  
				DNAPREP.PREP_NUMBER, 
				DNAPREP_REQUEST.REQUEST_DATE,
				DNAPREP_REQUEST.IS_FASTTRACK, 
				DNAPREP_STATUS.STATUSDATE,
				CHROMOSOMEDICT.CHROMOSOME
			FROM	CLONE, CHROMOSOMEDICT, GLYSTOCK, CLONE_CULTURE, DNAPREP_STATUS, DNAPREP, DNAPREP_REQUEST
			
			WHERE	(CHROMOSOMEDICT.CHROMOSOME 	LIKE 'VAR1') 		AND 
				(CHROMOSOMEDICT.SPECIESNAME 	LIKE 'VAR2')		AND 
				(CLONE.CHROMOSOME 		= CHROMOSOMEDICT.ID_DICT)	AND
				(CLONE.CLONENAME 		= GLYSTOCK.CLONENAME)		AND
				(GLYSTOCK.ID_GLYSTOCK 		= DNAPREP_REQUEST.ID_GLYSTOCK)	AND
				(DNAPREP_REQUEST.ID_REQUEST	= CLONE_CULTURE.ID_REQUEST)	AND
				(CLONE_CULTURE.ID_CULTURE	= DNAPREP.ID_CULTURE)		AND
				(DNAPREP.ID_PREP		= DNAPREP_STATUS.ID_PREP)	AND
				(DNAPREP_STATUS.ISCURRENT	= 1)				AND
				(DNAPREP_STATUS.STATUS 		= 3)
			ORDER BY CHROMOSOMEDICT.CHROMOSOME, DNAPREP.CLONENAME, DNAPREP.PREP_NUMBER";


$pkg->{Button1Label}	= "FingerPrint";
$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} | Request Date";
while(length($pkg->{Columnheaders}) < 42)
	{$pkg->{Columnheaders} = "$pkg->{Columnheaders} ";}
	
$pkg->{Columnheaders} = "$pkg->{Columnheaders} | Date Returned";
while(length($pkg->{Columnheaders}) < 59)
	{$pkg->{Columnheaders} = "$pkg->{Columnheaders} ";}

$pkg->{Columnheaders} = "$pkg->{Columnheaders} | Chr";
while(length($pkg->{Columnheaders}) < 67)
	{$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'],[3,6,'Prep'],[4,15,'Request Date'],[6,15,'Date Returned'],[7,5,'Chromosome']];				
undef $pkg->{Selection};
		
$pkg->Addtobrowse();
undef @{$pkg->{Contents}};
$pkg->Refresh();
$pkg->{Title}->configure(-text => "Operator : $pkg->{Who}\tRole Type : $pkg->{Roletype}\t\tFinger print DNApreps");

}


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


$sql = "	SELECT 	DNAPREP.ID_PREP 
		FROM DNAPREP, DNAPREP_REQUEST, DNAPREP_STATUS, DNAREQUEST_STATUS, CLONE_CULTURE
		WHERE	(DNAPREP_STATUS.ISCURRENT	= 1)				AND
			(DNAPREP_STATUS.ID_PREP		= DNAPREP.ID_PREP)		AND
			(DNAPREP.ID_CULTURE		= CLONE_CULTURE.ID_CULTURE)	AND
			(CLONE_CULTURE.ID_REQUEST	= DNAPREP_REQUEST.ID_REQUEST)	AND
			(DNAREQUEST_STATUS.ISCURRENT	= 1)				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)\nFOR UPDATE NOWAIT";

return $sql;

}		



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

# To kill prep. Set prep status to 9 QC-Failed
# Check to see if any more preps are live on that request
# If not then reissue
my $radio = 'Failed Pre-Fingerprinting checks';
	# Need To ask For Failure Reason;
	$pkg->radiocheck(\$radio,'Failed Pre-QC checks','Selected By Mistake');
	$pkg->{Mainwin}->waitVariable(\$radio);
	if($radio !~ /\D/){return;}

foreach (@{$pkg->{Contents}})
{

eval{
	
	if($radio =~ /^Selected/)
	{		
	$sql = "DELETE 	FROM DNAPREP_STATUS
		WHERE	ISCURRENT	= 1	AND
			ID_PREP 	= $_->[2]";
			
	push @multisql,$sql;
		
	# ROLLING BACK TO PREVIOUS STATUS USING MAX STATUSDATE TO FIND IT ONA PREP	
	$sql = "UPDATE 	DNAPREP_STATUS 
		SET 	ISCURRENT = 1
		WHERE	STATUSDATE IN (	
			SELECT 	MAX(STATUSDATE) 
			FROM 	DNAPREP_STATUS 
			WHERE 	ID_PREP = $_->[2] and ISCURRENT = 0) AND
			ID_PREP = $_->[2]";
			
	push @multisql,$sql;
	
	# ERASE EPPENDORF RACK COMMENTS
	$sql = "UPDATE 	DNAPREP
		SET	COMMENTS 	= ''
		WHERE	ID_PREP		= $_->[2]";
			
	push @multisql,$sql;
	
	
	
	}# selected
	else
	{
	# Kill individual prep
	$sql = "UPDATE 	DNAPREP_STATUS 
		SET 	ISCURRENT = 0 
		WHERE 	ISCURRENT = 1 AND ID_PREP = $_->[2]";
	
	push @multisql,$sql;
	# Qc fail
	$sql = "INSERT INTO 	DNAPREP_STATUS	(ID_PREP, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
		VALUES				($_->[2] ,9,SYSDATE,1, $$, 'DODO','$pkg->{Who}')";
					
	push @multisql,$sql;
	
	#succesfully made
	$sql = "SELECT 	COUNT(DNAPREP.ID_PREP)
		FROM 	DNAPREP , DNAPREP_STATUS, CLONE_CULTURE
		WHERE 	(DNAPREP_STATUS.STATUS		= 7)				AND
			(DNAPREP_STATUS.ISCURRENT	= 1)				AND
			(DNAPREP_STATUS.ID_PREP		= DNAPREP.ID_PREP)		AND
			(DNAPREP.ID_CULTURE		= CLONE_CULTURE.ID_CULTURE)	AND
			(CLONE_CULTURE.ID_REQUEST	= $_->[1])";

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




	# Check to see how many preps live on request
	$sql = "SELECT 	COUNT(DNAPREP.ID_PREP)
		FROM 	DNAPREP , DNAPREP_STATUS, CLONE_CULTURE
		WHERE 	(DNAPREP_STATUS.STATUS		< 7)				AND
			(DNAPREP_STATUS.ISCURRENT	= 1)				AND
			(DNAPREP_STATUS.ID_PREP		= DNAPREP.ID_PREP)		AND
			(DNAPREP.ID_CULTURE		= CLONE_CULTURE.ID_CULTURE)	AND
			(CLONE_CULTURE.ID_REQUEST	= $_->[1])";

	$ref = $pkg->Querydb($sql);
	
	
	# No other preps live, this is the last. request status will change
	if($ref->[0][0] == 1)
	{
	$sql = "UPDATE 	DNAREQUEST_STATUS 
		SET 	ISCURRENT = 0 
		WHERE 	ISCURRENT = 1 AND ID_REQUEST = $_->[1]";
	
	push @multisql,$sql;
	
	if($completed == 0)
	{
		# RE REQUEST !!!!!! not RE ISSUE as we are further down the pipeline
		# Leave it Up to the Operator to either cancel the request and resend
		$sql = "INSERT INTO 	DNAREQUEST_STATUS	(ID_REQUEST, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
			VALUES					($_->[1] , 6,SYSDATE,1, $$, 'DODO','$pkg->{Who}')";
	}
	else
	{
		# complete, all preps through
		$sql = "INSERT INTO 	DNAREQUEST_STATUS	(ID_REQUEST, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
			VALUES					($_->[1] , 4,SYSDATE,1, $$, 'DODO','$pkg->{Who}')";
	}
	push @multisql,$sql;
	}#end no live preps
	}# else failed prep


$pkg->MultiWritedb(@multisql);
undef @multisql;
};
if($@ =~ /ORA-00054:/)
{	my $chk;
	$pkg->Message("LOCK OUT\n\nData Currently Being Accessed By another user\n\nContact Bug If Problem persists",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	$pkg->{Query1} = "Another User Is Accessing $pkg->{Query1} Try Again Later";
	undef @{$pkg->{Data}};
	return;}
if($@)
{
	print STDERR "$@ \n"; return;
}




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







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

my $list = [];
my $clonelist = [];
eval{
my $i = 1;
#################################
# UPDATE PRJECT STATUS
$pkg->Projectstatus(7);
#################################




foreach (@{$pkg->{Contents}})
{

$sql = "UPDATE 	DNAPREP_STATUS
	SET 	ISCURRENT = 0
	WHERE 	ISCURRENT = 1	AND
		ID_PREP = $_->[2]";
		
push @multisql,$sql;

# Prep Fingerprinted
$sql = "INSERT INTO DNAPREP_STATUS 	(ID_PREP, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
	VALUES				($_->[2],4,SYSDATE,1, $$, 'DODO','$pkg->{Who}')";
push @multisql,$sql;


my $letter = chr(64 + $_->[3]);
$line = "$line \"$_->[0]-$letter\"";

while(length($_->[0]) < 11)
{$_->[0] = "$_->[0] ";}

$_->[0] = "$_->[0]-$_->[3]";

while(length($_->[0]) < 22)
{$_->[0] = "$_->[0] ";}

$_->[0] = "$_->[0] CHR $_->[7]";
push @{$list}, [$_->[0], $i, $_->[5], "Finger Printing Worksheet"];

 
if(($i)%12 == 0)
{
	$line = "$line \n"; 
	push @{$clonelist},$line; 
	$line ='';
}

my $q = scalar @{$list};
if($q > 96)
{
$line = "$line\n\n";
$pkg->Setprinter("Print FINGERPRINT\nworksheet on printer\n",\$chk);
$pkg->{Mainwin}->waitVariable(\$chk);
if($chk != 1){return;}
undef $chk;
$pkg->Printplate("Eppendorf Rack - Plate","FINGER PRINTING WORKSHEET", $pkg->{Who},@{$list});
undef $list;
}

$i++;
}

if($list)
{
$pkg->Setprinter("Print FINGERPRINT\nworksheet on printer\n",\$chk);
$pkg->{Mainwin}->waitVariable(\$chk);
if($chk != 1){return;}
undef $chk;

$pkg->Printplate("Eppendorf Rack - Plate","FINGER PRINTING WORKSHEET", $pkg->{Who},@{$list});
}


$line = "$line \n"; 
push @{$clonelist},$line; 
# disabled export list, use only if asked for
$pkg->Textbox($clonelist);
$pkg->MultiWritedb(@multisql);
};
if($@ =~ /ORA-00054:/)
{	my $chk;
	$pkg->Message("LOCK OUT\n\nData Currently Being Accessed By another user\n\nContact Bug If Problem persists",\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	$pkg->{Query1} = "Another User Is Accessing $pkg->{Query1} Try Again Later";
	undef @{$pkg->{Data}};
	return;
}
if($@)
{
	print STDERR "$@ \n"; return;
}




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





}
1;

