#!/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 strict;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
use Tk;
use NewBrowseEntry;
#use Time::localtime;

use Exporter;
$VERSION = 1.01;
@ISA = qw(Exporter);

@EXPORT = qw(&Verifynumber &makeID);
################################################################
# Andy-/-Johns Sanger check functions Stole from Checkdigit.pm
################################################################
sub makeID 
{
my $pkg = shift;
my $s;

if(! ref $pkg)
{$s = $pkg;}else{ ($s) = @_;}

  return $s =~ /^[A-Z][A-Z][1-9][0-9]*$/ ? $s . makeCheck($s) : "";
}

sub IdOrNull {
    my ($s, $type) = @_;
    return validID($s, $type) ? substr($s, 2, -1) : "NULL";
}

sub validID {
    my ($s, $type) = @_;
    return "" if $s !~ /^[A-Z][A-Z][1-9][0-9]*[A-Z]$/;
    if (defined $type) {
    #Modified to return NULL on type miss match
	return "NULL" if $type ne substr($s, 0, 2);
    }
    
    my $ck = substr($s, length($s) - 1, 1);
    return $ck eq makeCheck(substr($s, 0, -1));
}

sub makeCheck {
    my ($s) = @_;
    my @chars = split //, $s;

    my $len = scalar @chars;
    my $sum = 0;
    foreach my $c (@chars) {
	$sum += ord($c) * $len--;
    }
    return chr($sum % 23 + ord('A'));
}
################################################################
# My barcode validation shrub!
################################################################


sub Verifynumber
{
my $pkg = shift;
my $code;
my $type;
my $prefix = "Not Determined";
my $number;
my $check = "Not Determined";




if(! ref $pkg)
{
	$code = $pkg;
	$type = shift;
	$code = "$code";
}
else
{
	($code,$type) = @_;
	$code = "$code";
}

$number = $code;


my $sanger = '';
my $s;
my $strip;
my $p;

if($code !~ /\D/g)
{
	if((length($code) > 11)&&(length($code) < 14))
	{
	while(length($code) < 13){$code = "0$code";}
		$number 	= substr($code,0,12);
			
		$check	 	= chr(substr($number,10));
				
				
		$prefix		= &Letter_prefix(substr($number,0,3));
		$number		= substr($number,3,7)/1;
		$code = "$prefix$number$check";
		my $r = validID($code,$type);
		if ($r eq "NULL")	{$p = "Invalid"	;}
		elsif(!$r)		{$p = "Bad"	;}
		else			{$p = "Good"	;}

		return {	Process => $p, 
				Type 	=> $prefix, 
				Number 	=> $number, 
				Check 	=> $check,
				Whole 	=> $code
			};
	}
}
	
$check = validID($code,$type);
if ($check eq "NULL")	{	$p = "Invalid"	;}
elsif(!$check)		{	$p = "Bad"	;}
else			{	$p = "Good"	;}

if($p ne "Bad")
{
	$prefix = substr($code,0,2);
	$number = substr($code,2,(length($code)-3));
	$check 	= substr($code,length($code)-1);
}



return {	Process => $p, 
		Type 	=> $prefix, 
		Number 	=> $number, 
		Check 	=> $check,
		Whole 	=> $code
	};				

}

sub Number_prefix
{
# Return the number of two letter prefix
my ($prefix) = @_;
my $i;
my $j;

$i = (substr $prefix,0,1);
$j = (substr $prefix,1,1);

$i = ord($i)-64;
$j = ord($j)-64;
if($i < 1){$i = 0;}
if($j < 1){$j = 0;}


$prefix = (($i * 27) + $j) * 1000000000;

return $prefix;
}


sub Letter_prefix
{
# Return two letter prefix given a number
my ($prefix) = @_;
my $i;
my $j;

$i = int($prefix/27);
$j = $prefix%27;

if($i != 0){$i = chr($i + 64);}
if($j != 0){$j = chr($j + 64);}

return ("$i$j");
}

