koha-dev.rot13.org Git - koha_fer/blob - 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, classification, 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=?, classification=?,
 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     # Replaced item's itemtype with the more user-friendly description...
 924     my $dbh = C4::Context->dbh;
 925     my %itemtypes;
 926     my $sth = $dbh->prepare("SELECT itemtype,description FROM itemtypes");
 927     $sth->execute();
 928     while ( my $data = $sth->fetchrow_hashref ) {
 929         $$item->{'itemtype'} = $data->{'description'} if ($$item->{'itemtype'} eq $data->{'itemtype'});
 930     }
 931
 932     $Text::Wrap::columns   = $text_wrap_cols;
 933     $Text::Wrap::separator = "\n";
 934
 935     my $str;
 936
 937     my $top_text_margin = ( $fontsize + 3 );    #FIXME: This should be a template parameter and passed in...
 938     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.).
 939
 940     my $layout_id = $$conf_data->{'id'};
 941
 942     my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
 943
 944     my @str_fields = get_text_fields($layout_id, 'codes' );
 945     my @fields;
 946     foreach my $field (@str_fields) {
 947         push (@fields, $field->{'code'});
 948     }
 949
 950     my $old_fontname = $fontname; # We need to keep track of the original font passed in...
 951
 952     foreach my $field (@fields) {
 953         # This allows us to print the title in italic (oblique) type... (Times Roman has a different nomenclature.)
 954         # It seems there should be a better way to handle fonts in the label/patron card tool altogether -fbcit
 955         ($field eq 'title') ? (($old_fontname =~ /T/) ? ($fontname = 'TI') : ($fontname = ($old_fontname . 'O'))) : ($fontname = $old_fontname);
 956         my $font = prFont($fontname);
 957         # if the display option for this field is selected in the DB,
 958         # and the item record has some values for this field, display it.
 959         if ( $$conf_data->{"$field"} && $$item->{"$field"} ) {
 960             # get the string
 961             $str = $$item->{"$field"};
 962             # strip out naughty existing nl/cr's
 963             $str =~ s/\n//g;
 964             $str =~ s/\r//g;
 965             my @strings;
 966             if ($field eq 'itemcallnumber') { # If the field contains the call number, we do some special processing on it here...
 967                 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.)
 968                     while ( $str =~ /\// ) {
 969                         $str =~ /^(.*)\/(.*)$/;
 970                         unshift @strings, $2;
 971                         $str = $1;
 972                     }
 973                     unshift @strings, $str;
 974                 } else {
 975                     push @strings, $str;    # or if we are not wrapping the call number just send it along as we found it...
 976                 }
 977             } else {    # Here we will strip out all trailing '/' in fields other than the call number...
 978                 $str =~ s/\/$//g;
 979                 push @strings, $str;
 980             }
 981             # loop for each string line
 982             foreach my $str (@strings) {
 983                 my $hPos;
 984                 if ( $printingtype eq 'BIB' ) { #FIXME: This is a hack and needs to be implimented as a text justification option in the template...
 985                     # some code to try and center each line on the label based on font size and string point width...
 986                     my $stringwidth = prStrWidth($str, $fontname, $fontsize);
 987                     my $whitespace = ( $label_width - ( $stringwidth + (2 * $left_text_margin) ) );
 988                     $hPos = ( ( $whitespace  / 2 ) + $x_pos + $left_text_margin );
 989                     #warn "\$label_width=$label_width \$stringwidth=$stringwidth \$whitespace=$whitespace \$left_text_margin=$left_text_margin for $str\n";
 990                 } else {
 991                     $hPos = ( $x_pos + $left_text_margin );
 992                 }
 993                 PrintText( $hPos, $vPos, $font, $fontsize, $str );
 994                 $vPos = $vPos - $line_spacer;
 995             }
 996         }    # if field is
 997     }    #foreach feild
 998 }
 999
