3 # Copyright 2006 Katipo Communications.
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
23 use vars qw($VERSION @ISA @EXPORT);
27 use Algorithm::CheckDigits;
29 # use Smart::Comments;
35 C4::Labels - Functions for printing spine labels and barcodes in Koha
45 &get_label_options &get_label_items
46 &build_circ_barcode &draw_boundaries
47 &drawbox &GetActiveLabelTemplate
48 &GetAllLabelTemplates &DeleteTemplate
49 &GetSingleLabelTemplate &SaveTemplate
50 &CreateTemplate &SetActiveTemplate
51 &SaveConf &DrawSpineText &GetTextWrapCols
52 &GetUnitsValue &DrawBarcode
56 &get_batches &delete_batch
57 &add_batch &SetFontSize &printText
60 get_layout &save_layout &add_layout
61 &set_active_layout &by_order
63 &delete_layout &get_active_layout
67 =item get_label_options;
69 $options = get_label_options()
72 Return a pointer on a hash list containing info from labels_conf table in Koha DB.
77 sub get_label_options {
78 my $dbh = C4::Context->dbh;
79 my $query2 = " SELECT * FROM labels_conf where active = 1";
80 my $sth = $dbh->prepare($query2);
82 my $conf_data = $sth->fetchrow_hashref;
89 ## FIXME: this if/else could be compacted...
90 my $dbh = C4::Context->dbh;
92 my $query = " Select * from labels_conf";
93 my $sth = $dbh->prepare($query);
96 while ( my $data = $sth->fetchrow_hashref ) {
98 $data->{'fieldlist'} = get_text_fields( $data->{'id'} );
99 push( @resultsloop, $data );
109 my ($layout_id) = @_;
110 my $dbh = C4::Context->dbh;
112 # get the actual items to be printed.
113 my $query = " Select * from labels_conf where id = ?";
114 my $sth = $dbh->prepare($query);
115 $sth->execute($layout_id);
116 my $data = $sth->fetchrow_hashref;
121 sub get_active_layout {
122 my ($layout_id) = @_;
123 my $dbh = C4::Context->dbh;
125 # get the actual items to be printed.
126 my $query = " Select * from labels_conf where active = 1";
127 my $sth = $dbh->prepare($query);
129 my $data = $sth->fetchrow_hashref;
135 my ($layout_id) = @_;
136 my $dbh = C4::Context->dbh;
138 # get the actual items to be printed.
139 my $query = "delete from labels_conf where id = ?";
140 my $sth = $dbh->prepare($query);
141 $sth->execute($layout_id);
145 sub get_printingtypes {
146 my ($layout_id) = @_;
149 push( @printtypes, { code => 'BAR', desc => "barcode" } );
150 push( @printtypes, { code => 'BIB', desc => "biblio" } );
151 push( @printtypes, { code => 'BARBIB', desc => "barcode / biblio" } );
152 push( @printtypes, { code => 'BIBBAR', desc => "biblio / barcode" } );
153 push( @printtypes, { code => 'ALT', desc => "alternating labels" } );
155 my $conf = get_layout($layout_id);
156 my $active_printtype = $conf->{'printingtype'};
158 # lop thru layout, insert selected to hash
160 foreach my $printtype (@printtypes) {
161 if ( $printtype->{'code'} eq $active_printtype ) {
162 $printtype->{'active'} = 'MOO';
168 sub build_text_dropbox {
171 # my @fields = get_text_fields();
172 # my $field_count = scalar @fields;
173 my $field_count = 10; # <----------- FIXME hard coded
177 ? push( @lines, { num => '', selected => '1' } )
178 : push( @lines, { num => '' } );
179 for ( my $i = 1 ; $i <= $field_count ; $i++ ) {
180 my $line = { num => "$i" };
181 $line->{'selected'} = 1 if $i eq $order;
182 push( @lines, $line );
185 # add a blank row too
190 sub get_text_fields {
191 my ($layout_id, $sorttype) = @_;
193 my ( $a, $b, $c, $d, $e, $f, $g, $h, $i ,$j, $k );
195 my $sortorder = get_layout($layout_id);
202 order => $sortorder->{'itemtype'}
207 order => $sortorder->{'dewey'}
209 $c = { code => 'issn', desc => "ISSN",
210 order => $sortorder->{'issn'} };
211 $d = { code => 'isbn', desc => "ISBN",
212 order => $sortorder->{'isbn'} };
215 desc => "Classification",
216 order => $sortorder->{'class'}
221 order => $sortorder->{'subclass'}
226 order => $sortorder->{'barcode'}
229 { code => 'author', desc => "Author", order => $sortorder->{'author'} };
230 $i = { code => 'title', desc => "Title", order => $sortorder->{'title'} };
231 $j = { code => 'itemcallnumber', desc => "Call Number", order => $sortorder->{'itemcallnumber'} };
232 $k = { code => 'subtitle', desc => "Subtitle", order => $sortorder->{'subtitle'} };
234 my @text_fields = ( $a, $b, $c, $d, $e, $f, $g, $h, $i ,$j, $k );
237 foreach my $field (@text_fields) {
238 push( @new_fields, $field ) if $field->{'order'} > 0;
241 my @sorted_fields = sort by_order @new_fields;
243 foreach my $field (@sorted_fields) {
244 $sorttype eq 'codes' ? $active_fields .= "$field->{'code'} " :
245 $active_fields .= "$field->{'desc'} ";
247 return $active_fields;
252 $$a{order} <=> $$b{order};
257 my $dbh = C4::Context->dbh;
259 "select distinct batch_id from labels order by batch_id desc limit 1";
260 my $sth = $dbh->prepare($q);
262 my $data = $sth->fetchrow_hashref;
265 if ( !$data->{'batch_id'} ) {
269 $new_batch = ( $data->{'batch_id'} + 1 );
276 sub get_highest_batch {
278 my $dbh = C4::Context->dbh;
280 "select distinct batch_id from labels order by batch_id desc limit 1";
281 my $sth = $dbh->prepare($q);
283 my $data = $sth->fetchrow_hashref;
286 if ( !$data->{'batch_id'} ) {
290 $new_batch = $data->{'batch_id'};
298 my $dbh = C4::Context->dbh;
299 my $q = "select batch_id, count(*) as num from labels group by batch_id";
300 my $sth = $dbh->prepare($q);
303 while ( my $data = $sth->fetchrow_hashref ) {
304 push( @resultsloop, $data );
308 # adding a dummy batch=1 value , if none exists in the db
309 if ( !scalar(@resultsloop) ) {
310 push( @resultsloop, { batch_id => '1' , num => '0' } );
317 my $dbh = C4::Context->dbh;
318 my $q = "DELETE FROM labels where batch_id = ?";
319 my $sth = $dbh->prepare($q);
320 $sth->execute($batch_id);
324 sub get_barcode_types {
325 my ($layout_id) = @_;
326 my $layout = get_layout($layout_id);
327 my $barcode = $layout->{'barcodetype'};
330 push( @array, { code => 'CODE39', desc => 'Code 39' } );
331 push( @array, { code => 'CODE39MOD', desc => 'Code39 + Modulo43' } );
332 push( @array, { code => 'CODE39MOD10', desc => 'Code39 + Modulo10' } );
333 push( @array, { code => 'ITF', desc => 'Interleaved 2 of 5' } );
335 foreach my $line (@array) {
336 if ( $line->{'code'} eq $barcode ) {
337 $line->{'active'} = 1;
348 $unitvalue = '1' if ( $units eq 'POINT' );
349 $unitvalue = '2.83464567' if ( $units eq 'MM' );
350 $unitvalue = '28.3464567' if ( $units eq 'CM' );
351 $unitvalue = 72 if ( $units eq 'INCH' );
355 sub GetTextWrapCols {
356 my ( $fontsize, $label_width ) = @_;
358 my $left_text_margin = 3;
359 my ( $strtmp, $strwidth );
361 my $textlimit = $label_width - $left_text_margin;
363 while ( $strwidth < $textlimit ) {
364 $strwidth = prStrWidth( $string, 'C', $fontsize );
365 $string = $string . '0';
367 # warn "strwidth $strwidth, $textlimit, $string";
373 sub GetActiveLabelTemplate {
374 my $dbh = C4::Context->dbh;
375 my $query = " SELECT * FROM labels_templates where active = 1 limit 1";
376 my $sth = $dbh->prepare($query);
378 my $active_tmpl = $sth->fetchrow_hashref;
383 sub GetSingleLabelTemplate {
385 my $dbh = C4::Context->dbh;
386 my $query = " SELECT * FROM labels_templates where tmpl_id = ?";
387 my $sth = $dbh->prepare($query);
388 $sth->execute($tmpl_id);
389 my $template = $sth->fetchrow_hashref;
394 sub SetActiveTemplate {
398 my $dbh = C4::Context->dbh;
399 my $query = " UPDATE labels_templates SET active = NULL";
400 my $sth = $dbh->prepare($query);
403 my $query = "UPDATE labels_templates SET active = 1 WHERE tmpl_id = ?";
404 my $sth = $dbh->prepare($query);
405 $sth->execute($tmpl_id);
409 sub set_active_layout {
411 my ($layout_id) = @_;
412 my $dbh = C4::Context->dbh;
413 my $query = " UPDATE labels_conf SET active = NULL";
414 my $sth = $dbh->prepare($query);
417 my $query = "UPDATE labels_conf SET active = 1 WHERE id = ?";
418 my $sth = $dbh->prepare($query);
419 $sth->execute($layout_id);
425 my $dbh = C4::Context->dbh;
426 my $query = " DELETE FROM labels_templates where tmpl_id = ?";
427 my $sth = $dbh->prepare($query);
428 $sth->execute($tmpl_id);
434 $tmpl_id, $tmpl_code, $tmpl_desc, $page_width,
435 $page_height, $label_width, $label_height, $topmargin,
436 $leftmargin, $cols, $rows, $colgap,
437 $rowgap, $fontsize, $units
439 my $dbh = C4::Context->dbh;
441 " UPDATE labels_templates SET tmpl_code=?, tmpl_desc=?, page_width=?,
442 page_height=?, label_width=?, label_height=?, topmargin=?,
443 leftmargin=?, cols=?, rows=?, colgap=?, rowgap=?, fontsize=?,
447 my $sth = $dbh->prepare($query);
449 $tmpl_code, $tmpl_desc, $page_width, $page_height,
450 $label_width, $label_height, $topmargin, $leftmargin,
451 $cols, $rows, $colgap, $rowgap,
452 $fontsize, $units, $tmpl_id
460 $tmpl_code, $tmpl_desc, $page_width, $page_height,
461 $label_width, $label_height, $topmargin, $leftmargin,
462 $cols, $rows, $colgap, $rowgap,
466 my $dbh = C4::Context->dbh;
468 my $query = "INSERT INTO labels_templates (tmpl_code, tmpl_desc, page_width,
469 page_height, label_width, label_height, topmargin,
470 leftmargin, cols, rows, colgap, rowgap, fontsize, units)
471 VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?,?)";
473 my $sth = $dbh->prepare($query);
475 $tmpl_code, $tmpl_desc, $page_width, $page_height,
476 $label_width, $label_height, $topmargin, $leftmargin,
477 $cols, $rows, $colgap, $rowgap,
482 sub GetAllLabelTemplates {
483 my $dbh = C4::Context->dbh;
485 # get the actual items to be printed.
487 my $query = " Select * from labels_templates ";
488 my $sth = $dbh->prepare($query);
491 while ( my $data = $sth->fetchrow_hashref ) {
492 push( @resultsloop, $data );
496 #warn Dumper @resultsloop;
504 $barcodetype, $title, $subtitle, $isbn, $issn,
505 $itemtype, $bcn, $dcn, $classif,
506 $subclass, $itemcallnumber, $author, $tmpl_id,
507 $printingtype, $guidebox, $startlabel, $layoutname
510 my $dbh = C4::Context->dbh;
511 my $query2 = "update labels_conf set active = NULL";
512 my $sth2 = $dbh->prepare($query2);
514 my $query2 = "INSERT INTO labels_conf
515 ( barcodetype, title, subtitle, isbn,issn, itemtype, barcode,
516 dewey, class, subclass, itemcallnumber, author, printingtype,
517 guidebox, startlabel, layoutname, active )
518 values ( ?, ?, ?, ?, ?, ?, ?, ?,?, ?, ?, ?, ?, ?,?,?, 1 )";
519 my $sth2 = $dbh->prepare($query2);
521 $barcodetype, $title, $subtitle, $isbn, $issn,
523 $itemtype, $bcn, $dcn, $classif,
524 $subclass, $itemcallnumber, $author, $printingtype,
525 $guidebox, $startlabel, $layoutname
529 SetActiveTemplate($tmpl_id);
536 $barcodetype, $title, $subtitle, $isbn, $issn,
537 $itemtype, $bcn, $dcn, $classif,
538 $subclass, $itemcallnumber, $author, $tmpl_id,
539 $printingtype, $guidebox, $startlabel, $layoutname,
545 my $dbh = C4::Context->dbh;
546 my $query2 = "update labels_conf set
547 barcodetype=?, title=?, subtitle=?, isbn=?,issn=?,
548 itemtype=?, barcode=?, dewey=?, class=?,
549 subclass=?, itemcallnumber=?, author=?, printingtype=?,
550 guidebox=?, startlabel=?, layoutname=? where id = ?";
551 my $sth2 = $dbh->prepare($query2);
553 $barcodetype, $title, $subtitle, $isbn, $issn,
554 $itemtype, $bcn, $dcn, $classif,
555 $subclass, $itemcallnumber, $author, $printingtype,
556 $guidebox, $startlabel, $layoutname, $layout_id
563 =item get_label_items;
565 $options = get_label_items()
568 Returns an array of references-to-hash, whos keys are the field from the biblio, biblioitems, items and labels tables in the Koha database.
573 sub get_label_items {
575 my $dbh = C4::Context->dbh;
577 my @resultsloop = ();
583 my $query3 = "Select * from labels where batch_id = ? order by labelid ";
584 $sth = $dbh->prepare($query3);
585 $sth->execute($batch_id);
590 my $query3 = "Select * from labels";
591 $sth = $dbh->prepare($query3);
594 my $cnt = $sth->rows;
596 while ( my $data = $sth->fetchrow_hashref ) {
598 # lets get some summary info from each item
600 select i.*, bi.*, b.* from items i,biblioitems bi,biblio b
601 where itemnumber=? and i.biblioitemnumber=bi.biblioitemnumber and
602 bi.biblionumber=b.biblionumber";
604 my $sth1 = $dbh->prepare($query1);
605 $sth1->execute( $data->{'itemnumber'} );
607 my $data1 = $sth1->fetchrow_hashref();
609 $data1->{'labelno'} = $i1;
610 $data1->{'batch_id'} = $batch_id;
611 $data1->{'summary'} =
612 "$data1->{'barcode'}, $data1->{'title'}, $data1->{'isbn'}";
614 push( @resultsloop, $data1 );
626 barcode title subtitle
627 dewey isbn issn author class
628 itemtype subclass itemcallnumber
636 my ( $y_pos, $label_height, $fontsize, $x_pos, $left_text_margin,
637 $text_wrap_cols, $item, $conf_data )
639 # hack to fix column name mismatch betwen labels_conf.class, and bibitems.classification
640 $$item->{'class'} = $$item->{'classification'};
642 $Text::Wrap::columns = $text_wrap_cols;
643 $Text::Wrap::separator = "\n";
648 my $top_text_margin = ( $fontsize + 3 );
649 my $line_spacer = ($fontsize); # number of pixels between text rows.
651 # add your printable fields manually in here
653 my $layout_id = $$conf_data->{'id'};
655 # my @fields = GetItemFields();
657 my $str_fields = get_text_fields($layout_id, 'codes' );
658 my @fields = split(/ /, $str_fields);
661 my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
662 my $hPos = ( $x_pos + $left_text_margin );
664 # warn Dumper $conf_data;
667 foreach my $field (@fields) {
670 # $$item->{"$field"} = $field . ": " . $$item->{"$field"};
672 # if the display option for this field is selected in the DB,
673 # and the item record has some values for this field, display it.
674 if ( $$conf_data->{"$field"} && $$item->{"$field"} ) {
676 # warn "CONF_TYPE = $field";
679 $str = $$item->{"$field"};
680 # strip out naughty existing nl/cr's
684 # chop the string up into _upto_ 12 chunks
685 # and seperate the chunks with newlines
687 $str = wrap( "", "", "$str" );
688 $str = wrap( "", "", "$str" );
690 # split the chunks between newline's, into an array
691 my @strings = split /\n/, $str;
693 # then loop for each string line
694 foreach my $str (@strings) {
696 #warn "HPOS , VPOS $hPos, $vPos ";
697 # set the font size A
699 # prText( $hPos, $vPos, $str );
700 PrintText( $hPos, $vPos, $fontsize, $str );
701 $vPos = $vPos - $line_spacer;
703 } # if field is } #foreach feild
708 my ( $hPos, $vPos, $fontsize, $text ) = @_;
709 my $str = "BT /Ft1 $fontsize Tf $hPos $vPos Td ($text) Tj ET";
717 my $str = "BT/F13 30 Tf288 720 Td( AAAAAAAAAA ) TjET";
723 # x and y are from the top-left :)
724 my ( $x_pos, $y_pos, $height, $width, $barcode, $barcodetype ) = @_;
725 my $num_of_bars = length($barcode);
726 my $bar_width = $width * .8; # %80 of length of label width
729 my $guard_length = 10;
732 if ( $barcodetype eq 'CODE39' ) {
733 $bar_length = '17.5';
735 ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
736 $xsize_ratio = ( $bar_width / $tot_bar_length );
738 PDF::Reuse::Barcode::Code39(
739 x => ( $x_pos + ( $width / 10 ) ),
740 y => ( $y_pos + ( $height / 10 ) ),
741 value => "*$barcode*",
742 ySize => ( .02 * $height ),
743 xSize => $xsize_ratio,
748 warn "$barcodetype, $barcode FAILED:$@";
752 elsif ( $barcodetype eq 'CODE39MOD' ) {
754 # get modulo43 checksum
755 my $c39 = CheckDigits('code_39');
756 $barcode = $c39->complete($barcode);
760 ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
761 $xsize_ratio = ( $bar_width / $tot_bar_length );
763 PDF::Reuse::Barcode::Code39(
764 x => ( $x_pos + ( $width / 10 ) ),
765 y => ( $y_pos + ( $height / 10 ) ),
766 value => "*$barcode*",
767 ySize => ( .02 * $height ),
768 xSize => $xsize_ratio,
774 warn "$barcodetype, $barcode FAILED:$@";
777 elsif ( $barcodetype eq 'CODE39MOD10' ) {
779 # get modulo43 checksum
780 my $c39_10 = CheckDigits('visa');
781 $barcode = $c39_10->complete($barcode);
785 ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
786 $xsize_ratio = ( $bar_width / $tot_bar_length );
788 PDF::Reuse::Barcode::Code39(
789 x => ( $x_pos + ( $width / 10 ) ),
790 y => ( $y_pos + ( $height / 10 ) ),
791 value => "*$barcode*",
792 ySize => ( .02 * $height ),
793 xSize => $xsize_ratio,
800 warn "$barcodetype, $barcode FAILED:$@";
805 elsif ( $barcodetype eq 'COOP2OF5' ) {
806 $bar_length = '9.43333333333333';
808 ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
809 $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
811 PDF::Reuse::Barcode::COOP2of5(
812 x => ( $x_pos + ( $width / 10 ) ),
813 y => ( $y_pos + ( $height / 10 ) ),
815 ySize => ( .02 * $height ),
816 xSize => $xsize_ratio,
820 warn "$barcodetype, $barcode FAILED:$@";
824 elsif ( $barcodetype eq 'INDUSTRIAL2OF5' ) {
825 $bar_length = '13.1333333333333';
827 ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
828 $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
830 PDF::Reuse::Barcode::Industrial2of5(
831 x => ( $x_pos + ( $width / 10 ) ),
832 y => ( $y_pos + ( $height / 10 ) ),
834 ySize => ( .02 * $height ),
835 xSize => $xsize_ratio,
839 warn "$barcodetype, $barcode FAILED:$@";
843 my $moo2 = $tot_bar_length * $xsize_ratio;
845 warn " $x_pos, $y_pos, $barcode, $barcodetype\n";
847 "BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length R*TOT.BAR =$moo2 \n";
850 =item build_circ_barcode;
852 build_circ_barcode( $x_pos, $y_pos, $barcode,
853 $barcodetype, \$item);
855 $item is the result of a previous call to get_label_items();
860 sub build_circ_barcode {
861 my ( $x_pos_circ, $y_pos, $value, $barcodetype, $item ) = @_;
865 #warn "value = $value\n";
869 if ( $barcodetype eq 'EAN13' ) {
871 #testing EAN13 barcodes hack
872 $value = $value . '000000000';
874 $value = substr( $value, 0, 12 );
878 PDF::Reuse::Barcode::EAN13(
879 x => ( $x_pos_circ + 27 ),
880 y => ( $y_pos + 15 ),
888 # added for xpdf compat. doesnt use type3 fonts., but increases filesize from 20k to 200k
889 # i think its embedding extra fonts in the pdf file.
894 $item->{'barcodeerror'} = 1;
896 #warn "EAN13BARCODE FAILED:$@";
902 elsif ( $barcodetype eq 'Code39' ) {
905 PDF::Reuse::Barcode::Code39(
906 x => ( $x_pos_circ + 9 ),
907 y => ( $y_pos + 15 ),
917 $item->{'barcodeerror'} = 1;
919 #warn "CODE39BARCODE $value FAILED:$@";
926 elsif ( $barcodetype eq 'Matrix2of5' ) {
928 #warn "MATRIX ELSE:";
930 #testing MATRIX25 barcodes hack
931 # $value = $value.'000000000';
934 # $value = substr( $value, 0, 12 );
938 PDF::Reuse::Barcode::Matrix2of5(
939 x => ( $x_pos_circ + 27 ),
940 y => ( $y_pos + 15 ),
950 $item->{'barcodeerror'} = 1;
952 #warn "BARCODE FAILED:$@";
959 elsif ( $barcodetype eq 'EAN8' ) {
961 #testing ean8 barcodes hack
962 $value = $value . '000000000';
964 $value = substr( $value, 0, 8 );
970 PDF::Reuse::Barcode::EAN8(
971 x => ( $x_pos_circ + 42 ),
972 y => ( $y_pos + 15 ),
982 $item->{'barcodeerror'} = 1;
984 #warn "BARCODE FAILED:$@";
991 elsif ( $barcodetype eq 'UPC-E' ) {
993 PDF::Reuse::Barcode::UPCE(
994 x => ( $x_pos_circ + 27 ),
995 y => ( $y_pos + 15 ),
1005 $item->{'barcodeerror'} = 1;
1007 #warn "BARCODE FAILED:$@";
1013 elsif ( $barcodetype eq 'NW7' ) {
1015 PDF::Reuse::Barcode::NW7(
1016 x => ( $x_pos_circ + 27 ),
1017 y => ( $y_pos + 15 ),
1027 $item->{'barcodeerror'} = 1;
1029 #warn "BARCODE FAILED:$@";
1035 elsif ( $barcodetype eq 'ITF' ) {
1037 PDF::Reuse::Barcode::ITF(
1038 x => ( $x_pos_circ + 27 ),
1039 y => ( $y_pos + 15 ),
1049 $item->{'barcodeerror'} = 1;
1051 #warn "BARCODE FAILED:$@";
1057 elsif ( $barcodetype eq 'Industrial2of5' ) {
1059 PDF::Reuse::Barcode::Industrial2of5(
1060 x => ( $x_pos_circ + 27 ),
1061 y => ( $y_pos + 15 ),
1070 $item->{'barcodeerror'} = 1;
1072 #warn "BARCODE FAILED:$@";
1078 elsif ( $barcodetype eq 'IATA2of5' ) {
1080 PDF::Reuse::Barcode::IATA2of5(
1081 x => ( $x_pos_circ + 27 ),
1082 y => ( $y_pos + 15 ),
1091 $item->{'barcodeerror'} = 1;
1093 #warn "BARCODE FAILED:$@";
1100 elsif ( $barcodetype eq 'COOP2of5' ) {
1102 PDF::Reuse::Barcode::COOP2of5(
1103 x => ( $x_pos_circ + 27 ),
1104 y => ( $y_pos + 15 ),
1113 $item->{'barcodeerror'} = 1;
1115 #warn "BARCODE FAILED:$@";
1121 elsif ( $barcodetype eq 'UPC-A' ) {
1124 PDF::Reuse::Barcode::UPCA(
1125 x => ( $x_pos_circ + 27 ),
1126 y => ( $y_pos + 15 ),
1135 $item->{'barcodeerror'} = 1;
1137 #warn "BARCODE FAILED:$@";
1146 =item draw_boundaries
1148 sub draw_boundaries ($x_pos_spine, $x_pos_circ1, $x_pos_circ2,
1149 $y_pos, $spine_width, $label_height, $circ_width)
1151 This sub draws boundary lines where the label outlines are, to aid in printer testing, and debugging.
1156 sub draw_boundaries {
1159 $x_pos_spine, $x_pos_circ1, $x_pos_circ2, $y_pos,
1160 $spine_width, $label_height, $circ_width
1163 my $y_pos_initial = ( ( 792 - 36 ) - 90 );
1164 my $y_pos = $y_pos_initial;
1167 for ( $i = 1 ; $i <= 8 ; $i++ ) {
1169 &drawbox( $x_pos_spine, $y_pos, ($spine_width), ($label_height) );
1171 #warn "OLD BOXES x=$x_pos_spine, y=$y_pos, w=$spine_width, h=$label_height";
1172 &drawbox( $x_pos_circ1, $y_pos, ($circ_width), ($label_height) );
1173 &drawbox( $x_pos_circ2, $y_pos, ($circ_width), ($label_height) );
1175 $y_pos = ( $y_pos - $label_height );
1182 sub drawbox { $lower_left_x, $lower_left_y,
1183 $upper_right_x, $upper_right_y )
1185 this is a low level sub, that draws a pdf box, it is called by draw_boxes
1187 FYI: the $upper_right_x and $upper_right_y values are RELATIVE to $lower_left_x and $lower_left_y
1189 and $lower_left_x, $lower_left_y are ABSOLUTE, this caught me out!
1195 my ( $llx, $lly, $urx, $ury ) = @_;
1197 # warn "llx,y= $llx,$lly , urx,y=$urx,$ury \n";
1199 my $str = "q\n"; # save the graphic state
1200 $str .= "0.5 w\n"; # border color red
1201 $str .= "1.0 0.0 0.0 RG\n"; # border color red
1202 # $str .= "0.5 0.75 1.0 rg\n"; # fill color blue
1203 $str .= "1.0 1.0 1.0 rg\n"; # fill color white
1205 $str .= "$llx $lly $urx $ury re\n"; # a rectangle
1206 $str .= "B\n"; # fill (and a little more)
1207 $str .= "Q\n"; # save the graphic state
1213 END { } # module clean-up code here (global destructor)
1222 Mason James <mason@katipo.co.nz>