C4/Labels.pm

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