C4/Labels.pm

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