BUGFIXING mail alert on issue arrival
[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 use vars qw($VERSION @ISA @EXPORT);
22
23 use PDF::Reuse;
24 use Text::Wrap;
25 use Algorithm::CheckDigits;
26 # use Data::Dumper;
27 # use Smart::Comments;
28
29 BEGIN {
30         $VERSION = 0.03;
31         require Exporter;
32         @ISA    = qw(Exporter);
33         @EXPORT = qw(
34                 &get_label_options &get_label_items
35                 &build_circ_barcode &draw_boundaries
36                 &drawbox &GetActiveLabelTemplate
37                 &GetAllLabelTemplates &DeleteTemplate
38                 &GetSingleLabelTemplate &SaveTemplate
39                 &CreateTemplate &SetActiveTemplate
40                 &SaveConf &DrawSpineText &GetTextWrapCols
41                 &GetUnitsValue &DrawBarcode
42                 &get_printingtypes
43                 &get_layouts
44                 &get_barcode_types
45                 &get_batches &delete_batch
46                 &add_batch &SetFontSize &printText
47                 &GetItemFields
48                 &get_text_fields
49                 get_layout &save_layout &add_layout
50                 &set_active_layout &by_order
51                 &build_text_dropbox
52                 &delete_layout &get_active_layout
53                 &get_highest_batch
54                 &deduplicate_batch
55                 &GetAllPrinterProfiles &GetSinglePrinterProfile
56                 &SaveProfile &CreateProfile &DeleteProfile
57                 &GetAssociatedProfile &SetAssociatedProfile
58         );
59 }
60
61 my $DEBUG = 0;
62
63 =head1 NAME
64
65 C4::Labels - Functions for printing spine labels and barcodes in Koha
66
67 =head1 FUNCTIONS
68
69 =over 2
70
71 =item get_label_options;
72
73         $options = get_label_options()
74
75 Return a pointer on a hash list containing info from labels_conf table in Koha DB.
76
77 =cut
78
79 #'
80 sub get_label_options {
81     my $dbh    = C4::Context->dbh;
82     my $query2 = " SELECT * FROM labels_conf where active = 1";
83     my $sth    = $dbh->prepare($query2);
84     $sth->execute();
85     my $conf_data = $sth->fetchrow_hashref;
86     $sth->finish;
87     return $conf_data;
88 }
89
90 sub get_layouts {
91
92 ## FIXME: this if/else could be compacted...
93     my $dbh = C4::Context->dbh;
94     my @data;
95     my $query = " Select * from labels_conf";
96     my $sth   = $dbh->prepare($query);
97     $sth->execute();
98     my @resultsloop;
99     while ( my $data = $sth->fetchrow_hashref ) {
100
101         $data->{'fieldlist'} = get_text_fields( $data->{'id'} );
102         push( @resultsloop, $data );
103     }
104     $sth->finish;
105
106     # @resultsloop
107
108     return @resultsloop;
109 }
110
111 sub get_layout {
112     my ($layout_id) = @_;
113     my $dbh = C4::Context->dbh;
114
115     # get the actual items to be printed.
116     my $query = " Select * from labels_conf where id = ?";
117     my $sth   = $dbh->prepare($query);
118     $sth->execute($layout_id);
119     my $data = $sth->fetchrow_hashref;
120     $sth->finish;
121     return $data;
122 }
123
124 sub get_active_layout {
125     my ($layout_id) = @_;
126     my $dbh = C4::Context->dbh;
127
128     # get the actual items to be printed.
129     my $query = " Select * from labels_conf where active = 1";
130     my $sth   = $dbh->prepare($query);
131     $sth->execute();
132     my $data = $sth->fetchrow_hashref;
133     $sth->finish;
134     return $data;
135 }
136
137 sub delete_layout {
138     my ($layout_id) = @_;
139     my $dbh = C4::Context->dbh;
140
141     # get the actual items to be printed.
142     my $query = "delete from  labels_conf where id = ?";
143     my $sth   = $dbh->prepare($query);
144     $sth->execute($layout_id);
145     $sth->finish;
146 }
147
148 sub get_printingtypes {
149     my ($layout_id) = @_;
150     my @printtypes;
151
152     push( @printtypes, { code => 'BAR',    desc => "barcode" } );
153     push( @printtypes, { code => 'BIB',    desc => "biblio" } );
154     push( @printtypes, { code => 'BARBIB', desc => "barcode / biblio" } );
155     push( @printtypes, { code => 'BIBBAR', desc => "biblio / barcode" } );
156     push( @printtypes, { code => 'ALT',    desc => "alternating labels" } );
157
158     my $conf             = get_layout($layout_id);
159     my $active_printtype = $conf->{'printingtype'};
160
161     # lop thru layout, insert selected to hash
162
163     foreach my $printtype (@printtypes) {
164         if ( $printtype->{'code'} eq $active_printtype ) {
165             $printtype->{'active'} = 'MOO';
166         }
167     }
168     return @printtypes;
169 }
170
171 sub build_text_dropbox {
172     my ($order) = @_;
173
174     #  my @fields      = get_text_fields();
175     #    my $field_count = scalar @fields;
176     my $field_count = 10;    # <-----------       FIXME hard coded
177
178     my @lines;
179     !$order
180       ? push( @lines, { num => '', selected => '1' } )
181       : push( @lines, { num => '' } );
182     for ( my $i = 1 ; $i <= $field_count ; $i++ ) {
183         my $line = { num => "$i" };
184         $line->{'selected'} = 1 if $i eq $order;
185         push( @lines, $line );
186     }
187
188     # add a blank row too
189
190     return @lines;
191 }
192
193 sub get_text_fields {
194     my ($layout_id, $sorttype) = @_;
195
196     my ( $a, $b, $c, $d, $e, $f, $g, $h, $i ,$j, $k );
197
198     my $sortorder = get_layout($layout_id);
199
200     # $sortorder
201
202     $a = {
203         code  => 'itemtype',
204         desc  => "Item Type",
205         order => $sortorder->{'itemtype'}
206     };
207     $b = {
208         code  => 'dewey',
209         desc  => "Dewey",
210         order => $sortorder->{'dewey'}
211     };
212     $c = { code => 'issn', desc => "ISSN", 
213         order => $sortorder->{'issn'} };
214     $d = { code => 'isbn', desc => "ISBN", 
215             order => $sortorder->{'isbn'} };
216     $e = {
217         code  => 'class',
218         desc  => "Classification",
219         order => $sortorder->{'class'}
220     };
221     $f = {
222         code  => 'subclass',
223         desc  => "Sub-Class",
224         order => $sortorder->{'subclass'}
225     };
226     $g = {
227         code  => 'barcode',
228         desc  => "Barcode",
229         order => $sortorder->{'barcode'}
230     };
231     $h =
232       { code => 'author', desc => "Author", order => $sortorder->{'author'} };
233     $i = { code => 'title', desc => "Title", order => $sortorder->{'title'} };
234     $j = { code => 'itemcallnumber', desc => "Call Number", order => $sortorder->{'itemcallnumber'} };
235         $k = { code => 'subtitle', desc => "Subtitle", order => $sortorder->{'subtitle'} }; 
236     
237         my @text_fields = ( $a, $b, $c, $d, $e, $f, $g, $h, $i ,$j, $k );
238
239     my @new_fields;
240     foreach my $field (@text_fields) {
241         push( @new_fields, $field ) if $field->{'order'} > 0;
242     }
243
244     my @sorted_fields = sort by_order @new_fields;
245     my $active_fields;
246     foreach my $field (@sorted_fields) {
247      $sorttype eq 'codes' ?   $active_fields .= "$field->{'code'} " :
248           $active_fields .= "$field->{'desc'} ";
249     }
250     return $active_fields;
251
252 }
253
254 sub by_order {
255     $$a{order} <=> $$b{order};
256 }
257
258 sub add_batch {
259     my $new_batch;
260     my $dbh = C4::Context->dbh;
261     my $q =
262       "select distinct batch_id from labels order by batch_id desc limit 1";
263     my $sth = $dbh->prepare($q);
264     $sth->execute();
265     my $data = $sth->fetchrow_hashref;
266     $sth->finish;
267
268     if ( !$data->{'batch_id'} ) {
269         $new_batch = 1;
270     }
271     else {
272         $new_batch = ( $data->{'batch_id'} + 1 );
273     }
274
275     return $new_batch;
276 }
277
278
279 sub get_highest_batch {
280     my $new_batch;
281     my $dbh = C4::Context->dbh;
282     my $q =
283       "select distinct batch_id from labels order by batch_id desc limit 1";
284     my $sth = $dbh->prepare($q);
285     $sth->execute();
286     my $data = $sth->fetchrow_hashref;
287     $sth->finish;
288
289     if ( !$data->{'batch_id'} ) {
290         $new_batch = 1;
291     }
292     else {
293         $new_batch =  $data->{'batch_id'};
294     }
295
296     return $new_batch;
297 }
298
299
300 sub get_batches {
301     my $dbh = C4::Context->dbh;
302     my $q   = "select batch_id, count(*) as num from labels group by batch_id";
303     my $sth = $dbh->prepare($q);
304     $sth->execute();
305     my @resultsloop;
306     while ( my $data = $sth->fetchrow_hashref ) {
307         push( @resultsloop, $data );
308     }
309     $sth->finish;
310
311 # Not sure why we are doing this rather than simply telling the user that no batches are currently defined.
312 # So I'm commenting this out and modifying label-manager.tmpl to properly inform the user as stated. -fbcit
313     # adding a dummy batch=1 value , if none exists in the db
314 #    if ( !scalar(@resultsloop) ) {
315 #        push( @resultsloop, { batch_id => '1' , num => '0' } );
316 #    }
317     return @resultsloop;
318 }
319
320 sub delete_batch {
321     my ($batch_id) = @_;
322     my $dbh        = C4::Context->dbh;
323     my $q          = "DELETE FROM labels where batch_id  = ?";
324     my $sth        = $dbh->prepare($q);
325     $sth->execute($batch_id);
326     $sth->finish;
327 }
328
329 sub get_barcode_types {
330     my ($layout_id) = @_;
331     my $layout      = get_layout($layout_id);
332     my $barcode     = $layout->{'barcodetype'};
333     my @array;
334
335     push( @array, { code => 'CODE39',    desc => 'Code 39' } );
336     push( @array, { code => 'CODE39MOD', desc => 'Code39 + Modulo43' } );
337     push( @array, { code => 'CODE39MOD10', desc => 'Code39 + Modulo10' } ); 
338         push( @array, { code => 'ITF',       desc => 'Interleaved 2 of 5' } );
339
340     foreach my $line (@array) {
341         if ( $line->{'code'} eq $barcode ) {
342             $line->{'active'} = 1;
343         }
344
345     }
346     return @array;
347 }
348
349 sub GetUnitsValue {
350     my ($units) = @_;
351     my $unitvalue;
352
353     $unitvalue = '1'          if ( $units eq 'POINT' );
354     $unitvalue = '2.83464567' if ( $units eq 'MM' );
355     $unitvalue = '28.3464567' if ( $units eq 'CM' );
356     $unitvalue = 72           if ( $units eq 'INCH' );
357     return $unitvalue;
358 }
359
360 sub GetTextWrapCols {
361     my ( $fontsize, $label_width ) = @_;
362     my $string           = "0";
363     my $left_text_margin = 3;
364     my ( $strtmp, $strwidth );
365     my $count     = 0;
366     my $textlimit = $label_width - $left_text_margin;
367
368     while ( $strwidth < $textlimit ) {
369         $strwidth = prStrWidth( $string, 'C', $fontsize );
370         $string = $string . '0';
371
372         #       warn "strwidth $strwidth, $textlimit, $string";
373         $count++;
374     }
375     return $count;
376 }
377
378 sub GetActiveLabelTemplate {
379     my $dbh   = C4::Context->dbh;
380     my $query = " SELECT * FROM labels_templates where active = 1 limit 1";
381     my $sth   = $dbh->prepare($query);
382     $sth->execute();
383     my $active_tmpl = $sth->fetchrow_hashref;
384     $sth->finish;
385     return $active_tmpl;
386 }
387
388 sub GetSingleLabelTemplate {
389     my ($tmpl_id) = @_;
390     my $dbh       = C4::Context->dbh;
391     my $query     = " SELECT * FROM labels_templates where tmpl_id = ?";
392     my $sth       = $dbh->prepare($query);
393     $sth->execute($tmpl_id);
394     my $template = $sth->fetchrow_hashref;
395     $sth->finish;
396     return $template;
397 }
398
399 sub SetActiveTemplate {
400
401     my ($tmpl_id) = @_;
402   
403     my $dbh   = C4::Context->dbh;
404     my $query = " UPDATE labels_templates SET active = NULL";
405     my $sth   = $dbh->prepare($query);
406     $sth->execute();
407
408     $query = "UPDATE labels_templates SET active = 1 WHERE tmpl_id = ?";
409     $sth   = $dbh->prepare($query);
410     $sth->execute($tmpl_id);
411     $sth->finish;
412 }
413
414 sub set_active_layout {
415
416     my ($layout_id) = @_;
417     my $dbh         = C4::Context->dbh;
418     my $query       = " UPDATE labels_conf SET active = NULL";
419     my $sth         = $dbh->prepare($query);
420     $sth->execute();
421
422     $query = "UPDATE labels_conf SET active = 1 WHERE id = ?";
423     $sth   = $dbh->prepare($query);
424     $sth->execute($layout_id);
425     $sth->finish;
426 }
427
428 sub DeleteTemplate {
429     my ($tmpl_id) = @_;
430     my $dbh       = C4::Context->dbh;
431     my $query     = " DELETE  FROM labels_templates where tmpl_id = ?";
432     my $sth       = $dbh->prepare($query);
433     $sth->execute($tmpl_id);
434     $sth->finish;
435 }
436
437 sub SaveTemplate {
438     my (
439         $tmpl_id,     $tmpl_code,   $tmpl_desc,    $page_width,
440         $page_height, $label_width, $label_height, $topmargin,
441         $leftmargin,  $cols,        $rows,         $colgap,
442         $rowgap,      $fontsize,     $units
443     ) = @_;
444     my $dbh = C4::Context->dbh;
445     my $query =
446       " UPDATE labels_templates SET tmpl_code=?, tmpl_desc=?, page_width=?,
447                page_height=?, label_width=?, label_height=?, topmargin=?,
448                leftmargin=?, cols=?, rows=?, colgap=?, rowgap=?, fontsize=?,
449                            units=? 
450                   WHERE tmpl_id = ?";
451
452     my $sth = $dbh->prepare($query);
453     $sth->execute(
454         $tmpl_code,   $tmpl_desc,    $page_width, $page_height,
455         $label_width, $label_height, $topmargin,  $leftmargin,
456         $cols,        $rows,         $colgap,     $rowgap,
457         $fontsize,    $units,        $tmpl_id
458     );
459     $sth->finish;
460 }
461
462 sub CreateTemplate {
463     my $tmpl_id;
464     my (
465         $tmpl_code,   $tmpl_desc,    $page_width, $page_height,
466         $label_width, $label_height, $topmargin,  $leftmargin,
467         $cols,        $rows,         $colgap,     $rowgap,
468         $fontsize,     $units
469     ) = @_;
470
471     my $dbh = C4::Context->dbh;
472
473     my $query = "INSERT INTO labels_templates (tmpl_code, tmpl_desc, page_width,
474                          page_height, label_width, label_height, topmargin,
475                          leftmargin, cols, rows, colgap, rowgap, fontsize, units)
476                          VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?,?)";
477
478     my $sth = $dbh->prepare($query);
479     $sth->execute(
480         $tmpl_code,   $tmpl_desc,    $page_width, $page_height,
481         $label_width, $label_height, $topmargin,  $leftmargin,
482         $cols,        $rows,         $colgap,     $rowgap,
483         $fontsize,    $units
484     );
485 }
486
487 sub GetAllLabelTemplates {
488     my $dbh = C4::Context->dbh;
489
490     # get the actual items to be printed.
491     my @data;
492     my $query = " Select * from labels_templates ";
493     my $sth   = $dbh->prepare($query);
494     $sth->execute();
495     my @resultsloop;
496     while ( my $data = $sth->fetchrow_hashref ) {
497         push( @resultsloop, $data );
498     }
499     $sth->finish;
500
501     #warn Dumper @resultsloop;
502     return @resultsloop;
503 }
504
505 #sub SaveConf {
506 sub add_layout {
507
508     my (
509         $barcodetype,  $title,          $subtitle,      $isbn,       $issn,
510         $itemtype,     $bcn,            $dcn,        $classif,
511         $subclass,     $itemcallnumber, $author,     $tmpl_id,
512         $printingtype, $guidebox,       $startlabel, $layoutname
513     ) = @_;
514
515     my $dbh    = C4::Context->dbh;
516     my $query2 = "update labels_conf set active = NULL";
517     my $sth2   = $dbh->prepare($query2);
518     $sth2->execute();
519     $query2 = "INSERT INTO labels_conf
520             ( barcodetype, title, subtitle, isbn,issn, itemtype, barcode,
521               dewey, class, subclass, itemcallnumber, author, printingtype,
522                 guidebox, startlabel, layoutname, active )
523                values ( ?, ?, ?, ?, ?, ?, ?,  ?,?, ?, ?, ?, ?, ?,?,?, 1 )";
524     $sth2 = $dbh->prepare($query2);
525     $sth2->execute(
526         $barcodetype, $title, $subtitle, $isbn, $issn,
527
528         $itemtype, $bcn,            $dcn,    $classif,
529         $subclass, $itemcallnumber, $author, $printingtype,
530         $guidebox, $startlabel,     $layoutname
531     );
532     $sth2->finish;
533
534     SetActiveTemplate($tmpl_id);
535     return;
536 }
537
538 sub save_layout {
539
540     my (
541         $barcodetype,  $title,          $subtitle,      $isbn,       $issn,
542         $itemtype,     $bcn,            $dcn,        $classif,
543         $subclass,     $itemcallnumber, $author,     $tmpl_id,
544         $printingtype, $guidebox,       $startlabel, $layoutname,
545         $layout_id
546     ) = @_;
547 ### $layoutname
548 ### $layout_id
549
550     my $dbh    = C4::Context->dbh;
551     my $query2 = "update labels_conf set 
552              barcodetype=?, title=?, subtitle=?, isbn=?,issn=?, 
553             itemtype=?, barcode=?,    dewey=?, class=?,
554              subclass=?, itemcallnumber=?, author=?,  printingtype=?,  
555                guidebox=?, startlabel=?, layoutname=? where id = ?";
556     my $sth2 = $dbh->prepare($query2);
557     $sth2->execute(
558         $barcodetype, $title,          $subtitle,       $isbn,       $issn,
559         $itemtype,    $bcn,            $dcn,        $classif,
560         $subclass,    $itemcallnumber, $author,     $printingtype,
561         $guidebox,    $startlabel,     $layoutname, $layout_id
562     );
563     $sth2->finish;
564
565     return;
566 }
567
568 =item GetAllPrinterProfiles;
569
570     @profiles = GetAllPrinterProfiles()
571
572 Returns an array of references-to-hash, whos keys are .....
573
574 =cut
575
576 sub GetAllPrinterProfiles {
577
578     my $dbh = C4::Context->dbh;
579     my @data;
580     my $query = "SELECT * FROM printers_profile AS pp INNER JOIN labels_templates AS lt ON pp.tmpl_id = lt.tmpl_id; ";
581     my $sth = $dbh->prepare($query);
582     $sth->execute();
583     my @resultsloop;
584     while ( my $data = $sth->fetchrow_hashref ) {
585         push( @resultsloop, $data );
586     }
587     $sth->finish;
588
589     return @resultsloop;
590 }
591
592 =item GetSinglePrinterProfile;
593
594     $profile = GetSinglePrinterProfile()
595
596 Returns a hashref whos keys are...
597
598 =cut
599
600 sub GetSinglePrinterProfile {
601     my ($prof_id) = @_;
602     my $dbh       = C4::Context->dbh;
603     my $query     = " SELECT * FROM printers_profile WHERE prof_id = ?; ";
604     my $sth       = $dbh->prepare($query);
605     $sth->execute($prof_id);
606     my $template = $sth->fetchrow_hashref;
607     $sth->finish;
608     return $template;
609 }
610
611 =item SaveProfile;
612
613     SaveProfile('parameters')
614
615 When passed a set of parameters, this function updates the given profile with the new parameters.
616
617 =cut
618
619 sub SaveProfile {
620     my (
621         $prof_id,       $offset_horz,   $offset_vert,   $creep_horz,    $creep_vert,    $units
622     ) = @_;
623     my $dbh = C4::Context->dbh;
624     my $query =
625       " UPDATE printers_profile
626         SET offset_horz=?, offset_vert=?, creep_horz=?, creep_vert=?, unit=? 
627         WHERE prof_id = ? ";
628     my $sth = $dbh->prepare($query);
629     $sth->execute(
630         $offset_horz,   $offset_vert,   $creep_horz,    $creep_vert,    $units,         $prof_id
631     );
632     $sth->finish;
633 }
634
635 =item CreateProfile;
636
637     CreateProfile('parameters')
638
639 When passed a set of parameters, this function creates a new profile containing those parameters
640 and returns any errors.
641
642 =cut
643
644 sub CreateProfile {
645     my (
646         $prof_id,       $printername,   $paper_bin,     $tmpl_id,     $offset_horz,
647         $offset_vert,   $creep_horz,    $creep_vert,    $units
648     ) = @_;
649     my $dbh = C4::Context->dbh;
650     my $query = 
651         " INSERT INTO printers_profile (prof_id, printername, paper_bin, tmpl_id,
652                                         offset_horz, offset_vert, creep_horz, creep_vert, unit)
653           VALUES(?,?,?,?,?,?,?,?,?) ";
654     my $sth = $dbh->prepare($query);
655     $sth->execute(
656         $prof_id,       $printername,   $paper_bin,     $tmpl_id,     $offset_horz,
657         $offset_vert,   $creep_horz,    $creep_vert,    $units
658     );
659     my $error =  $sth->errstr;
660     $sth->finish;
661     return $error;
662 }
663
664 =item DeleteProfile;
665
666     DeleteProfile(prof_id)
667
668 When passed a profile id, this function deletes that profile from the database and returns any errors.
669
670 =cut
671
672 sub DeleteProfile {
673     my ($prof_id) = @_;
674     my $dbh       = C4::Context->dbh;
675     my $query     = " DELETE FROM printers_profile WHERE prof_id = ?";
676     my $sth       = $dbh->prepare($query);
677     $sth->execute($prof_id);
678     my $error = $sth->errstr;
679     $sth->finish;
680     return $error;
681 }
682
683 =item GetAssociatedProfile;
684
685     $assoc_prof = GetAssociatedProfile(tmpl_id)
686
687 When passed a template id, this function returns the parameters from the currently associated printer profile
688 in a hashref where key=fieldname and value=fieldvalue.
689
690 =cut
691
692 sub GetAssociatedProfile {
693     my ($tmpl_id) = @_;
694     my $dbh   = C4::Context->dbh;
695     # First we find out the prof_id for the associated profile...
696     my $query = "SELECT * FROM labels_profile WHERE tmpl_id = ?";
697     my $sth   = $dbh->prepare($query);
698     $sth->execute($tmpl_id);
699     my $assoc_prof = $sth->fetchrow_hashref;
700     $sth->finish;
701     # Then we retrieve that profile and return it to the caller...
702     $assoc_prof = GetSinglePrinterProfile($assoc_prof->{'prof_id'});
703     return $assoc_prof;
704 }
705
706 =item SetAssociatedProfile;
707
708     SetAssociatedProfile($prof_id, $tmpl_id)
709
710 When passed both a profile id and template id, this function establishes an association between the two. No more
711 than one profile may be associated with any given template at the same time.
712
713 =cut
714
715 sub SetAssociatedProfile {
716
717     my ($prof_id, $tmpl_id) = @_;
718   
719     my $dbh = C4::Context->dbh;
720     my $query = "INSERT INTO labels_profile (prof_id, tmpl_id) VALUES (?,?) ON DUPLICATE KEY UPDATE prof_id = ?";
721     my $sth = $dbh->prepare($query);
722     $sth->execute($prof_id, $tmpl_id, $prof_id);
723     $sth->finish;
724 }
725
726 =item get_label_items;
727
728         $options = get_label_items()
729
730 Returns an array of references-to-hash, whos keys are the field from the biblio, biblioitems, items and labels tables in the Koha database.
731
732 =cut
733
734 #'
735 sub get_label_items {
736     my ($batch_id) = @_;
737     my $dbh = C4::Context->dbh;
738
739     my @resultsloop = ();
740     my $count;
741     my @data;
742     my $sth;
743
744     if ($batch_id) {
745         my $query3 = "Select * from labels where batch_id = ? order by labelid ";
746         $sth = $dbh->prepare($query3);
747         $sth->execute($batch_id);
748
749     }
750     else {
751
752         my $query3 = "Select * from labels";
753         $sth = $dbh->prepare($query3);
754         $sth->execute();
755     }
756     my $cnt = $sth->rows;
757     my $i1  = 1;
758     while ( my $data = $sth->fetchrow_hashref ) {
759
760         # lets get some summary info from each item
761         my $query1 = " 
762          select i.*, bi.*, b.*  from items i,biblioitems bi,biblio b 
763                 where itemnumber=? and  i.biblioitemnumber=bi.biblioitemnumber and                  
764                 bi.biblionumber=b.biblionumber"; 
765      
766                 my $sth1 = $dbh->prepare($query1);
767         $sth1->execute( $data->{'itemnumber'} );
768
769         my $data1 = $sth1->fetchrow_hashref();
770         $data1->{'labelno'}  = $i1;
771         $data1->{'labelid'}  = $data->{'labelid'};
772         $data1->{'batch_id'} = $batch_id;
773         $data1->{'summary'} =
774           "$data1->{'barcode'}, $data1->{'title'}, $data1->{'isbn'}";
775
776         push( @resultsloop, $data1 );
777         $sth1->finish;
778
779         $i1++;
780     }
781     $sth->finish;
782     return @resultsloop;
783
784 }
785
786 sub GetItemFields {
787     my @fields = qw (
788       barcode title subtitle
789       dewey isbn issn author class
790       itemtype subclass itemcallnumber
791
792     );
793     return @fields;
794 }
795
796 sub deduplicate_batch {
797         my $batch_id = shift or return undef;
798         my $query = "
799         SELECT DISTINCT
800                         batch_id,itemnumber,
801                         count(labelid) as count 
802         FROM     labels 
803         WHERE    batch_id = ?
804         GROUP BY itemnumber,batch_id
805         HAVING   count > 1
806         ORDER BY batch_id,
807                          count DESC  ";
808         my $sth = C4::Context->dbh->prepare($query);
809         $sth->execute($batch_id);
810         $sth->rows or return undef;
811
812         my $del_query = qq(
813         DELETE 
814         FROM     labels 
815         WHERE    batch_id = ?
816         AND      itemnumber = ?
817         ORDER BY timestamp ASC
818         );
819         my $killed = 0;
820         while (my $data = $sth->fetchrow_hashref()) {
821                 my $itemnumber = $data->{itemnumber} or next;
822                 my $limit      = $data->{count} - 1  or next;
823                 my $sth2 = C4::Context->dbh->prepare("$del_query  LIMIT $limit");
824                 # die sprintf "$del_query LIMIT %s\n (%s, %s)", $limit, $batch_id, $itemnumber;
825                 # $sth2->execute($batch_id, C4::Context->dbh->quote($data->{itemnumber}), $data->{count} - 1)
826                 $sth2->execute($batch_id, $itemnumber) and
827                         $killed += ($data->{count} - 1);
828         }
829         return $killed;
830 }
831
832 sub DrawSpineText {
833
834     my ( $y_pos, $label_height, $fontsize, $x_pos, $left_text_margin,
835         $text_wrap_cols, $item, $conf_data )
836       = @_;
837 # hack to fix column name mismatch betwen labels_conf.class, and bibitems.classification
838         $$item->{'class'} = $$item->{'classification'};
839  
840     $Text::Wrap::columns   = $text_wrap_cols;
841     $Text::Wrap::separator = "\n";
842
843     my $str;
844     ##      $item
845
846     my $top_text_margin = ( $fontsize + 3 );
847     my $line_spacer = ($fontsize);    # number of pixels between text rows.
848
849     # add your printable fields manually in here
850
851 my $layout_id = $$conf_data->{'id'};
852
853 #    my @fields = GetItemFields();
854
855 my $str_fields = get_text_fields($layout_id, 'codes' );
856 my @fields = split(/ /, $str_fields);
857 #warn Dumper(@fields);
858 ### @fields
859
860     my $vPos   = ( $y_pos + ( $label_height - $top_text_margin ) );
861     my $hPos   = ( $x_pos + $left_text_margin );
862
863     # warn Dumper $conf_data;
864     #warn Dumper $item;
865
866     foreach my $field (@fields) {
867
868         # testing hack
869 #     $$item->{"$field"} = $field . ": " . $$item->{"$field"};
870
871         # if the display option for this field is selected in the DB,
872         # and the item record has some values for this field, display it.
873         if ( $$conf_data->{"$field"} && $$item->{"$field"} ) {
874
875             #            warn "CONF_TYPE = $field";
876
877             # get the string
878             $str = $$item->{"$field"};
879             # strip out naughty existing nl/cr's
880             $str =~ s/\n//g;
881             $str =~ s/\r//g;
882
883             # chop the string up into _upto_ 12 chunks
884             # and seperate the chunks with newlines
885
886             $str = wrap( "", "", "$str" );
887             $str = wrap( "", "", "$str" );
888
889             # split the chunks between newline's, into an array
890             my @strings = split /\n/, $str;
891
892             # then loop for each string line
893             foreach my $str (@strings) {
894
895                 #warn "HPOS ,  VPOS $hPos, $vPos ";
896                 # set the font size A
897
898                 #   prText( $hPos, $vPos, $str );
899                 PrintText( $hPos, $vPos, $fontsize, $str );
900                 $vPos = $vPos - $line_spacer;
901             }
902         }    # if field is     }    #foreach feild
903     }
904 }
905
906 sub PrintText {
907     my ( $hPos, $vPos, $fontsize, $text ) = @_;
908     my $str = "BT /Ft1 $fontsize Tf $hPos $vPos Td ($text) Tj ET";
909     prAdd($str);
910 }
911
912 sub SetFontSize {
913
914     my ($fontsize) = @_;
915 ### fontsize
916     my $str = "BT/F13 30 Tf288 720 Td( AAAAAAAAAA ) TjET";
917     prAdd($str);
918 }
919
920 sub DrawBarcode {
921
922     # x and y are from the top-left :)
923     my ( $x_pos, $y_pos, $height, $width, $barcode, $barcodetype ) = @_;
924     my $num_of_bars = length($barcode);
925     my $bar_width   = $width * .8;        # %80 of length of label width
926     my $tot_bar_length;
927     my $bar_length;
928     my $guard_length = 10;
929     my $xsize_ratio;
930
931     if ( $barcodetype eq 'CODE39' ) {
932         $bar_length = '17.5';
933         $tot_bar_length =
934           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
935         $xsize_ratio = ( $bar_width / $tot_bar_length );
936         eval {
937             PDF::Reuse::Barcode::Code39(
938                 x => ( $x_pos + ( $width / 10 ) ),
939                 y => ( $y_pos + ( $height / 10 ) ),
940                 value         => "*$barcode*",
941                 ySize         => ( .02 * $height ),
942                 xSize         => $xsize_ratio,
943                 hide_asterisk => 1,
944             );
945         };
946         if ($@) {
947             warn "$barcodetype, $barcode FAILED:$@";
948         }
949     }
950
951     elsif ( $barcodetype eq 'CODE39MOD' ) {
952
953         # get modulo43 checksum
954         my $c39 = CheckDigits('code_39');
955         $barcode = $c39->complete($barcode);
956
957         $bar_length = '19';
958         $tot_bar_length =
959           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
960         $xsize_ratio = ( $bar_width / $tot_bar_length );
961         eval {
962             PDF::Reuse::Barcode::Code39(
963                 x => ( $x_pos + ( $width / 10 ) ),
964                 y => ( $y_pos + ( $height / 10 ) ),
965                 value         => "*$barcode*",
966                 ySize         => ( .02 * $height ),
967                 xSize         => $xsize_ratio,
968                 hide_asterisk => 1,
969             );
970         };
971
972         if ($@) {
973             warn "$barcodetype, $barcode FAILED:$@";
974         }
975     }
976     elsif ( $barcodetype eq 'CODE39MOD10' ) {
977  
978         # get modulo43 checksum
979         my $c39_10 = CheckDigits('visa');
980         $barcode = $c39_10->complete($barcode);
981
982         $bar_length = '19';
983         $tot_bar_length =
984           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
985         $xsize_ratio = ( $bar_width / $tot_bar_length );
986         eval {
987             PDF::Reuse::Barcode::Code39(
988                 x => ( $x_pos + ( $width / 10 ) ),
989                 y => ( $y_pos + ( $height / 10 ) ),
990                 value         => "*$barcode*",
991                 ySize         => ( .02 * $height ),
992                 xSize         => $xsize_ratio,
993                 hide_asterisk => 1,
994                                 text         => 0, 
995             );
996         };
997
998         if ($@) {
999             warn "$barcodetype, $barcode FAILED:$@";
1000         }
1001     }
1002
1003  
1004     elsif ( $barcodetype eq 'COOP2OF5' ) {
1005         $bar_length = '9.43333333333333';
1006         $tot_bar_length =
1007           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
1008         $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
1009         eval {
1010             PDF::Reuse::Barcode::COOP2of5(
1011                 x => ( $x_pos + ( $width / 10 ) ),
1012                 y => ( $y_pos + ( $height / 10 ) ),
1013                 value => $barcode,
1014                 ySize => ( .02 * $height ),
1015                 xSize => $xsize_ratio,
1016             );
1017         };
1018         if ($@) {
1019             warn "$barcodetype, $barcode FAILED:$@";
1020         }
1021     }
1022
1023     elsif ( $barcodetype eq 'INDUSTRIAL2OF5' ) {
1024         $bar_length = '13.1333333333333';
1025         $tot_bar_length =
1026           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
1027         $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
1028         eval {
1029             PDF::Reuse::Barcode::Industrial2of5(
1030                 x => ( $x_pos + ( $width / 10 ) ),
1031                 y => ( $y_pos + ( $height / 10 ) ),
1032                 value => $barcode,
1033                 ySize => ( .02 * $height ),
1034                 xSize => $xsize_ratio,
1035             );
1036         };
1037         if ($@) {
1038             warn "$barcodetype, $barcode FAILED:$@";
1039         }
1040     }
1041
1042     my $moo2 = $tot_bar_length * $xsize_ratio;
1043
1044     warn "$x_pos, $y_pos, $barcode, $barcodetype" if $DEBUG;
1045     warn "BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length  R*TOT.BAR =$moo2" if $DEBUG;
1046 }
1047
1048 =item build_circ_barcode;
1049
1050   build_circ_barcode( $x_pos, $y_pos, $barcode,
1051                 $barcodetype, \$item);
1052
1053 $item is the result of a previous call to get_label_items();
1054
1055 =cut
1056
1057 #'
1058 sub build_circ_barcode {
1059     my ( $x_pos_circ, $y_pos, $value, $barcodetype, $item ) = @_;
1060
1061     #warn Dumper \$item;
1062
1063     #warn "value = $value\n";
1064
1065     #$DB::single = 1;
1066
1067     if ( $barcodetype eq 'EAN13' ) {
1068
1069         #testing EAN13 barcodes hack
1070         $value = $value . '000000000';
1071         $value =~ s/-//;
1072         $value = substr( $value, 0, 12 );
1073
1074         #warn $value;
1075         eval {
1076             PDF::Reuse::Barcode::EAN13(
1077                 x     => ( $x_pos_circ + 27 ),
1078                 y     => ( $y_pos + 15 ),
1079                 value => $value,
1080
1081                 #            prolong => 2.96,
1082                 #            xSize   => 1.5,
1083
1084                 # ySize   => 1.2,
1085
1086 # added for xpdf compat. doesnt use type3 fonts., but increases filesize from 20k to 200k
1087 # i think its embedding extra fonts in the pdf file.
1088 #  mode => 'graphic',
1089             );
1090         };
1091         if ($@) {
1092             $item->{'barcodeerror'} = 1;
1093
1094             #warn "EAN13BARCODE FAILED:$@";
1095         }
1096
1097         #warn $barcodetype;
1098
1099     }
1100     elsif ( $barcodetype eq 'Code39' ) {
1101
1102         eval {
1103             PDF::Reuse::Barcode::Code39(
1104                 x     => ( $x_pos_circ + 9 ),
1105                 y     => ( $y_pos + 15 ),
1106                 value => $value,
1107
1108                 #           prolong => 2.96,
1109                 xSize => .85,
1110
1111                 ySize => 1.3,
1112             );
1113         };
1114         if ($@) {
1115             $item->{'barcodeerror'} = 1;
1116
1117             #warn "CODE39BARCODE $value FAILED:$@";
1118         }
1119
1120         #warn $barcodetype;
1121
1122     }
1123
1124     elsif ( $barcodetype eq 'Matrix2of5' ) {
1125
1126         #warn "MATRIX ELSE:";
1127
1128         #testing MATRIX25  barcodes hack
1129         #    $value = $value.'000000000';
1130         $value =~ s/-//;
1131
1132         #    $value = substr( $value, 0, 12 );
1133         #warn $value;
1134
1135         eval {
1136             PDF::Reuse::Barcode::Matrix2of5(
1137                 x     => ( $x_pos_circ + 27 ),
1138                 y     => ( $y_pos + 15 ),
1139                 value => $value,
1140
1141                 #        prolong => 2.96,
1142                 #       xSize   => 1.5,
1143
1144                 # ySize   => 1.2,
1145             );
1146         };
1147         if ($@) {
1148             $item->{'barcodeerror'} = 1;
1149
1150             #warn "BARCODE FAILED:$@";
1151         }
1152
1153         #warn $barcodetype;
1154
1155     }
1156
1157     elsif ( $barcodetype eq 'EAN8' ) {
1158
1159         #testing ean8 barcodes hack
1160         $value = $value . '000000000';
1161         $value =~ s/-//;
1162         $value = substr( $value, 0, 8 );
1163
1164         #warn $value;
1165
1166         #warn "EAN8 ELSEIF";
1167         eval {
1168             PDF::Reuse::Barcode::EAN8(
1169                 x       => ( $x_pos_circ + 42 ),
1170                 y       => ( $y_pos + 15 ),
1171                 value   => $value,
1172                 prolong => 2.96,
1173                 xSize   => 1.5,
1174
1175                 # ySize   => 1.2,
1176             );
1177         };
1178
1179         if ($@) {
1180             $item->{'barcodeerror'} = 1;
1181
1182             #warn "BARCODE FAILED:$@";
1183         }
1184
1185         #warn $barcodetype;
1186
1187     }
1188
1189     elsif ( $barcodetype eq 'UPC-E' ) {
1190         eval {
1191             PDF::Reuse::Barcode::UPCE(
1192                 x       => ( $x_pos_circ + 27 ),
1193                 y       => ( $y_pos + 15 ),
1194                 value   => $value,
1195                 prolong => 2.96,
1196                 xSize   => 1.5,
1197
1198                 # ySize   => 1.2,
1199             );
1200         };
1201
1202         if ($@) {
1203             $item->{'barcodeerror'} = 1;
1204
1205             #warn "BARCODE FAILED:$@";
1206         }
1207
1208         #warn $barcodetype;
1209
1210     }
1211     elsif ( $barcodetype eq 'NW7' ) {
1212         eval {
1213             PDF::Reuse::Barcode::NW7(
1214                 x       => ( $x_pos_circ + 27 ),
1215                 y       => ( $y_pos + 15 ),
1216                 value   => $value,
1217                 prolong => 2.96,
1218                 xSize   => 1.5,
1219
1220                 # ySize   => 1.2,
1221             );
1222         };
1223
1224         if ($@) {
1225             $item->{'barcodeerror'} = 1;
1226
1227             #warn "BARCODE FAILED:$@";
1228         }
1229
1230         #warn $barcodetype;
1231
1232     }
1233     elsif ( $barcodetype eq 'ITF' ) {
1234         eval {
1235             PDF::Reuse::Barcode::ITF(
1236                 x       => ( $x_pos_circ + 27 ),
1237                 y       => ( $y_pos + 15 ),
1238                 value   => $value,
1239                 prolong => 2.96,
1240                 xSize   => 1.5,
1241
1242                 # ySize   => 1.2,
1243             );
1244         };
1245
1246         if ($@) {
1247             $item->{'barcodeerror'} = 1;
1248
1249             #warn "BARCODE FAILED:$@";
1250         }
1251
1252         #warn $barcodetype;
1253
1254     }
1255     elsif ( $barcodetype eq 'Industrial2of5' ) {
1256         eval {
1257             PDF::Reuse::Barcode::Industrial2of5(
1258                 x       => ( $x_pos_circ + 27 ),
1259                 y       => ( $y_pos + 15 ),
1260                 value   => $value,
1261                 prolong => 2.96,
1262                 xSize   => 1.5,
1263
1264                 # ySize   => 1.2,
1265             );
1266         };
1267         if ($@) {
1268             $item->{'barcodeerror'} = 1;
1269
1270             #warn "BARCODE FAILED:$@";
1271         }
1272
1273         #warn $barcodetype;
1274
1275     }
1276     elsif ( $barcodetype eq 'IATA2of5' ) {
1277         eval {
1278             PDF::Reuse::Barcode::IATA2of5(
1279                 x       => ( $x_pos_circ + 27 ),
1280                 y       => ( $y_pos + 15 ),
1281                 value   => $value,
1282                 prolong => 2.96,
1283                 xSize   => 1.5,
1284
1285                 # ySize   => 1.2,
1286             );
1287         };
1288         if ($@) {
1289             $item->{'barcodeerror'} = 1;
1290
1291             #warn "BARCODE FAILED:$@";
1292         }
1293
1294         #warn $barcodetype;
1295
1296     }
1297
1298     elsif ( $barcodetype eq 'COOP2of5' ) {
1299         eval {
1300             PDF::Reuse::Barcode::COOP2of5(
1301                 x       => ( $x_pos_circ + 27 ),
1302                 y       => ( $y_pos + 15 ),
1303                 value   => $value,
1304                 prolong => 2.96,
1305                 xSize   => 1.5,
1306
1307                 # ySize   => 1.2,
1308             );
1309         };
1310         if ($@) {
1311             $item->{'barcodeerror'} = 1;
1312
1313             #warn "BARCODE FAILED:$@";
1314         }
1315
1316         #warn $barcodetype;
1317
1318     }
1319     elsif ( $barcodetype eq 'UPC-A' ) {
1320
1321         eval {
1322             PDF::Reuse::Barcode::UPCA(
1323                 x       => ( $x_pos_circ + 27 ),
1324                 y       => ( $y_pos + 15 ),
1325                 value   => $value,
1326                 prolong => 2.96,
1327                 xSize   => 1.5,
1328
1329                 # ySize   => 1.2,
1330             );
1331         };
1332         if ($@) {
1333             $item->{'barcodeerror'} = 1;
1334
1335             #warn "BARCODE FAILED:$@";
1336         }
1337
1338         #warn $barcodetype;
1339
1340     }
1341
1342 }
1343
1344 =item draw_boundaries
1345
1346  sub draw_boundaries ($x_pos_spine, $x_pos_circ1, $x_pos_circ2,
1347                 $y_pos, $spine_width, $label_height, $circ_width)  
1348
1349 This sub draws boundary lines where the label outlines are, to aid in printer testing, and debugging.
1350
1351 =cut
1352
1353 #'
1354 sub draw_boundaries {
1355
1356     my (
1357         $x_pos_spine, $x_pos_circ1,  $x_pos_circ2, $y_pos,
1358         $spine_width, $label_height, $circ_width
1359     ) = @_;
1360
1361     my $y_pos_initial = ( ( 792 - 36 ) - 90 );
1362     $y_pos            = $y_pos_initial; # FIXME - why are we ignoring the y_pos parameter by redefining it?
1363     my $i             = 1;
1364
1365     for ( $i = 1 ; $i <= 8 ; $i++ ) {
1366
1367         &drawbox( $x_pos_spine, $y_pos, ($spine_width), ($label_height) );
1368
1369    #warn "OLD BOXES  x=$x_pos_spine, y=$y_pos, w=$spine_width, h=$label_height";
1370         &drawbox( $x_pos_circ1, $y_pos, ($circ_width), ($label_height) );
1371         &drawbox( $x_pos_circ2, $y_pos, ($circ_width), ($label_height) );
1372
1373         $y_pos = ( $y_pos - $label_height );
1374
1375     }
1376 }
1377
1378 =item drawbox
1379
1380         sub drawbox {   $lower_left_x, $lower_left_y, 
1381                         $upper_right_x, $upper_right_y )
1382
1383 this is a low level sub, that draws a pdf box, it is called by draw_boxes
1384
1385 FYI: the  $upper_right_x and $upper_right_y values are RELATIVE to  $lower_left_x and $lower_left_y
1386
1387 and $lower_left_x, $lower_left_y are ABSOLUTE, this caught me out!
1388
1389 =cut
1390
1391 #'
1392 sub drawbox {
1393     my ( $llx, $lly, $urx, $ury ) = @_;
1394
1395     #    warn "llx,y= $llx,$lly  ,   urx,y=$urx,$ury \n";
1396
1397     my $str = "q\n";    # save the graphic state
1398     $str .= "0.5 w\n";              # border color red
1399     $str .= "1.0 0.0 0.0  RG\n";    # border color red
1400          #   $str .= "0.5 0.75 1.0 rg\n";           # fill color blue
1401     $str .= "1.0 1.0 1.0  rg\n";    # fill color white
1402
1403     $str .= "$llx $lly $urx $ury re\n";    # a rectangle
1404     $str .= "B\n";                         # fill (and a little more)
1405     $str .= "Q\n";                         # save the graphic state
1406
1407     prAdd($str);
1408
1409 }
1410
1411 END { }    # module clean-up code here (global destructor)
1412
1413 1;
1414 __END__
1415
1416 =back
1417
1418 =head1 AUTHOR
1419
1420 Mason James <mason@katipo.co.nz>
1421
1422 =cut
1423