#######################################################################
# 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.                #
# PRIMARILY THESE ARE MESSAGING FUNCTIONS SUCH AS EMAIL ETC           #
#                                                                     #
#######################################################################
package Utilities;
use strict;
use Tk;
use Mail;
use vars qw(@ISA %SIG);

sub Statusdis
{
my ($pkg, $mess, $ref) = @_;
my $l = 0;
my $x;
my $y;
my @lines;

$mess = "Standby. Contacting Database";
@lines = split /\n/, $mess;
foreach(@lines)
{
if(length($_) > $l){$l = length($_);}
}



my $win = $pkg->{Mainwin}->Toplevel;
$win->title("Message");
$l = $l/2;
$x = 550 - ($l*6);

$win->geometry("+$x+400");
$win->protocol('WM_DELETE_WINDOW', sub{$pkg->Killmessage($win);});
$win->Label(	-font 			=> '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
		-text			=> $mess
	)->pack(-side 			=> 'top', 
		-padx 			=> 20, 
		-pady 			=> 15);


$win->grab();

$$ref = $win;
#$pkg->Killmessage($win);

}

sub Message
{
my ($pkg, $mess, $ref, $cmd) = @_;
my $l = 0;
my $x;
my $y;
my @lines;
my $e;


$mess = substr($mess,0,200);
@lines = split /\n/, $mess;
foreach(@lines)
{
if(length($_) > $l){$l = length($_);}
}



my $win = $pkg->{Mainwin}->Toplevel;
$win->title("Message");
$l = $l/2;
$x = 550 - ($l*6);

$win->geometry("+$x+400");
$win->protocol('WM_DELETE_WINDOW', sub{$pkg->Killmessage($win);});
$win->Label(	-font 			=> '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
		-text			=> $mess
	)->pack(-side 			=> 'top', 
		-padx 			=> 20, 
		-pady 			=> 15);


if (defined $cmd)
{

$win->Button(	-fg 			=> 'black', 
		-bg 			=> 'grey85',
		-activeforeground 	=> 'tomato2',
		-activebackground 	=> 'lemonchiffon1',
		-width			=> 5,
		-text 			=> "Yes", 
		-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
		-command 		=> sub{	$$ref = 1; 
						$pkg->Killmessage($win);  
						}
	)->pack(-side 			=> 'left',
		-pady			=> 10,
		-padx			=> 60);
		
$e = $win->Button(	-fg 			=> 'black', 
		-bg 			=> 'grey85',
		-activeforeground 	=> 'darkgreen',
		-activebackground 	=> 'lemonchiffon1',
		-width			=> 5,
		-text 			=> "No", 
		-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
		-command 		=> sub{	$$ref = 0; 
						$pkg->Killmessage($win);
						}
	)->pack(-side 			=> 'right',
		-pady			=> 10,
		-padx			=> 60);
}
else
{
$e = $win->Button(	-fg 			=> 'black', 
		-bg 			=> 'grey85',
		-activeforeground 	=> 'darkgreen',
		-activebackground 	=> 'lemonchiffon1',
		-text 			=> "OK", 
		-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
		-command 		=> sub{	$$ref = 0;
						$pkg->Killmessage($win);
						}
	)->pack(-side 			=> 'bottom',
		-padx			=> 5,
		-pady			=> 10);
}

$e->focus();
$win->grab();

}


sub Topwindow
{
my $pkg = shift;

if(@_)
	{$pkg->{Mainwin} = shift;}
else
	{return $pkg->{Mainwin};}


}

sub Killmessage
{
my ($pkg,$win) = @_;
$win->grabRelease();
$win->destroy()
}

sub Textbox