sub Calculatebarcode
{
my ($pkg,$l) = @_;

# This is a number assume barcode

my $cl = &makeID("$pkg->{Type}$l");
if(!$cl){return (-1);}

my $bc = &Number_prefix($pkg->{"Type"}) + ($l * 100);
$bc += ord(substr($cl,length($cl)-1));
if(length($bc) == 11){$bc ="0$bc";}
$l = $cl;
return ($bc, $l);
}
#############################################################
#Start Of Labelelling code
#############################################################
sub new
{
my $pkg = shift;

my $setup	={	Label		=> [],
			Printer		=> '',
			Type		=> '',
			Quantity	=> 1,
			Barcode		=> '',
			Name		=> '',
			Project		=> '',
			Owner		=> '',
			Suffix		=> '',
			User		=> '',
			Date		=> '',
			New		=> '',
			DBH		=> ''};
my ($d, $m, $y) = (localtime)[3,4,5];
#if($y > 99){$y = $y + 2000;}else{$y = $y + 1900;}

$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`;
chop ($setup->{"User"});

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





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


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 Window
{
my $pkg = shift;

$pkg->{"Window"} ? return $pkg->{"Window"} : '';

}


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

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

sub Database
{
my ($pkg,$d) = @_;

if($d)
{$pkg->{"DBH"} = $$d;}
else
{eval {$pkg->{"DBH"} = WrapDBI->connect('dodo', {RaiseError => 1});};

if ($@){if($pkg->{"Label"}){undef $pkg->{"Label"};} die "ERROR : Cannot connect to Database";}
}


}




sub Query
{
my ($pkg, $t) = @_;
my $ref;
my $sql;

if($t)
{
# T followed by 1 to 3 digits, return number as $1
if($pkg->{"User"} =~ /^T(\d{1,3})$/)
{
# treat owner as a team
$sql ="	SELECT 	1 AS SORTORDER, BARCODE_PRINTER.DESCRIPTION, BARCODE_PRINTER.OFFSET, BARCODE_PRINTER.DENSITY,
		BARCODE_PRINTER.ACTIVE_LABEL
	FROM 	BARCODE_PRINTER, DEFAULT_PRINTERS, BARCODE_PREFIX
	WHERE	BARCODE_PREFIX.ID_PREFIX		=	'".$pkg->{"Type"}."'		AND
		BARCODE_PREFIX.ID_LABEL			=	BARCODE_PRINTER.ACTIVE_LABEL	AND
		BARCODE_PRINTER.ISCURRENT		=	1				AND
		BARCODE_PRINTER.ID_PRINTER		=	DEFAULT_PRINTERS.ID_PRINTER	AND
		DEFAULT_PRINTERS.TEAMNAME		=	$1
	UNION ALL
	SELECT 	2 AS SORTORDER, BARCODE_PRINTER.DESCRIPTION, BARCODE_PRINTER.OFFSET, BARCODE_PRINTER.DENSITY,
		BARCODE_PRINTER.ACTIVE_LABEL
	FROM 	BARCODE_PRINTER, DEFAULT_PRINTERS, BARCODE_PREFIX
	WHERE	BARCODE_PREFIX.ID_PREFIX		=	'".$pkg->{"Type"}."'			AND
		BARCODE_PREFIX.ID_LABEL			=	BARCODE_PRINTER.ACTIVE_LABEL	AND
		BARCODE_PRINTER.ISCURRENT		=	1				AND
		BARCODE_PRINTER.ID_PRINTER		=	DEFAULT_PRINTERS.ID_PRINTER	AND
		NOT DEFAULT_PRINTERS.TEAMNAME		=	$1
	ORDER BY SORTORDER, 2";
}
else
{

$sql ="	SELECT 	1 AS SORTORDER, BARCODE_PRINTER.DESCRIPTION, BARCODE_PRINTER.OFFSET, BARCODE_PRINTER.DENSITY,
		BARCODE_PRINTER.ACTIVE_LABEL 
	FROM 	BARCODE_PRINTER, DEFAULT_PRINTERS, TEAM_PERSON, PERSON, BARCODE_PREFIX
	WHERE	BARCODE_PREFIX.ID_PREFIX		=	'".$pkg->{"Type"}."'		AND
		BARCODE_PREFIX.ID_LABEL			=	BARCODE_PRINTER.ACTIVE_LABEL	AND
		BARCODE_PRINTER.ISCURRENT		=	1				AND
		BARCODE_PRINTER.ID_PRINTER		=	DEFAULT_PRINTERS.ID_PRINTER	AND
		DEFAULT_PRINTERS.TEAMNAME		=	TEAM_PERSON.TEAMNAME		AND	
		TEAM_PERSON.ID_PERSON			=	PERSON.ID_PERSON		AND
		PERSON.ISCURRENT			=	1				AND	
		PERSON.EMAIL				=	'".$pkg->{User}."'
	UNION ALL
	SELECT 	2 AS SORTORDER, BARCODE_PRINTER.DESCRIPTION, BARCODE_PRINTER.OFFSET, BARCODE_PRINTER.DENSITY,
		BARCODE_PRINTER.ACTIVE_LABEL
	FROM 	BARCODE_PRINTER, BARCODE_PREFIX
	WHERE	BARCODE_PREFIX.ID_PREFIX		=	'".$pkg->{"Type"}."'		AND
		BARCODE_PREFIX.ID_LABEL			=	BARCODE_PRINTER.ACTIVE_LABEL	AND
		BARCODE_PRINTER.ISCURRENT		=	1				AND
		NOT BARCODE_PRINTER.ID_PRINTER		IN (SELECT DEFAULT_PRINTERS.ID_PRINTER 
		FROM 	DEFAULT_PRINTERS, TEAM_PERSON, PERSON
		WHERE	DEFAULT_PRINTERS.TEAMNAME		=	TEAM_PERSON.TEAMNAME		AND	
			TEAM_PERSON.ID_PERSON			=	PERSON.ID_PERSON		AND
			PERSON.ISCURRENT			=	1				AND	
			PERSON.EMAIL				=	'".$pkg->{User}."')
	ORDER BY SORTORDER, 2";


}
}
else
{
$sql = "SELECT 	1 AS SORTORDER, BARCODE_PRINTER.DESCRIPTION, BARCODE_PRINTER.OFFSET, BARCODE_PRINTER.DENSITY,
		BARCODE_PRINTER.ACTIVE_LABEL 
	FROM 	BARCODE_PRINTER, BARCODE_PREFIX
	WHERE	BARCODE_PREFIX.ID_PREFIX	= '".$pkg->{"Type"}."'				AND
		BARCODE_PREFIX.ID_LABEL	    	= BARCODE_PRINTER.ACTIVE_LABEL			AND
		BARCODE_PRINTER.ISCURRENT   	= 1						AND
		BARCODE_PRINTER.DESCRIPTION 	Like '".$pkg->{"Printer"}."'
	ORDER BY SORTORDER, 2";


}

eval{

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

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

$idlist->finish();


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

return $ref;}




}

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




sub Printer
{
my ($pkg,$p) = @_;
if($p)
	{$pkg->{"Printer"} = $p;}
elsif($ENV{LABELS})
	{$pkg->{"Printer"} = $ENV{LABELS};}
	
return $pkg->{"Printer"};
}


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)";}
my $comment;

#bsw
if($pkg->{"Printer"})
{	#printer must be set
	$parameters = $pkg->Query();
	if(!$parameters->[0])
	{
		$comment = "You cannot print $pkg->{\"Type\"} entities on printer, $pkg->{\"Printer\"}\n"; 	
	}
}
else
{
	$parameters = $pkg->Query(1);
	if(!$parameters->[0])
	{
		$comment = "Cannot Find a Printer for the specifed prefix type, $pkg->{\"Type\"}, in the database\n";
	}
}
if($comment){if($pkg->{"Label"}){undef$pkg->{"Label"};} die "ERROR : $comment\n\nPlease select another printer\n";}


$pkg->{"Printer"} = $parameters->[0][1];

my $reply = `lpq -P$pkg->{"Printer"}`;
if(length($reply) < 1){$comment = "Label Printer, $pkg->{\"Printer\"}, Unavailable";}
elsif($reply =~ /Printer Off Line/){$comment = "Label Printer,$pkg->{\"Printer\"}, Off line";}

if($comment){if($pkg->{"Label"}){undef $pkg->{"Label"};}die "ERROR : $comment\n\nPlease select another printer\n";}


# need to pad quantity to avoid driver errors
while (length($pkg->{"Quantity"}) < 4){$pkg->{"Quantity"} = "0$pkg->{\"Quantity\"}";}

# USING ACTIVE LABEL VALUE FROM BARCODE_PRINTER
my $labels = scalar @{$pkg->{"Label"}};
my $p = 0;
if(($parameters->[0][4] == 1)&&($pkg->{"Type"} eq 'MP')){$p = 1;$pkg->Positionlabels($parameters->[0][2],$parameters->[0][3]); }
if(($parameters->[0][4] == 1)&&($pkg->{"Type"} eq 'ID')){$p = 1;$pkg->Identitylabels($parameters->[0][2],$parameters->[0][3]); }
if(($parameters->[0][4] == 2)&&($pkg->{"Type"} eq 'DR')){$p = 1;$pkg->Eppendorflabel($parameters->[0][2],$parameters->[0][3]); }
if(($parameters->[0][4] == 1)&&($pkg->{"Type"} eq 'GL')){$p = 1;$pkg->Labwarelabel($parameters->[0][2],$parameters->[0][3]); }
if(($parameters->[0][4] == 1)&&($pkg->{"Type"} eq 'DS')){$p = 1;$pkg->Petridishlabel($parameters->[0][2],$parameters->[0][3]); }
if(($parameters->[0][4] == 2)&&($pkg->{"Type"} eq 'GS')){$p = 1;$pkg->Smalltextlabel($parameters->[0][2],$parameters->[0][3]); }
if(($parameters->[0][4] == 2)&&($pkg->{"Type"} eq 'LG')){$p = 1;$pkg->Ligationlabel($parameters->[0][2],$parameters->[0][3]); }



if(($parameters->[0][4] == 1)&&($p == 0)){$pkg->Platelabels($parameters->[0][2],$parameters->[0][3]); $p = 1;}
elsif(($pkg->{"Label"})&&($p == 0))
{undef $pkg->{"Label"}; die "ERROR : Cannot find a printer driver for type $pkg->{\"Type\"} and printer $pkg->{\"Printer\"}\n";}

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

$pkg->Updatelabelcount($labels);


#if($printer_type->{$pkg->{"Type"}} eq 'sl'){$pkg->Smalllabels();}

}

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

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

$pkg->Labellist();

}




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"}};

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

}

# For printing 92 x 8mm labels (microtitre and petri dishes)
sub Platelabels
{
my ($pkg, $offset, $density) = @_;

my $lf		= chr(10);
my $esc		= chr(27);
my $null	= chr(0);

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


# Ensure right label configuaration and alignment
while(length($density) < 2)
{$density = "0$density";}

if(length($density) > 2){$density = "05";}

while(length($offset) < 3)
{$offset = "0$offset";}

if(length($offset) > 3){$offset = "000";}

print $f $esc,"D0111,0920,0075",$lf,$null;
print $f $esc,"AY;+$density,0",$lf,$null;
print $f $esc,"AX;-$offset,+000,+00",$lf,$null;
print $f $esc,"T20C32",$lf,$null;

#DATE
print $f $esc,"PC001;0020,0035,1,1,G,00,B",$lf,$null;
#Human readable Form
print $f $esc,"PC002;0020,0065,1,1,G,00,B",$lf,$null;

#Project
print $f $esc,"PC004;0520,0065,05,1,G,+03,00,B",$lf,$null;
#Suffix
print $f $esc,"PC005;0770,0035,1,1,G,00,B",$lf,$null;
#Owner
print $f $esc,"PC006;0770,0065,1,1,G,00,B",$lf,$null;


#EAN 13 medium res
print $f $esc,"XB01;0250,0000,5,3,02,0,0070,+0000000000,002,0,00",$lf,$null;

#my $count = 0;

foreach my $l (@{$pkg->{"Label"}})
{
my $bc;

print $f $esc,"C",$lf,$null;
#bsw
if($l->{"Barcode"} eq 'BREAK')
{
	print $f $esc,"T20C32",$lf,$null;;
}
else
{	my $bc;
	($bc,$l->{"Barcode"}) = $pkg->Calculatebarcode($l->{"Barcode"});
	
	if($bc == -1){close $f; if($pkg->{"Label"}){undef $pkg->{"Label"};} die "ERROR : Invalid Number Type In Sanger Barcode Calculation\n";}
	

while (length($l->{"Barcode"}) < 11)
{$l->{"Barcode"} = " $l->{\"Barcode\"} ";}

$l->{"Name"} 	= substr($l->{"Name"},0,18);
$l->{"Project"}	= substr($l->{"Project"},0,18);
$l->{"Suffix"}	= substr($l->{"Suffix"},0,5);
$l->{"Owner"}	= substr($l->{"Owner"},0,5);

#Adjust display for shorter lengths
#Platename
if(length($l->{"Name"}) < 10)
{print $f $esc,"PC003;0520,0035,1,1,G,+03,00,B",$lf,$null;}
else{print $f $esc,"PC003;0520,0035,05,1,G,+03,00,B",$lf,$null;}
#Project
if(length($l->{"Project"}) < 10) {print $f $esc,"PC004;0520,0065,1,1,G,+03,00,B",$lf,$null;}

print $f $esc,"RC001;$l->{\"Date\"}",$lf,$null;
if($l->{"Barcode"})	{print $f $esc,"RC002;$l->{\"Barcode\"}",$lf,$null; print $f $esc,"RB01;$bc",$lf,$null;}
if($l->{"Name"})	{$l->{"Name"} =~ s/_/-/g; print $f $esc,"RC003;$l->{\"Name\"}",$lf,$null;}
if($l->{"Project"})	{$l->{"Project"} =~ s/_/-/g; print $f $esc,"RC004;$l->{\"Project\"}",$lf,$null;}
if($l->{"Suffix"})	{print $f $esc,"RC005;$l->{\"Suffix\"}",$lf,$null;}
if($l->{"Owner"})	{print $f $esc,"RC006;$l->{\"Owner\"}",$lf,$null;}


print $f $esc,"LC;0510,0010,0510,0075,0,2",$lf,$null;
print $f $esc,"LC;0760,0010,0760,0075,0,2",$lf,$null;

# added transmissive sensor check
print $f $esc,"XS;I,$pkg->{\"Quantity\"},0002C5201",$lf,$null;

}#BREAK if

}
close $f or die "Cannot close pipe to Label Printer : $pkg->{\"Printer\"}";
undef $pkg->{"Label"};
}


sub Identitylabels
{
my ($pkg, $offset, $density) = @_;

my $lf		= chr(10);
my $esc		= chr(27);
my $null	= chr(0);

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


# Ensure right label configuaration and alignment
while(length($density) < 2)
{$density = "0$density";}

if(length($density) > 2){$density = "05";}

while(length($offset) < 3)
{$offset = "0$offset";}

if(length($offset) > 3){$offset = "000";}

#$offset = "000";

print $f $esc,"D0111,0920,0080",$lf,$null;
print $f $esc,"AY;+$density,0",$lf,$null;
print $f $esc,"AX;-$offset,+000,+00",$lf,$null;
print $f $esc,"T20C32",$lf,$null;

#name
print $f $esc,"PC001;0600,0035,1,1,G,00,B",$lf,$null;
#team
print $f $esc,"PC002;0600,0065,1,1,G,00,B",$lf,$null;


print $f $esc,"PC003;0300,0035,1,1,G,00,B",$lf,$null;
print $f $esc,"PC004;0300,0065,1,1,G,00,B",$lf,$null;


#EAN 13 medium res
print $f $esc,"XB01;0030,0005,5,3,02,0,0070,+0000000000,002,0,00",$lf,$null;

foreach my $l (@{$pkg->{"Label"}})
{
my $bc;

print $f $esc,"C",$lf,$null;
if($l->{"Barcode"} eq 'BREAK')
{
	print $f $esc,"T20C32",$lf,$null;;
}
else
{
	my $bc;
	($bc, $l->{"Barcode"})= $pkg->Calculatebarcode($l->{"Barcode"});
	if($bc == -1){close $f; if($pkg->{"Label"}){undef $pkg->{"Label"};} die "ERROR : Invalid Number Type In Sanger Barcode Calculation\n";}
	

while (length($l->{"Barcode"}) < 11)
{$l->{"Barcode"} = " $l->{\"Barcode\"} ";}

$l->{"Name"} 	= substr($l->{"Name"},0,20);
$l->{"Owner"}	= substr($l->{"Owner"},0,20);

print $f $esc,"RB01;$bc",$lf,$null;

if($l->{"Name"})		{print $f $esc,"RC001;$l->{\"Name\"}",$lf,$null;}
if($l->{"Owner"})		{print $f $esc,"RC002;$l->{\"Owner\"}",$lf,$null;}

print $f $esc,"RC003;ORACLE (LIVE)",$lf,$null;
print $f $esc,"RC004;Sample Tracking",$lf,$null;
print $f $esc,"LC;0580,0010,0580,0075,0,2",$lf,$null;

# added transmissive sensor check
print $f $esc,"XS;I,$pkg->{\"Quantity\"},0002C5201",$lf,$null;


}
}
close $f or die "Cannot close pipe to Label Printer : $pkg->{\"Printer\"}";
undef $pkg->{"Label"};
}


sub Positionlabels
{
my ($pkg, $offset, $density) = @_;

my $lf		= chr(10);
my $esc		= chr(27);
my $null	= chr(0);

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


# Ensure right label configuaration and alignment
while(length($density) < 2)
{$density = "0$density";}

if(length($density) > 2){$density = "05";}

while(length($offset) < 3)
{$offset = "0$offset";}

if(length($offset) > 3){$offset = "000";}

#$offset = "000";

print $f $esc,"D0111,0920,0080",$lf,$null;
print $f $esc,"AY;+$density,0",$lf,$null;
print $f $esc,"AX;-$offset,+000,+00",$lf,$null;
print $f $esc,"T20C32",$lf,$null;

#name
print $f $esc,"PC001;0150,0075,1,1,H,00,B",$lf,$null;

#EAN 13 medium res
print $f $esc,"XB01;0500,0001,5,3,02,0,0070,+0000000000,002,0,00",$lf,$null;

foreach my $l (@{$pkg->{"Label"}})
{
my $bc;

print $f $esc,"C",$lf,$null;
if($l->{"Barcode"} eq 'BREAK')
{
	print $f $esc,"T20C32",$lf,$null;;
}
else
{
	my $bc;
	($bc, $l->{"Barcode"})= $pkg->Calculatebarcode($l->{"Barcode"});
	if($bc == -1){close $f; if($pkg->{"Label"}){undef $pkg->{"Label"};} die "ERROR : Invalid Number Type In Sanger Barcode Calculation\n";}
	

while (length($l->{"Barcode"}) < 11)
{$l->{"Barcode"} = " $l->{\"Barcode\"} ";}

$l->{"Name"} 	= substr($l->{"Name"},0,20);
$l->{"Owner"}	= substr($l->{"Owner"},0,20);

print $f $esc,"RB01;$bc",$lf,$null;

if($l->{"Name"})		{print $f $esc,"RC001;$l->{\"Name\"}",$lf,$null;}


# added transmissive sensor check
print $f $esc,"XS;I,$pkg->{\"Quantity\"},0002C5201",$lf,$null;


}
}
close $f or die "Cannot close pipe to Label Printer : $pkg->{\"Printer\"}";
undef $pkg->{"Label"};
}

sub Updatelabelcount {
my ($pkg,$labels) = @_;
my $sql;
my $ref;

$sql = "	SELECT 	FLOOR((RUNNING_TOTAL/LABELTYPEDICT.PER_ROLL)*100), 
			LABEL_ROLL.ID_PRINTER, 
			LABELTYPEDICT.PER_ROLL,
			LABEL_ROLL.ID_LABEL
		FROM 	LABEL_ROLL, BARCODE_PRINTER, LABELTYPEDICT
		WHERE	LABELTYPEDICT.ID_DICT		= LABEL_ROLL.ID_LABEL
		AND	LABEL_ROLL.ISCURRENT		= 1
		AND	LABEL_ROLL.ID_PRINTER		= BARCODE_PRINTER.ID_PRINTER	
		AND	BARCODE_PRINTER.DESCRIPTION 	= '$pkg->{\"Printer\"}'";
eval {
if(!$pkg->{"DBH"}){$pkg->Database();}

my $idlist = $pkg->{"DBH"}->prepare($sql);
$idlist->execute();
$ref = $idlist->fetchrow_arrayref;
$idlist->finish();

if($ref)
{
$sql = "	UPDATE 	LABEL_ROLL
		SET	RUNNING_TOTAL	=	RUNNING_TOTAL - $labels
		where	ID_PRINTER	=	$ref->[1]
		AND	ISCURRENT		= 1";
	
my $idlist = $pkg->{"DBH"}->prepare($sql);
$idlist->execute();
$idlist->finish();
$pkg->{"DBH"}->commit;


if($ref->[0] < 5)
{
	open (MAIL,"|/usr/bin/mail bsw");
	print MAIL "From: Printer $pkg->{\"Printer\"} <>\n";
	print MAIL "To: bsw\n";
	print MAIL "Subject: $pkg->{\"Printer\"} Labels Running Low\n\n";
	print MAIL "This is an Automated Message.\n\nPrinter, $pkg->{\"Printer\"}, may be running low of labels\n";
	print MAIL "Please check with $pkg->{\"User\"} ,and update oracle label counter for this printer using\n\n";
	print MAIL "At an xterm prompt type : labelcount -printer <printer> -roll <NEW | a number>\n";
	print MAIL "                     e.g. labelcount -printer $pkg->{\"Printer\"} -roll NEW \n                           A new roll was installed\n\n";
	print MAIL "                     e.g. labelcount -printer $pkg->{\"Printer\"} -roll 1000 \n                          Adjust current label count to 1000 on existing roll\n\n";
	print MAIL "THIS IS LOOKING AT LIVE !!!!!!!! \n\n\n";
	close(MAIL);

}
	
	
}
else
{
open (MAIL,"|/usr/bin/mail bsw");
print MAIL "From: Printer $pkg->{\"Printer\"}        <>\n";
print MAIL "To: bsw\n";
print MAIL "Subject: No Label Counter Defined\n\n";
print MAIL "This is an Automated Message.\n No Label count has been defined for printer $pkg->{\"Printer\"}\n";
close(MAIL);
}

$pkg->{"DBH"}->disconnect();
undef $pkg->{"DBH"};

};
if($@){$pkg->{"DBH"}->rollback(); die "ERROR : Cannot query database $@";}
}





sub Viewprinters {
my ($pkg) = @_;
my $radio;
my $ref;


if($pkg->{Printerlist}){undef $pkg->{Printerlist}};
if(Tk::Exists($pkg->{"Window"})){$pkg->{"Window"}->destroy();};



# get default printers put them at the head of the list
$ref = $pkg->Query(1);

foreach(@{$ref})
{
#get rid of any spaces in printername
$_->[0] =~ s/ //g;
push @{$pkg->{Printerlist}},$_;
}

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


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




my $t = $frame1->Label(				-font 			=> '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
						-text			=> "Set Default Printer",
						-width			=> 25,
						-anchor			=> 'w',	
		)->grid(			-row			=> 1, 
						-column			=> 1,
						-sticky			=> 'we');	

$frame1->Label(					-font 			=> '-schumacher-clean-bold-r-normal--14-140-75-75-c-80-iso8859-1',
						-text			=> "Printer     Status",
						-bg			=> "lightblue",
						-width			=> 35,
						-anchor			=> 'w',	
		)->grid(			-row			=> 2, 
						-column			=> 1,
						-columnspan		=> 2,
						-sticky			=> 'we');	
						
$pkg->{Browse} = $frame1->Listbox(		-width 			=> 35,
						-selectmode 		=> 'single',
						-fg 			=> 'black',
						-selectbackground 	=> 'green',
						-font			=> '-schumacher-clean-bold-r-normal--14-140-75-75-c-80-iso8859-1',
						-height			=> 5,	
		)->grid(			-row			=> 3, 
						-column			=> 1);


my $scroll = $frame1->Scrollbar(		-width 			=> 12,
						-command 		=> ['yview',$pkg->{Browse}]
		)->grid(			-row			=> 3, 
						-column			=> 2,
						-sticky			=> 'ns');




$pkg->{Browse}->configure(	 -yscrollcommand 	=> ['set', $scroll]);


$pkg->{Browse}->bind('<ButtonPress-1>', 	[\&Testchoice,	$pkg,0]);

$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->{"Window"}->grabRelease();
									$pkg->{"Window"}->destroy();
									undef $pkg->{Printerlist};
									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				=> 'Refresh',
				-height 			=> 1,
				-state 				=> 'normal',
				-font 				=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground 		=> 'lemonchiffon1',
				-command 			=> sub {
									if($pkg->{Printerlist})
									{
									
									foreach(@{$pkg->{Printerlist}})
									{undef $_->[5];}
									$pkg->Viewlist();
									}
									},
				-relief 			=> 'raised'
		)->grid(	-row 				=> 1, 
				-column 			=> 2,
				-padx				=> 5,
				-pady				=> 5, 
				-sticky 			=> 'w');




$pkg->Viewlist();

#$pkg->{"Window"}->grab();

MainLoop;

}

sub Testchoice
{
my ($e,$pkg) = @_;
if(!$pkg){$pkg = $e;}

if(!$pkg->{Printerlist}){$pkg->{Browse}->selectionClear(0, 'end');return;}

my @s = $pkg->{Browse}->curselection();

my $reply = `lpq -P$pkg->{Printerlist}->[$s[0]][1]`;

if(length($reply) < 1){
	$pkg->{Printerlist}->[$s[0]][5] = "Printer Is Unavailable";
	$pkg->{Browse}->bell();
	undef $pkg->{"Printer"};
	}
elsif($reply =~ /Printer Off Line/){
	$pkg->{Printerlist}->[$s[0]][5] = "Printer Is Off Line";
	$pkg->{Browse}->bell();
	undef $pkg->{"Printer"};
	}
else{
	$pkg->{Printerlist}->[$s[0]][5] = "Printer Is Okay";
	$pkg->{"Printer"} = $pkg->{Printerlist}->[$s[0]][1];
	$pkg->{"Printer"} =~ s/ //g;
	}
	
my $pad = $pkg->{Printerlist}->[$s[0]][1];	
while(length($pad) < 11){$pad = "$pad ";}	
	
$pkg->{Browse}->delete($s[0]);
$pkg->{Browse}->insert($s[0], "$pad $pkg->{Printerlist}->[$s[0]][5]");

if ($pkg->{Printerlist}->[$s[0]][5] =~ /Printer Is Okay/)
{$pkg->{Browse}->selection('set' => $s[0],$s[0]);}
}

sub Viewlist
{
my ($e, $pkg) = @_;
if(!$pkg){$pkg = $e;}
				
$pkg->{Browse}->delete(0,'end');



if(!$pkg->{Printerlist})
{
	$pkg->{Browse}->insert('end',"Contact Bug");
	$pkg->{Browse}->insert('end',"No printer available");
	undef $pkg->{"Printer"};
	undef $pkg->{Printerlist};
}
else
{
	foreach(@{$pkg->{Printerlist}})
	{
	$_->[1] = substr($_->[1],0,11);					
	$pkg->{Browse}->insert('end',$_->[1]);
		if(($pkg->{"Printer"})&&($_->[1] =~ /$pkg->{"Printer"}/))
		{
		$pkg->{Browse}->selection('set' => 'end','end');
		$pkg->Testchoice();
		}

	}#foreach in printerlist

}


}

sub Petridishlabel
{
my ($pkg, $offset, $density) = @_;

my $lf		= chr(10);
my $esc		= chr(27);
my $null	= chr(0);

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


# Ensure right label configuaration and alignment
while(length($density) < 2)
{$density = "0$density";}

if(length($density) > 2){$density = "05";}

while(length($offset) < 3)
{$offset = "0$offset";}

if(length($offset) > 3){$offset = "000";}

print $f $esc,"D0111,0920,0075",$lf,$null;
print $f $esc,"AY;+$density,0",$lf,$null;
print $f $esc,"AX;-$offset,+000,+00",$lf,$null;
print $f $esc,"T20C32",$lf,$null;

#DATE
print $f $esc,"PC001;0300,0035,1,1,G,00,B",$lf,$null;
#Human readable Form
print $f $esc,"PC002;0300,0065,1,1,G,00,B",$lf,$null;

#Project
print $f $esc,"PC004;0300,0065,1,1,G,+03,00,B",$lf,$null;
#Suffix
print $f $esc,"PC005;0770,0035,1,1,G,00,B",$lf,$null;

#EAN 13 medium res
print $f $esc,"XB01;0030,0000,5,3,02,0,0070,+0000000000,002,0,00",$lf,$null;

#my $count = 0;

foreach my $l (@{$pkg->{"Label"}})
{
my $bc;
$l->{"Suffix"}	= substr($l->{"Suffix"},0,5);
print $f $esc,"C",$lf,$null;
#bsw
if($l->{"Barcode"} eq 'BREAK')
{
	print $f $esc,"T20C32",$lf,$null;;
}
else
{	my $bc;
	($bc,$l->{"Barcode"}) = $pkg->Calculatebarcode($l->{"Barcode"});
	
	if($bc == -1){close $f; if($pkg->{"Label"}){undef $pkg->{"Label"};} die "ERROR : Invalid Number Type In Sanger Barcode Calculation\n";}
	

while (length($l->{"Barcode"}) < 11)
{$l->{"Barcode"} = " $l->{\"Barcode\"} ";}

$l->{"Name"} 	= substr($l->{"Name"},0,18);
$l->{"Project"}	= substr($l->{"Project"},0,30);

print $f $esc,"PC003;0520,0035,1,1,G,+03,00,B",$lf,$null;

print $f $esc,"RC001;$l->{\"Date\"}",$lf,$null;
if($l->{"Barcode"})	{print $f $esc,"RB01;$bc",$lf,$null;}
if($l->{"Name"})	{print $f $esc,"RC003;$l->{\"Name\"}",$lf,$null;}
if($l->{"Project"})	{print $f $esc,"RC004;$l->{\"Project\"}",$lf,$null;}
if($l->{"Suffix"})	{print $f $esc,"RC005;$l->{\"Suffix\"}",$lf,$null;}

# added transmissive sensor check
print $f $esc,"XS;I,$pkg->{\"Quantity\"},0002C5201",$lf,$null;

}#BREAK if

}
close $f or die "Cannot close pipe to Label Printer : $pkg->{\"Printer\"}";
undef $pkg->{"Label"};
}

sub Labwarelabel
{
my ($pkg, $offset, $density) = @_;

my $lf		= chr(10);
my $esc		= chr(27);
my $null	= chr(0);

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


# Ensure right label configuaration and alignment
while(length($density) < 2)
{$density = "0$density";}

if(length($density) > 2){$density = "05";}

while(length($offset) < 3)
{$offset = "0$offset";}

if(length($offset) > 3){$offset = "000";}

print $f $esc,"D0111,0920,0075",$lf,$null;
print $f $esc,"AY;+$density,0",$lf,$null;
print $f $esc,"AX;-$offset,+000,+00",$lf,$null;
#print $f $esc,"T20C32",$lf,$null;

#DATE
print $f $esc,"PC001;0180,0035,1,1,G,00,B",$lf,$null;

#Project
print $f $esc,"PC002;0180,0065,1,1,G,+03,00,B",$lf,$null;
#Suffix
print $f $esc,"PC003;0500,0035,1,1,G,+03,00,B",$lf,$null;

#Name
print $f $esc,"PC004;0500,0065,1,1,G,+03,00,B",$lf,$null;

#EAN 13 medium res
print $f $esc,"XB01;0030,0000,5,3,01,0,0070,+0000000000,002,0,00",$lf,$null;

#my $count = 0;

foreach my $l (@{$pkg->{"Label"}})
{
my $bc;

print $f $esc,"C",$lf,$null;
#bsw
if($l->{"Barcode"} eq 'BREAK')
{
	print $f $esc,"T20C32",$lf,$null;;
}
else
{	my $bc;
	($bc,$l->{"Barcode"}) = $pkg->Calculatebarcode($l->{"Barcode"});
	
	if($bc == -1){close $f; if($pkg->{"Label"}){undef $pkg->{"Label"};} die "ERROR : Invalid Number Type In Sanger Barcode Calculation\n";}
	

while (length($l->{"Barcode"}) < 11)
{$l->{"Barcode"} = " $l->{\"Barcode\"} ";}

$l->{"Project"}	= substr($l->{"Project"},0,30);


if($l->{"Date"})	{print $f $esc,"RC001;$l->{\"Date\"}",$lf,$null;}
if($l->{"Barcode"})	{print $f $esc,"RB01;$bc",$lf,$null;}
if($l->{"Project"})	{print $f $esc,"RC002;$l->{\"Project\"}",$lf,$null;}

if($l->{"Suffix"}) 
{
	print $f $esc,"RC003;$l->{\"Suffix\"}",$lf,$null;
}
else
{
	print $f $esc,"RC003;LABWARE LABEL",$lf,$null;
}

if($l->{"Name"})	{print $f $esc,"RC004;$l->{\"Name\"}",$lf,$null;}




# added transmissive sensor check
print $f $esc,"XS;I,$pkg->{\"Quantity\"},0002C5201",$lf,$null;

}#BREAK if

}
close $f or die "Cannot close pipe to Label Printer : $pkg->{\"Printer\"}";
undef $pkg->{"Label"};
}




sub Eppendorflabel
{
my ($pkg, $offset, $density) = @_;

my $lf		= chr(10);
my $esc		= chr(27);
my $null	= chr(0);
my $project1;
my $project2;
my $project3;
my $name1;
my $name2;

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


# Ensure right label configuaration and alignment
while(length($density) < 2)
{$density = "0$density";}

if(length($density) > 2){$density = "05";}

while(length($offset) < 3)
{$offset = "0$offset";}

if(length($offset) > 3){$offset = "000";}

print $f $esc,"D0430,0300,0400",$lf,$null;
print $f $esc,"AY;+$density,0",$lf,$null;
print $f $esc,"AX;-$offset,+000,+00",$lf,$null;
print $f $esc,"T20C32",$lf,$null;


#DATE
print $f $esc,"PC001;0030,0210,05,05,H,+03,11,B",$lf,$null;

#Project
print $f $esc,"PC002;0112,0210,05,05,H,+02,11,B",$lf,$null;
print $f $esc,"PC003;0062,0210,05,05,H,+02,11,B",$lf,$null;


#Name (On round Label)
print $f $esc,"PC005;0230,0180,05,1,G,+00,00,B",$lf,$null;
print $f $esc,"PC006;0210,0207,05,1,G,+00,00,B",$lf,$null;

#Suffix (On round label)
print $f $esc,"PC007;0215,0232,05,1,G,+01,00,B",$lf,$null;


print $f $esc,"PC008;0142,0210,05,1,G,+01,11,B",$lf,$null;

#EAN 13 medium res
print $f $esc,"XB01;0035,0100,5,3,01,0,0100,+0000000000,002,0,00",$lf,$null;



print $f $esc,"PC009;0112,0020,05,05,H,+02,11,B",$lf,$null;
print $f $esc,"PC010;0062,0020,05,05,H,+02,11,B",$lf,$null;


########################################
#Printing Batch header
print $f $esc,"C",$lf,$null;
print $f $esc,"RC009;Printed By $pkg->{\"User\"}",$lf,$null;
my $printtime = localtime();
print $f $esc,"RC010;$printtime",$lf,$null;
print $f $esc,"XS;I,0001,0002C5201",$lf,$null;
########################################
print $f $esc,"C",$lf,$null;
foreach my $l (@{$pkg->{"Label"}})
{
my $bc;


#bsw
if($l->{"Barcode"} eq 'BREAK')
{
	print $f $esc,"T20C32",$lf,$null;;
}
else
{	my $bc;
	($bc,$l->{"Barcode"}) = $pkg->Calculatebarcode($l->{"Barcode"});
	
	if($bc == -1){close $f; if($pkg->{"Label"}){undef $pkg->{"Label"};} die "ERROR : Invalid Number Type In Sanger Barcode Calculation\n";}
	

while (length($l->{"Barcode"}) < 11)
{$l->{"Barcode"} = " $l->{\"Barcode\"} ";}

if($l->{"Project"})
{
($project1,$project2) = split /-/,$l->{"Project"};

$project2= "-$project2";

$project1 = substr($project1,0,11);
$project2 = substr($project2,0,11);


#$project1 = substr($l->{"Project"},0,10);
#if (length($l->{"Project"}) > 10){$project2 = substr($l->{"Project"},10,10);}
#else{$project2 = '';}

#if (length($l->{"Project"}) > 20){$project3 = substr($l->{"Project"},20,10);}
#else{$project3 = '';}


}


#$l->{"Suffix"}	= substr($l->{"Suffix"},0,4);


if($l->{"Name"})
{
if (length($l->{"Name"}) < 9)
	{
	$name2 = $l->{"Name"};
	$name1 = '';
	}
elsif((length($l->{"Name"}) == 10)||(length($l->{"Name"}) == 9))
	{
	$name1 = substr($l->{"Name"},0,2);
	$name2 = substr($l->{"Name"},2,8);
	}
else
	{
	$name1 = substr($l->{"Name"},0,7);
	if (length($l->{"Name"}) > 6){$name2 = substr($l->{"Name"},7,8);}
	else{$name2 = '';}
	}
}

print $f $esc,"RC001;$l->{\"Date\"}",$lf,$null;
if($bc)			{print $f $esc,"RB01;$bc",$lf,$null;}
if($project1)		{print $f $esc,"RC002;$project1",$lf,$null;}
if($project2)		{print $f $esc,"RC003;$project2",$lf,$null;}

if($name1)		{print $f $esc,"RC005;$name1",$lf,$null;}
if($name2)		{print $f $esc,"RC006;$name2",$lf,$null;}

if($l->{"Suffix"})	{print $f $esc,"RC007;$l->{\"Suffix\"}",$lf,$null;}

if($l->{"Owner"})	
{
	$l->{"Owner"} = substr($l->{"Owner"},0,12);
	print $f $esc,"RC008;$l->{\"Owner\"}",$lf,$null;

}

# added transmissive sensor check
print $f $esc,"XS;I,$pkg->{\"Quantity\"},0002C5201",$lf,$null;

}#BREAK if

}
close $f or die "Cannot close pipe to Label Printer : $pkg->{\"Printer\"}";
undef $pkg->{"Label"};
}


sub Ligationlabel
{
my ($pkg, $offset, $density) = @_;

my $lf		= chr(10);
my $esc		= chr(27);
my $null	= chr(0);
my $project1;
my $project2;
my $project3;
my $name1;
my $name2;

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


# Ensure right label configuaration and alignment
while(length($density) < 2)
{$density = "0$density";}

if(length($density) > 2){$density = "05";}

while(length($offset) < 3)
{$offset = "0$offset";}

if(length($offset) > 3){$offset = "000";}
print $f $esc,"D0430,0300,0400",$lf,$null;
print $f $esc,"AY;+$density,0",$lf,$null;
print $f $esc,"AX;-$offset,+000,+00",$lf,$null;
print $f $esc,"T20C32",$lf,$null;


#DATE
print $f $esc,"PC001;0030,0210,05,05,H,+03,11,B",$lf,$null;

#Project
print $f $esc,"PC002;0115,0210,05,05,H,+02,11,B",$lf,$null;
print $f $esc,"PC003;0065,0210,05,05,H,+02,11,B",$lf,$null;


#Name (On round Label)
print $f $esc,"PC005;0218,0205,05,1,G,+00,00,B",$lf,$null;


#Suffix (On round label)
print $f $esc,"PC007;0218,0230,05,1,G,+01,00,B",$lf,$null;


print $f $esc,"PC008;0145,0210,05,1,G,+01,11,B",$lf,$null;

#EAN 13 medium res
print $f $esc,"XB01;0035,0100,5,3,01,0,0100,+0000000000,002,0,00",$lf,$null;

print $f $esc,"PC009;0112,0020,05,05,H,+02,11,B",$lf,$null;
print $f $esc,"PC010;0062,0020,05,05,H,+02,11,B",$lf,$null;




########################################
#Printing Batch header
print $f $esc,"C",$lf,$null;
print $f $esc,"RC009;Printed By $pkg->{\"User\"}",$lf,$null;
my $printtime = localtime();
print $f $esc,"RC010;$printtime",$lf,$null;
print $f $esc,"XS;I,0001,0002C5201",$lf,$null;
########################################
print $f $esc,"C",$lf,$null;





foreach my $l (@{$pkg->{"Label"}})
{
my $bc;

print $f $esc,"C",$lf,$null;
#bsw
if($l->{"Barcode"} eq 'BREAK')
{
	print $f $esc,"T20C32",$lf,$null;;
}
else
{	my $bc;
	($bc,$l->{"Barcode"}) = $pkg->Calculatebarcode($l->{"Barcode"});
	
	if($bc == -1){close $f; if($pkg->{"Label"}){undef $pkg->{"Label"};} die "ERROR : Invalid Number Type In Sanger Barcode Calculation\n";}
	

while (length($l->{"Barcode"}) < 11)
{$l->{"Barcode"} = " $l->{\"Barcode\"} ";}

if($l->{"Project"})
{
$project1 = substr($l->{"Project"},0,10);
if (length($l->{"Project"}) > 10){$project2 = substr($l->{"Project"},10,10);}
else{$project2 = '';}

if (length($l->{"Project"}) > 20){$project3 = substr($l->{"Project"},20,10);}
else{$project3 = '';}


}



print $f $esc,"RC001;$l->{\"Date\"}",$lf,$null;
if($bc)			{print $f $esc,"RB01;$bc",$lf,$null;}
if($project1)		{print $f $esc,"RC002;$project1",$lf,$null;}
if($project2)		{print $f $esc,"RC003;$project2",$lf,$null;}

if($l->{"Name"})	{print $f $esc,"RC005;$l->{\"Name\"}",$lf,$null;}

if($l->{"Suffix"})	{print $f $esc,"RC007;$l->{\"Suffix\"}",$lf,$null;}

if($l->{"Owner"})	
{
	$l->{"Owner"} = substr($l->{"Owner"},0,12);
	print $f $esc,"RC008;$l->{\"Owner\"}",$lf,$null;

}

# added transmissive sensor check
print $f $esc,"XS;I,$pkg->{\"Quantity\"},0002C5201",$lf,$null;

}#BREAK if

}
close $f or die "Cannot close pipe to Label Printer : $pkg->{\"Printer\"}";
undef $pkg->{"Label"};
}

















sub Smalltextlabel
{
my ($pkg, $offset, $density) = @_;

my $lf		= chr(10);
my $esc		= chr(27);
my $null	= chr(0);
my $project1;
my $project2;
my $project3;
my $name1;
my $name2;

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


# Ensure right label configuaration and alignment
while(length($density) < 2)
{$density = "0$density";}

if(length($density) > 2){$density = "05";}

while(length($offset) < 3)
{$offset = "0$offset";}

if(length($offset) > 3){$offset = "000";}


print $f $esc,"D0430,0300,0400",$lf,$null;
print $f $esc,"AY;+$density,0",$lf,$null;
print $f $esc,"AX;-$offset,+000,+00",$lf,$null;
print $f $esc,"T20C32",$lf,$null;


#DATE
print $f $esc,"PC001;0030,0210,05,05,H,+03,11,B",$lf,$null;

#Project
print $f $esc,"PC002;0105,0210,05,05,H,+02,11,B",$lf,$null;
print $f $esc,"PC003;0065,0210,05,05,H,+02,11,B",$lf,$null;
print $f $esc,"PC008;0145,0210,05,1,G,+01,11,B",$lf,$null;

#NAME
print $f $esc,"PC005;0235,0188,05,1,G,+00,00,B",$lf,$null;
print $f $esc,"PC006;0220,0215,05,1,G,+00,00,B",$lf,$null;

#Suffix (On round label)
print $f $esc,"PC007;0225,0240,05,1,G,+01,00,B",$lf,$null;

print $f $esc,"PC009;0112,0020,05,05,H,+02,11,B",$lf,$null;
print $f $esc,"PC010;0062,0020,05,05,H,+02,11,B",$lf,$null;

########################################
#Printing Batch header
print $f $esc,"C",$lf,$null;
print $f $esc,"RC009;Printed By $pkg->{\"User\"}",$lf,$null;
my $printtime = localtime();
print $f $esc,"RC010;$printtime",$lf,$null;
print $f $esc,"XS;I,0001,0002C5201",$lf,$null;
########################################
print $f $esc,"C",$lf,$null;

foreach my $l (@{$pkg->{"Label"}})
{


print $f $esc,"C",$lf,$null;

if($l->{"Barcode"} eq 'BREAK')
{
	print $f $esc,"T20C32",$lf,$null;;
}
else
{	

if($l->{"Project"})
{
$project1 = substr($l->{"Project"},0,10);
if (length($l->{"Project"}) > 10){$project2 = substr($l->{"Project"},10,10);}
else{$project2 = '';}

if (length($l->{"Project"}) > 20){$project3 = substr($l->{"Project"},20,10);}
else{$project3 = '';}


}


if($l->{"Name"})
{
if (length($l->{"Name"}) < 9)
	{
	$name2 = $l->{"Name"};
	$name1 = '';
	}
elsif((length($l->{"Name"}) == 10)||(length($l->{"Name"}) == 9))
	{
	$name1 = substr($l->{"Name"},0,2);
	$name2 = substr($l->{"Name"},2,8);
	}
else
	{
	$name1 = substr($l->{"Name"},0,7);
	if (length($l->{"Name"}) > 6){$name2 = substr($l->{"Name"},7,8);}
	else{$name2 = '';}
	}
}

print $f $esc,"RC001;$l->{\"Date\"}",$lf,$null;
if($project1)		{print $f $esc,"RC002;$project1",$lf,$null;}
if($project2)		{print $f $esc,"RC003;$project2",$lf,$null;}

if($name1)		{print $f $esc,"RC005;$name1",$lf,$null;}
if($name2)		{print $f $esc,"RC006;$name2",$lf,$null;}

if($l->{"Suffix"})	{print $f $esc,"RC007;$l->{\"Suffix\"}",$lf,$null;}

if($l->{"Owner"})	
{
	$l->{"Owner"} = substr($l->{"Owner"},0,12);
	print $f $esc,"RC008;$l->{\"Owner\"}",$lf,$null;

}

print $f $esc,"LC;0010,0095,0140,0185,1,2,002",$lf,$null;

# added transmissive sensor check
print $f $esc,"XS;I,$pkg->{\"Quantity\"},0002C5201",$lf,$null;

}#BREAK if

}
close $f or die "Cannot close pipe to Label Printer : $pkg->{\"Printer\"}";
undef $pkg->{"Label"};
}


1;
