#!/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 Barcode;
use Checkbarcode;
use WrapDBI;
use Tk;

@ISA = qw(Checkbarcode);

*ESC 	= \chr(27);
*LF	= \chr(10);
*NULL 	= \chr(0);




sub new

{


my $pkg = shift;

my $setup	={	Label		=> [],
			Printer		=> '',
			Type		=> '',
			Quantity	=> '0001',
			Barcode		=> '',
			Name		=> '',
			Project		=> '',
			Owner		=> '',
			Suffix		=> '',
			User		=> '',
			Date		=> '',
			DHDL		=> 'NOTUSED',
			FHDL		=> '',
			HeaderLabel	=> 1,
			FooterLabel	=> 0};
			
if(@_)
{
	$setup->{"DHDL"} = shift;
}
else
{
	warn "No Database Handle Defined For Use By Barcode Module\n";
}
			
			
my ($d, $m, $y) = (localtime)[3,4,5];
$y = $y + 1900;
$m = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")[$m];
$setup->{"Date"} = uc("$d-$m-$y");

$setup->{"User"} = `whoami`;
chomp $setup->{"User"};


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

############################################################
# Accessor methods
############################################################
sub Barcode {
my ($pkg,$t) = @_;
$t ? $pkg->{"Barcode"} = $t : return $pkg->{"Barcode"};
}

sub Name {
my ($pkg,$t) = @_;
$t ? $pkg->{"Name"} = $t : return $pkg->{"Name"};
}

sub Project {
my ($pkg,$t) = @_;
$t ? $pkg->{"Project"} = $t : return $pkg->{"Project"};
}

sub Owner {
my ($pkg,$t) = @_;
$t ? $pkg->{"Owner"} = $t : return $pkg->{"Owner"};
}

sub Suffix {
my ($pkg,$t) = @_;
$t ? $pkg->{"Suffix"} = $t : return $pkg->{"Suffix"};
}

sub Date {
my ($pkg,$t) = @_;
$t ? $pkg->{"Date"} = uc($t) : return $pkg->{"Date"};
}

sub Type {
my ($pkg,$t) = @_;
$t ? $pkg->{"Type"} = $t : return $pkg->{"Type"};
}

sub Quantity {
my ($pkg,$q) = @_;
$q = '0000'.$q;

$q ? $pkg->{"Quantity"} = substr($q,length($q)-4,4) : return $pkg->{"Quantity"};
}

sub HumanReadable {
my ($pkg,$q) = @_;


$q ? $pkg->{"HumanReadable"} = $q : return $pkg->{"HumanReadable"};
}

sub HeaderLabel {
my ($pkg,$p) = @_;

$pkg->{"HeaderLabel"} = $p;
return $pkg->{"HeaderLabel"};
}

sub FooterLabel {
my ($pkg,$p) = @_;

$pkg->{"FooterLabel"} = $p;
return $pkg->{"FooterLabel"};
}







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

$pkg->{"Barcode"}	= 'BREAK';

$pkg->Labellist();

}

sub User {
my ($pkg,$p) = @_;
$p ? $pkg->{"User"} = $p : return $pkg->{"User"};
}

sub Printer {
my ($pkg,$p) = @_;
$p ? $pkg->{"Printer"} = $p : return $pkg->{"Printer"};
}

###########################################################
# 
###########################################################
sub PrintJobHeaderLabel {
my ($pkg) 	= @_;
my $FHDL 		= $pkg->{"FHDL"};
my $PrintTime 		= localtime();

if($pkg->{"HeaderLabel"} == 0){return;}

$_ =  $pkg->{"Type"};
SWITCH: {

	$_ =~ /MS/   && do { 
			
			
			print $FHDL $ESC,"PC001;0100,0025,1,1,G,+03,00,B",$LF,$NULL;
			print $FHDL $ESC,"PC002;0100,0055,1,1,G,+03,00,B",$LF,$NULL;
			print $FHDL $ESC,"C",$LF,$NULL;
			
			print $FHDL $ESC,"RC001;Printed By $pkg->{\"User\"}",$LF,$NULL;
			print $FHDL $ESC,"RC002;$PrintTime",$LF,$NULL;
			print $FHDL $ESC,"XS;I,0001,0002C5201",$LF,$NULL;
			print $FHDL $ESC,"C",$LF,$NULL;
			
			last SWITCH; 
			};


	}#End Of Switch

}
sub PrintJobFooterLabel {
my ($pkg) 	= @_;
my $FHDL 		= $pkg->{"FHDL"};
my $PrintTime 		= localtime();

if($pkg->{"FooterLabel"} == 0){return;}

$_ = $pkg->{"Type"};
SWITCH: {

	$_ =~ /MS/  && do { 
			print $FHDL $ESC,"PC001;0050,0025,1,1,G,+03,00,B",$LF,$NULL;
			
			print $FHDL $ESC,"C",$LF,$NULL;
			print $FHDL $ESC,"RC001;* THIS IS THE BOTTOM OF YOUR LABEL LIST *",$LF,$NULL;
			
			print $FHDL $ESC,"XS;I,0001,0002C5201",$LF,$NULL;
			print $FHDL $ESC,"C",$LF,$NULL;
			
			last SWITCH; 
			};

			
	warn "Barcode Module : No Header Label defined For Label Type $type\n";
	}#End Of Switch

}
sub FormatLabel {


my $pkg = shift;
my $FHDL = $pkg->{"FHDL"};
my $DriverRef = {};




# Need To ensure printer knows what size label its got
# Oracle says what can run on what.


if($pkg->{"Type"} !~ /MB/){$pkg->FooterLabel(1);} 

$_ = $pkg->{"Type"};
SWITCH: {
	# Long labels 96 x 8 mm main label type in WP.
	$_ =~ /DP|AP/   && do { 
			print FHDL $ESC,"D0098,0710,0070",$LF,$NULL;
			#print FHDL $ESC,"AY;+08,0",$LF,$NULL;
			#print FHDL $ESC,"AX;+004,+000,+00",$LF,$NULL;
	#		print FHDL $ESC,"T20C32",$LF,$NULL;
			print FHDL $ESC,"C",$LF,$NULL;
	
		 	last SWITCH; 
			};
	
	}# end of SWITCH for base label type

# see If user has asked for a header label saying who this print jobe belongs to.


$pkg->PrintJobHeaderLabel($type);



	
# determine label layout using prefix
$_ = $pkg->{"Type"};
SWITCH: {
	# Customised Label Formats
	
			
	/DP|AP/  && do { 
			$pkg->MicroArrayPlateLabels();

		 	last SWITCH; 
			};
					
	/CA/  && do { 
			$pkg->CancerPlateLabels();

		 	last SWITCH; 
			};
						
	
	}# end of SWITCH for label format
	
$pkg->PrintJobFooterLabel();	
}


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


