C4/Labels.pm

   1 package C4::Labels;
   2
   3 # Copyright 2006 Katipo Communications.
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 use strict;
  21 require Exporter;
  22
  23 use vars qw($VERSION @ISA @EXPORT);
  24
  25 use PDF::Reuse;
  26 use Text::Wrap;
  27
  28 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
  29     shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
  30 };
  31
  32 =head1 NAME
  33
  34 C4::Labels - Functions for printing spine labels and barcodes in Koha
  35
  36 =head1 FUNCTIONS
  37
  38 =over 2
  39
  40 =cut
  41
  42 @ISA = qw(Exporter);
  43 @EXPORT = qw(
  44         &get_label_options &get_label_items
  45         &build_circ_barcode &draw_boundaries
  46   &drawbox &GetActiveLabelTemplate
  47   &GetAllLabelTemplates &DeleteTemplate
  48   &GetSingleLabelTemplate &SaveTemplate
  49   &CreateTemplate &SetActiveTemplate
  50   &SaveConf &DrawSpineText &GetTextWrapCols
  51   &GetUnitsValue &DrawBarcode
  52
  53 );
  54
  55 =item get_label_options;
  56
  57         $options = get_label_options()
  58
  59
  60 Return a pointer on a hash list containing info from labels_conf table in Koha DB.
  61
  62 =cut
  63
  64 #'
  65 sub get_label_options {
  66     my $dbh    = C4::Context->dbh;
  67     my $query2 = " SELECT * FROM labels_conf LIMIT 1 ";
  68     my $sth    = $dbh->prepare($query2);
  69     $sth->execute();
  70     my $conf_data = $sth->fetchrow_hashref;
  71     $sth->finish;
  72     return $conf_data;
  73 }
  74
  75 sub GetUnitsValue {
  76     my ($units) = @_;
  77     my $unitvalue;
  78
  79     $unitvalue = '1'          if ( $units eq 'POINT' );
  80     $unitvalue = '2.83464567' if ( $units eq 'MM' );
  81     $unitvalue = '28.3464567' if ( $units eq 'CM' );
  82     $unitvalue = 72           if ( $units eq 'INCH' );
  83     warn $units, $unitvalue;
  84     return $unitvalue;
  85 }
  86
  87 sub GetTextWrapCols {
  88     my ( $fontsize, $label_width ) = @_;
  89     my $string           = "0";
  90     my $left_text_margin = 3;
  91     my ( $strtmp, $strwidth );
  92     my $count     = 0;
  93     my $textlimit = $label_width - $left_text_margin;
  94
  95     while ( $strwidth < $textlimit ) {
  96         $strwidth = prStrWidth( $string, 'C', $fontsize );
  97         $string   = $string . '0';
  98
  99         #       warn "strwidth $strwidth, $textlimit, $string";
 100         $count++;
 101     }
 102     return $count;
 103 }
 104
 105 sub GetActiveLabelTemplate {
 106     my $dbh   = C4::Context->dbh;
 107     my $query = " SELECT * FROM labels_templates where active = 1 limit 1";
 108     my $sth   = $dbh->prepare($query);
 109     $sth->execute();
 110     my $active_tmpl = $sth->fetchrow_hashref;
 111     $sth->finish;
 112     return $active_tmpl;
 113 }
 114
 115 sub GetSingleLabelTemplate {
 116     my ($tmpl_code) = @_;
 117     my $dbh         = C4::Context->dbh;
 118     my $query       = " SELECT * FROM labels_templates where tmpl_code = ?";
 119     my $sth         = $dbh->prepare($query);
 120     $sth->execute($tmpl_code);
 121     my $template = $sth->fetchrow_hashref;
 122     $sth->finish;
 123     return $template;
 124 }
 125
 126 sub SetActiveTemplate {
 127
 128     my ($tmpl_id) = @_;
 129     warn "TMPL_ID = $tmpl_id";
 130     my $dbh   = C4::Context->dbh;
 131     my $query = " UPDATE labels_templates SET active = NULL";
 132     my $sth   = $dbh->prepare($query);
 133     $sth->execute;
 134
 135     $query = "UPDATE labels_templates SET active = 1 WHERE tmpl_id = ?";
 136     $sth   = $dbh->prepare($query);
 137     $sth->execute($tmpl_id);
 138     $sth->finish;
 139 }
 140
 141 sub DeleteTemplate {
 142     my ($tmpl_code) = @_;
 143     my $dbh         = C4::Context->dbh;
 144     my $query       = " DELETE  FROM labels_templates where tmpl_code = ?";
 145     my $sth         = $dbh->prepare($query);
 146     $sth->execute($tmpl_code);
 147     $sth->finish;
 148 }
 149
 150 sub SaveTemplate {
 151
 152     my (
 153         $tmpl_id,     $tmpl_code,   $tmpl_desc,    $page_width,
 154         $page_height, $label_width, $label_height, $topmargin,
 155         $leftmargin,  $cols,        $rows,         $colgap,
 156         $rowgap,      $active,      $fontsize,     $units
 157       )
 158       = @_;
 159
 160     #warn "FONTSIZE =$fontsize";
 161
 162     my $dbh   = C4::Context->dbh;
 163     my $query =
 164       " UPDATE labels_templates SET tmpl_code=?, tmpl_desc=?, page_width=?,
 165                          page_height=?, label_width=?, label_height=?, topmargin=?,
 166                          leftmargin=?, cols=?, rows=?, colgap=?, rowgap=?, fontsize=?,
 167                                                  units=?
 168                   WHERE tmpl_id = ?";
 169
 170     my $sth = $dbh->prepare($query);
 171     $sth->execute(
 172         $tmpl_code,   $tmpl_desc,    $page_width, $page_height,
 173         $label_width, $label_height, $topmargin,  $leftmargin,
 174         $cols,        $rows,         $colgap,     $rowgap,
 175         $fontsize,    $units,        $tmpl_id
 176     );
 177     $sth->finish;
 178
 179     SetActiveTemplate($tmpl_id) if ( $active eq '1' );
 180 }
 181
 182 sub CreateTemplate {
 183     my $tmpl_id;
 184     my (
 185         $tmpl_code,   $tmpl_desc,    $page_width, $page_height,
 186         $label_width, $label_height, $topmargin,  $leftmargin,
 187         $cols,        $rows,         $colgap,     $rowgap,
 188         $active,      $fontsize,     $units
 189       )
 190       = @_;
 191
 192     my $dbh = C4::Context->dbh;
 193
 194     my $query = "INSERT INTO labels_templates (tmpl_code, tmpl_desc, page_width,
 195                          page_height, label_width, label_height, topmargin,
 196                          leftmargin, cols, rows, colgap, rowgap, fontsize, units)
 197                          VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?,?)";
 198
 199     my $sth = $dbh->prepare($query);
 200     $sth->execute(
 201         $tmpl_code,   $tmpl_desc,    $page_width, $page_height,
 202         $label_width, $label_height, $topmargin,  $leftmargin,
 203         $cols,        $rows,         $colgap,     $rowgap,
 204         $fontsize,    $units
 205     );
 206
 207     warn "ACTIVE = $active";
 208
 209     if ( $active eq '1' ) {
 210
 211   # get the tmpl_id of the newly created template, then call SetActiveTemplate()
 212         my $query =
 213           "SELECT tmpl_id from labels_templates order by tmpl_id desc limit 1";
 214         my $sth = $dbh->prepare($query);
 215         $sth->execute();
 216
 217         my $data    = $sth->fetchrow_hashref;
 218         my $tmpl_id = $data->{'tmpl_id'};
 219
 220         SetActiveTemplate($tmpl_id);
 221         $sth->finish;
 222     }
 223     return $tmpl_id;
 224 }
 225
 226 sub GetAllLabelTemplates {
 227     my $dbh = C4::Context->dbh;
 228
 229     # get the actual items to be printed.
 230     my @data;
 231     my $query = " Select * from labels_templates ";
 232     my $sth   = $dbh->prepare($query);
 233     $sth->execute();
 234     my @resultsloop;
 235     while ( my $data = $sth->fetchrow_hashref ) {
 236         push( @resultsloop, $data );
 237     }
 238     $sth->finish;
 239
 240     return @resultsloop;
 241 }
 242
 243 sub SaveConf {
 244
 245     my (
 246         $barcodetype,    $title,  $isbn,    $itemtype,
 247         $bcn,            $dcn,    $classif, $subclass,
 248         $itemcallnumber, $author, $tmpl_id, $printingtype,
 249         $guidebox,       $startlabel
 250       )
 251       = @_;
 252
 253     my $dbh    = C4::Context->dbh;
 254     my $query2 = "DELETE FROM labels_conf";
 255     my $sth2   = $dbh->prepare($query2);
 256     $sth2->execute;
 257     $query2 = "INSERT INTO labels_conf
 258             ( barcodetype, title, isbn, itemtype, barcode,
 259               dewey, class, subclass, itemcallnumber, author, printingtype,
 260                 guidebox, startlabel )
 261                values ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )";
 262     $sth2 = $dbh->prepare($query2);
 263     $sth2->execute(
 264         $barcodetype,    $title,  $isbn,         $itemtype,
 265         $bcn,            $dcn,    $classif,      $subclass,
 266         $itemcallnumber, $author, $printingtype, $guidebox,
 267         $startlabel
 268     );
 269     $sth2->finish;
 270
 271     SetActiveTemplate($tmpl_id);
 272     return;
 273 }
 274
 275 =item get_label_items;
 276
 277         $options = get_label_items()
 278
 279
 280 Returns an array of references-to-hash, whos keys are the field from the biblio, biblioitems, items and labels tables in the Koha database.
 281
 282 =cut
 283
 284 #'
 285 sub get_label_items {
 286     my $dbh = C4::Context->dbh;
 287
 288     # get the actual items to be printed.
 289     my @data;
 290     my $query3 = " Select * from labels ";
 291     my $sth    = $dbh->prepare($query3);
 292     $sth->execute();
 293     my @resultsloop;
 294     my $cnt = $sth->rows;
 295     my $i1  = 1;
 296     while ( my $data = $sth->fetchrow_hashref ) {
 297
 298         # lets get some summary info from each item
 299         my $query1 =
 300           " select * from biblio, biblioitems, items where itemnumber = ? and
 301                                 items.biblioitemnumber=biblioitems.biblioitemnumber and
 302                                 biblioitems.biblionumber=biblio.biblionumber";
 303
 304         my $sth1 = $dbh->prepare($query1);
 305         $sth1->execute( $data->{'itemnumber'} );
 306         my $data1 = $sth1->fetchrow_hashref();
 307
 308         push( @resultsloop, $data1 );
 309         $sth1->finish;
 310
 311         $i1++;
 312     }
 313     $sth->finish;
 314     return @resultsloop;
 315 }
 316
 317 sub DrawSpineText {
 318
 319     my ( $y_pos, $label_height, $fontsize, $x_pos, $left_text_margin,
 320         $text_wrap_cols, $item, $conf_data )
 321       = @_;
 322
 323     $Text::Wrap::columns   = $text_wrap_cols;
 324     $Text::Wrap::separator = "\n";
 325
 326     my $str;
 327
 328     my $top_text_margin = ( $fontsize + 3 );
 329     my $line_spacer = ($fontsize);    # number of pixels between text rows.
 330
 331     # add your printable fields manually in here
 332     my @fields =
 333       qw (dewey isbn classification itemtype subclass itemcallnumber);
 334     my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
 335     my $hPos = ( $x_pos + $left_text_margin );
 336
 337     foreach my $field (@fields) {
 338
 339         # if the display option for this field is selected in the DB,
 340         # and the item record has some values for this field, display it.
 341         if ( $$conf_data->{"$field"} && $$item->{"$field"} ) {
 342
 343             #            warn "CONF_TYPE = $field";
 344
 345             # get the string
 346             $str = $$item->{"$field"};
 347
 348             # strip out naughty existing nl/cr's
 349             $str =~ s/\n//g;
 350             $str =~ s/\r//g;
 351
 352             # chop the string up into _upto_ 12 chunks
 353             # and seperate the chunks with newlines
 354
 355             $str = wrap( "", "", "$str" );
 356             $str = wrap( "", "", "$str" );
 357
 358             # split the chunks between newline's, into an array
 359             my @strings = split /\n/, $str;
 360
 361             # then loop for each string line
 362             foreach my $str (@strings) {
 363
 364                 #warn "HPOS ,  VPOS $hPos, $vPos ";
 365                 prText( $hPos, $vPos, $str );
 366                 $vPos = $vPos - $line_spacer;
 367             }
 368         }    # if field is valid
 369     }    #foreach feild
 370 }
 371
 372 sub DrawBarcode {
 373
 374     my ( $x_pos, $y_pos, $height, $width, $barcode, $barcodetype ) = @_;
 375     $barcode = '123456789';
 376     my $num_of_bars = length($barcode);
 377     my $bar_width = ( ( $width / 10 ) * 8 );    # %80 of lenght of label width
 378     my $tot_bar_length;
 379     my $bar_length;
 380     my $guard_length = 10;
 381     my $xsize_ratio;
 382
 383     if ( $barcodetype eq 'Code39' ) {
 384         $bar_length     = '14.4333333333333';
 385         $tot_bar_length =
 386           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
 387         $xsize_ratio = ( $bar_width / $tot_bar_length );
 388         eval {
 389             PDF::Reuse::Barcode::Code39(
 390                 x => ( $x_pos + ( $width / 10 ) ),
 391                 y => ( $y_pos + ( $height / 10 ) ),
 392                 value => "*$barcode*",
 393                 ySize => ( .02 * $height ),
 394                 xSize => $xsize_ratio,
 395                 hide_asterisk => $xsize_ratio,
 396             );
 397         };
 398         if ($@) {
 399             warn "$barcodetype, $barcode FAILED:$@";
 400         }
 401     }
 402
 403     elsif ( $barcodetype eq 'COOP2of5' ) {
 404         $bar_length     = '9.43333333333333';
 405         $tot_bar_length =
 406           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
 407         $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
 408         eval {
 409             PDF::Reuse::Barcode::COOP2of5(
 410                 x => ( $x_pos + ( $width / 10 ) ),
 411                 y => ( $y_pos + ( $height / 10 ) ),
 412                 value => $barcode,
 413                 ySize => ( .02 * $height ),
 414                 xSize => $xsize_ratio,
 415             );
 416         };
 417         if ($@) {
 418             warn "$barcodetype, $barcode FAILED:$@";
 419         }
 420     }
 421
 422     elsif ( $barcodetype eq 'Industrial2of5' ) {
 423         $bar_length     = '13.1333333333333';
 424         $tot_bar_length =
 425           ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
 426         $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
 427         eval {
 428             PDF::Reuse::Barcode::Industrial2of5(
 429                 x => ( $x_pos + ( $width / 10 ) ),
 430                 y => ( $y_pos + ( $height / 10 ) ),
 431                 value => $barcode,
 432                 ySize => ( .02 * $height ),
 433                 xSize => $xsize_ratio,
 434             );
 435         };
 436         if ($@) {
 437             warn "$barcodetype, $barcode FAILED:$@";
 438         }
 439     }
 440     my $moo2 = $tot_bar_length * $xsize_ratio;
 441
 442     warn " $x_pos, $y_pos, $barcode, $barcodetype\n";
 443     warn
 444 "BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length  R*TOT.BAR =$moo2 \n";
 445 }
 446
 447 =item build_circ_barcode;
 448
 449   build_circ_barcode( $x_pos, $y_pos, $barcode,
 450                 $barcodetype, \$item);
 451
 452 $item is the result of a previous call to get_label_items();
 453
 454 =cut
 455
 456 #'
 457 sub build_circ_barcode {
 458     my ( $x_pos_circ, $y_pos, $value, $barcodetype, $item ) = @_;
 459
 460     #warn "value = $value\n";
 461
 462     #$DB::single = 1;
 463
 464     if ( $barcodetype eq 'EAN13' ) {
 465
 466         #testing EAN13 barcodes hack
 467         $value = $value . '000000000';
 468         $value =~ s/-//;
 469         $value = substr( $value, 0, 12 );
 470
 471         #warn $value;
 472         eval {
 473             PDF::Reuse::Barcode::EAN13(
 474                 x     => ( $x_pos_circ + 27 ),
 475                 y     => ( $y_pos + 15 ),
 476                 value => $value,
 477
 478                 #            prolong => 2.96,
 479                 #            xSize   => 1.5,
 480
 481                 # ySize   => 1.2,
 482
 483 # added for xpdf compat. doesnt use type3 fonts., but increases filesize from 20k to 200k
 484 # i think its embedding extra fonts in the pdf file.
 485 #  mode => 'graphic',
 486             );
 487         };
 488         if ($@) {
 489             $item->{'barcodeerror'} = 1;
 490
 491             #warn "EAN13BARCODE FAILED:$@";
 492         }
 493
 494         #warn $barcodetype;
 495
 496     }
 497     elsif ( $barcodetype eq 'Code39' ) {
 498         eval {
 499             PDF::Reuse::Barcode::Code39(
 500                 x     => ( $x_pos_circ + 9 ),
 501                 y     => ( $y_pos + 15 ),
 502                 #           prolong => 2.96,
 503                 xSize => .85,
 504                 ySize => 1.3,
 505                                 value => "*$value*",
 506                                 #hide_asterisk => $xsize_ratio,
 507             );
 508         };
 509         if ($@) {
 510             $item->{'barcodeerror'} = 1;
 511
 512             #warn "CODE39BARCODE $value FAILED:$@";
 513         }
 514
 515         #warn $barcodetype;
 516
 517     }
 518
 519     elsif ( $barcodetype eq 'Matrix2of5' ) {
 520
 521         #warn "MATRIX ELSE:";
 522
 523         #testing MATRIX25  barcodes hack
 524         #    $value = $value.'000000000';
 525         $value =~ s/-//;
 526
 527         #    $value = substr( $value, 0, 12 );
 528         #warn $value;
 529
 530         eval {
 531             PDF::Reuse::Barcode::Matrix2of5(
 532                 x     => ( $x_pos_circ + 27 ),
 533                 y     => ( $y_pos + 15 ),
 534                 value => $value,
 535
 536                 #        prolong => 2.96,
 537                 #       xSize   => 1.5,
 538
 539                 # ySize   => 1.2,
 540             );
 541         };
 542         if ($@) {
 543             $item->{'barcodeerror'} = 1;
 544
 545             #warn "BARCODE FAILED:$@";
 546         }
 547
 548         #warn $barcodetype;
 549
 550     }
 551
 552     elsif ( $barcodetype eq 'EAN8' ) {
 553
 554         #testing ean8 barcodes hack
 555         $value = $value . '000000000';
 556         $value =~ s/-//;
 557         $value = substr( $value, 0, 8 );
 558
 559         #warn $value;
 560
 561         #warn "EAN8 ELSEIF";
 562         eval {
 563             PDF::Reuse::Barcode::EAN8(
 564                 x       => ( $x_pos_circ + 42 ),
 565                 y       => ( $y_pos + 15 ),
 566                 value   => $value,
 567                 prolong => 2.96,
 568                 xSize   => 1.5,
 569
 570                 # ySize   => 1.2,
 571             );
 572         };
 573
 574         if ($@) {
 575             $item->{'barcodeerror'} = 1;
 576
 577             #warn "BARCODE FAILED:$@";
 578         }
 579
 580         #warn $barcodetype;
 581
 582     }
 583
 584     elsif ( $barcodetype eq 'UPC-E' ) {
 585         eval {
 586             PDF::Reuse::Barcode::UPCE(
 587                 x       => ( $x_pos_circ + 27 ),
 588                 y       => ( $y_pos + 15 ),
 589                 value   => $value,
 590                 prolong => 2.96,
 591                 xSize   => 1.5,
 592
 593                 # ySize   => 1.2,
 594             );
 595         };
 596
 597         if ($@) {
 598             $item->{'barcodeerror'} = 1;
 599
 600             #warn "BARCODE FAILED:$@";
 601         }
 602
 603         #warn $barcodetype;
 604
 605     }
 606     elsif ( $barcodetype eq 'NW7' ) {
 607         eval {
 608             PDF::Reuse::Barcode::NW7(
 609                 x       => ( $x_pos_circ + 27 ),
 610                 y       => ( $y_pos + 15 ),
 611                 value   => $value,
 612                 prolong => 2.96,
 613                 xSize   => 1.5,
 614
 615                 # ySize   => 1.2,
 616             );
 617         };
 618
 619         if ($@) {
 620             $item->{'barcodeerror'} = 1;
 621
 622             #warn "BARCODE FAILED:$@";
 623         }
 624
 625         #warn $barcodetype;
 626
 627     }
 628     elsif ( $barcodetype eq 'ITF' ) {
 629         eval {
 630             PDF::Reuse::Barcode::ITF(
 631                 x       => ( $x_pos_circ + 27 ),
 632                 y       => ( $y_pos + 15 ),
 633                 value   => $value,
 634                 prolong => 2.96,
 635                 xSize   => 1.5,
 636
 637                 # ySize   => 1.2,
 638             );
 639         };
 640
 641         if ($@) {
 642             $item->{'barcodeerror'} = 1;
 643
 644             #warn "BARCODE FAILED:$@";
 645         }
 646
 647         #warn $barcodetype;
 648
 649     }
 650     elsif ( $barcodetype eq 'Industrial2of5' ) {
 651         eval {
 652             PDF::Reuse::Barcode::Industrial2of5(
 653                 x       => ( $x_pos_circ + 27 ),
 654                 y       => ( $y_pos + 15 ),
 655                 value   => $value,
 656                 prolong => 2.96,
 657                 xSize   => 1.5,
 658
 659                 # ySize   => 1.2,
 660             );
 661         };
 662         if ($@) {
 663             $item->{'barcodeerror'} = 1;
 664
 665             #warn "BARCODE FAILED:$@";
 666         }
 667
 668         #warn $barcodetype;
 669
 670     }
 671     elsif ( $barcodetype eq 'IATA2of5' ) {
 672         eval {
 673             PDF::Reuse::Barcode::IATA2of5(
 674                 x       => ( $x_pos_circ + 27 ),
 675                 y       => ( $y_pos + 15 ),
 676                 value   => $value,
 677                 prolong => 2.96,
 678                 xSize   => 1.5,
 679
 680                 # ySize   => 1.2,
 681             );
 682         };
 683         if ($@) {
 684             $item->{'barcodeerror'} = 1;
 685
 686             #warn "BARCODE FAILED:$@";
 687         }
 688
 689         #warn $barcodetype;
 690
 691     }
 692
 693     elsif ( $barcodetype eq 'COOP2of5' ) {
 694         eval {
 695             PDF::Reuse::Barcode::COOP2of5(
 696                 x       => ( $x_pos_circ + 27 ),
 697                 y       => ( $y_pos + 15 ),
 698                 value   => $value,
 699                 prolong => 2.96,
 700                 xSize   => 1.5,
 701
 702                 # ySize   => 1.2,
 703             );
 704         };
 705         if ($@) {
 706             $item->{'barcodeerror'} = 1;
 707
 708             #warn "BARCODE FAILED:$@";
 709         }
 710
 711         #warn $barcodetype;
 712
 713     }
 714     elsif ( $barcodetype eq 'UPC-A' ) {
 715
 716         eval {
 717             PDF::Reuse::Barcode::UPCA(
 718                 x       => ( $x_pos_circ + 27 ),
 719                 y       => ( $y_pos + 15 ),
 720                 value   => $value,
 721                 prolong => 2.96,
 722                 xSize   => 1.5,
 723
 724                 # ySize   => 1.2,
 725             );
 726         };
 727         if ($@) {
 728             $item->{'barcodeerror'} = 1;
 729
 730             #warn "BARCODE FAILED:$@";
 731         }
 732
 733         #warn $barcodetype;
 734
 735     }
 736
 737 }
 738
 739 =item draw_boundaries
 740
 741  sub draw_boundaries ($x_pos_spine, $x_pos_circ1, $x_pos_circ2,
 742                 $y_pos, $spine_width, $label_height, $circ_width)
 743
 744 This sub draws boundary lines where the label outlines are, to aid in printer testing, and debugging.
 745
 746 =cut
 747
 748 #'
 749 sub draw_boundaries {
 750
 751     my (
 752         $x_pos_spine, $x_pos_circ1,  $x_pos_circ2, $y_pos,
 753         $spine_width, $label_height, $circ_width
 754       )
 755       = @_;
 756
 757     my $y_pos_initial = ( ( 792 - 36 ) - 90 );
 758     $y_pos            = $y_pos_initial;
 759     my $i             = 1;
 760
 761     for ( $i = 1 ; $i <= 8 ; $i++ ) {
 762
 763         &drawbox( $x_pos_spine, $y_pos, ($spine_width), ($label_height) );
 764
 765    #warn "OLD BOXES  x=$x_pos_spine, y=$y_pos, w=$spine_width, h=$label_height";
 766         &drawbox( $x_pos_circ1, $y_pos, ($circ_width), ($label_height) );
 767         &drawbox( $x_pos_circ2, $y_pos, ($circ_width), ($label_height) );
 768
 769         $y_pos = ( $y_pos - $label_height );
 770
 771     }
 772 }
 773
 774 =item drawbox
 775
 776         sub drawbox {   $lower_left_x, $lower_left_y,
 777                         $upper_right_x, $upper_right_y )
 778
 779 this is a low level sub, that draws a pdf box, it is called by draw_boxes
 780
 781 FYI: the  $upper_right_x and $upper_right_y values are RELATIVE to  $lower_left_x and $lower_left_y
 782
 783 and $lower_left_x, $lower_left_y are ABSOLUTE, this caught me out!
 784
 785 =cut
 786
 787 #'
 788 sub drawbox {
 789     my ( $llx, $lly, $urx, $ury ) = @_;
 790
 791     #    warn "llx,y= $llx,$lly  ,   urx,y=$urx,$ury \n";
 792
 793     my $str = "q\n";    # save the graphic state
 794     $str .= "0.5 w\n";                     # border color red
 795     $str .= "1.0 0.0 0.0  RG\n";           # border color red
 796     $str .= "0.5 0.75 1.0 rg\n";           # fill color blue
 797     $str .= "$llx $lly $urx $ury re\n";    # a rectangle
 798     $str .= "B\n";                         # fill (and a little more)
 799     $str .= "Q\n";                         # save the graphic state
 800
 801     prAdd($str);
 802
 803 }
 804
 805 END { }    # module clean-up code here (global destructor)
 806
 807 1;
 808 __END__
 809
 810 =back
 811
 812 =head1 AUTHOR
 813
 814 Mason James <mason@katipo.co.nz>
 815 =cut
 816