#!/usr/local/bin/perl -w
#
# 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.


package Ondemand;
use strict;
#use lib '/nfs/disk65/bsw/barcode/';
use Barcode;
use Tk;
use WrapDBI;
use NewBrowseEntry;

use dodo_utilities;
use vars qw(@ISA %SIG);
@ISA = qw(Utilities Barcode);

sub new
{
my $pkg = shift;

my $setup	={	DBH		=> '',
			User		=> ''};

$setup->{User} = `whoami`;
chop ($setup->{User});

if(@_){$setup->{User} = shift;}


# Label attribute is an array of hashes
bless $setup,$pkg;

return $setup;
}




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

sub DS 
{
my ($pkg) = @_;

my $sql = "	SELECT 	CLONE_CULTURE.ID_CULTURE, 
			GLYSTOCK.CLONENAME, 
			CLONE_CULTURE.DATE_STREAKED,
			'' AS OWNER,
			PERSON.FORENAME,
			UPPER(CLONEPLATE.DESCRIPTION||' ('||ROWCOL_MAP.MAPROW||ROWCOL_MAP.MAPCOL||')')
		FROM	CLONE_CULTURE, GLYSTOCK, TEAM_PERSON_ROLE, PERSON, CLONEWELL, CLONEPLATE,ROWCOL_MAP
		WHERE	PERSON.ID_PERSON		= TEAM_PERSON_ROLE.ID_PERSON	AND
			TEAM_PERSON_ROLE.ID_ROLE	= CLONE_CULTURE.OPERATOR	AND
			ROWCOL_MAP.ID_MAP		= CLONEWELL.ID_MAP		AND
			CLONEPLATE.ID_CLONEPLATE	= CLONEWELL.ID_CLONEPLATE	AND
			CLONEWELL.ID_GLYSTOCK		= GLYSTOCK.ID_GLYSTOCK		AND
			GLYSTOCK.ID_GLYSTOCK		= CLONE_CULTURE.ID_GLYSTOCK	AND
			(";

			
if(ref $pkg->{ID} eq 'ARRAY')
{
	foreach (@{$pkg->{ID}})
	{
	$sql = "$sql\nCLONE_CULTURE.ID_CULTURE 	= $_ OR";
	}		
}else
{
	$sql = "$sql\nCLONE_CULTURE.ID_CULTURE 	= $pkg->{ID} OR";
}			
$sql = substr($sql,0,length($sql)-2);
$sql = "$sql)";			

return $pkg->Querydb($sql);
}

sub DR
{
my ($pkg) = @_;

my $sql = "	SELECT 	DNAPREP.ID_PREP, 
			DNAPREP.CLONENAME, 
			DNAPREP_STATUS.STATUSDATE,
			DNAPREPTYPEDICT.DESCRIPTION, 
			DNAPREP.PREP_NUMBER,
			CHROMOSOMEDICT.CHROMOSOME
		FROM	DNAPREP, DNAPREP_STATUS,DNAPREPTYPEDICT,CHROMOSOMEDICT, CLONE
		WHERE	(DNAPREPTYPEDICT.id_dict	= DNAPREP.PREP_TYPE)			AND
			(DNAPREP_STATUS.STATUS		= 1)					AND
			(CHROMOSOMEDICT.id_DICT		= CLONE.CHROMOSOME)			AND
			(CLONE.CLONENAME		= DNAPREP.CLONENAME)			AND
			(DNAPREP_STATUS.ID_PREP 	= DNAPREP.ID_PREP)			AND
			(";

			
if(ref $pkg->{ID} eq 'ARRAY')
{
	foreach (@{$pkg->{ID}})
	{
	$sql = "$sql\nDNAPREP.ID_PREP 	= $_ OR";
	}		
}else
{
	$sql = "$sql\nDNAPREP.ID_PREP 	= $pkg->{ID} OR";
}			
$sql = substr($sql,0,length($sql)-2);
$sql = "$sql)";			
my $ref = $pkg->Querydb($sql);


my $prepno = "-$ref->[0][4]";
$ref->[0]->[4] = "$prepno ($ref->[0][5])";
$ref->[0]->[5] = "$ref->[0][1]$prepno";

return $ref;
}




sub LG
{
my ($pkg) = @_;

my $sql = "	SELECT	LIGATION.ID_LIGATION,
			LIGATION.ID_LIGATION,
        		TO_CHAR(LIGATION_STATUS.STATUSDATE, 'DD/MM/YYYY'),
			LIGATION.CLONENAME,
			VECTORSITE.VECTORNAME,
			LIGATION.ID_LIGATION 
		FROM   	LIGATION, LIGATION_STATUS,
        		LIGATION_BATCH, 
			VECTORSITE, 
        		FRAGMENTATION_BAND
		WHERE  	LIGATION.ID_FRAGBAND 		= FRAGMENTATION_BAND.ID_FRAGBAND	AND
			VECTORSITE.ID_VECTORSITE	= LIGATION_BATCH.SEQ_VECTOR		AND
			LIGATION_BATCH.ID_LIGBATCH	= LIGATION.ID_LIGBATCH			AND
			LIGATION_STATUS.STATUS		IN (1,2)				AND
			LIGATION_STATUS.ID_LIGATION	= LIGATION.ID_LIGATION			AND
			(";
			
if(ref $pkg->{ID} eq 'ARRAY')
{
	foreach (@{$pkg->{ID}})
	{
	$sql = "$sql\nLIGATION.ID_LIGATION 	= $_ OR";
	}		
}else
{
	$sql = "$sql\nLIGATION.ID_LIGATION 	= $pkg->{ID} OR";
}			
$sql = substr($sql,0,length($sql)-2);
$sql = "$sql)";	
	
my $ref = $pkg->Querydb($sql);


return $ref;
}









sub Querydb
{
my ($pkg,$sql) = @_;

my $ref;

eval{

if(!$pkg->{DBH}){$pkg->Connect();}

my $idlist = $pkg->{DBH}->prepare($sql);
$idlist->execute();
	 
if ($DBI::err)
{die "Error: $idlist->errstr \n";}
else
{$ref = $idlist->fetchall_arrayref;}

$idlist->finish();


};
if($@){die "Cannot query database\n$@\n";}
else
{
$pkg->{DBH}->disconnect();
undef $pkg->{DBH};

return $ref;
}

}



sub Connect
{
my $pkg = shift;
my $user;

if(@_){$user  = shift;}
else{$user = 'dodo';}
eval {$pkg->{DBH} = WrapDBI->connect($user, {RaiseError => 1});};

if ($@){if($pkg->{Printerlist}){undef $pkg->{Printerlist};} die "Cannot connect to Database\n$@\n";}

}





sub Reprint
{
my ($pkg) = @_;


my $ref;
my $l;

if(!$pkg->{Prefix}){die "You must define a prefix for the label you require\n";}
if(!$pkg->{ID}){die "You must define the number(s) of the label required\n";}

if	($pkg->{Prefix} eq 'DS'){$ref = $pkg->DS();}
elsif	($pkg->{Prefix} eq 'DR'){$ref = $pkg->DR();}
elsif	($pkg->{Prefix} eq 'LG'){$ref = $pkg->LG();}
else{die "Sorry a reprint method for the prefix, $pkg->{Prefix}, does not exist\nContact Bug\n";}

$pkg->Type($pkg->{Prefix});			# required
$pkg->Quantity(1);				# optional defaults to 1
$pkg->Itemstoprocess($ref);

while($ref = $pkg->Itemstoprocess())
{
$pkg->Barcode($ref->[0]);			
$pkg->Name("$ref->[1]");     			# optional
$pkg->Date("$ref->[2]");
$pkg->Owner("$ref->[3]");
$pkg->Suffix("$ref->[4]");
$pkg->Project("$ref->[5]");  			# optional
$pkg->Labellist();				# Required
$l =1;
}

eval{
if($l){$pkg->Printlabel();}
else{die "Sorry There are no entries in the database matching your label request\n";}
};if($@){die "There was a problem printing your label\n$@\n";}
}

sub Reprintwindow
{
my ($pkg) = @_;
my $ref;
my $identity;

if(Tk::Exists($pkg->{Window})){$pkg->{Window}->destroy();$|; print "Good Bye\n";};



$pkg->{main} = new MainWindow();
$pkg->Topwindow($pkg->{main});
$pkg->{main}->title("(F2) Oracle Label Generation Application (OLGA)");
$pkg->{main}->minsize(640, 170); 
$pkg->{main}->maxsize(640, 170);
$pkg->{main}->geometry("+210+220");
$pkg->{main}->protocol('WM_DELETE_main', 	sub {# Do nothing
						});
my $frame1 = $pkg->{main}->Frame(		-width 			=> -1,
						-relief 		=> "ridge",
						-bg 			=> "gray85",
						-borderwidth 		=> 2
				)->grid(	-row 			=> 2,
						-column 		=> 1, 
						-sticky 		=> 'we');


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

$pkg->{main}->Label(				-font 			=> '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
						-text			=> "Reprint Barcode Label",
						-fg			=> 'blue',
						-width			=> 25,
						-anchor			=> 'center',	
		)->grid(			-row			=> 1, 
						-column			=> 1,
						-columnspan		=> 2,
						-sticky			=> 'we');


$frame1->Label(					-font 			=> '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
						-text			=> "Select Type Of Item",
						-width			=> 25,
						-anchor			=> 'w',	
		)->grid(			-row			=> 2, 
						-column			=> 1,
						-sticky			=> 'we');	

$frame1->Label(					-font 			=> '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
						-text			=> "Barcode Or ID",
						-width			=> 25,
						-anchor			=> 'w',	
		)->grid(			-row			=> 3, 
						-column			=> 1,
						-sticky			=> 'we');	
						

my $labeltypes =$frame1->BrowseEntry(		-width 			=> 45,
						-fg 			=> 'blue1',
						-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
						-state 			=> 'readonly',
						-variable		=>\$pkg->{Labeltype},
						-browsecmd		=> sub {$pkg->{Prefix} = $pkg->{$pkg->{Labeltype}};$identity->focus();},
		)->grid(			-row 			=> 2,
						-column 		=> 2,
						-sticky 		=> 'we');
					
$labeltypes->Subwidget("slistbox")->Subwidget("listbox")->configure(	-font 	=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
									-height	=> 3,
									-fg 	=> 'blue1');




$identity = $frame1->Entry(			-fg 			=> 'black',
						-bg 			=> 'lemonchiffon1',
						-selectforeground 	=> 'lemonchiffon1',
						-selectbackground 	=> 'black',
						-width 			=> 21,
						-font 			=>'-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
						-textvariable 		=> \$pkg->{ID},
						-state 			=> 'normal',
						-relief 		=> 'flat'
		)->grid(			-row			=> 3, 
						-column			=> 2,
						-sticky			=> 'we');




$identity ->bind('<Key-Return>', sub{ 	
					my $hash = &Verifynumber($pkg->{ID});
					if($hash->{Process} eq "Good")
					{
						$pkg->{ID} 	= $hash->{Number};
						$pkg->{Prefix} 	= $hash->{Type};
						
					}else
					{
					if(!$pkg->{Prefix}){$pkg->Message("You Must define A Prefix\n");return;}
					if($pkg->{ID} =~ /\D+/g){$pkg->Message("ID Must be a number!\n");return;}
					}
					eval{$pkg->Reprint();};
					if($@){$pkg->Message($@);}
					else{$pkg->Message("Label Printed On Printer ".$pkg->Printer());}
					undef $pkg->{ID};
					
					}
					);
$identity->focus();

$frame2->Button(		-fg 				=> 'black',
				-bg 				=> 'grey85',
				-width				=> 10,
				-anchor 			=> 'center',
				-text				=> 'Exit',
				-height 			=> 1,
				-state 				=> 'normal',
				-font 				=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground 		=> 'lemonchiffon1',
				-command 			=> sub {
									#$pkg->{main}->grabRelease();
									$pkg->{main}->destroy();
									undef $pkg->{Printerlist};
									$|;
									print "Good Bye\n";
									return;},
				-relief 			=> 'raised'
		)->grid(	-row 				=> 1, 
				-column 			=> 1,
				-padx				=> 5,
				-pady				=> 5, 
				-sticky 			=> 'w');									


$frame2->Button(		-fg 				=> 'black',
				-bg 				=> 'grey85',
				-width				=> 10,
				-anchor 			=> 'center',
				-text				=> 'Print',
				-height 			=> 1,
				-state 				=> 'normal',
				-font 				=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground 		=> 'lemonchiffon1',
				-command 			=> sub {
									if(!$pkg->{Prefix}){$pkg->Message("You Must define A Prefix\n");return;}
									if($pkg->{ID} =~ /\D+/g){$pkg->Message("ID Must be a number!\n");return;}
									
									eval{$pkg->Reprint();};
									if($@){$pkg->Message($@);}
									else{$pkg->Message("Label Printed On Printer ".$pkg->Printer());}
									undef $pkg->{ID};
									},
				-relief 			=> 'raised'
		)->grid(	-row 				=> 1, 
				-column 			=> 2,
				-padx				=> 5,
				-pady				=> 5, 
				-sticky 			=> 'w');




$frame2->Button(		-fg 				=> 'black',
				-bg 				=> 'grey85',
				-width				=> 10,
				-anchor 			=> 'center',
				-text				=> 'Select Printer',
				-height 			=> 1,
				-state 				=> 'normal',
				-font 				=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground 		=> 'lemonchiffon1',
				-command 			=> [sub {
									my $pkg = shift;
									if(!$pkg->{Prefix})
									{
										$pkg->Message("You must define a prefix for the label you require\n");
									}
									else
									{
										$pkg->Type($pkg->{Prefix});
										$pkg->Viewprinters();
										
									}
									},$pkg],
				-relief 			=> 'raised'
		)->grid(	-row 				=> 1, 
				-column 			=> 3,
				-padx				=> 5,
				-pady				=> 5, 
				-sticky 			=> 'w');
			
my $sql = "	SELECT 	ID_PREFIX,DESCRIPTION
		FROM	BARCODE_PREFIX
		ORDER BY DESCRIPTION";
my $array;		
#$pkg->Query($sql);
$pkg->Itemstoprocess($pkg->Querydb($sql));
while($array = $pkg->Itemstoprocess())
{
	$pkg->{$array->[1]} = $array->[0];
	
	$labeltypes->insert('end',$array->[1]);
}
MainLoop;
}



1;
