package Database;


sub new {
my ($pkg, $check)  = @_ ;
my $setup = {};
my $prepare;

if($check ==1){$setup->{Debug} = $check;}

$setup->{Handle}	= '';
$setup->{User}		= 'dodo';

if($setup->{Debug}){	$ENV{TWO_TASK} 		= 'old_sids';}
else{			$ENV{TWO_TASK} 		= 'cas1';}

print "\nStandby.....\ndodo_digests connecting to oracle.....\n";

$setup->{"dbh"} = WrapDBI->connect($setup->{"User"}, {RaiseError => 1});
$setup->{"gull"} = WrapDBI->connect('gull', {RaiseError => 1});

$prepare = $setup->{"dbh"}->prepare("SELECT SEQ_SESSION.NEXTVAL FROM DUAL");
$prepare->execute();
my $session = $prepare->fetch();
$prepare->finish();

$setup->{Session} 	= $session->[0];
$setup->{Who}		= `whoami`;
chomp $setup->{Who};

print "Connection complete.\n";


if(!$check)
{
print "Checking User Authorisation\n";
# Restrict user access to program to subcloners and fingerprinters
$prepare = $setup->{"dbh"}->prepare("	SELECT 	TPR.ID_ROLE 
					FROM 	TEAM_PERSON_ROLE TPR, PERSON P 
					WHERE 	TPR.ROLETYPE IN ('F-Printer','Subcloning')
					AND	TPR.ID_PERSON	= P.ID_PERSON
					AND	P.EMAIL		= '$setup->{Who}'
					AND	ROWNUM 		= 1");
$prepare->execute();
my $role = $prepare->fetch();
$prepare->finish();


print "Authorisation check complete \n";


if(!$role->[0])
{
print "\n\n=================================================================\n";
print "You do not have the correct user priviledges to use this program\n";
print "Contact Bug to have your Status changed\n";
print "\n\n=================================================================\n";
$setup->{"dbh"}->disconnect;
$setup->{"gull"}->disconnect;
exit;
}

$setup->{Role} 	= $role->[0];
}
else
{
	$setup->{Role} 	= 10601
}

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


sub Connect {

my $pkg = shift;
if(undef $pkg->{"dbh"})
{
	$pkg->{"dbh"} = WrapDBI->connect($pkg->{"User"}, {RaiseError => 1});
}

}


sub Disconnect {
my $pkg = shift;

if($pkg->{"dbh"})
{
	$pkg->Finishqueries();
	$pkg->{"dbh"}->disconnect();
	$pkg->{"gull"}->disconnect();
	undef $pkg->{"dbh"};
}


}

sub Finishqueries {
my $pkg = shift;


$pkg->{Queries}->[99]->finish();
$pkg->{Queries}->[100]->finish();
$pkg->{Queries}->[200]->finish();
$pkg->{Queries}->[300]->finish();





}


sub Preparequeries {
my $pkg = shift;
my $prepare;
my $sql;
print "Preparing Queries\n";

eval {

	
	
						
$pkg->{Queries}->[99] = $pkg->{"dbh"}->prepare("SELECT	PD.DESCRIPTION, PS.STATUSDATE, PS.OPERATOR, CP.PRIORITY
						FROM	PROJECTSTATUSDICT PD, PROJECT_STATUS PS, CLONE_PRIORITY CP
						WHERE	CP.IS_CURRENT		= 1
						AND	CP.CLONENAME		= PS.PROJECTNAME 
						AND	PD.ID_DICT		= PS.STATUS
						AND	PS.ISCURRENT		= 1
						AND	PS.PROJECTNAME 		= ?");
						
$pkg->{Queries}->[100] = $pkg->{"dbh"}->prepare("SELECT	P.EMAIL, RD.REQUEST_DATE, DT.DESCRIPTION, D.COMMENTS
						FROM	RDREQUEST_ENZYME RZ, RDREQUEST RD, RDREQUEST_STATUS RS, 
							RDREQUESTSTATUSDICT DT, PERSON P, DNAPREP D
						WHERE	P.ID_PERSON	= RD.REQUESTED_BY
						AND	DT.ID_DICT	=  RS.STATUS
						AND	RZ.ENZYMENAME	= 'HindIII'
						AND	RZ.ID_RDREQUEST	= RD.ID_RDREQUEST
						AND	NOT RS.STATUS	= 3
						AND	RS.ISCURRENT	= 1
						AND	RS.ID_RDREQUEST	= RD.ID_RDREQUEST
						AND	D.ID_PREP	= RD.ID_DNAPREP
						AND	RD.ID_RDREQUEST	= ?");
											
$pkg->{Queries}->[200] = $pkg->{"dbh"}->prepare("SELECT	GLI.ANALYSIS_DATE,  P.EMAIL, GLI.INSERT_SIZE_BP, RG.GELNAME, GLI.UNIX_PATH, D.COMMENTS
						FROM	RDGEL_LANE GL, RDGEL_LANE_IMAGE GLI, 
							RDGEL RG, RDGEL_STATUS RGS, PERSON P, DNAPREP D, RDREQUEST RD
						WHERE	P.ID_PERSON	= GLI.OPERATOR
						AND	RGS.ISCURRENT	= 1
						AND	RGS.ID_RDGEL	= GL.ID_RDGEL
						AND	RG.ID_RDGEL	= GL.ID_RDGEL
						AND	GLI.ISGOOD	= 1
						AND	GLI.LANE	= GL.LANE
						AND	GLI.ID_RDGEL	= GL.ID_RDGEL
						AND	GL.ID_RDREQUEST = RD.ID_RDREQUEST
						AND	D.ID_PREP	= RD.ID_DNAPREP
						AND	RD.ID_RDREQUEST = ?
						ORDER BY GLI.ANALYSIS_DATE");
						
$pkg->{Queries}->[300] = $pkg->{"dbh"}->prepare("SELECT	P.EMAIL, RD.REQUEST_DATE, DT.DESCRIPTION, D.COMMENTS, TO_CHAR(DS.STATUSDATE,'DD-MON-YYYY HH:MI AM'), DS.OPERATOR
						FROM	RDREQUEST_ENZYME RZ, RDREQUEST RD, RDREQUEST_STATUS RS, 
							RDREQUESTSTATUSDICT DT, PERSON P, DNAPREP D, DNAPREP_STATUS DS
						WHERE	P.ID_PERSON	= RD.REQUESTED_BY
						AND	DT.ID_DICT	=  RS.STATUS
						AND	RZ.ENZYMENAME	= 'HindIII'
						AND	RZ.ID_RDREQUEST	= RD.ID_RDREQUEST
						AND	RS.ID_RDREQUEST	= RD.ID_RDREQUEST
						AND	DS.STATUS	= 32
						AND	DS.ID_PREP	= D.ID_PREP
						AND	D.ID_PREP	= RD.ID_DNAPREP
						AND	RD.ID_RDREQUEST	= ?");
																
};if($@){die "Prepare Failed\n$@\n";}		

print "Executing Interface \n";

}





sub Retrieve {
my ($pkg, $option, $A, $B, $C) = @_;
my $ref = [];

if(($option > -1)&&($option < 3)&&($A))
{
	$pkg->{Queries}->[$option]->execute($A);
	my $ref = $pkg->{Queries}->[$option]->fetchall_arrayref();
	return $ref;
}


if($option == 100)
{
# $A = clonename
# $B = ID_DNAPREP

	$pkg->{Queries}->[99]->execute($A);
	my $project = $pkg->{Queries}->[99]->fetchall_arrayref();
	$ref->[0] = "\nCLONE \t\t: $A\n\nProject Status\t: $project->[0][0] By $project->[0][2] on the $project->[0][1]\n\n";
	
	
	
	$pkg->{Queries}->[100]->execute($B);
	my $digest  = $pkg->{Queries}->[100]->fetchall_arrayref();
	
	$ref->[1] = "RESTRICTION DIGEST REQUEST INFORMATION.\n--------------------------------------\n";
	$ref->[1] = "$ref->[1]Requested By $digest->[0][0] on the $digest->[0][1]\n\n";
	$ref->[1] = "$ref->[1]Request Status ".uc($digest->[0][2])."\n";
	$ref->[1] = "$ref->[1]Location \t: $digest->[0][3]\n";
	return $ref;

}



if($option == 200)
{
# $A = clonename
# $B = ID_DNAPREP
	$pkg->{Queries}->[99]->execute($A);
	my $project = $pkg->{Queries}->[99]->fetchall_arrayref();
	$ref->[0] = "\nCLONE \t\t: $A\n\nProject Status\t: $project->[0][0] By $project->[0][2] on the $project->[0][1]\n\n";
	
	
	$pkg->{Queries}->[200]->execute($B);
	my $digest  = $pkg->{Queries}->[200]->fetchall_arrayref();
	
	$ref->[1] = "RESTRICTION DIGEST INFORMATION.\n--------------------------------------\n";
	$ref->[1] = "$ref->[1]Gelname  \t: $digest->[0][3]\nOperator\t: $digest->[0][1]\n";
	$ref->[1] = "$ref->[1]Size (BP)\t: $digest->[0][2]\nAnalysis Date\t: $digest->[0][0]\n";
	$ref->[1] = "$ref->[1]Unix Path\t: $digest->[0][4]\n";
	$ref->[1] = "$ref->[1]Location \t: $digest->[0][5]\n";
	
	return $ref;

}

if($option == 300)
{
# $A = clonename
# $B = ID_DNAPREP

	$pkg->{Queries}->[99]->execute($A);
	my $project = $pkg->{Queries}->[99]->fetchall_arrayref();
	$ref->[0] = "\nCLONE \t\t: $A\n\nProject Status\t: $project->[0][0] By $project->[0][2] on the $project->[0][1]\n\n";
	
	
	
	$pkg->{Queries}->[300]->execute($B);
	my $digest  = $pkg->{Queries}->[300]->fetchall_arrayref();
	
	$ref->[1] = "RESTRICTION DIGEST REQUEST INFORMATION 300.\n--------------------------------------\n";
	$ref->[1] = "$ref->[1]Requested By $digest->[0][0] on the $digest->[0][1]\n\n";
	$ref->[1] = "$ref->[1]Request Status\t: ".uc($digest->[0][2])."\n";
	$ref->[1] = "$ref->[1]Location \t: $digest->[0][3]\n";
	$ref->[1] = "$ref->[1]Tagged By  \t: $digest->[0][5]\n";
	$ref->[1] = "$ref->[1]Tag Date  \t: $digest->[0][4]\n";
	return $ref;

}




return $ref;
}


sub Prep_status {
my ($pkg, $status, $iscurrent, $action) = @_
# $action  = 1 set new status as current


}
sub BindLookup {
my ($pkg, $sql, $Value) = @_;
my $ref;
my $prepare;

$prepare = $pkg->{"dbh"}->prepare($sql);

$prepare->execute($Value);
$ref = $prepare->fetchall_arrayref();
$prepare->finish();

return $ref;
}


sub Lookup {
my ($pkg, $sql) = @_;
my $ref;
my $prepare;

$prepare = $pkg->{"dbh"}->prepare($sql);

$prepare->execute();
$ref = $prepare->fetchall_arrayref();
$prepare->finish();

return $ref;
}

sub Projectstatus {
my ($pkg, $projectname, $status, $iscurrent, $remark) = @_;
my $sql;
my $prepare;





if($iscurrent == 1)
{
	$iscurrent = 1;
	$sql = "UPDATE PROJECT_STATUS SET ISCURRENT = 0 WHERE ISCURRENT = 1 AND PROJECTNAME = ?";
	$prepare = $pkg->{"gull"}->prepare($sql);
	$prepare->execute($projectname);
}



if($status == 2)
{


$sql = "	UPDATE 	GLYSTOCK
		SET	IS_AVAILABLE 	= 0
		WHERE	IS_AVAILABLE 	= 1
		AND	CLONENAME	= ?";
		
$prepare = $pkg->{"dbh"}->prepare($sql);
$prepare->execute($projectname);
$pkg->{"dbh"}->commit;


# Used to set selected status back to wen it was last set to avoid screwing over HUMWEEK reports.
# For clarity, a new selected statement will be created. 27/3/00 bsw
$sql = "	UPDATE PROJECT_STATUS
		SET ISCURRENT = 1
		WHERE
		(PROJECTNAME, STATUSDATE, STATUS) =
		(SELECT B.PROJECTNAME, MAX(B.STATUSDATE), B.STATUS
		FROM	PROJECT_STATUS B
		WHERE	B.STATUS 	= 2
		AND	B.PROJECTNAME	= ?
		group by B.PROJECTNAME, B.STATUS)";
}



$sql = "INSERT INTO PROJECT_STATUS (PROJECTNAME, STATUS, ISCURRENT, OPERATOR, PROGRAM, REMARK, SESSIONID)
	VALUES (?, ?, ?, ?,'DODO_DIGESTS',?, ?)";



$prepare = $pkg->{"gull"}->prepare($sql);
$prepare->execute($projectname, $status,$iscurrent,$pkg->{Who},$remark,$pkg->{Session});
$pkg->{"gull"}->commit;

#$gull->rollback();
#$gull->commit;
#$gull->disconnect();

}


sub Restrictiondigest {
my ($pkg, $rdrequest, $status) = @_;
my $sql;
my $laneinfo;
my $prepare;


# Kill Off Restriction Digest
if($status == 0)
{
# Marking this gell image as bad
$sql	= "	UPDATE RDGEL_LANE_IMAGE RI
		SET	ISGOOD = 0
		WHERE	
		EXISTS (SELECT 'X'
		FROM	RDGEL_LANE RL
		WHERE	RI.ISGOOD	= 1
		AND	RI.ID_RDGEL	= RL.ID_RDGEL
		AND	RI.LANE		= RL.LANE
		AND	RL.ID_RDREQUEST	= ?)";
		
		
$prepare = $pkg->{"dbh"}->prepare($sql);
$prepare->execute($rdrequest);



}
else
{
# Just change the restriction digestions request status

$sql	= "	UPDATE	RDREQUEST_STATUS
		SET	ISCURRENT = 0
		WHERE	ISCURRENT = 1
		AND	ID_RDREQUEST	= ?";

$prepare = $pkg->{"dbh"}->prepare($sql);
$prepare->execute($rdrequest);

$sql	= "	INSERT INTO RDREQUEST_STATUS 	(ID_RDREQUEST, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
		VALUES				(?, ?, SYSDATE,1,?,'DODO_DIGESTS',?)";

$prepare = $pkg->{"dbh"}->prepare($sql);
$prepare->execute($rdrequest, $status,$pkg->{Session},$pkg->{Who});

}
$pkg->{"dbh"}->commit;

}



sub Dnapreparation {
my ($pkg, $prepid, $status, $iscurrent, $comment) = @_;
my $prepare;

if($iscurrent == 1)
{
	$sql = "	UPDATE 	DNAPREP_STATUS
			SET	ISCURRENT	= 0
			WHERE	ISCURRENT	= 1
			AND	ID_PREP		= ?";
			
	$prepare = $pkg->{"dbh"}->prepare($sql);
	$prepare->execute($prepid);	

}

$sql	= "	INSERT INTO 	DNAPREP_STATUS 	(ID_PREP, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
		VALUES				(?, ?, SYSDATE,?,?,'DODO_DIGESTS', ?)";

$prepare = $pkg->{"dbh"}->prepare($sql);
$prepare->execute($prepid, $status,$iscurrent,$pkg->{Session},$pkg->{Who});

$pkg->{"dbh"}->commit;

# deal with comment


}

sub Preparationrequest {
my ($pkg, $clone) = @_;



$sql = "	INSERT INTO DNAPREP_REQUEST (ID_REQUEST, ID_GLYSTOCK, REQUESTED_BY, REQUEST_DATE, IS_FASTTRACK)
		(SELECT SEQ_DPREQUEST.NEXTVAL, G.ID_GLYSTOCK, ?, SYSDATE, CP.PRIORITY
		FROM 	GLYSTOCK G, CLONE_PRIORITY CP
		WHERE	CP.IS_CURRENT	= 1
		AND	CP.CLONENAME	= G.CLONENAME
		AND	G.IS_AVAILABLE 	= 1
		AND	G.CLONENAME 	= ?
		AND	ROWNUM		= 1)";


print "I Think Role = $pkg->{Role} <<>> $clone\n";

$prepare = $pkg->{"dbh"}->prepare($sql);
$prepare->execute($pkg->{Role},$clone);

$sql = "	INSERT INTO DNAREQUEST_STATUS (ID_REQUEST,STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
		VALUES(SEQ_DPREQUEST.CURRVAL, 6, SYSDATE, 1, ?,'DODO_DIGESTS', ?)";
		
$prepare = $pkg->{"dbh"}->prepare($sql);
$prepare->execute( $pkg->{Session}, $pkg->{Who});

$pkg->{"dbh"}->commit;
}

sub Tagpreparation {
my ($pkg, $prepid) = @_ ;
my $prepare;
my  $tagged;


$sql 	= " 	SELECT 	'X' 
		FROM 	DUAL
		WHERE 	EXISTS (SELECT 'X'
		FROM 	DNAPREP_STATUS S
		WHERE	S.STATUS = 32
		AND 	S.ID_PREP = $prepid)";
		
$prepare = $pkg->{"dbh"}->prepare($sql);
$prepare->execute();

$tagged = $prepare->fetchrow_arrayref();

if($tagged->[0])
{
	$sql = "DELETE FROM DNAPREP_STATUS WHERE ID_PREP = $prepid AND STATUS = 32";

	$prepare = $pkg->{"dbh"}->prepare($sql);
	$prepare->execute();
	$pkg->{"dbh"}->commit();
	return 'Un Tagged';

}
else
{
	$pkg->Dnapreparation($prepid,32,0);
	return 'Tagged';
}

}

sub DigestRequest {
my ($pkg, $prepid, $enzyme) = @_;
my $sql;
my $prepare;
my $ref;

$sql = "SELECT 	RD.ID_RDREQUEST
	FROM	RDREQUEST RD, RDREQUEST_ENZYME RZ, RDREQUEST_STATUS RS
	WHERE	RZ.ENZYMENAME		= ?
	AND	RZ.ID_RDREQUEST	= RS.ID_RDREQUEST
	AND	RS.STATUS		IN (1,2,4,5)
	AND	RS.ISCURRENT		= 1
	AND	RS.ID_RDREQUEST		= RD.ID_RDREQUEST
	AND	RD.ID_DNAPREP 		= ?
	AND 	ROWNUM = 1";	


$prepare = $pkg->{"dbh"}->prepare($sql);
$prepare->execute($enzyme,$prepid);

$ref = $prepare->fetchrow_arrayref();
$prepare->finish();


return $ref->[0];

}



sub Whoami {
my $pkg = shift;

if(@_)
{
	$pkg->{Who} = shift;

}
else
{
	return $pkg->{Who};
}


}

sub Eppendorfrack {
my ($pkg, $description) = @_;
my $sql;
my $data;
my $prepare;
my $hit;

# Get bulk of plate
$sql = "SELECT	D.CLONENAME, D.PREP_NUMBER, D.COMMENTS, D.ID_PREP, 'Awaiting H3', CD.CHROMOSOME, TO_CHAR(DA.STATUSDATE,'DD-MON-YYYY')
FROM 	DNAPREP D, DNAPREP_STATUS DS, CLONE C, CHROMOSOMEDICT CD, DNAPREP_STATUS DA
WHERE	NOT EXISTS (	
  SELECT 	'X' 
  FROM 	PROJECT_STATUS S, CLONE_PROJECT CP
  WHERE	S.ISCURRENT	= 1
  AND	S.STATUS	= 24
  AND	S.PROJECTNAME	= CP.PROJECTNAME
  AND	CP.CLONENAME	= C.CLONENAME)
AND	DA.STATUS	= 1
AND	DA.ID_PREP	= D.ID_PREP
AND	CD.ID_DICT	= C.CHROMOSOME
AND	C.CLONENAME	= D.CLONENAME
AND	DS.STATUS	IN (7, 15, 20)
AND	DS.ISCURRENT	= 1
AND	DS.ID_PREP	= D.ID_PREP
AND	D.COMMENTS	LIKE ?";

$prepare = $pkg->{"dbh"}->prepare($sql);
$prepare->execute("PLATE $description%");

$data = $prepare->fetchall_arrayref();
$prepare->finish();
if(!$data->[0][0]){return $data;}



$sql = "SELECT 'A' FROM DUAL
	WHERE EXISTS (
	SELECT 	'B' 
	FROM 	RDREQUEST_STATUS RS, RDREQUEST_ENZYME RZ, RDREQUEST RD
	WHERE	RS.STATUS	= 3
	AND	RS.ISCURRENT	= 1
	AND	RS.ID_RDREQUEST	= RZ.ID_RDREQUEST
	AND	RZ.ENZYMENAME	= 'HindIII'
	AND	RZ.ID_RDREQUEST	= RD.ID_RDREQUEST
	AND	RD.ID_DNAPREP 	= ?)";



$prepare = $pkg->{"dbh"}->prepare($sql);


foreach(@{$data})
{
	$prepare->execute($_->[3]);
	$hit = $prepare->fetchrow_arrayref();
	if($hit->[0])
	{$_->[4] = 'H3 Done';}
}
$prepare->finish();

$sql = "SELECT 'A' FROM DUAL
	WHERE EXISTS (
	SELECT 	'B' 
	FROM DNAPREP_STATUS DS
	WHERE	DS.STATUS 	IN(4, 33)
	AND	DS.ID_PREP 	= ?)";




$prepare = $pkg->{"dbh"}->prepare($sql);

foreach(@{$data})
{
	$prepare->execute($_->[3]);
	$hit = $prepare->fetchrow_arrayref();
	if($hit->[0])
	{$_->[4] = 'H3 Checked';}
}

$prepare->finish();


$sql = "SELECT 'A' FROM DUAL
	WHERE EXISTS (
	SELECT 	'B' 
	FROM RDREQUEST RD, RDREQUEST_STATUS RS
	WHERE	RS.STATUS	IN (1,2,4,5)
	AND	RS.ISCURRENT	= 1
	AND	RS.ID_RDREQUEST	= RD.ID_RDREQUEST
	AND	RD.ID_DNAPREP	= ?)";



$prepare = $pkg->{"dbh"}->prepare($sql);


foreach(@{$data})
{
	if($_->[4] ne 'Awaiting H3')
	{
	$prepare->execute($_->[3]);
	$hit = $prepare->fetchrow_arrayref();
	if(!$hit->[0])
	{$_->[4] = 'ALL DONE';}
	}
}

$prepare->finish();



return $data;

}
sub Lock {
my $pkg = shift;
if(@_)
{
	undef $pkg->{Lock};
}
else
{
	return $pkg->{Lock};
}

}

sub GetLock {
my ($pkg,$data) = @_;
my $prepare;
my $sql;

warn "Firing Get lock \n";

$pkg->{"dbh"}->commit();
my $l = $pkg->Lock();

warn "Lock currently set to $l <<\n";
$pkg->Lock(1);





$sql = "SELECT D.ID_PREP FROM DNAPREP D WHERE D.ID_PREP = ? FOR UPDATE NOWAIT";

$prepare = $pkg->{"dbh"}->prepare($sql);

eval {
foreach(@{$data})
{
	warn " >> $_->[1] << \n";
	$prepare->execute($_->[1]);	
}
};if($@ =~ /ORA-00054:/)
{	
	$pkg->{Lock} = 1;
	return 999;
}	
if($@){die "Error Getting Data Lock";}


}

sub GetClones {
my ($pkg,$Option, $SpeciesChromosome) = @_;

my ($Species, $chr) = split (/ /, $SpeciesChromosome);


if($chr =~ /UNK/){$chr = '';}

$pkg->{Prepared}->{PREPS}->execute($chr, $Species);
#$pkg->{Prepared}->{PREPS}->execute();

return $pkg->{Prepared}->{PREPS}->fetchall_arrayref();;

}



1;