{
my ($pkg, $list) = @_;
my $x;
my $y;
my @lines;

if(Tk::Exists($pkg->{Textbox})){$pkg->{Textbox}->destroy();};
$pkg->{Textbox} = $pkg->{Mainwin}->Toplevel;
$pkg->{Textbox}->title("Export List");
$pkg->{Textbox}->geometry("+20+185");
$pkg->{Textbox}->protocol('WM_DELETE_WINDOW', sub{$pkg->{Textbox}->destroy();});

my $l = $pkg->{Textbox}->Text(			-width 			=> 150,
					#	-font			=> '-schumacher-clean-bold-r-normal--14-140-75-75-c-80-iso8859-1',
						-height			=> 10,	
		)->grid(			-row			=> 3, 
						-column			=> 1);


my $s = $pkg->{Textbox}->Scrollbar(		-width 			=> 12,
						-command 		=> ['yview',$l]
		)->grid(			-row			=> 3, 
						-column			=> 2,
						-sticky			=> 'ns');
						
$l->configure(	 -yscrollcommand 	=> ['set', $s]);

$pkg->{Textbox}->Button(			-fg 			=> 'black', 
						-bg 			=> 'grey85',
						-activeforeground 	=> 'darkgreen',
						-activebackground 	=> 'lemonchiffon1',
						-text 			=> "Close", 
						-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
						-command 		=> sub{$pkg->{Textbox}->destroy();}
		)->grid(			-row			=> 4, 
						-column			=> 1,
						-columnspan		=> 2,
						-pady			=> 2,
						-sticky			=> 'ns');

foreach(@{$list}){$l->insert('end',$_);}


}
sub Leaveprogram
{
my $pkg = shift;

$pkg->{Mainwin}->destroy();
print "Good Bye .......\n";
exit;
}

sub TIEHANDLE
{
my ($pkg, $win) = @_;
my $obj = {Mainwin => $win};
bless $obj,$pkg;
return $obj;

}
sub PRINT
{
my ($pkg,$mess) = @_;
my $t = scalar (localtime(time));
$mess = "Application : DODO\nProgram     : $0 \nProcess ID  : $$\nERROR Occured At $t\n\n$mess";
$pkg->email($mess, "An Error Has Occured In The Application");

}

sub email
{
my ($pkg,$mess,$title) = @_;
my $email = 'bug';
my $win = my $main = new MainWindow;
$win->title("DODO Mail Editor");
$win->minsize(800,500);
$win->maxsize(800,500);
$win->geometry("+172+246");
$win->protocol('WM_DELETE_WINDOW', sub{$pkg->Killmessage($win);});


$pkg->{Who} = `whoami`;
chomp $pkg->{Who};



my $f = $win->Frame(			-width 		=> 600,
					-height 	=> 300,
					-relief 	=> "ridge",
					-bg 		=> "gray85",
					-borderwidth 	=> 5
				)->grid(-row 		=> 1,
					-ipadx		=> 10,
					-ipady		=> 10,
					-column 	=> 1,
					-sticky 	=> 'we');
					
$f->Label(	-font 			=> '-adobe-helvetica-medium-r-normal--20-140-100-100-p-100-iso8859-1',
		-text			=> $title,
		-fg			=> 'blue1',
		-anchor			=> 'center'
	)->grid(-row 			=> 1,
		-column 		=> 1,
		-columnspan		=> 2,
		-sticky			=> 'we',
		-padx 			=> 20, 
		-pady 			=> 2);


my $t = $f->Text(#-font	 		=> '-schumacher-clean-bold-r-normal--14-140-75-75-c-80-iso8859-1',
		-width			=> 80,
		-height			=> 15,
		-wrap			=> 'word',
		-relief			=> 'ridge'
	)->grid(-row 			=> 3,
		-column 		=> 1,
		-columnspan		=> 2,
		-sticky			=> 'we', 
		-padx 			=> 10, 
		-pady 			=> 2);
		
$t->insert('end', $mess);

$f->Label(	-text			=> "Send To",
		-fg			=> 'black',
		-bg			=> 'grey85',
		-width			=> 10,
		-anchor			=> 'w',
		-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
	)->grid(-row 			=> 2,
		-column 		=> 1,
		-columnspan		=> 1,
		-sticky			=> 'e',);
	
$f->Entry(	-textvariable		=> \$email,
		-fg			=> 'black',
		-bg			=> 'lemonchiffon1',
		-width			=> 10,
		-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
	)->grid(-row 			=> 2,
		-column 		=> 2,
		-columnspan		=> 1,
		-sticky			=> 'w',);
			
$f->Button(	-fg 			=> 'lemonchiffon1', 
		-bg 			=> 'red',
		-activeforeground 	=> 'red',
		-activebackground 	=> 'lemonchiffon1',
		-width			=> 10,
		-text 			=> "EXIT", 
		-font 			=> '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
		-command 		=> sub{	$pkg->Killmessage($win);}
	)->grid(-row 			=> 4,
		-column 		=> 2,
		-columnspan		=> 1,
		-sticky			=> 'w',
		-padx			=> 120,
		-pady			=> 5);
		
$f->Button(	-fg 			=> 'lemonchiffon1', 
		-bg 			=> 'darkgreen',
		-activeforeground 	=> 'darkgreen',
		-activebackground 	=> 'lemonchiffon1',
		-width			=> 10,
		-text 			=> "Send", 
		-font 			=> '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
		-command 		=> sub{
						open (MAIL,"|/usr/bin/mail $email");
						print MAIL "To: $email\n";
						print MAIL "Subject: DODO E MAIL\n\n";
						$mess = $t->get('0.0', 'end');
						print MAIL $mess;
						close(MAIL);
						
						
						$pkg->Killmessage($win);
						},
	)->grid(-row 			=> 4,
		-column 		=> 1,
		-columnspan		=> 1,
		-sticky			=> 'e',
		-padx			=> 120,
		-pady			=> 5);
MainLoop;

}