1000 sub PrintText {
1001     my ( $hPos, $vPos, $font, $fontsize, $text ) = @_;
1002     my $str = "BT /$font $fontsize Tf $hPos $vPos Td ($text) Tj ET";
1003     prAdd($str);
1004 }
1005
1006 sub DrawPatronCardText {
1007
1008     my ( $x_pos, $y_pos, $label_height, $label_width, $fontname, $fontsize, $left_text_margin,
1009         $text_wrap_cols, $text, $printingtype )
1010       = @_;
1011
1012     my $top_text_margin = 25;    #FIXME: This should be a template parameter and passed in...
1013
1014     my $vPos   = ( $y_pos + ( $label_height - $top_text_margin ) );
1015     my $font = prFont($fontname);
1016
1017     my $hPos;
1018
1019     foreach my $line (keys %$text) {
1020         warn "Current text is \"$line\" and font size for \"$line\" is $text->{$line} points";
1021         # some code to try and center each line on the label based on font size and string point width...
1022         my $stringwidth = prStrWidth($line, $fontname, $text->{$line});
1023         my $whitespace = ( $label_width - ( $stringwidth + (2 * $left_text_margin) ) );
1024         $hPos = ( ( $whitespace  / 2 ) + $x_pos + $left_text_margin );
1025
1026         PrintText( $hPos, $vPos, $font, $text->{$line}, $line );
1027         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.).
1028         $vPos = $vPos - ($line_spacer + $text->{$line});   # Linefeed equiv: leading + font size
1029     }
1030 }
1031
1032 # Not used anywhere.
1033
1034 #sub SetFontSize {
1035 #
1036 #    my ($fontsize) = @_;
1037 #### fontsize
1038 #    my $str = "BT/F13 30 Tf288 720 Td( AAAAAAAAAA ) TjET";
1039 #    prAdd($str);
1040 #}
1041
1042 sub DrawBarcode {
1043
1044     # x and y are from the top-left :)
1045     my ( $x_pos, $y_pos, $height, $width, $barcode, $barcodetype ) = @_;
1046     my $num_of_bars = length($barcode);
1047     my $bar_width   = $width * .8;        # %80 of length of label width
1048     my $tot_bar_length;
1049     my $bar_length;
1050     my $guard_length = 10;
1051     my $xsize_ratio;
1052
1053     if ( $barcodetype eq 'CODE39' ) {
1054         $bar_length = '17.5';
1055         $tot_bar_length =
1056           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
1057         $xsize_ratio = ( $bar_width / $tot_bar_length );
1058         eval {
1059             PDF::Reuse::Barcode::Code39(
1060                 x => ( $x_pos + ( $width / 10 ) ),
1061                 y => ( $y_pos + ( $height / 10 ) ),
1062                 value         => "*$barcode*",
1063                 ySize         => ( .02 * $height ),
1064                 xSize         => $xsize_ratio,
1065                 hide_asterisk => 1,
1066             );
1067         };
1068         if ($@) {
1069             warn "$barcodetype, $barcode FAILED:$@";
1070         }
1071     }
1072
1073     elsif ( $barcodetype eq 'CODE39MOD' ) {
1074
1075         # get modulo43 checksum
1076         my $c39 = CheckDigits('code_39');
1077         $barcode = $c39->complete($barcode);
1078
1079         $bar_length = '19';
1080         $tot_bar_length =
1081           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
1082         $xsize_ratio = ( $bar_width / $tot_bar_length );
1083         eval {
1084             PDF::Reuse::Barcode::Code39(
1085                 x => ( $x_pos + ( $width / 10 ) ),
1086                 y => ( $y_pos + ( $height / 10 ) ),
1087                 value         => "*$barcode*",
1088                 ySize         => ( .02 * $height ),
1089                 xSize         => $xsize_ratio,
1090                 hide_asterisk => 1,
1091             );
1092         };
1093
1094         if ($@) {
1095             warn "$barcodetype, $barcode FAILED:$@";
1096         }
1097     }
1098     elsif ( $barcodetype eq 'CODE39MOD10' ) {
1099
1100         # get modulo43 checksum
1101         my $c39_10 = CheckDigits('visa');
1102         $barcode = $c39_10->complete($barcode);
1103
1104         $bar_length = '19';
1105         $tot_bar_length =
1106           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
1107         $xsize_ratio = ( $bar_width / $tot_bar_length );
1108         eval {
1109             PDF::Reuse::Barcode::Code39(
1110                 x => ( $x_pos + ( $width / 10 ) ),
1111                 y => ( $y_pos + ( $height / 10 ) ),
1112                 value         => "*$barcode*",
1113                 ySize         => ( .02 * $height ),
1114                 xSize         => $xsize_ratio,
1115                 hide_asterisk => 1,
1116                                 text         => 0,
1117             );
1118         };
1119
1120         if ($@) {
1121             warn "$barcodetype, $barcode FAILED:$@";
1122         }
1123     }
1124
1125
1126     elsif ( $barcodetype eq 'COOP2OF5' ) {
1127         $bar_length = '9.43333333333333';
1128         $tot_bar_length =
1129           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
1130         $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
1131         eval {
1132             PDF::Reuse::Barcode::COOP2of5(
1133                 x => ( $x_pos + ( $width / 10 ) ),
1134                 y => ( $y_pos + ( $height / 10 ) ),
1135                 value => $barcode,
1136                 ySize => ( .02 * $height ),
1137                 xSize => $xsize_ratio,
1138             );
1139         };
1140         if ($@) {
1141             warn "$barcodetype, $barcode FAILED:$@";
1142         }
1143     }
1144
1145     elsif ( $barcodetype eq 'INDUSTRIAL2OF5' ) {
1146         $bar_length = '13.1333333333333';
1147         $tot_bar_length =
1148           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
1149         $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
1150         eval {
1151             PDF::Reuse::Barcode::Industrial2of5(
1152                 x => ( $x_pos + ( $width / 10 ) ),
1153                 y => ( $y_pos + ( $height / 10 ) ),
1154                 value => $barcode,
1155                 ySize => ( .02 * $height ),
1156                 xSize => $xsize_ratio,
1157             );
1158         };
1159         if ($@) {
1160             warn "$barcodetype, $barcode FAILED:$@";
1161         }
1162     }
1163
1164     my $moo2 = $tot_bar_length * $xsize_ratio;
1165
1166     warn "$x_pos, $y_pos, $barcode, $barcodetype" if $DEBUG;
1167     warn "BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length  R*TOT.BAR =$moo2" if $DEBUG;
1168 }
1169
1170 =item build_circ_barcode;
1171
1172   build_circ_barcode( $x_pos, $y_pos, $barcode,
1173                 $barcodetype, \$item);
1174
1175 $item is the result of a previous call to GetLabelItems();
1176
1177 =cut
1178
1179 #'
1180 sub build_circ_barcode {
1181     my ( $x_pos_circ, $y_pos, $value, $barcodetype, $item ) = @_;
1182
1183     #warn Dumper \$item;
1184
1185     #warn "value = $value\n";
1186
1187     #$DB::single = 1;
1188
1189     if ( $barcodetype eq 'EAN13' ) {
1190
1191         #testing EAN13 barcodes hack
1192         $value = $value . '000000000';
1193         $value =~ s/-//;
1194         $value = substr( $value, 0, 12 );
1195
1196         #warn $value;
1197         eval {
1198             PDF::Reuse::Barcode::EAN13(
1199                 x     => ( $x_pos_circ + 27 ),
1200                 y     => ( $y_pos + 15 ),
1201                 value => $value,
1202
1203                 #            prolong => 2.96,
1204                 #            xSize   => 1.5,
1205
1206                 # ySize   => 1.2,
1207
1208 # added for xpdf compat. doesnt use type3 fonts., but increases filesize from 20k to 200k
1209 # i think its embedding extra fonts in the pdf file.
1210 #  mode => 'graphic',
1211             );
1212         };
1213         if ($@) {
1214             $item->{'barcodeerror'} = 1;
1215
1216             #warn "EAN13BARCODE FAILED:$@";
1217         }
1218
1219         #warn $barcodetype;
1220
1221     }
1222     elsif ( $barcodetype eq 'Code39' ) {
1223
1224         eval {
1225             PDF::Reuse::Barcode::Code39(
1226                 x     => ( $x_pos_circ + 9 ),
1227                 y     => ( $y_pos + 15 ),
1228                 value => $value,
1229
1230                 #           prolong => 2.96,
1231                 xSize => .85,
1232
1233                 ySize => 1.3,
1234             );
1235         };
1236         if ($@) {
1237             $item->{'barcodeerror'} = 1;
1238
1239             #warn "CODE39BARCODE $value FAILED:$@";
1240         }
1241
1242         #warn $barcodetype;
1243
1244     }
1245
1246     elsif ( $barcodetype eq 'Matrix2of5' ) {
1247
1248         #warn "MATRIX ELSE:";
1249
1250         #testing MATRIX25  barcodes hack
1251         #    $value = $value.'000000000';
1252         $value =~ s/-//;
1253
1254         #    $value = substr( $value, 0, 12 );
1255         #warn $value;
1256
1257         eval {
1258             PDF::Reuse::Barcode::Matrix2of5(
1259                 x     => ( $x_pos_circ + 27 ),
1260                 y     => ( $y_pos + 15 ),
1261                 value => $value,
1262
1263                 #        prolong => 2.96,
1264                 #       xSize   => 1.5,
1265
1266                 # ySize   => 1.2,
1267             );
1268         };
1269         if ($@) {
1270             $item->{'barcodeerror'} = 1;
1271
1272             #warn "BARCODE FAILED:$@";
1273         }
1274
1275         #warn $barcodetype;
1276
1277     }
1278
1279     elsif ( $barcodetype eq 'EAN8' ) {
1280
1281         #testing ean8 barcodes hack
1282         $value = $value . '000000000';
1283         $value =~ s/-//;
1284         $value = substr( $value, 0, 8 );
1285
1286         #warn $value;
1287
1288         #warn "EAN8 ELSEIF";
1289         eval {
1290             PDF::Reuse::Barcode::EAN8(
1291                 x       => ( $x_pos_circ + 42 ),
1292                 y       => ( $y_pos + 15 ),
1293                 value   => $value,
1294                 prolong => 2.96,
1295                 xSize   => 1.5,
1296
1297                 # ySize   => 1.2,
1298             );
1299         };
1300
1301         if ($@) {
1302             $item->{'barcodeerror'} = 1;
1303
1304             #warn "BARCODE FAILED:$@";
1305         }
1306
1307         #warn $barcodetype;
1308
1309     }
1310
1311     elsif ( $barcodetype eq 'UPC-E' ) {
1312         eval {
1313             PDF::Reuse::Barcode::UPCE(
1314                 x       => ( $x_pos_circ + 27 ),
1315                 y       => ( $y_pos + 15 ),
1316                 value   => $value,
1317                 prolong => 2.96,
1318                 xSize   => 1.5,
1319
1320                 # ySize   => 1.2,
1321             );
1322         };
1323
1324         if ($@) {
1325             $item->{'barcodeerror'} = 1;
1326
1327             #warn "BARCODE FAILED:$@";
1328         }
1329
1330         #warn $barcodetype;
1331
1332     }
1333     elsif ( $barcodetype eq 'NW7' ) {
1334         eval {
1335             PDF::Reuse::Barcode::NW7(
1336                 x       => ( $x_pos_circ + 27 ),
1337                 y       => ( $y_pos + 15 ),
1338                 value   => $value,
1339                 prolong => 2.96,
1340                 xSize   => 1.5,
1341
1342                 # ySize   => 1.2,
1343             );
1344         };
1345
1346         if ($@) {
1347             $item->{'barcodeerror'} = 1;
1348
1349             #warn "BARCODE FAILED:$@";
1350         }
1351
1352         #warn $barcodetype;
1353
1354     }
1355     elsif ( $barcodetype eq 'ITF' ) {
1356         eval {
1357             PDF::Reuse::Barcode::ITF(
1358                 x       => ( $x_pos_circ + 27 ),
1359                 y       => ( $y_pos + 15 ),
1360                 value   => $value,
1361                 prolong => 2.96,
1362                 xSize   => 1.5,
1363
1364                 # ySize   => 1.2,
1365             );
1366         };
1367
1368         if ($@) {
1369             $item->{'barcodeerror'} = 1;
1370
1371             #warn "BARCODE FAILED:$@";
1372         }
1373
1374         #warn $barcodetype;
1375
1376     }
1377     elsif ( $barcodetype eq 'Industrial2of5' ) {
1378         eval {
1379             PDF::Reuse::Barcode::Industrial2of5(
1380                 x       => ( $x_pos_circ + 27 ),
1381                 y       => ( $y_pos + 15 ),
1382                 value   => $value,
1383                 prolong => 2.96,
1384                 xSize   => 1.5,
1385
1386                 # ySize   => 1.2,
1387             );
1388         };
1389         if ($@) {
1390             $item->{'barcodeerror'} = 1;
1391
1392             #warn "BARCODE FAILED:$@";
1393         }
1394
1395         #warn $barcodetype;
1396
1397     }
1398     elsif ( $barcodetype eq 'IATA2of5' ) {
1399         eval {
1400             PDF::Reuse::Barcode::IATA2of5(
1401                 x       => ( $x_pos_circ + 27 ),
1402                 y       => ( $y_pos + 15 ),
1403                 value   => $value,
1404                 prolong => 2.96,
1405                 xSize   => 1.5,
1406
1407                 # ySize   => 1.2,
1408             );
1409         };
1410         if ($@) {
1411             $item->{'barcodeerror'} = 1;
1412
1413             #warn "BARCODE FAILED:$@";
1414         }
1415
1416         #warn $barcodetype;
1417
1418     }
1419
1420     elsif ( $barcodetype eq 'COOP2of5' ) {
1421         eval {
1422             PDF::Reuse::Barcode::COOP2of5(
1423                 x       => ( $x_pos_circ + 27 ),
1424                 y       => ( $y_pos + 15 ),
1425                 value   => $value,
1426                 prolong => 2.96,
1427                 xSize   => 1.5,
1428
1429                 # ySize   => 1.2,
1430             );
1431         };
1432         if ($@) {
1433             $item->{'barcodeerror'} = 1;
1434
1435             #warn "BARCODE FAILED:$@";
1436         }
1437
1438         #warn $barcodetype;
1439
1440     }
1441     elsif ( $barcodetype eq 'UPC-A' ) {
1442
1443         eval {
1444             PDF::Reuse::Barcode::UPCA(
1445                 x       => ( $x_pos_circ + 27 ),
1446                 y       => ( $y_pos + 15 ),
1447                 value   => $value,
1448                 prolong => 2.96,
1449                 xSize   => 1.5,
1450
1451                 # ySize   => 1.2,
1452             );
1453         };
1454         if ($@) {
1455             $item->{'barcodeerror'} = 1;
1456
1457             #warn "BARCODE FAILED:$@";
1458         }
1459
1460         #warn $barcodetype;
1461
1462     }
1463
1464 }
1465
1466 =item draw_boundaries
1467
1468  sub draw_boundaries ($x_pos_spine, $x_pos_circ1, $x_pos_circ2,
1469                 $y_pos, $spine_width, $label_height, $circ_width)
1470
1471 This sub draws boundary lines where the label outlines are, to aid in printer testing, and debugging.
1472
1473 =cut
1474
1475 #'
1476 sub draw_boundaries {
1477
1478     my (
1479         $x_pos_spine, $x_pos_circ1,  $x_pos_circ2, $y_pos,
1480         $spine_width, $label_height, $circ_width
1481     ) = @_;
1482
1483     my $y_pos_initial = ( ( 792 - 36 ) - 90 );
1484     $y_pos            = $y_pos_initial; # FIXME - why are we ignoring the y_pos parameter by redefining it?
1485     my $i             = 1;
1486
1487     for ( $i = 1 ; $i <= 8 ; $i++ ) {
1488
1489         &drawbox( $x_pos_spine, $y_pos, ($spine_width), ($label_height) );
1490
1491    #warn "OLD BOXES  x=$x_pos_spine, y=$y_pos, w=$spine_width, h=$label_height";
1492         &drawbox( $x_pos_circ1, $y_pos, ($circ_width), ($label_height) );
1493         &drawbox( $x_pos_circ2, $y_pos, ($circ_width), ($label_height) );
1494
1495         $y_pos = ( $y_pos - $label_height );
1496
1497     }
1498 }
1499
1500 =item drawbox
1501
1502         sub drawbox {   $lower_left_x, $lower_left_y,
1503                         $upper_right_x, $upper_right_y )
1504
1505 this is a low level sub, that draws a pdf box, it is called by draw_boxes
1506
1507 FYI: the  $upper_right_x and $upper_right_y values are RELATIVE to  $lower_left_x and $lower_left_y
1508
1509 and $lower_left_x, $lower_left_y are ABSOLUTE, this caught me out!
1510
1511 =cut
1512
1513 #'
1514 sub drawbox {
1515     my ( $llx, $lly, $urx, $ury ) = @_;
1516
1517     #    warn "llx,y= $llx,$lly  ,   urx,y=$urx,$ury \n";
1518
1519     my $str = "q\n";    # save the graphic state
1520     $str .= "0.5 w\n";              # border color red
1521     $str .= "1.0 0.0 0.0  RG\n";    # border color red
1522          #   $str .= "0.5 0.75 1.0 rg\n";           # fill color blue
1523     $str .= "1.0 1.0 1.0  rg\n";    # fill color white
1524
1525     $str .= "$llx $lly $urx $ury re\n";    # a rectangle
1526     $str .= "B\n";                         # fill (and a little more)
1527     $str .= "Q\n";                         # save the graphic state
1528
1529     prAdd($str);
1530
1531 }
1532
1533 END { }    # module clean-up code here (global destructor)
1534
1535 1;
1536 __END__
1537
1538 =back
1539
1540 =head1 AUTHOR
1541
1542 Mason James <mason@katipo.co.nz>
1543
1544 =cut
1545