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