sub Logon
{
# Assume Not Using Role method So determine Role and ID Role
my $pkg = shift;
my $sql;
my $ref;

if (@_)
	{$pkg->{Who} = shift;}
else
{
	$pkg->{Who} = `whoami`;
	chomp $pkg->{Who};
}

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


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

if(!$pkg->{Role})
{
if(!$pkg->{Roletype})
{
$sql = "SELECT		ID_ROLE, TEAM_PERSON_ROLE.ROLETYPE
	FROM		TEAM_PERSON_ROLE, PERSON
	WHERE		(TEAM_PERSON_ROLE.ID_PERSON = PERSON.ID_PERSON)		AND
			(TEAM_PERSON_ROLE.ROLETYPE = 'Subcloning' 	OR
			TEAM_PERSON_ROLE.ROLETYPE = 'F-Printer'		OR
			TEAM_PERSON_ROLE.ROLETYPE = 'Finishing')		AND
			(PERSON.ISCURRENT = '1')				AND
			(PERSON.EMAIL = '$pkg->{Who}')";
}
else
{
$sql = "SELECT		ID_ROLE, TEAM_PERSON_ROLE.ROLETYPE
	FROM		TEAM_PERSON_ROLE, PERSON
	WHERE		(TEAM_PERSON_ROLE.ID_PERSON = PERSON.ID_PERSON)		AND
			(TEAM_PERSON_ROLE.ROLETYPE  = '$pkg->{Roletype}')	AND
			(PERSON.ISCURRENT = '1')				AND
			(PERSON.EMAIL = '$pkg->{Who}')";
}

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

	if(!$ref->[0][0])
	{	my $m = " =======================================================================\n";
		$m =  "$m 			ACCESS DENIED\n\n";
		$m =  "$m Sorry $pkg->{Who}, You Are Not an Authorised User Of DODO Applications.\n";
		$m =  "$m Contact Bug to Have Your Status Changed.\n";
		$m =  "$m ========================================================================\n";
		print STDERR $m;
		exit;
	}

	$pkg->{Role} 		= $ref->[0][0];
	$pkg->{RoleType}	= $ref->[0][1];

}

my @res = grep /^F-Printer|Subcloning|Finishing/, $pkg->{Roletype};
if(!@res)
{		my $m = " =======================================================================\n";
		$m =  "$m 			ACCESS DENIED\n\n";
		$m =  "$m Sorry $pkg->{Who}, You Are Not an Authorised User Of DODO Applications.\n";
		$m =  "$m Contact Bug to Have Your Status Changed.\n";
		$m =  "$m ========================================================================\n";
		print STDERR $m;
		exit;
}
}



