barcodes/barcodesGenerator.pl

   1 #!/usr/bin/perl
   2
   3 # script to generate items barcodes
   4 # written 07/04
   5 # by Veleda Matias - matias_veleda@hotmail.com - Physics Library UNLP Argentina and
   6 #    Castañeda Sebastian - seba3c@yahoo.com.ar - Physics Library UNLP Argentina and
   7
   8 # This file is part of Koha.
   9 #
  10 # Koha is free software; you can redistribute it and/or modify it under the
  11 # terms of the GNU General Public License as published by the Free Software
  12 # Foundation; either version 2 of the License, or (at your option) any later
  13 # version.
  14 #
  15 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  16 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  17 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License along with
  20 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  21 # Suite 330, Boston, MA  02111-1307 USA
  22
  23 require Exporter;
  24
  25 use strict;
  26
  27 use CGI;
  28 use C4::Context;
  29 use C4::Output;
  30
  31
  32 #FIXME : module deprecated ?
  33 use PDF::API2;
  34 use PDF::API2::Page;
  35 use PDF::API2::Util;
  36 use C4::Barcodes::PrinterConfig;
  37 use Time::localtime;
  38
  39 # This function returns the path to deal with the correct files, considering
  40 # templates set and language.
  41 sub getPath {
  42     my $type         = shift @_;
  43     my $templatesSet = C4::Context->preference('template');
  44     my $lang         = C4::Context->preference('opaclanguages');
  45     if ( $type eq "intranet" ) {
  46         return "$ENV{'DOCUMENT_ROOT'}/intranet-tmpl/$templatesSet/$lang";
  47     }
  48     else {
  49         return "$ENV{'DOCUMENT_ROOT'}/opac-tmpl/$templatesSet/$lang";
  50     }
  51 }
  52
  53 # Load a configuration file. Before use this function, check if that file exists.
  54 sub loadConfFromFile {
  55     my $fileName = shift @_;
  56     my %keyValues;
  57     open FILE, "<$fileName";
  58     while (<FILE>) {
  59         chomp;
  60         if (/\s*([\w_]*)\s*=\s*([\[\]\<\>\w_\s:@,\.-]*)\s*/) {
  61             $keyValues{$1} = $2;
  62         }
  63     }
  64     close FILE;
  65     return %keyValues;
  66 }
  67
  68 # Save settings to a configuration file. It delete previous configuration settings.
  69 sub saveConfToFile {
  70     my $fileName  = shift @_;
  71     my %keyValues = %{ shift @_ };
  72     my $i;
  73     open FILE, ">$fileName";
  74     foreach $i ( keys(%keyValues) ) {
  75         print FILE $i . " = " . $keyValues{$i} . "\n";
  76     }
  77     close FILE;
  78 }
  79
  80 # Load the config file.
  81 my $filenameConf =
  82   &getPath("intranet") . "/includes/labelConfig/itemsLabelConfig.conf";
  83 my %labelConfig = &loadConfFromFile($filenameConf);
  84
  85 # Creates a CGI object and take its parameters
  86 my $cgi              = new CGI;
  87 my $from             = $cgi->param('from');
  88 my $to               = $cgi->param('to');
  89 my $individualCodes  = $cgi->param('individualCodes');
  90 my $rangeType        = $cgi->param('rangeType');
  91 my $pageType         = $cgi->param('pages');
  92 my $label            = $cgi->param('label');
  93 my $numbersystem     = $cgi->param('numbersystem');
  94 my $text_under_label = $cgi->param('text_under_label');
  95
  96 # Generate the checksum from an inventary code
  97 sub checksum {
  98
  99     sub calculateDigit {
 100         my $code       = shift @_;
 101         my $sum        = 0;
 102         my $odd_parity = 1;
 103         my $i;
 104         for ( $i = length($code) - 1 ; $i >= 0 ; $i-- ) {
 105             if ($odd_parity) {
 106                 $sum = $sum + ( 3 * substr( $code, $i, 1 ) );
 107             }
 108             else {
 109                 $sum = $sum + substr( $code, $i, 1 );
 110             }
 111             $odd_parity = !$odd_parity;
 112         }
 113         my $check_digit = 10 - ( $sum % 10 );
 114         if ( $check_digit == 10 ) {
 115             $check_digit = 0;
 116         }
 117         return $code . $check_digit;
 118     }
 119
 120     my $currentCode = shift @_;
 121     $currentCode = &calculateDigit($currentCode);
 122     return $currentCode;
 123 }
 124
 125 # Assigns a temporary name to the PDF file
 126 sub assingFilename {
 127     my ( $from, $to ) = @_;
 128     my $ip      = $cgi->remote_addr();
 129     my $random  = int( rand(1000000) );
 130     my $timeObj = localtime();
 131     my ( $day, $month, $year, $hour, $min, $sec ) = (
 132         $timeObj->mday,
 133         $timeObj->mon + 1,
 134         $timeObj->year + 1900,
 135         $timeObj->hour, $timeObj->min, $timeObj->sec
 136     );
 137     my $tmpFileName =
 138         $random . '-' . $ip
 139       . '-(From '
 140       . $from . ' to '
 141       . $to . ')-['
 142       . $day . '.'
 143       . $month . '.'
 144       . $year . ']-['
 145       . $hour . ':'
 146       . $min . ':'
 147       . $sec . '].pdf';
 148     return $tmpFileName;
 149 }
 150
 151 sub getCallnum {
 152
 153     #grabs a callnumber for the specified barcode
 154     my ($barcode) = @_;
 155     my $query =
 156 "select dewey from items,biblioitems where items.biblionumber=biblioitems.biblionumber and items.barcode=?";
 157     my $dbh = C4::Context->dbh;
 158     my $sth = $dbh->prepare($query);
 159     $sth->execute($barcode);
 160     my ($callnum) = $sth->fetchrow_array();
 161     warn "Call number is:" . $barcode;
 162     return $callnum;
 163 }
 164
 165 # Takes inventary codes from database and if they are between
 166 # the interval specify by parameters, it generates the correspond barcodes
 167 sub barcodesGenerator {
 168     my ( $from, $to, $rangeType, $individualCodes, $text_under_label ) = @_;
 169
 170     # Returns a database handler
 171     my $dbh = C4::Context->dbh;
 172
 173     # Create the query to database
 174     # Assigns a temporary filename for the pdf file
 175     my $tmpFileName = &assingFilename( $from, $to );
 176
 177     # warn "range type: ".$rangeType;
 178     if ( $rangeType eq 'continuous' ) {
 179
 180         # Set the temp directory for pdf´s files
 181         if ( !defined( $ENV{'TEMP'} ) ) {
 182             $ENV{'TEMP'} = '/tmp/';
 183         }
 184         $tmpFileName = $ENV{'TEMP'} . $tmpFileName;
 185
 186         # Creates a PDF object
 187         my $pdf = PDF::API2->new( -file => $tmpFileName );
 188
 189         # Set the positions where barcodes are going to be placed
 190         C4::Barcodes::PrinterConfig::setPositionsForX(
 191             $labelConfig{'marginLeft'}, $labelConfig{'labelWidth'},
 192             $labelConfig{'columns'},    $labelConfig{'pageType'}
 193         );
 194         C4::Barcodes::PrinterConfig::setPositionsForY(
 195             $labelConfig{'marginBottom'}, $labelConfig{'labelHeigth'},
 196             $labelConfig{'rows'},         $labelConfig{'pageType'}
 197         );
 198
 199         # Creates a font object
 200         my $tr = $pdf->corefont('Helvetica-Bold');
 201
 202         # Barcode position
 203         my ( $page, $gfx, $text );
 204         for ( my $code = $from ; $code <= $to ; $code++ ) {
 205
 206             # Generetase checksum
 207             my $codeC = &checksum($code);
 208
 209             # Generate the corresponde barcode to $code
 210             # warn "Code is :-->".$codeC."<--";
 211             my $barcode = $pdf->barcode(
 212                 -font => $tr,         # The font object to use
 213                 -type => 'ean128',    # Standard of codification
 214                 -code => $codeC,      # Text to codify
 215                 -extn => '012345',    # Barcode extension (if it is aplicable)
 216                 -umzn => 10,          # Top limit of the finished bar
 217                 -lmzn => 10,          # Bottom limit of the finished bar
 218                 -zone => 15,          # Bars size
 219                 -quzn => 0,           # Space destinated for legend
 220                 -ofwt => 0.01,        # Bars width
 221                 -fnsz => 8,           # Font size
 222                 -text => ''
 223             );
 224
 225             ( my $x, my $y, $pdf, $page, $gfx, $text, $tr, $label ) =
 226               C4::Barcodes::PrinterConfig::getLabelPosition( $label, $pdf,
 227                 $page, $gfx, $text, $tr, $pageType );
 228
 229             # Assigns a barcodes to $gfx
 230             $gfx->barcode( $barcode, $x, $y,
 231                 ( 72 / $labelConfig{'systemDpi'} ) );
 232
 233             # Assigns the additional information to the barcode (Legend)
 234             $text->translate( $x - 48, $y - 22 );
 235
 236             #warn "code is ".$codeC;
 237             if ($text_under_label) {
 238                 $text->text($text_under_label);
 239             }
 240             else {
 241                 $text->text( getCallnum($code) );
 242             }
 243         }
 244
 245         # Writes the objects added in $gfx to $page
 246         $pdf->finishobjects( $page, $gfx, $text );
 247
 248         # Save changes to the PDF
 249         $pdf->saveas;
 250
 251         # Close the conection with the PDF file
 252         $pdf->end;
 253
 254         # Show the PDF file
 255         print $cgi->redirect(
 256             "/cgi-bin/koha/barcodes/pdfViewer.pl?tmpFileName=$tmpFileName");
 257     }
 258     else {
 259         my $rangeCondition;
 260         if ( $individualCodes ne "" ) {
 261             $rangeCondition = "AND (I.barcode IN " . $individualCodes . ")";
 262         }
 263         else {
 264             $rangeCondition =
 265               "AND (I.barcode >= " . $from . " AND I.barcode <=" . $to . " )";
 266         }
 267
 268         my $query =
 269 "SELECT CONCAT('$numbersystem',REPEAT('0',((12 - LENGTH('$numbersystem')) - LENGTH(I.barcode))), I.barcode) AS Codigo, B.title, B.author FROM biblio B, items I WHERE (I.biblionumber = B.biblioNumber ) "
 270           . $rangeCondition
 271           . " AND (I.barcode <> 'FALTA') ORDER BY Codigo";
 272
 273         # Prepare the query
 274         my $sth = $dbh->prepare($query);
 275
 276         # Executes the query
 277         $sth->execute;
 278         if ( $sth->rows ) {    # There are inventary codes
 279                                # Set the temp directory for pdf´s files
 280             if ( !defined( $ENV{'TEMP'} ) ) {
 281                 $ENV{'TEMP'} = '/tmp/';
 282             }
 283
 284             # Assigns a temporary filename for the pdf file
 285             my $tmpFileName = &assingFilename( $from, $to );
 286             $tmpFileName = $ENV{'TEMP'} . $tmpFileName;
 287
 288             # Creates a PDF object
 289             my $pdf = PDF::API2->new( -file => $tmpFileName );
 290
 291             # Set the positions where barcodes are going to be placed
 292             C4::Barcodes::PrinterConfig::setPositionsForX(
 293                 $labelConfig{'marginLeft'}, $labelConfig{'labelWidth'},
 294                 $labelConfig{'columns'},    $labelConfig{'pageType'}
 295             );
 296             C4::Barcodes::PrinterConfig::setPositionsForY(
 297                 $labelConfig{'marginBottom'}, $labelConfig{'labelHeigth'},
 298                 $labelConfig{'rows'},         $labelConfig{'pageType'}
 299             );
 300
 301             # Creates a font object
 302             my $tr = $pdf->corefont('Helvetica-Bold');
 303
 304             # Barcode position
 305             my ( $page, $gfx, $text );
 306             while ( my ( $code, $dewey, $title, $author ) =
 307                 $sth->fetchrow_array )
 308             {
 309
 310                 # Generetase checksum
 311                 $code = &checksum($code);
 312
 313                 # Generate the corresponde barcode to $code
 314                 my $barcode = $pdf->barcode(
 315                     -font => $tr,       # The font object to use
 316                     -type => 'ean13',   # Standard of codification
 317                     -code => $code,     # Text to codify
 318                     -extn => '012345',  # Barcode extension (if it is aplicable)
 319                     -umzn => 10,        # Top limit of the finished bar
 320                     -lmzn => 10,        # Bottom limit of the finished bar
 321                     -zone => 15,        # Bars size
 322                     -quzn => 0,         # Space destinated for legend
 323                     -ofwt => 0.01,      # Bars width
 324                     -fnsz => 8,         # Font size
 325                     -text => ''
 326                 );
 327
 328                 ( my $x, my $y, $pdf, $page, $gfx, $text, $tr, $label ) =
 329                   C4::Barcodes::PrinterConfig::getLabelPosition( $label, $pdf,
 330                     $page, $gfx, $text, $tr, $pageType );
 331
 332                 # Assigns a barcodes to $gfx
 333                 $gfx->barcode( $barcode, $x, $y,
 334                     ( 72 / $labelConfig{'systemDpi'} ) );
 335
 336                 # Assigns the additional information to the barcode (Legend)
 337                 $text->translate( $x - 48, $y - 22 );
 338                 if ($text_under_label) {
 339                     $text->text($text_under_label);
 340                 }
 341                 else {
 342                     $text->text( substr $title, 0, 30 );
 343                     $text->translate( $x - 48, $y - 29 );
 344
 345                     #$text->text(substr $author, 0, 30);
 346                     $text->text( substr $author, 0, 30 );
 347                 }
 348             }
 349
 350             # Writes the objects added in $gfx to $page
 351             $pdf->finishobjects( $page, $gfx, $text );
 352
 353             # Save changes to the PDF
 354             $pdf->saveas;
 355
 356             # Close the conection with the PDF file
 357             $pdf->end;
 358
 359             # Show the PDF file
 360             print $cgi->redirect(
 361                 "/cgi-bin/koha/barcodes/pdfViewer.pl?tmpFileName=$tmpFileName");
 362         }
 363         else {
 364
 365             # Rollback and shows the error legend
 366             print $cgi->redirect("/cgi-bin/koha/barcodes/barcodes.pl?error=1");
 367         }
 368         $sth->finish;
 369     }
 370 }
 371
 372 barcodesGenerator( $from, $to, $rangeType, $individualCodes,
 373     $text_under_label );