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