sub radiocheck
{
my ($pkg,$chk, @checks) = @_;
my $win = $pkg->{Mainwin}->Toplevel;
my $radio;

$win->title("Please Select");

$win->geometry("+210+220");
$win->protocol('WM_DELETE_WINDOW', sub{$pkg->Killmessage($win);});

foreach(@checks)
{
$win->Radiobutton(				-font 			=> '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
						-text			=> $_,
						-width			=> 25,
						-anchor			=> 'w',
						-value			=> $_,
						-variable		=> \$radio	
		)->pack(			-side 			=> 'top', 
						-padx 			=> 20, 
						-pady 			=> 5);

}

$win->Button(					-fg 			=> 'black', 
						-bg 			=> 'grey85',
						-activeforeground 	=> 'tomato2',
						-activebackground 	=> 'lemonchiffon1',
						-width			=> 5,
						-text 			=> "OK", 
						-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
						-command 		=> sub{		$$chk = $radio; 
											$pkg->Killmessage($win);
											return;  
										}
		)->pack(			-side 			=> 'left',
						-pady			=> 10,
						-padx			=> 60);
		
$win->Button(					-fg 			=> 'black', 
						-bg 			=> 'grey85',
						-activeforeground 	=> 'darkgreen',
						-activebackground 	=> 'lemonchiffon1',
						-width			=> 5,
						-text 			=> "Cancel", 
						-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
						-command 		=> sub{		$$chk = 0; 
											$pkg->Killmessage($win);
											return;
										}
		)->pack(			-side 			=> 'right',
						-pady			=> 10,
						-padx			=> 60);


$win->grab();


}
sub InputBox
{
my ($pkg,$title, $chk) = @_;
my $win = $pkg->{Mainwin}->Toplevel;
my $radio;

$win->title("InputBox");

$win->geometry("+210+220");
$win->protocol('WM_DELETE_WINDOW', sub{$pkg->Killmessage($win);});

$win->Label(					-font 			=> '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
						-text			=> $title,
						-width			=> 35,
						-anchor			=> 'w',	
		)->pack(			-side 			=> 'top', 
						-padx 			=> 20, 
						-pady 			=> 5);	


my $e = $win->Entry(					-font 			=> '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
						-width			=> 20,
						-bg			=> 'lemonchiffon1',
						-textvariable		=> \$radio	
		)->pack(			-side 			=> 'top', 
						-padx 			=> 20, 
						-pady 			=> 5);
$e->focus();						
$e->bind('<Key-Return>', sub{$$chk = $radio;$pkg->Killmessage($win);return;});

$win->Button(					-fg 			=> 'black', 
						-bg 			=> 'grey85',
						-activeforeground 	=> 'tomato2',
						-activebackground 	=> 'lemonchiffon1',
						-width			=> 5,
						-text 			=> "OK", 
						-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
						-command 		=> sub{
											$$chk = $radio;
											$pkg->Killmessage($win);
											return;  
										}
		)->pack(			-side 			=> 'left',
						-pady			=> 10,
						-padx			=> 60);
		
$win->Button(					-fg 			=> 'black', 
						-bg 			=> 'grey85',
						-activeforeground 	=> 'darkgreen',
						-activebackground 	=> 'lemonchiffon1',
						-width			=> 5,
						-text 			=> "Cancel", 
						-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
						-command 		=> sub{		
											$$chk = 0; 
											$pkg->Killmessage($win);
											return;
										}
		)->pack(			-side 			=> 'right',
						-pady			=> 10,
						-padx			=> 60);


$win->grab();


}

