Koha/C4/Labels.pm
Ryan Higgins 6e2564450e Adding labels generator.
Signed-off-by: Joshua Ferraro <jmf@liblime.com>
Signed-off-by: Chris Cormack <crc@liblime.com>
2007-08-18 17:39:38 -05:00

1224 lines
32 KiB
Perl
Executable file

package C4::Labels;
# Copyright 2006 Katipo Communications.
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
use strict;
require Exporter;
use vars qw($VERSION @ISA @EXPORT);
use PDF::Reuse;
use Text::Wrap;
use Algorithm::CheckDigits;
# use Data::Dumper;
# use Smart::Comments;
$VERSION = 0.01;
=head1 NAME
C4::Labels - Functions for printing spine labels and barcodes in Koha
=head1 FUNCTIONS
=over 2
=cut
@ISA = qw(Exporter);
@EXPORT = qw(
&get_label_options &get_label_items
&build_circ_barcode &draw_boundaries
&drawbox &GetActiveLabelTemplate
&GetAllLabelTemplates &DeleteTemplate
&GetSingleLabelTemplate &SaveTemplate
&CreateTemplate &SetActiveTemplate
&SaveConf &DrawSpineText &GetTextWrapCols
&GetUnitsValue &DrawBarcode
&get_printingtypes
&get_layouts
&get_barcode_types
&get_batches &delete_batch
&add_batch &SetFontSize &printText
&GetItemFields
&get_text_fields
get_layout &save_layout &add_layout
&set_active_layout &by_order
&build_text_dropbox
&delete_layout &get_active_layout
&get_highest_batch
);
=item get_label_options;
$options = get_label_options()
Return a pointer on a hash list containing info from labels_conf table in Koha DB.
=cut
#'
sub get_label_options {
my $dbh = C4::Context->dbh;
my $query2 = " SELECT * FROM labels_conf where active = 1";
my $sth = $dbh->prepare($query2);
$sth->execute();
my $conf_data = $sth->fetchrow_hashref;
$sth->finish;
return $conf_data;
}
sub get_layouts {
## FIXME: this if/else could be compacted...
my $dbh = C4::Context->dbh;
my @data;
my $query = " Select * from labels_conf";
my $sth = $dbh->prepare($query);
$sth->execute();
my @resultsloop;
while ( my $data = $sth->fetchrow_hashref ) {
$data->{'fieldlist'} = get_text_fields( $data->{'id'} );
push( @resultsloop, $data );
}
$sth->finish;
# @resultsloop
return @resultsloop;
}
sub get_layout {
my ($layout_id) = @_;
my $dbh = C4::Context->dbh;
# get the actual items to be printed.
my $query = " Select * from labels_conf where id = ?";
my $sth = $dbh->prepare($query);
$sth->execute($layout_id);
my $data = $sth->fetchrow_hashref;
$sth->finish;
return $data;
}
sub get_active_layout {
my ($layout_id) = @_;
my $dbh = C4::Context->dbh;
# get the actual items to be printed.
my $query = " Select * from labels_conf where active = 1";
my $sth = $dbh->prepare($query);
$sth->execute();
my $data = $sth->fetchrow_hashref;
$sth->finish;
return $data;
}
sub delete_layout {
my ($layout_id) = @_;
my $dbh = C4::Context->dbh;
# get the actual items to be printed.
my $query = "delete from labels_conf where id = ?";
my $sth = $dbh->prepare($query);
$sth->execute($layout_id);
$sth->finish;
}
sub get_printingtypes {
my ($layout_id) = @_;
my @printtypes;
push( @printtypes, { code => 'BAR', desc => "barcode" } );
push( @printtypes, { code => 'BIB', desc => "biblio" } );
push( @printtypes, { code => 'BARBIB', desc => "barcode / biblio" } );
push( @printtypes, { code => 'BIBBAR', desc => "biblio / barcode" } );
push( @printtypes, { code => 'ALT', desc => "alternating labels" } );
my $conf = get_layout($layout_id);
my $active_printtype = $conf->{'printingtype'};
# lop thru layout, insert selected to hash
foreach my $printtype (@printtypes) {
if ( $printtype->{'code'} eq $active_printtype ) {
$printtype->{'active'} = 'MOO';
}
}
return @printtypes;
}
sub build_text_dropbox {
my ($order) = @_;
# my @fields = get_text_fields();
# my $field_count = scalar @fields;
my $field_count = 10; # <----------- FIXME hard coded
my @lines;
!$order
? push( @lines, { num => '', selected => '1' } )
: push( @lines, { num => '' } );
for ( my $i = 1 ; $i <= $field_count ; $i++ ) {
my $line = { num => "$i" };
$line->{'selected'} = 1 if $i eq $order;
push( @lines, $line );
}
# add a blank row too
return @lines;
}
sub get_text_fields {
my ($layout_id, $sorttype) = @_;
my ( $a, $b, $c, $d, $e, $f, $g, $h, $i ,$j, $k );
my $sortorder = get_layout($layout_id);
# $sortorder
$a = {
code => 'itemtype',
desc => "Item Type",
order => $sortorder->{'itemtype'}
};
$b = {
code => 'dewey',
desc => "Dewey",
order => $sortorder->{'dewey'}
};
$c = { code => 'issn', desc => "ISSN",
order => $sortorder->{'issn'} };
$d = { code => 'isbn', desc => "ISBN",
order => $sortorder->{'isbn'} };
$e = {
code => 'class',
desc => "Classification",
order => $sortorder->{'class'}
};
$f = {
code => 'subclass',
desc => "Sub-Class",
order => $sortorder->{'subclass'}
};
$g = {
code => 'barcode',
desc => "Barcode",
order => $sortorder->{'barcode'}
};
$h =
{ code => 'author', desc => "Author", order => $sortorder->{'author'} };
$i = { code => 'title', desc => "Title", order => $sortorder->{'title'} };
$j = { code => 'itemcallnumber', desc => "Call Number", order => $sortorder->{'itemcallnumber'} };
$k = { code => 'subtitle', desc => "Subtitle", order => $sortorder->{'subtitle'} };
my @text_fields = ( $a, $b, $c, $d, $e, $f, $g, $h, $i ,$j, $k );
my @new_fields;
foreach my $field (@text_fields) {
push( @new_fields, $field ) if $field->{'order'} > 0;
}
my @sorted_fields = sort by_order @new_fields;
my $active_fields;
foreach my $field (@sorted_fields) {
$sorttype eq 'codes' ? $active_fields .= "$field->{'code'} " :
$active_fields .= "$field->{'desc'} ";
}
return $active_fields;
}
sub by_order {
$$a{order} <=> $$b{order};
}
sub add_batch {
my $new_batch;
my $dbh = C4::Context->dbh;
my $q =
"select distinct batch_id from labels order by batch_id desc limit 1";
my $sth = $dbh->prepare($q);
$sth->execute();
my $data = $sth->fetchrow_hashref;
$sth->finish;
if ( !$data->{'batch_id'} ) {
$new_batch = 1;
}
else {
$new_batch = ( $data->{'batch_id'} + 1 );
}
return $new_batch;
}
sub get_highest_batch {
my $new_batch;
my $dbh = C4::Context->dbh;
my $q =
"select distinct batch_id from labels order by batch_id desc limit 1";
my $sth = $dbh->prepare($q);
$sth->execute();
my $data = $sth->fetchrow_hashref;
$sth->finish;
if ( !$data->{'batch_id'} ) {
$new_batch = 1;
}
else {
$new_batch = $data->{'batch_id'};
}
return $new_batch;
}
sub get_batches {
my $dbh = C4::Context->dbh;
my $q = "select batch_id, count(*) as num from labels group by batch_id";
my $sth = $dbh->prepare($q);
$sth->execute();
my @resultsloop;
while ( my $data = $sth->fetchrow_hashref ) {
push( @resultsloop, $data );
}
$sth->finish;
# adding a dummy batch=1 value , if none exists in the db
if ( !scalar(@resultsloop) ) {
push( @resultsloop, { batch_id => '1' , num => '0' } );
}
return @resultsloop;
}
sub delete_batch {
my ($batch_id) = @_;
my $dbh = C4::Context->dbh;
my $q = "DELETE FROM labels where batch_id = ?";
my $sth = $dbh->prepare($q);
$sth->execute($batch_id);
$sth->finish;
}
sub get_barcode_types {
my ($layout_id) = @_;
my $layout = get_layout($layout_id);
my $barcode = $layout->{'barcodetype'};
my @array;
push( @array, { code => 'CODE39', desc => 'Code 39' } );
push( @array, { code => 'CODE39MOD', desc => 'Code39 + Modulo43' } );
push( @array, { code => 'CODE39MOD10', desc => 'Code39 + Modulo10' } );
push( @array, { code => 'ITF', desc => 'Interleaved 2 of 5' } );
foreach my $line (@array) {
if ( $line->{'code'} eq $barcode ) {
$line->{'active'} = 1;
}
}
return @array;
}
sub GetUnitsValue {
my ($units) = @_;
my $unitvalue;
$unitvalue = '1' if ( $units eq 'POINT' );
$unitvalue = '2.83464567' if ( $units eq 'MM' );
$unitvalue = '28.3464567' if ( $units eq 'CM' );
$unitvalue = 72 if ( $units eq 'INCH' );
return $unitvalue;
}
sub GetTextWrapCols {
my ( $fontsize, $label_width ) = @_;
my $string = "0";
my $left_text_margin = 3;
my ( $strtmp, $strwidth );
my $count = 0;
my $textlimit = $label_width - $left_text_margin;
while ( $strwidth < $textlimit ) {
$strwidth = prStrWidth( $string, 'C', $fontsize );
$string = $string . '0';
# warn "strwidth $strwidth, $textlimit, $string";
$count++;
}
return $count;
}
sub GetActiveLabelTemplate {
my $dbh = C4::Context->dbh;
my $query = " SELECT * FROM labels_templates where active = 1 limit 1";
my $sth = $dbh->prepare($query);
$sth->execute();
my $active_tmpl = $sth->fetchrow_hashref;
$sth->finish;
return $active_tmpl;
}
sub GetSingleLabelTemplate {
my ($tmpl_id) = @_;
my $dbh = C4::Context->dbh;
my $query = " SELECT * FROM labels_templates where tmpl_id = ?";
my $sth = $dbh->prepare($query);
$sth->execute($tmpl_id);
my $template = $sth->fetchrow_hashref;
$sth->finish;
return $template;
}
sub SetActiveTemplate {
my ($tmpl_id) = @_;
my $dbh = C4::Context->dbh;
my $query = " UPDATE labels_templates SET active = NULL";
my $sth = $dbh->prepare($query);
$sth->execute();
my $query = "UPDATE labels_templates SET active = 1 WHERE tmpl_id = ?";
my $sth = $dbh->prepare($query);
$sth->execute($tmpl_id);
$sth->finish;
}
sub set_active_layout {
my ($layout_id) = @_;
my $dbh = C4::Context->dbh;
my $query = " UPDATE labels_conf SET active = NULL";
my $sth = $dbh->prepare($query);
$sth->execute();
my $query = "UPDATE labels_conf SET active = 1 WHERE id = ?";
my $sth = $dbh->prepare($query);
$sth->execute($layout_id);
$sth->finish;
}
sub DeleteTemplate {
my ($tmpl_id) = @_;
my $dbh = C4::Context->dbh;
my $query = " DELETE FROM labels_templates where tmpl_id = ?";
my $sth = $dbh->prepare($query);
$sth->execute($tmpl_id);
$sth->finish;
}
sub SaveTemplate {
my (
$tmpl_id, $tmpl_code, $tmpl_desc, $page_width,
$page_height, $label_width, $label_height, $topmargin,
$leftmargin, $cols, $rows, $colgap,
$rowgap, $fontsize, $units
) = @_;
my $dbh = C4::Context->dbh;
my $query =
" UPDATE labels_templates SET tmpl_code=?, tmpl_desc=?, page_width=?,
page_height=?, label_width=?, label_height=?, topmargin=?,
leftmargin=?, cols=?, rows=?, colgap=?, rowgap=?, fontsize=?,
units=?
WHERE tmpl_id = ?";
my $sth = $dbh->prepare($query);
$sth->execute(
$tmpl_code, $tmpl_desc, $page_width, $page_height,
$label_width, $label_height, $topmargin, $leftmargin,
$cols, $rows, $colgap, $rowgap,
$fontsize, $units, $tmpl_id
);
$sth->finish;
}
sub CreateTemplate {
my $tmpl_id;
my (
$tmpl_code, $tmpl_desc, $page_width, $page_height,
$label_width, $label_height, $topmargin, $leftmargin,
$cols, $rows, $colgap, $rowgap,
$fontsize, $units
) = @_;
my $dbh = C4::Context->dbh;
my $query = "INSERT INTO labels_templates (tmpl_code, tmpl_desc, page_width,
page_height, label_width, label_height, topmargin,
leftmargin, cols, rows, colgap, rowgap, fontsize, units)
VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?,?)";
my $sth = $dbh->prepare($query);
$sth->execute(
$tmpl_code, $tmpl_desc, $page_width, $page_height,
$label_width, $label_height, $topmargin, $leftmargin,
$cols, $rows, $colgap, $rowgap,
$fontsize, $units
);
}
sub GetAllLabelTemplates {
my $dbh = C4::Context->dbh;
# get the actual items to be printed.
my @data;
my $query = " Select * from labels_templates ";
my $sth = $dbh->prepare($query);
$sth->execute();
my @resultsloop;
while ( my $data = $sth->fetchrow_hashref ) {
push( @resultsloop, $data );
}
$sth->finish;
#warn Dumper @resultsloop;
return @resultsloop;
}
#sub SaveConf {
sub add_layout {
my (
$barcodetype, $title, $subtitle, $isbn, $issn,
$itemtype, $bcn, $dcn, $classif,
$subclass, $itemcallnumber, $author, $tmpl_id,
$printingtype, $guidebox, $startlabel, $layoutname
) = @_;
my $dbh = C4::Context->dbh;
my $query2 = "update labels_conf set active = NULL";
my $sth2 = $dbh->prepare($query2);
$sth2->execute();
my $query2 = "INSERT INTO labels_conf
( barcodetype, title, subtitle, isbn,issn, itemtype, barcode,
dewey, class, subclass, itemcallnumber, author, printingtype,
guidebox, startlabel, layoutname, active )
values ( ?, ?, ?, ?, ?, ?, ?, ?,?, ?, ?, ?, ?, ?,?,?, 1 )";
my $sth2 = $dbh->prepare($query2);
$sth2->execute(
$barcodetype, $title, $subtitle, $isbn, $issn,
$itemtype, $bcn, $dcn, $classif,
$subclass, $itemcallnumber, $author, $printingtype,
$guidebox, $startlabel, $layoutname
);
$sth2->finish;
SetActiveTemplate($tmpl_id);
return;
}
sub save_layout {
my (
$barcodetype, $title, $subtitle, $isbn, $issn,
$itemtype, $bcn, $dcn, $classif,
$subclass, $itemcallnumber, $author, $tmpl_id,
$printingtype, $guidebox, $startlabel, $layoutname,
$layout_id
) = @_;
### $layoutname
### $layout_id
my $dbh = C4::Context->dbh;
my $query2 = "update labels_conf set
barcodetype=?, title=?, subtitle=?, isbn=?,issn=?,
itemtype=?, barcode=?, dewey=?, class=?,
subclass=?, itemcallnumber=?, author=?, printingtype=?,
guidebox=?, startlabel=?, layoutname=? where id = ?";
my $sth2 = $dbh->prepare($query2);
$sth2->execute(
$barcodetype, $title, $subtitle, $isbn, $issn,
$itemtype, $bcn, $dcn, $classif,
$subclass, $itemcallnumber, $author, $printingtype,
$guidebox, $startlabel, $layoutname, $layout_id
);
$sth2->finish;
return;
}
=item get_label_items;
$options = get_label_items()
Returns an array of references-to-hash, whos keys are the field from the biblio, biblioitems, items and labels tables in the Koha database.
=cut
#'
sub get_label_items {
my ($batch_id) = @_;
my $dbh = C4::Context->dbh;
my @resultsloop = ();
my $count;
my @data;
my $sth;
if ($batch_id) {
my $query3 = "Select * from labels where batch_id = ? order by labelid ";
$sth = $dbh->prepare($query3);
$sth->execute($batch_id);
}
else {
my $query3 = "Select * from labels";
$sth = $dbh->prepare($query3);
$sth->execute();
}
my $cnt = $sth->rows;
my $i1 = 1;
while ( my $data = $sth->fetchrow_hashref ) {
# lets get some summary info from each item
my $query1 = "
select i.*, bi.*, b.* from items i,biblioitems bi,biblio b
where itemnumber=? and i.biblioitemnumber=bi.biblioitemnumber and
bi.biblionumber=b.biblionumber";
my $sth1 = $dbh->prepare($query1);
$sth1->execute( $data->{'itemnumber'} );
my $data1 = $sth1->fetchrow_hashref();
$data1->{'labelno'} = $i1;
$data1->{'batch_id'} = $batch_id;
$data1->{'summary'} =
"$data1->{'barcode'}, $data1->{'title'}, $data1->{'isbn'}";
push( @resultsloop, $data1 );
$sth1->finish;
$i1++;
}
$sth->finish;
return @resultsloop;
}
sub GetItemFields {
my @fields = qw (
barcode title subtitle
dewey isbn issn author class
itemtype subclass itemcallnumber
);
return @fields;
}
sub DrawSpineText {
my ( $y_pos, $label_height, $fontsize, $x_pos, $left_text_margin,
$text_wrap_cols, $item, $conf_data )
= @_;
# hack to fix column name mismatch betwen labels_conf.class, and bibitems.classification
$$item->{'class'} = $$item->{'classification'};
$Text::Wrap::columns = $text_wrap_cols;
$Text::Wrap::separator = "\n";
my $str;
## $item
my $top_text_margin = ( $fontsize + 3 );
my $line_spacer = ($fontsize); # number of pixels between text rows.
# add your printable fields manually in here
my $layout_id = $$conf_data->{'id'};
# my @fields = GetItemFields();
my $str_fields = get_text_fields($layout_id, 'codes' );
my @fields = split(/ /, $str_fields);
### @fields
my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
my $hPos = ( $x_pos + $left_text_margin );
# warn Dumper $conf_data;
#warn Dumper $item;
foreach my $field (@fields) {
# testing hack
# $$item->{"$field"} = $field . ": " . $$item->{"$field"};
# if the display option for this field is selected in the DB,
# and the item record has some values for this field, display it.
if ( $$conf_data->{"$field"} && $$item->{"$field"} ) {
# warn "CONF_TYPE = $field";
# get the string
$str = $$item->{"$field"};
# strip out naughty existing nl/cr's
$str =~ s/\n//g;
$str =~ s/\r//g;
# chop the string up into _upto_ 12 chunks
# and seperate the chunks with newlines
$str = wrap( "", "", "$str" );
$str = wrap( "", "", "$str" );
# split the chunks between newline's, into an array
my @strings = split /\n/, $str;
# then loop for each string line
foreach my $str (@strings) {
#warn "HPOS , VPOS $hPos, $vPos ";
# set the font size A
# prText( $hPos, $vPos, $str );
PrintText( $hPos, $vPos, $fontsize, $str );
$vPos = $vPos - $line_spacer;
}
} # if field is } #foreach feild
}
}
sub PrintText {
my ( $hPos, $vPos, $fontsize, $text ) = @_;
my $str = "BT /Ft1 $fontsize Tf $hPos $vPos Td ($text) Tj ET";
prAdd($str);
}
sub SetFontSize {
my ($fontsize) = @_;
### fontsize
my $str = "BT/F13 30 Tf288 720 Td( AAAAAAAAAA ) TjET";
prAdd($str);
}
sub DrawBarcode {
# x and y are from the top-left :)
my ( $x_pos, $y_pos, $height, $width, $barcode, $barcodetype ) = @_;
my $num_of_bars = length($barcode);
my $bar_width = $width * .8; # %80 of length of label width
my $tot_bar_length;
my $bar_length;
my $guard_length = 10;
my $xsize_ratio;
if ( $barcodetype eq 'CODE39' ) {
$bar_length = '17.5';
$tot_bar_length =
( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
$xsize_ratio = ( $bar_width / $tot_bar_length );
eval {
PDF::Reuse::Barcode::Code39(
x => ( $x_pos + ( $width / 10 ) ),
y => ( $y_pos + ( $height / 10 ) ),
value => "*$barcode*",
ySize => ( .02 * $height ),
xSize => $xsize_ratio,
hide_asterisk => 1,
);
};
if ($@) {
warn "$barcodetype, $barcode FAILED:$@";
}
}
elsif ( $barcodetype eq 'CODE39MOD' ) {
# get modulo43 checksum
my $c39 = CheckDigits('code_39');
$barcode = $c39->complete($barcode);
$bar_length = '19';
$tot_bar_length =
( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
$xsize_ratio = ( $bar_width / $tot_bar_length );
eval {
PDF::Reuse::Barcode::Code39(
x => ( $x_pos + ( $width / 10 ) ),
y => ( $y_pos + ( $height / 10 ) ),
value => "*$barcode*",
ySize => ( .02 * $height ),
xSize => $xsize_ratio,
hide_asterisk => 1,
);
};
if ($@) {
warn "$barcodetype, $barcode FAILED:$@";
}
}
elsif ( $barcodetype eq 'CODE39MOD10' ) {
# get modulo43 checksum
my $c39_10 = CheckDigits('visa');
$barcode = $c39_10->complete($barcode);
$bar_length = '19';
$tot_bar_length =
( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
$xsize_ratio = ( $bar_width / $tot_bar_length );
eval {
PDF::Reuse::Barcode::Code39(
x => ( $x_pos + ( $width / 10 ) ),
y => ( $y_pos + ( $height / 10 ) ),
value => "*$barcode*",
ySize => ( .02 * $height ),
xSize => $xsize_ratio,
hide_asterisk => 1,
text => 0,
);
};
if ($@) {
warn "$barcodetype, $barcode FAILED:$@";
}
}
elsif ( $barcodetype eq 'COOP2OF5' ) {
$bar_length = '9.43333333333333';
$tot_bar_length =
( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
$xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
eval {
PDF::Reuse::Barcode::COOP2of5(
x => ( $x_pos + ( $width / 10 ) ),
y => ( $y_pos + ( $height / 10 ) ),
value => $barcode,
ySize => ( .02 * $height ),
xSize => $xsize_ratio,
);
};
if ($@) {
warn "$barcodetype, $barcode FAILED:$@";
}
}
elsif ( $barcodetype eq 'INDUSTRIAL2OF5' ) {
$bar_length = '13.1333333333333';
$tot_bar_length =
( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
$xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
eval {
PDF::Reuse::Barcode::Industrial2of5(
x => ( $x_pos + ( $width / 10 ) ),
y => ( $y_pos + ( $height / 10 ) ),
value => $barcode,
ySize => ( .02 * $height ),
xSize => $xsize_ratio,
);
};
if ($@) {
warn "$barcodetype, $barcode FAILED:$@";
}
}
my $moo2 = $tot_bar_length * $xsize_ratio;
warn " $x_pos, $y_pos, $barcode, $barcodetype\n";
warn
"BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length R*TOT.BAR =$moo2 \n";
}
=item build_circ_barcode;
build_circ_barcode( $x_pos, $y_pos, $barcode,
$barcodetype, \$item);
$item is the result of a previous call to get_label_items();
=cut
#'
sub build_circ_barcode {
my ( $x_pos_circ, $y_pos, $value, $barcodetype, $item ) = @_;
#warn Dumper \$item;
#warn "value = $value\n";
#$DB::single = 1;
if ( $barcodetype eq 'EAN13' ) {
#testing EAN13 barcodes hack
$value = $value . '000000000';
$value =~ s/-//;
$value = substr( $value, 0, 12 );
#warn $value;
eval {
PDF::Reuse::Barcode::EAN13(
x => ( $x_pos_circ + 27 ),
y => ( $y_pos + 15 ),
value => $value,
# prolong => 2.96,
# xSize => 1.5,
# ySize => 1.2,
# added for xpdf compat. doesnt use type3 fonts., but increases filesize from 20k to 200k
# i think its embedding extra fonts in the pdf file.
# mode => 'graphic',
);
};
if ($@) {
$item->{'barcodeerror'} = 1;
#warn "EAN13BARCODE FAILED:$@";
}
#warn $barcodetype;
}
elsif ( $barcodetype eq 'Code39' ) {
eval {
PDF::Reuse::Barcode::Code39(
x => ( $x_pos_circ + 9 ),
y => ( $y_pos + 15 ),
value => $value,
# prolong => 2.96,
xSize => .85,
ySize => 1.3,
);
};
if ($@) {
$item->{'barcodeerror'} = 1;
#warn "CODE39BARCODE $value FAILED:$@";
}
#warn $barcodetype;
}
elsif ( $barcodetype eq 'Matrix2of5' ) {
#warn "MATRIX ELSE:";
#testing MATRIX25 barcodes hack
# $value = $value.'000000000';
$value =~ s/-//;
# $value = substr( $value, 0, 12 );
#warn $value;
eval {
PDF::Reuse::Barcode::Matrix2of5(
x => ( $x_pos_circ + 27 ),
y => ( $y_pos + 15 ),
value => $value,
# prolong => 2.96,
# xSize => 1.5,
# ySize => 1.2,
);
};
if ($@) {
$item->{'barcodeerror'} = 1;
#warn "BARCODE FAILED:$@";
}
#warn $barcodetype;
}
elsif ( $barcodetype eq 'EAN8' ) {
#testing ean8 barcodes hack
$value = $value . '000000000';
$value =~ s/-//;
$value = substr( $value, 0, 8 );
#warn $value;
#warn "EAN8 ELSEIF";
eval {
PDF::Reuse::Barcode::EAN8(
x => ( $x_pos_circ + 42 ),
y => ( $y_pos + 15 ),
value => $value,
prolong => 2.96,
xSize => 1.5,
# ySize => 1.2,
);
};
if ($@) {
$item->{'barcodeerror'} = 1;
#warn "BARCODE FAILED:$@";
}
#warn $barcodetype;
}
elsif ( $barcodetype eq 'UPC-E' ) {
eval {
PDF::Reuse::Barcode::UPCE(
x => ( $x_pos_circ + 27 ),
y => ( $y_pos + 15 ),
value => $value,
prolong => 2.96,
xSize => 1.5,
# ySize => 1.2,
);
};
if ($@) {
$item->{'barcodeerror'} = 1;
#warn "BARCODE FAILED:$@";
}
#warn $barcodetype;
}
elsif ( $barcodetype eq 'NW7' ) {
eval {
PDF::Reuse::Barcode::NW7(
x => ( $x_pos_circ + 27 ),
y => ( $y_pos + 15 ),
value => $value,
prolong => 2.96,
xSize => 1.5,
# ySize => 1.2,
);
};
if ($@) {
$item->{'barcodeerror'} = 1;
#warn "BARCODE FAILED:$@";
}
#warn $barcodetype;
}
elsif ( $barcodetype eq 'ITF' ) {
eval {
PDF::Reuse::Barcode::ITF(
x => ( $x_pos_circ + 27 ),
y => ( $y_pos + 15 ),
value => $value,
prolong => 2.96,
xSize => 1.5,
# ySize => 1.2,
);
};
if ($@) {
$item->{'barcodeerror'} = 1;
#warn "BARCODE FAILED:$@";
}
#warn $barcodetype;
}
elsif ( $barcodetype eq 'Industrial2of5' ) {
eval {
PDF::Reuse::Barcode::Industrial2of5(
x => ( $x_pos_circ + 27 ),
y => ( $y_pos + 15 ),
value => $value,
prolong => 2.96,
xSize => 1.5,
# ySize => 1.2,
);
};
if ($@) {
$item->{'barcodeerror'} = 1;
#warn "BARCODE FAILED:$@";
}
#warn $barcodetype;
}
elsif ( $barcodetype eq 'IATA2of5' ) {
eval {
PDF::Reuse::Barcode::IATA2of5(
x => ( $x_pos_circ + 27 ),
y => ( $y_pos + 15 ),
value => $value,
prolong => 2.96,
xSize => 1.5,
# ySize => 1.2,
);
};
if ($@) {
$item->{'barcodeerror'} = 1;
#warn "BARCODE FAILED:$@";
}
#warn $barcodetype;
}
elsif ( $barcodetype eq 'COOP2of5' ) {
eval {
PDF::Reuse::Barcode::COOP2of5(
x => ( $x_pos_circ + 27 ),
y => ( $y_pos + 15 ),
value => $value,
prolong => 2.96,
xSize => 1.5,
# ySize => 1.2,
);
};
if ($@) {
$item->{'barcodeerror'} = 1;
#warn "BARCODE FAILED:$@";
}
#warn $barcodetype;
}
elsif ( $barcodetype eq 'UPC-A' ) {
eval {
PDF::Reuse::Barcode::UPCA(
x => ( $x_pos_circ + 27 ),
y => ( $y_pos + 15 ),
value => $value,
prolong => 2.96,
xSize => 1.5,
# ySize => 1.2,
);
};
if ($@) {
$item->{'barcodeerror'} = 1;
#warn "BARCODE FAILED:$@";
}
#warn $barcodetype;
}
}
=item draw_boundaries
sub draw_boundaries ($x_pos_spine, $x_pos_circ1, $x_pos_circ2,
$y_pos, $spine_width, $label_height, $circ_width)
This sub draws boundary lines where the label outlines are, to aid in printer testing, and debugging.
=cut
#'
sub draw_boundaries {
my (
$x_pos_spine, $x_pos_circ1, $x_pos_circ2, $y_pos,
$spine_width, $label_height, $circ_width
) = @_;
my $y_pos_initial = ( ( 792 - 36 ) - 90 );
my $y_pos = $y_pos_initial;
my $i = 1;
for ( $i = 1 ; $i <= 8 ; $i++ ) {
&drawbox( $x_pos_spine, $y_pos, ($spine_width), ($label_height) );
#warn "OLD BOXES x=$x_pos_spine, y=$y_pos, w=$spine_width, h=$label_height";
&drawbox( $x_pos_circ1, $y_pos, ($circ_width), ($label_height) );
&drawbox( $x_pos_circ2, $y_pos, ($circ_width), ($label_height) );
$y_pos = ( $y_pos - $label_height );
}
}
=item drawbox
sub drawbox { $lower_left_x, $lower_left_y,
$upper_right_x, $upper_right_y )
this is a low level sub, that draws a pdf box, it is called by draw_boxes
FYI: the $upper_right_x and $upper_right_y values are RELATIVE to $lower_left_x and $lower_left_y
and $lower_left_x, $lower_left_y are ABSOLUTE, this caught me out!
=cut
#'
sub drawbox {
my ( $llx, $lly, $urx, $ury ) = @_;
# warn "llx,y= $llx,$lly , urx,y=$urx,$ury \n";
my $str = "q\n"; # save the graphic state
$str .= "0.5 w\n"; # border color red
$str .= "1.0 0.0 0.0 RG\n"; # border color red
# $str .= "0.5 0.75 1.0 rg\n"; # fill color blue
$str .= "1.0 1.0 1.0 rg\n"; # fill color white
$str .= "$llx $lly $urx $ury re\n"; # a rectangle
$str .= "B\n"; # fill (and a little more)
$str .= "Q\n"; # save the graphic state
prAdd($str);
}
END { } # module clean-up code here (global destructor)
1;
__END__
=back
=head1 AUTHOR
Mason James <mason@katipo.co.nz>
=cut