push @{$pkg->{"Label"}},{	"Barcode" 	=> $pkg->{"Barcode"}, 
				"Name" 		=> $pkg->{"Name"},
				"Project" 	=> $pkg->{"Project"}, 
				"Suffix"	=> $pkg->{"Suffix"},
				"Owner" 	=> $pkg->{"Owner"}, 
				"Date" 		=> $pkg->{"Date"},
				"HumanReadable"	=> $pkg->{"HumanReadable"}};

$pkg->{"Barcode"}	= '';
$pkg->{"Name"} 		= '';
$pkg->{"Project"}	= ''; 
$pkg->{"Suffix"} 	= '';
$pkg->{"Owner"}		= '';
$pkg->{"HumanReadable"} = '';


}

sub Checkprinter {
my $pkg = shift;
my $sql;
my $DefaultPrinter;

###################################################
# If printer already defined, assume programmer
# knows what they are doing. (......mmmh)
#
# Barcode Printer Information stored on tracking,OPS cas1/2
# Microarrays on different DB. handle printer requests directly.
#
###################################################




#if($pkg->{"Type"} =~ /MB/)
#{
#	$pkg->{"Printer"} = 'd311bc';
#}
#else
#{
#	$pkg->{"Printer"} = 'd311bc';
#}

if(!$pkg->{"Printer"}){$pkg->{"Printer"} = 'g218bc';}


open FHDL, "| lpr -l -P$pkg->{\"Printer\"}" or die "Cannot open pipe to Label printer $pkg->{\"Printer\"}";
#open FHDL, ">label01.txt";
$pkg->{"FHDL"} = *FHDL;

return $pkg->{"Printer"};

}

##################################################################
# Main Printing Module
##################################################################

sub Printlabel {


my $pkg = shift;
my $ref;
my $parameters;


# has type been set ?
if(!$pkg->{"Type"})	{if($pkg->{"Label"}){undef $pkg->{"Label"};} die "ERROR : Prefix Not defined, Cannot generate Label (s)";}
if(!$pkg->{"User"})	{if($pkg->{"Label"}){undef $pkg->{"Label"};} die "ERROR : Label owner not defined, Cannot generate Label (s)";}


$pkg->Checkprinter();


$pkg->FormatLabel();


undef $pkg->{"Label"};
close $pkg->{"FHDL"};

}
sub CancerPlateLabels {


my $pkg 	= shift;
my $FHDL 	= $pkg->{"FHDL"};
my $pad 	= '                ';
my $i;

##############################################################
# Set Up label postions and fonts
# Date
print $FHDL $ESC,"PC001;0350,0025,05,1,G,+03,00,B",$LF,$NULL;
# Human Readable
print $FHDL $ESC,"PC002;0520,0025,05,1,G,+03,00,W",$LF,$NULL;

# Name
print $FHDL $ESC,"PC003;0350,0065,05,1,H,+03,00,B",$LF,$NULL;

# EAN 13 medium res barcode
print $FHDL $ESC,"XB01;0070,0000,5,3,02,0,0070,+0000000000,002,0,00",$LF,$NULL;
##############################################################


foreach my $CurrentLabel (@{$pkg->{"Label"}})
{
	# Clear label layout form printers memory
	print $FHDL $ESC,"C",$LF,$NULL;
	
	# Used ased for a blank label to be printed in middle of the job
	if($CurrentLabel->{"Barcode"} eq 'BREAK'){print $FHDL $ESC,"T20C32",$LF,$NULL; next;}
	
	($CurrentLabel->{"Barcode"}, $HumanReadable) = Calculatebarcode($pkg->{"Type"},$CurrentLabel->{"Barcode"});
	if($CurrentLabel->{"Barcode"} == -1){warn "Invalid Number Type In Sanger Barcode Calculation\n"; next;}
	
	# Restrict Amount Of Info that can be printed in any label field
	$CurrentLabel->{"Name"} 	= substr($CurrentLabel->{"Name"},0,30);
	
	$CurrentLabel->{"Name"} 	=~ s/_/-/g;
	
	
	print $FHDL $ESC,"RC001;$pkg->{\"Date\"}",$LF,$NULL;
	print $FHDL $ESC,"RC002;$HumanReadable",$LF,$NULL;
	
	
	print $FHDL $ESC,"RC003;$CurrentLabel->{\"Name\"}",$LF,$NULL;
	print $FHDL $ESC,"RB01;$CurrentLabel->{\"Barcode\"}",$LF,$NULL;
	print $FHDL $ESC,"XS;I,$pkg->{\"Quantity\"},0002C3201",$LF,$NULL;
	
}

}