sub Projectstatus
{
my ($pkg,$status,$set) = @_;
my @multisql;
my $gull;
my $sql;
my $projects;
my $comment;


# problems converting between formats going for simple approach
my $d = "ddmmyyyyhhmiss"; 

eval{	
####################################
# CONNECT AS GULL
####################################
	$gull = Database->new();
	$gull->Initialisedb();
	$gull->Userdb('gull');
	$gull->Connect_To_DB();

####################################
# GET LOCK
####################################

if($set)
{
$sql = "	SELECT 	PROJECT_STATUS.PROJECTNAME	
		FROM 	PROJECT_STATUS
		WHERE	PROJECT_STATUS.ISCURRENT	= 1		AND
			(";
}
elsif($status == 31)# Cleared For Library
{
$sql = "	SELECT 	PROJECT_STATUS.PROJECTNAME	
		FROM 	PROJECT_STATUS
		WHERE	PROJECT_STATUS.STATUS 		IN (5,7,9)	AND
			PROJECT_STATUS.ISCURRENT	= 1		AND
			(";
}
else
{
$sql = "	SELECT 	PROJECT_STATUS.PROJECTNAME	
		FROM 	PROJECT_STATUS
		WHERE	PROJECT_STATUS.STATUS 		= $status - 1	AND
			PROJECT_STATUS.ISCURRENT	= 1		AND
			(";
}			
			
foreach (@{$pkg->{Contents}})
{
	$sql = "$sql\nPROJECT_STATUS.PROJECTNAME 	=  '$_->[0]' OR";
	
}
	$sql = substr($sql,0,length($sql)-2);
	
#	Disabled Locking
#	$sql = "$sql)\nFOR UPDATE NOWAIT";
	$sql = "$sql)";
	
$projects = $gull->Querydb($sql);
};
if($@ =~ /ORA-00054:/)
{	my $chk;
	my $m = "LOCK OUT\n\nUnable To Update Project status\n";
	$m = "$m\nAnother User Is Currently Accessing The Projects Associated With These Clone(s)";
	$m = "$m\n\nUse Gull to update project statuses.\n\nContact Bug If Problem Persists";
	$pkg->Message($m,\$chk);
	$pkg->{Mainwin}->waitVariable(\$chk);
	#Re-establish Lock On Main data
	undef @{$pkg->{Data}};
	$pkg->Addtoresults();
	return;}
if($@)
{
	print STDERR "$@ \n";
	return;
}


#####################################
# UPDATE PROJECT STATUS
#####################################

foreach (@{$projects})
{		
		if($status == 9)#FISH comments
		{
		foreach my $preps (@{$pkg->{Contents}})
		{
			if(($preps->[5] eq 'Sent For FISHing')&&($preps->[0] eq $_->[0]))
			{$comment = $preps->[1];}
		}
		}
		
		$sql = "UPDATE 	PROJECT_STATUS
			SET	ISCURRENT 	= 0
			WHERE	ISCURRENT	= 1	AND
				PROJECTNAME	= '$_->[0]'";
		
		push @multisql, $sql;
		#$dates->[$i][1] =~ s/[-]|[:]|[ ]//g;
		
		# 	recieved = request date
		$sql = "INSERT INTO 	PROJECT_STATUS	(PROJECTNAME, STATUS, STATUSDATE, ISCURRENT,SESSIONID, PROGRAM, OPERATOR, REMARK)
			VALUES				('$_->[0]' ,$status,SYSDATE,1,$$,'DODO','$pkg->{Who}','$comment')";
		
		push @multisql, $sql;
}
		
eval{
# connect as gull
$gull->MultiWritedb(@multisql);
undef @multisql;
};if($@){print STDERR "Function	: Utilities::Projectstatus\n$@\n";}	
		
$gull->{dbh}->disconnect();

return 0;

}





1;
