fixing help feature with new template structure
[koha.git] / C4 / Labels.pm
1 package C4::Labels;
2
3 # Copyright 2006 Katipo Communications.
4 #
5 # This file is part of Koha.
6 #
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
10 # version.
11 #
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.
15 #
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
19
20 use strict;
21 require Exporter;
22
23 use vars qw($VERSION @ISA @EXPORT);
24
25 use PDF::Reuse;
26 use Text::Wrap;
27 use Algorithm::CheckDigits;
28 # use Data::Dumper;
29 # use Smart::Comments;
30
31 $VERSION = 0.01;
32
33 =head1 NAME
34
35 C4::Labels - Functions for printing spine labels and barcodes in Koha
36
37 =head1 FUNCTIONS
38
39 =over 2
40
41 =cut
42
43 @ISA    = qw(Exporter);
44 @EXPORT = qw(
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
53   &get_printingtypes
54   &get_layouts
55   &get_barcode_types
56   &get_batches &delete_batch
57   &add_batch &SetFontSize &printText
58   &GetItemFields
59   &get_text_fields
60   get_layout &save_layout &add_layout
61   &set_active_layout &by_order
62   &build_text_dropbox
63   &delete_layout &get_active_layout
64 &get_highest_batch
65 );
66
67 =item get_label_options;
68
69         $options = get_label_options()
70
71
72 Return a pointer on a hash list containing info from labels_conf table in Koha DB.
73
74 =cut
75
76 #'
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);
81     $sth->execute();
82     my $conf_data = $sth->fetchrow_hashref;
83     $sth->finish;
84     return $conf_data;
85 }
86
87 sub get_layouts {
88
89 ## FIXME: this if/else could be compacted...
90     my $dbh = C4::Context->dbh;
91     my @data;
92     my $query = " Select * from labels_conf";
93     my $sth   = $dbh->prepare($query);
94     $sth->execute();
95     my @resultsloop;
96     while ( my $data = $sth->fetchrow_hashref ) {
97
98         $data->{'fieldlist'} = get_text_fields( $data->{'id'} );
99         push( @resultsloop, $data );
100     }
101     $sth->finish;
102
103     # @resultsloop
104
105     return @resultsloop;
106 }
107
108 sub get_layout {
109     my ($layout_id) = @_;
110     my $dbh = C4::Context->dbh;
111
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;
117     $sth->finish;
118     return $data;
119 }
120
121 sub get_active_layout {
122     my ($layout_id) = @_;
123     my $dbh = C4::Context->dbh;
124
125     # get the actual items to be printed.
126     my $query = " Select * from labels_conf where active = 1";
127     my $sth   = $dbh->prepare($query);
128     $sth->execute();
129     my $data = $sth->fetchrow_hashref;
130     $sth->finish;
131     return $data;
132 }
133
134 sub delete_layout {
135     my ($layout_id) = @_;
136     my $dbh = C4::Context->dbh;
137
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);
142     $sth->finish;
143 }
144
145 sub get_printingtypes {
146     my ($layout_id) = @_;
147     my @printtypes;
148
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" } );
154
155     my $conf             = get_layout($layout_id);
156     my $active_printtype = $conf->{'printingtype'};
157
158     # lop thru layout, insert selected to hash
159
160     foreach my $printtype (@printtypes) {
161         if ( $printtype->{'code'} eq $active_printtype ) {
162             $printtype->{'active'} = 'MOO';
163         }
164     }
165     return @printtypes;
166 }
167
168 sub build_text_dropbox {
169     my ($order) = @_;
170
171     #  my @fields      = get_text_fields();
172     #    my $field_count = scalar @fields;
173     my $field_count = 10;    # <-----------       FIXME hard coded
174
175     my @lines;
176     !$order
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 );
183     }
184
185     # add a blank row too
186
187     return @lines;
188 }
189
190 sub get_text_fields {
191     my ($layout_id, $sorttype) = @_;
192
193     my ( $a, $b, $c, $d, $e, $f, $g, $h, $i ,$j, $k );
194
195     my $sortorder = get_layout($layout_id);
196
197     # $sortorder
198
199     $a = {
200         code  => 'itemtype',
201         desc  => "Item Type",
202         order => $sortorder->{'itemtype'}
203     };
204     $b = {
205         code  => 'dewey',
206         desc  => "Dewey",
207         order => $sortorder->{'dewey'}
208     };
209     $c = { code => 'issn', desc => "ISSN", 
210         order => $sortorder->{'issn'} };
211     $d = { code => 'isbn', desc => "ISBN", 
212             order => $sortorder->{'isbn'} };
213     $e = {
214         code  => 'class',
215         desc  => "Classification",
216         order => $sortorder->{'class'}
217     };
218     $f = {
219         code  => 'subclass',
220         desc  => "Sub-Class",
221         order => $sortorder->{'subclass'}
222     };
223     $g = {
224         code  => 'barcode',
225         desc  => "Barcode",
226         order => $sortorder->{'barcode'}
227     };
228     $h =
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'} }; 
233     
234         my @text_fields = ( $a, $b, $c, $d, $e, $f, $g, $h, $i ,$j, $k );
235
236     my @new_fields;
237     foreach my $field (@text_fields) {
238         push( @new_fields, $field ) if $field->{'order'} > 0;
239     }
240
241     my @sorted_fields = sort by_order @new_fields;
242     my $active_fields;
243     foreach my $field (@sorted_fields) {
244      $sorttype eq 'codes' ?   $active_fields .= "$field->{'code'} " :
245           $active_fields .= "$field->{'desc'} ";
246     }
247     return $active_fields;
248
249 }
250
251 sub by_order {
252     $$a{order} <=> $$b{order};
253 }
254
255 sub add_batch {
256     my $new_batch;
257     my $dbh = C4::Context->dbh;
258     my $q =
259       "select distinct batch_id from labels order by batch_id desc limit 1";
260     my $sth = $dbh->prepare($q);
261     $sth->execute();
262     my $data = $sth->fetchrow_hashref;
263     $sth->finish;
264
265     if ( !$data->{'batch_id'} ) {
266         $new_batch = 1;
267     }
268     else {
269         $new_batch = ( $data->{'batch_id'} + 1 );
270     }
271
272     return $new_batch;
273 }
274
275
276 sub get_highest_batch {
277     my $new_batch;
278     my $dbh = C4::Context->dbh;
279     my $q =
280       "select distinct batch_id from labels order by batch_id desc limit 1";
281     my $sth = $dbh->prepare($q);
282     $sth->execute();
283     my $data = $sth->fetchrow_hashref;
284     $sth->finish;
285
286     if ( !$data->{'batch_id'} ) {
287         $new_batch = 1;
288     }
289     else {
290         $new_batch =  $data->{'batch_id'};
291     }
292
293     return $new_batch;
294 }
295
296
297 sub get_batches {
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);
301     $sth->execute();
302     my @resultsloop;
303     while ( my $data = $sth->fetchrow_hashref ) {
304         push( @resultsloop, $data );
305     }
306     $sth->finish;
307
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' } );
311     }
312     return @resultsloop;
313 }
314
315 sub delete_batch {
316     my ($batch_id) = @_;
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);
321     $sth->finish;
322 }
323
324 sub get_barcode_types {
325     my ($layout_id) = @_;
326     my $layout      = get_layout($layout_id);
327     my $barcode     = $layout->{'barcodetype'};
328     my @array;
329
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' } );
334
335     foreach my $line (@array) {
336         if ( $line->{'code'} eq $barcode ) {
337             $line->{'active'} = 1;
338         }
339
340     }
341     return @array;
342 }
343
344 sub GetUnitsValue {
345     my ($units) = @_;
346     my $unitvalue;
347
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' );
352     return $unitvalue;
353 }
354
355 sub GetTextWrapCols {
356     my ( $fontsize, $label_width ) = @_;
357     my $string           = "0";
358     my $left_text_margin = 3;
359     my ( $strtmp, $strwidth );
360     my $count     = 0;
361     my $textlimit = $label_width - $left_text_margin;
362
363     while ( $strwidth < $textlimit ) {
364         $strwidth = prStrWidth( $string, 'C', $fontsize );
365         $string = $string . '0';
366
367         #       warn "strwidth $strwidth, $textlimit, $string";
368         $count++;
369     }
370     return $count;
371 }
372
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);
377     $sth->execute();
378     my $active_tmpl = $sth->fetchrow_hashref;
379     $sth->finish;
380     return $active_tmpl;
381 }
382
383 sub GetSingleLabelTemplate {
384     my ($tmpl_id) = @_;
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;
390     $sth->finish;
391     return $template;
392 }
393
394 sub SetActiveTemplate {
395
396     my ($tmpl_id) = @_;
397   
398     my $dbh   = C4::Context->dbh;
399     my $query = " UPDATE labels_templates SET active = NULL";
400     my $sth   = $dbh->prepare($query);
401     $sth->execute();
402
403     my $query = "UPDATE labels_templates SET active = 1 WHERE tmpl_id = ?";
404     my $sth   = $dbh->prepare($query);
405     $sth->execute($tmpl_id);
406     $sth->finish;
407 }
408
409 sub set_active_layout {
410
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);
415     $sth->execute();
416
417     my $query = "UPDATE labels_conf SET active = 1 WHERE id = ?";
418     my $sth   = $dbh->prepare($query);
419     $sth->execute($layout_id);
420     $sth->finish;
421 }
422
423 sub DeleteTemplate {
424     my ($tmpl_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);
429     $sth->finish;
430 }
431
432 sub SaveTemplate {
433     my (
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
438     ) = @_;
439     my $dbh = C4::Context->dbh;
440     my $query =
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=?,
444                            units=? 
445                   WHERE tmpl_id = ?";
446
447     my $sth = $dbh->prepare($query);
448     $sth->execute(
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
453     );
454     $sth->finish;
455 }
456
457 sub CreateTemplate {
458     my $tmpl_id;
459     my (
460         $tmpl_code,   $tmpl_desc,    $page_width, $page_height,
461         $label_width, $label_height, $topmargin,  $leftmargin,
462         $cols,        $rows,         $colgap,     $rowgap,
463         $fontsize,     $units
464     ) = @_;
465
466     my $dbh = C4::Context->dbh;
467
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(?,?,?,?,?,?,?,?,?,?,?,?,?,?)";
472
473     my $sth = $dbh->prepare($query);
474     $sth->execute(
475         $tmpl_code,   $tmpl_desc,    $page_width, $page_height,
476         $label_width, $label_height, $topmargin,  $leftmargin,
477         $cols,        $rows,         $colgap,     $rowgap,
478         $fontsize,    $units
479     );
480 }
481
482 sub GetAllLabelTemplates {
483     my $dbh = C4::Context->dbh;
484
485     # get the actual items to be printed.
486     my @data;
487     my $query = " Select * from labels_templates ";
488     my $sth   = $dbh->prepare($query);
489     $sth->execute();
490     my @resultsloop;
491     while ( my $data = $sth->fetchrow_hashref ) {
492         push( @resultsloop, $data );
493     }
494     $sth->finish;
495
496     #warn Dumper @resultsloop;
497     return @resultsloop;
498 }
499
500 #sub SaveConf {
501 sub add_layout {
502
503     my (
504         $barcodetype,  $title,          $subtitle,      $isbn,       $issn,
505         $itemtype,     $bcn,            $dcn,        $classif,
506         $subclass,     $itemcallnumber, $author,     $tmpl_id,
507         $printingtype, $guidebox,       $startlabel, $layoutname
508     ) = @_;
509
510     my $dbh    = C4::Context->dbh;
511     my $query2 = "update labels_conf set active = NULL";
512     my $sth2   = $dbh->prepare($query2);
513     $sth2->execute();
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);
520     $sth2->execute(
521         $barcodetype, $title, $subtitle, $isbn, $issn,
522
523         $itemtype, $bcn,            $dcn,    $classif,
524         $subclass, $itemcallnumber, $author, $printingtype,
525         $guidebox, $startlabel,     $layoutname
526     );
527     $sth2->finish;
528
529     SetActiveTemplate($tmpl_id);
530     return;
531 }
532
533 sub save_layout {
534
535     my (
536         $barcodetype,  $title,          $subtitle,      $isbn,       $issn,
537         $itemtype,     $bcn,            $dcn,        $classif,
538         $subclass,     $itemcallnumber, $author,     $tmpl_id,
539         $printingtype, $guidebox,       $startlabel, $layoutname,
540         $layout_id
541     ) = @_;
542 ### $layoutname
543 ### $layout_id
544
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);
552     $sth2->execute(
553         $barcodetype, $title,          $subtitle,       $isbn,       $issn,
554         $itemtype,    $bcn,            $dcn,        $classif,
555         $subclass,    $itemcallnumber, $author,     $printingtype,
556         $guidebox,    $startlabel,     $layoutname, $layout_id
557     );
558     $sth2->finish;
559
560     return;
561 }
562
563 =item get_label_items;
564
565         $options = get_label_items()
566
567
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.
569
570 =cut
571
572 #'
573 sub get_label_items {
574     my ($batch_id) = @_;
575     my $dbh = C4::Context->dbh;
576
577     my @resultsloop = ();
578     my $count;
579     my @data;
580     my $sth;
581
582     if ($batch_id) {
583         my $query3 = "Select * from labels where batch_id = ? order by labelid ";
584         $sth = $dbh->prepare($query3);
585         $sth->execute($batch_id);
586
587     }
588     else {
589
590         my $query3 = "Select * from labels";
591         $sth = $dbh->prepare($query3);
592         $sth->execute();
593     }
594     my $cnt = $sth->rows;
595     my $i1  = 1;
596     while ( my $data = $sth->fetchrow_hashref ) {
597
598         # lets get some summary info from each item
599         my $query1 = " 
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"; 
603      
604          my $sth1 = $dbh->prepare($query1);
605         $sth1->execute( $data->{'itemnumber'} );
606
607         my $data1 = $sth1->fetchrow_hashref();
608
609         $data1->{'labelno'}  = $i1;
610         $data1->{'batch_id'} = $batch_id;
611         $data1->{'summary'} =
612           "$data1->{'barcode'}, $data1->{'title'}, $data1->{'isbn'}";
613
614         push( @resultsloop, $data1 );
615         $sth1->finish;
616
617         $i1++;
618     }
619     $sth->finish;
620     return @resultsloop;
621
622 }
623
624 sub GetItemFields {
625     my @fields = qw (
626       barcode title subtitle
627       dewey isbn issn author class
628       itemtype subclass itemcallnumber
629
630     );
631     return @fields;
632 }
633
634 sub DrawSpineText {
635
636     my ( $y_pos, $label_height, $fontsize, $x_pos, $left_text_margin,
637         $text_wrap_cols, $item, $conf_data )
638       = @_;
639 # hack to fix column name mismatch betwen labels_conf.class, and bibitems.classification
640         $$item->{'class'} = $$item->{'classification'};
641  
642     $Text::Wrap::columns   = $text_wrap_cols;
643     $Text::Wrap::separator = "\n";
644
645     my $str;
646     ##      $item
647
648     my $top_text_margin = ( $fontsize + 3 );
649     my $line_spacer = ($fontsize);    # number of pixels between text rows.
650
651     # add your printable fields manually in here
652
653 my $layout_id = $$conf_data->{'id'};
654
655 #    my @fields = GetItemFields();
656
657 my $str_fields = get_text_fields($layout_id, 'codes' );
658 my @fields = split(/ /, $str_fields);
659 ### @fields
660
661     my $vPos   = ( $y_pos + ( $label_height - $top_text_margin ) );
662     my $hPos   = ( $x_pos + $left_text_margin );
663
664     # warn Dumper $conf_data;
665     #warn Dumper $item;
666
667     foreach my $field (@fields) {
668
669         # testing hack
670 #     $$item->{"$field"} = $field . ": " . $$item->{"$field"};
671
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"} ) {
675
676             #            warn "CONF_TYPE = $field";
677
678             # get the string
679             $str = $$item->{"$field"};
680             # strip out naughty existing nl/cr's
681             $str =~ s/\n//g;
682             $str =~ s/\r//g;
683
684             # chop the string up into _upto_ 12 chunks
685             # and seperate the chunks with newlines
686
687             $str = wrap( "", "", "$str" );
688             $str = wrap( "", "", "$str" );
689
690             # split the chunks between newline's, into an array
691             my @strings = split /\n/, $str;
692
693             # then loop for each string line
694             foreach my $str (@strings) {
695
696                 #warn "HPOS ,  VPOS $hPos, $vPos ";
697                 # set the font size A
698
699                 #   prText( $hPos, $vPos, $str );
700                 PrintText( $hPos, $vPos, $fontsize, $str );
701                 $vPos = $vPos - $line_spacer;
702             }
703         }    # if field is     }    #foreach feild
704     }
705 }
706
707 sub PrintText {
708     my ( $hPos, $vPos, $fontsize, $text ) = @_;
709     my $str = "BT /Ft1 $fontsize Tf $hPos $vPos Td ($text) Tj ET";
710     prAdd($str);
711 }
712
713 sub SetFontSize {
714
715     my ($fontsize) = @_;
716 ### fontsize
717     my $str = "BT/F13 30 Tf288 720 Td( AAAAAAAAAA ) TjET";
718     prAdd($str);
719 }
720
721 sub DrawBarcode {
722
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
727     my $tot_bar_length;
728     my $bar_length;
729     my $guard_length = 10;
730     my $xsize_ratio;
731
732     if ( $barcodetype eq 'CODE39' ) {
733         $bar_length = '17.5';
734         $tot_bar_length =
735           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
736         $xsize_ratio = ( $bar_width / $tot_bar_length );
737         eval {
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,
744                 hide_asterisk => 1,
745             );
746         };
747         if ($@) {
748             warn "$barcodetype, $barcode FAILED:$@";
749         }
750     }
751
752     elsif ( $barcodetype eq 'CODE39MOD' ) {
753
754         # get modulo43 checksum
755         my $c39 = CheckDigits('code_39');
756         $barcode = $c39->complete($barcode);
757
758         $bar_length = '19';
759         $tot_bar_length =
760           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
761         $xsize_ratio = ( $bar_width / $tot_bar_length );
762         eval {
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,
769                 hide_asterisk => 1,
770             );
771         };
772
773         if ($@) {
774             warn "$barcodetype, $barcode FAILED:$@";
775         }
776     }
777     elsif ( $barcodetype eq 'CODE39MOD10' ) {
778  
779         # get modulo43 checksum
780         my $c39_10 = CheckDigits('visa');
781         $barcode = $c39_10->complete($barcode);
782
783         $bar_length = '19';
784         $tot_bar_length =
785           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
786         $xsize_ratio = ( $bar_width / $tot_bar_length );
787         eval {
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,
794                 hide_asterisk => 1,
795                                 text         => 0, 
796             );
797         };
798
799         if ($@) {
800             warn "$barcodetype, $barcode FAILED:$@";
801         }
802     }
803
804  
805     elsif ( $barcodetype eq 'COOP2OF5' ) {
806         $bar_length = '9.43333333333333';
807         $tot_bar_length =
808           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
809         $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
810         eval {
811             PDF::Reuse::Barcode::COOP2of5(
812                 x => ( $x_pos + ( $width / 10 ) ),
813                 y => ( $y_pos + ( $height / 10 ) ),
814                 value => $barcode,
815                 ySize => ( .02 * $height ),
816                 xSize => $xsize_ratio,
817             );
818         };
819         if ($@) {
820             warn "$barcodetype, $barcode FAILED:$@";
821         }
822     }
823
824     elsif ( $barcodetype eq 'INDUSTRIAL2OF5' ) {
825         $bar_length = '13.1333333333333';
826         $tot_bar_length =
827           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
828         $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
829         eval {
830             PDF::Reuse::Barcode::Industrial2of5(
831                 x => ( $x_pos + ( $width / 10 ) ),
832                 y => ( $y_pos + ( $height / 10 ) ),
833                 value => $barcode,
834                 ySize => ( .02 * $height ),
835                 xSize => $xsize_ratio,
836             );
837         };
838         if ($@) {
839             warn "$barcodetype, $barcode FAILED:$@";
840         }
841     }
842
843     my $moo2 = $tot_bar_length * $xsize_ratio;
844
845     warn " $x_pos, $y_pos, $barcode, $barcodetype\n";
846     warn
847 "BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length  R*TOT.BAR =$moo2 \n";
848 }
849
850 =item build_circ_barcode;
851
852   build_circ_barcode( $x_pos, $y_pos, $barcode,
853                 $barcodetype, \$item);
854
855 $item is the result of a previous call to get_label_items();
856
857 =cut
858
859 #'
860 sub build_circ_barcode {
861     my ( $x_pos_circ, $y_pos, $value, $barcodetype, $item ) = @_;
862
863     #warn Dumper \$item;
864
865     #warn "value = $value\n";
866
867     #$DB::single = 1;
868
869     if ( $barcodetype eq 'EAN13' ) {
870
871         #testing EAN13 barcodes hack
872         $value = $value . '000000000';
873         $value =~ s/-//;
874         $value = substr( $value, 0, 12 );
875
876         #warn $value;
877         eval {
878             PDF::Reuse::Barcode::EAN13(
879                 x     => ( $x_pos_circ + 27 ),
880                 y     => ( $y_pos + 15 ),
881                 value => $value,
882
883                 #            prolong => 2.96,
884                 #            xSize   => 1.5,
885
886                 # ySize   => 1.2,
887
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.
890 #  mode => 'graphic',
891             );
892         };
893         if ($@) {
894             $item->{'barcodeerror'} = 1;
895
896             #warn "EAN13BARCODE FAILED:$@";
897         }
898
899         #warn $barcodetype;
900
901     }
902     elsif ( $barcodetype eq 'Code39' ) {
903
904         eval {
905             PDF::Reuse::Barcode::Code39(
906                 x     => ( $x_pos_circ + 9 ),
907                 y     => ( $y_pos + 15 ),
908                 value => $value,
909
910                 #           prolong => 2.96,
911                 xSize => .85,
912
913                 ySize => 1.3,
914             );
915         };
916         if ($@) {
917             $item->{'barcodeerror'} = 1;
918
919             #warn "CODE39BARCODE $value FAILED:$@";
920         }
921
922         #warn $barcodetype;
923
924     }
925
926     elsif ( $barcodetype eq 'Matrix2of5' ) {
927
928         #warn "MATRIX ELSE:";
929
930         #testing MATRIX25  barcodes hack
931         #    $value = $value.'000000000';
932         $value =~ s/-//;
933
934         #    $value = substr( $value, 0, 12 );
935         #warn $value;
936
937         eval {
938             PDF::Reuse::Barcode::Matrix2of5(
939                 x     => ( $x_pos_circ + 27 ),
940                 y     => ( $y_pos + 15 ),
941                 value => $value,
942
943                 #        prolong => 2.96,
944                 #       xSize   => 1.5,
945
946                 # ySize   => 1.2,
947             );
948         };
949         if ($@) {
950             $item->{'barcodeerror'} = 1;
951
952             #warn "BARCODE FAILED:$@";
953         }
954
955         #warn $barcodetype;
956
957     }
958
959     elsif ( $barcodetype eq 'EAN8' ) {
960
961         #testing ean8 barcodes hack
962         $value = $value . '000000000';
963         $value =~ s/-//;
964         $value = substr( $value, 0, 8 );
965
966         #warn $value;
967
968         #warn "EAN8 ELSEIF";
969         eval {
970             PDF::Reuse::Barcode::EAN8(
971                 x       => ( $x_pos_circ + 42 ),
972                 y       => ( $y_pos + 15 ),
973                 value   => $value,
974                 prolong => 2.96,
975                 xSize   => 1.5,
976
977                 # ySize   => 1.2,
978             );
979         };
980
981         if ($@) {
982             $item->{'barcodeerror'} = 1;
983
984             #warn "BARCODE FAILED:$@";
985         }
986
987         #warn $barcodetype;
988
989     }
990
991     elsif ( $barcodetype eq 'UPC-E' ) {
992         eval {
993             PDF::Reuse::Barcode::UPCE(
994                 x       => ( $x_pos_circ + 27 ),
995                 y       => ( $y_pos + 15 ),
996                 value   => $value,
997                 prolong => 2.96,
998                 xSize   => 1.5,
999
1000                 # ySize   => 1.2,
1001             );
1002         };
1003
1004         if ($@) {
1005             $item->{'barcodeerror'} = 1;
1006
1007             #warn "BARCODE FAILED:$@";
1008         }
1009
1010         #warn $barcodetype;
1011
1012     }
1013     elsif ( $barcodetype eq 'NW7' ) {
1014         eval {
1015             PDF::Reuse::Barcode::NW7(
1016                 x       => ( $x_pos_circ + 27 ),
1017                 y       => ( $y_pos + 15 ),
1018                 value   => $value,
1019                 prolong => 2.96,
1020                 xSize   => 1.5,
1021
1022                 # ySize   => 1.2,
1023             );
1024         };
1025
1026         if ($@) {
1027             $item->{'barcodeerror'} = 1;
1028
1029             #warn "BARCODE FAILED:$@";
1030         }
1031
1032         #warn $barcodetype;
1033
1034     }
1035     elsif ( $barcodetype eq 'ITF' ) {
1036         eval {
1037             PDF::Reuse::Barcode::ITF(
1038                 x       => ( $x_pos_circ + 27 ),
1039                 y       => ( $y_pos + 15 ),
1040                 value   => $value,
1041                 prolong => 2.96,
1042                 xSize   => 1.5,
1043
1044                 # ySize   => 1.2,
1045             );
1046         };
1047
1048         if ($@) {
1049             $item->{'barcodeerror'} = 1;
1050
1051             #warn "BARCODE FAILED:$@";
1052         }
1053
1054         #warn $barcodetype;
1055
1056     }
1057     elsif ( $barcodetype eq 'Industrial2of5' ) {
1058         eval {
1059             PDF::Reuse::Barcode::Industrial2of5(
1060                 x       => ( $x_pos_circ + 27 ),
1061                 y       => ( $y_pos + 15 ),
1062                 value   => $value,
1063                 prolong => 2.96,
1064                 xSize   => 1.5,
1065
1066                 # ySize   => 1.2,
1067             );
1068         };
1069         if ($@) {
1070             $item->{'barcodeerror'} = 1;
1071
1072             #warn "BARCODE FAILED:$@";
1073         }
1074
1075         #warn $barcodetype;
1076
1077     }
1078     elsif ( $barcodetype eq 'IATA2of5' ) {
1079         eval {
1080             PDF::Reuse::Barcode::IATA2of5(
1081                 x       => ( $x_pos_circ + 27 ),
1082                 y       => ( $y_pos + 15 ),
1083                 value   => $value,
1084                 prolong => 2.96,
1085                 xSize   => 1.5,
1086
1087                 # ySize   => 1.2,
1088             );
1089         };
1090         if ($@) {
1091             $item->{'barcodeerror'} = 1;
1092
1093             #warn "BARCODE FAILED:$@";
1094         }
1095
1096         #warn $barcodetype;
1097
1098     }
1099
1100     elsif ( $barcodetype eq 'COOP2of5' ) {
1101         eval {
1102             PDF::Reuse::Barcode::COOP2of5(
1103                 x       => ( $x_pos_circ + 27 ),
1104                 y       => ( $y_pos + 15 ),
1105                 value   => $value,
1106                 prolong => 2.96,
1107                 xSize   => 1.5,
1108
1109                 # ySize   => 1.2,
1110             );
1111         };
1112         if ($@) {
1113             $item->{'barcodeerror'} = 1;
1114
1115             #warn "BARCODE FAILED:$@";
1116         }
1117
1118         #warn $barcodetype;
1119
1120     }
1121     elsif ( $barcodetype eq 'UPC-A' ) {
1122
1123         eval {
1124             PDF::Reuse::Barcode::UPCA(
1125                 x       => ( $x_pos_circ + 27 ),
1126                 y       => ( $y_pos + 15 ),
1127                 value   => $value,
1128                 prolong => 2.96,
1129                 xSize   => 1.5,
1130
1131                 # ySize   => 1.2,
1132             );
1133         };
1134         if ($@) {
1135             $item->{'barcodeerror'} = 1;
1136
1137             #warn "BARCODE FAILED:$@";
1138         }
1139
1140         #warn $barcodetype;
1141
1142     }
1143
1144 }
1145
1146 =item draw_boundaries
1147
1148  sub draw_boundaries ($x_pos_spine, $x_pos_circ1, $x_pos_circ2,
1149                 $y_pos, $spine_width, $label_height, $circ_width)  
1150
1151 This sub draws boundary lines where the label outlines are, to aid in printer testing, and debugging.
1152
1153 =cut
1154
1155 #'
1156 sub draw_boundaries {
1157
1158     my (
1159         $x_pos_spine, $x_pos_circ1,  $x_pos_circ2, $y_pos,
1160         $spine_width, $label_height, $circ_width
1161     ) = @_;
1162
1163     my $y_pos_initial = ( ( 792 - 36 ) - 90 );
1164     my $y_pos         = $y_pos_initial;
1165     my $i             = 1;
1166
1167     for ( $i = 1 ; $i <= 8 ; $i++ ) {
1168
1169         &drawbox( $x_pos_spine, $y_pos, ($spine_width), ($label_height) );
1170
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) );
1174
1175         $y_pos = ( $y_pos - $label_height );
1176
1177     }
1178 }
1179
1180 =item drawbox
1181
1182         sub drawbox {   $lower_left_x, $lower_left_y, 
1183                         $upper_right_x, $upper_right_y )
1184
1185 this is a low level sub, that draws a pdf box, it is called by draw_boxes
1186
1187 FYI: the  $upper_right_x and $upper_right_y values are RELATIVE to  $lower_left_x and $lower_left_y
1188
1189 and $lower_left_x, $lower_left_y are ABSOLUTE, this caught me out!
1190
1191 =cut
1192
1193 #'
1194 sub drawbox {
1195     my ( $llx, $lly, $urx, $ury ) = @_;
1196
1197     #    warn "llx,y= $llx,$lly  ,   urx,y=$urx,$ury \n";
1198
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
1204
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
1208
1209     prAdd($str);
1210
1211 }
1212
1213 END { }    # module clean-up code here (global destructor)
1214
1215 1;
1216 __END__
1217
1218 =back
1219
1220 =head1 AUTHOR
1221
1222 Mason James <mason@katipo.co.nz>
1223 =cut
1224