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 #use Data::Dumper;
  25 use PDF::Reuse;
  26
  27
  28 $VERSION = 0.01;
  29
  30 =head1 NAME
  31
  32 C4::Labels - Functions for printing spine labels and barcodes in Koha
  33
  34 =head1 FUNCTIONS
  35
  36 =over 2
  37
  38 =cut
  39
  40 @ISA = qw(Exporter);
  41 @EXPORT = qw(
  42         &get_label_options &get_label_items
  43         &build_circ_barcode &draw_boundaries
  44         &draw_box
  45 );
  46
  47 =item get_label_options;
  48
  49         $options = get_label_options()
  50
  51
  52 Return a pointer on a hash list containing info from labels_conf table in Koha DB.
  53
  54 =cut
  55 #'
  56 sub get_label_options {
  57     my $dbh    = C4::Context->dbh;
  58     my $query2 = " SELECT * FROM labels_conf LIMIT 1 ";
  59     my $sth    = $dbh->prepare($query2);
  60     $sth->execute();
  61     my $conf_data = $sth->fetchrow_hashref;
  62     $sth->finish;
  63     return $conf_data;
  64 }
  65
  66 =item get_label_items;
  67
  68         $options = get_label_items()
  69
  70
  71 Returns an array of references-to-hash, whos keys are the field from the biblio, biblioitems, items and labels tables in the Koha database.
  72
  73 =cut
  74 #'
  75 sub get_label_items {
  76     my $dbh = C4::Context->dbh;
  77
  78     # get the actual items to be printed.
  79     my @data;
  80     my $query3 = " Select * from labels ";
  81     my $sth    = $dbh->prepare($query3);
  82     $sth->execute();
  83     my @resultsloop;
  84     my $cnt = $sth->rows;
  85     my $i1  = 1;
  86     while ( my $data = $sth->fetchrow_hashref ) {
  87
  88         # lets get some summary info from each item
  89         my $query1 =
  90           " select * from biblio, biblioitems, items where itemnumber = ? and
  91                                 items.biblioitemnumber=biblioitems.biblioitemnumber and
  92                                 biblioitems.biblionumber=biblio.biblionumber";
  93
  94         my $sth1 = $dbh->prepare($query1);
  95         $sth1->execute( $data->{'itemnumber'} );
  96         my $data1 = $sth1->fetchrow_hashref();
  97
  98         push( @resultsloop, $data1 );
  99         $sth1->finish;
 100
 101         $i1++;
 102     }
 103     $sth->finish;
 104     return @resultsloop;
 105 }
 106
 107 =item build_circ_barcode;
 108
 109   build_circ_barcode( $x_pos, $y_pos, $barcode,
 110                 $barcodetype, \$item);
 111
 112 $item is the result of a previous call to get_label_items();
 113
 114 =cut
 115 #'
 116 sub build_circ_barcode {
 117     my ( $x_pos_circ, $y_pos, $value, $barcodetype, $item ) = @_;
 118
 119 #warn Dumper \$item;
 120
 121     #warn "value = $value\n";
 122
 123     #$DB::single = 1;
 124
 125     if ( $barcodetype eq 'EAN13' ) {
 126
 127         #testing EAN13 barcodes hack
 128         $value = $value . '000000000';
 129         $value =~ s/-//;
 130         $value = substr( $value, 0, 12 );
 131
 132         #warn $value;
 133         eval {
 134             PDF::Reuse::Barcode::EAN13(
 135                 x     => ( $x_pos_circ + 27 ),
 136                 y     => ( $y_pos + 15 ),
 137                 value => $value,
 138
 139                 #            prolong => 2.96,
 140                 #            xSize   => 1.5,
 141
 142                 # ySize   => 1.2,
 143
 144 # added for xpdf compat. doesnt use type3 fonts., but increases filesize from 20k to 200k
 145 # i think its embedding extra fonts in the pdf file.
 146 #  mode => 'graphic',
 147             );
 148         };
 149         if ($@) {
 150             $item->{'barcodeerror'} = 1;
 151             #warn "EAN13BARCODE FAILED:$@";
 152         }
 153
 154         #warn $barcodetype;
 155
 156     }
 157     elsif ( $barcodetype eq 'Code39' ) {
 158
 159         eval {
 160             PDF::Reuse::Barcode::Code39(
 161                 x     => ( $x_pos_circ + 9 ),
 162                 y     => ( $y_pos + 15 ),
 163                 value => $value,
 164
 165                 #           prolong => 2.96,
 166                 xSize => .85,
 167
 168                 ySize => 1.3,
 169             );
 170         };
 171         if ($@) {
 172             $item->{'barcodeerror'} = 1;
 173             #warn "CODE39BARCODE $value FAILED:$@";
 174         }
 175
 176         #warn $barcodetype;
 177
 178     }
 179
 180     elsif ( $barcodetype eq 'Matrix2of5' ) {
 181
 182         #warn "MATRIX ELSE:";
 183
 184         #testing MATRIX25  barcodes hack
 185         #    $value = $value.'000000000';
 186         $value =~ s/-//;
 187
 188         #    $value = substr( $value, 0, 12 );
 189         #warn $value;
 190
 191         eval {
 192             PDF::Reuse::Barcode::Matrix2of5(
 193                 x     => ( $x_pos_circ + 27 ),
 194                 y     => ( $y_pos + 15 ),
 195                 value => $value,
 196
 197                 #        prolong => 2.96,
 198                 #       xSize   => 1.5,
 199
 200                 # ySize   => 1.2,
 201             );
 202         };
 203         if ($@) {
 204             $item->{'barcodeerror'} = 1;
 205             #warn "BARCODE FAILED:$@";
 206         }
 207
 208         #warn $barcodetype;
 209
 210     }
 211
 212     elsif ( $barcodetype eq 'EAN8' ) {
 213
 214         #testing ean8 barcodes hack
 215         $value = $value . '000000000';
 216         $value =~ s/-//;
 217         $value = substr( $value, 0, 8 );
 218
 219         #warn $value;
 220
 221         #warn "EAN8 ELSEIF";
 222         eval {
 223             PDF::Reuse::Barcode::EAN8(
 224                 x       => ( $x_pos_circ + 42 ),
 225                 y       => ( $y_pos + 15 ),
 226                 value   => $value,
 227                 prolong => 2.96,
 228                 xSize   => 1.5,
 229
 230                 # ySize   => 1.2,
 231             );
 232         };
 233
 234         if ($@) {
 235             $item->{'barcodeerror'} = 1;
 236             #warn "BARCODE FAILED:$@";
 237         }
 238
 239         #warn $barcodetype;
 240
 241     }
 242
 243     elsif ( $barcodetype eq 'UPC-E' ) {
 244         eval {
 245             PDF::Reuse::Barcode::UPCE(
 246                 x       => ( $x_pos_circ + 27 ),
 247                 y       => ( $y_pos + 15 ),
 248                 value   => $value,
 249                 prolong => 2.96,
 250                 xSize   => 1.5,
 251
 252                 # ySize   => 1.2,
 253             );
 254         };
 255
 256         if ($@) {
 257             $item->{'barcodeerror'} = 1;
 258             #warn "BARCODE FAILED:$@";
 259         }
 260
 261         #warn $barcodetype;
 262
 263     }
 264     elsif ( $barcodetype eq 'NW7' ) {
 265         eval {
 266             PDF::Reuse::Barcode::NW7(
 267                 x       => ( $x_pos_circ + 27 ),
 268                 y       => ( $y_pos + 15 ),
 269                 value   => $value,
 270                 prolong => 2.96,
 271                 xSize   => 1.5,
 272
 273                 # ySize   => 1.2,
 274             );
 275         };
 276
 277         if ($@) {
 278             $item->{'barcodeerror'} = 1;
 279             #warn "BARCODE FAILED:$@";
 280         }
 281
 282         #warn $barcodetype;
 283
 284     }
 285     elsif ( $barcodetype eq 'ITF' ) {
 286         eval {
 287             PDF::Reuse::Barcode::ITF(
 288                 x       => ( $x_pos_circ + 27 ),
 289                 y       => ( $y_pos + 15 ),
 290                 value   => $value,
 291                 prolong => 2.96,
 292                 xSize   => 1.5,
 293
 294                 # ySize   => 1.2,
 295             );
 296         };
 297
 298         if ($@) {
 299             $item->{'barcodeerror'} = 1;
 300             #warn "BARCODE FAILED:$@";
 301         }
 302
 303         #warn $barcodetype;
 304
 305     }
 306     elsif ( $barcodetype eq 'Industrial2of5' ) {
 307         eval {
 308             PDF::Reuse::Barcode::Industrial2of5(
 309                 x       => ( $x_pos_circ + 27 ),
 310                 y       => ( $y_pos + 15 ),
 311                 value   => $value,
 312                 prolong => 2.96,
 313                 xSize   => 1.5,
 314
 315                 # ySize   => 1.2,
 316             );
 317         };
 318         if ($@) {
 319             $item->{'barcodeerror'} = 1;
 320             #warn "BARCODE FAILED:$@";
 321         }
 322
 323         #warn $barcodetype;
 324
 325     }
 326     elsif ( $barcodetype eq 'IATA2of5' ) {
 327         eval {
 328             PDF::Reuse::Barcode::IATA2of5(
 329                 x       => ( $x_pos_circ + 27 ),
 330                 y       => ( $y_pos + 15 ),
 331                 value   => $value,
 332                 prolong => 2.96,
 333                 xSize   => 1.5,
 334
 335                 # ySize   => 1.2,
 336             );
 337         };
 338         if ($@) {
 339             $item->{'barcodeerror'} = 1;
 340             #warn "BARCODE FAILED:$@";
 341         }
 342
 343         #warn $barcodetype;
 344
 345     }
 346
 347     elsif ( $barcodetype eq 'COOP2of5' ) {
 348         eval {
 349             PDF::Reuse::Barcode::COOP2of5(
 350                 x       => ( $x_pos_circ + 27 ),
 351                 y       => ( $y_pos + 15 ),
 352                 value   => $value,
 353                 prolong => 2.96,
 354                 xSize   => 1.5,
 355
 356                 # ySize   => 1.2,
 357             );
 358         };
 359         if ($@) {
 360             $item->{'barcodeerror'} = 1;
 361             #warn "BARCODE FAILED:$@";
 362         }
 363
 364         #warn $barcodetype;
 365
 366     }
 367     elsif ( $barcodetype eq 'UPC-A' ) {
 368
 369         eval {
 370             PDF::Reuse::Barcode::UPCA(
 371                 x       => ( $x_pos_circ + 27 ),
 372                 y       => ( $y_pos + 15 ),
 373                 value   => $value,
 374                 prolong => 2.96,
 375                 xSize   => 1.5,
 376
 377                 # ySize   => 1.2,
 378             );
 379         };
 380         if ($@) {
 381             $item->{'barcodeerror'} = 1;
 382             #warn "BARCODE FAILED:$@";
 383         }
 384
 385         #warn $barcodetype;
 386
 387     }
 388
 389 }
 390
 391 =item draw_boundaries
 392
 393  sub draw_boundaries ($x_pos_spine, $x_pos_circ1, $x_pos_circ2,
 394                 $y_pos, $spine_width, $label_height, $circ_width)
 395
 396 This sub draws boundary lines where the label outlines are, to aid in printer testing, and debugging.
 397
 398 =cut
 399
 400 #'
 401 sub draw_boundaries {
 402
 403         my ($x_pos_spine, $x_pos_circ1, $x_pos_circ2,
 404                 $y_pos, $spine_width, $label_height, $circ_width) = @_;
 405
 406     my $y_pos_initial = ( ( 792 - 36 ) - 90 );
 407     my $y_pos         = $y_pos_initial;
 408     my $i             = 1;
 409
 410     for ( $i = 1 ; $i <= 8 ; $i++ ) {
 411
 412         &drawbox( $x_pos_spine, $y_pos, ($spine_width), ($label_height) );
 413
 414    #warn "OLD BOXES  x=$x_pos_spine, y=$y_pos, w=$spine_width, h=$label_height";
 415         &drawbox( $x_pos_circ1, $y_pos, ($circ_width), ($label_height) );
 416         &drawbox( $x_pos_circ2, $y_pos, ($circ_width), ($label_height) );
 417
 418         $y_pos = ( $y_pos - $label_height );
 419
 420     }
 421 }
 422
 423 =item drawbox
 424
 425         sub drawbox {   $lower_left_x, $lower_left_y,
 426                         $upper_right_x, $upper_right_y )
 427
 428 this is a low level sub, that draws a pdf box, it is called by draw_boxes
 429
 430 =cut
 431
 432 #'
 433 sub drawbox {
 434     my ( $llx, $lly, $urx, $ury ) = @_;
 435
 436     my $str = "q\n";    # save the graphic state
 437     $str .= "1.0 0.0 0.0  RG\n";           # border color red
 438     $str .= "1 1 1  rg\n";                 # fill color blue
 439     $str .= "$llx $lly $urx $ury re\n";    # a rectangle
 440     $str .= "B\n";                         # fill (and a little more)
 441     $str .= "Q\n";                         # save the graphic state
 442
 443     prAdd($str);
 444
 445 }
 446
 447 END { }    # module clean-up code here (global destructor)
 448
 449 1;
 450 __END__
 451
 452 =back
 453
 454 =head1 AUTHOR
 455
 456 Mason James <mason@katipo.co.nz>
 457 =cut
 458