sub MicroArrayPlateLabels {


my $pkg 	= shift;
my $FHDL 	= $pkg->{"FHDL"};
my $pad 	= '                ';
my $i;

##############################################################
# Set Up label postions and fonts
# Date
print $FHDL $ESC,"PC001;0040,0025,05,1,G,+03,00,B",$LF,$NULL;
# Human Readable
print $FHDL $ESC,"PC002;0040,0060,05,1,G,+03,00,B",$LF,$NULL;

# Name
print $FHDL $ESC,"PC003;0510,0025,05,1,G,+03,00,B",$LF,$NULL;

#Project
print $FHDL $ESC,"PC004;0510,0060,05,1,G,+03,00,B",$LF,$NULL;

# EAN 13 medium res barcode
# original
#print $FHDL $ESC,"XB01;0230,0000,5,3,02,0,0070,+0000000000,002,0,00",$LF,$NULL;

# mod
print $FHDL $ESC,"XB01;0230,0000,5,3,02,0,0070,+0000000000,002,0,00",$LF,$NULL;

##############################################################



foreach my $CurrentLabel (@{$pkg->{"Label"}})
{
	# Clear label layout form printers memory
	print $FHDL $ESC,"C",$LF,$NULL;
	
	# Used ased for a blank label to be printed in middle of the job
	if($CurrentLabel->{"Barcode"} eq 'BREAK'){print $FHDL $ESC,"T20C32",$LF,$NULL; next;}
	
	($CurrentLabel->{"Barcode"}, $HumanReadable) = Calculatebarcode($pkg->{"Type"},$CurrentLabel->{"Barcode"});
	if($CurrentLabel->{"Barcode"} == -1){warn "Invalid Number Type In Sanger Barcode Calculation\n"; next;}
	
	
	# Restrict Amount Of Info that can be printed in any label field
	$CurrentLabel->{"Name"} 	= substr($CurrentLabel->{"Name"},0,28);
	$CurrentLabel->{"Name"} 	=~ s/_/-/g;
	
	$CurrentLabel->{"Project"} 	= "$CurrentLabel->{\"Project\"}";

	# Date
	print $FHDL $ESC,"RC001;$pkg->{\"Date\"}",$LF,$NULL;
	
	# Human readable

#	warn "------------------------------\n";
#	warn "$HumanReadable\n";
#	warn "------------------------------\n";

	if ( (length $HumanReadable) > 11){ 
	    die "Cannot print human readable text (> 11-chars) Contact bug !\n";
	}

	print $FHDL $ESC,"RC002;$HumanReadable",$LF,$NULL;

	# Program name (could be used for something else)
	$CurrentLabel->{"Name"} = substr($CurrentLabel->{"Name"}, 0, 11);
	print $FHDL $ESC,"RC003;$CurrentLabel->{\"Name\"}",$LF,$NULL;

	# Projectname (all 4 96 well plates should come from the same project
	$CurrentLabel->{"Project"} = substr($CurrentLabel->{"Project"}, 0, 11);
	print $FHDL $ESC,"RC004;$CurrentLabel->{\"Project\"}",$LF,$NULL;
	
	# The barcode itself
	
	print $FHDL $ESC,"RB01;$CurrentLabel->{\"Barcode\"}",$LF,$NULL;

	print $FHDL $ESC,"XS;I,$pkg->{\"Quantity\"},0002C3201",$LF,$NULL;
}
}



sub TestPrinter {
my ($printer) = @_;


if(!$Printer)
{
	$Printer = 'd311bc';
};

my $PrinterCheck = `lpq -P  $Printer`;

if($PrinterCheck =~ /no spool directory/)
{	
	die "\n\nInValid Printer $Printer\n";
}

if($PrinterCheck !~ /Printer OK/)
{	
	die "\n\nSorry Printer $Printer appears to be unavailable at the moment\n\nPlease check the printer and retry.\n";
	
}


}


1;






