koha-patches/ean13-barcodes.diff

   1 diff --git a/C4/Barcodes.pm b/C4/Barcodes.pm
   2 index a528bd9..44e906a 100644
   3 --- a/C4/Barcodes.pm
   4 +++ b/C4/Barcodes.pm
   5 @@ -28,6 +28,7 @@ use C4::Dates;
   6  use C4::Barcodes::hbyymmincr;
   7  use C4::Barcodes::annual;
   8  use C4::Barcodes::incremental;
   9 +use C4::Barcodes::EAN13;
  10
  11  use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  12  use vars qw($debug $cgi_debug);        # from C4::Debug, of course
  13 @@ -137,8 +138,8 @@ sub next_value ($;$) {
  14         $incr++;
  15
  16         $debug and warn "$incr";
  17 -       $head = $self->process_head($head,$max,$specific);
  18 -       $tail = $self->process_tail($tail,$max,$specific);
  19 +       $head = $self->process_head($head,$incr,$specific);
  20 +       $tail = $self->process_tail($tail,$incr,$specific); # XXX use $incr and not $max!
  21         my $next_value = $head . $incr . $tail;
  22         $debug and print STDERR "(  next ) max barcode found: $next_value\n";
  23         return $next_value;
  24 @@ -177,6 +178,7 @@ our $types = {
  25         incremental => sub {C4::Barcodes::incremental->new_object(@_);},
  26         hbyymmincr  => sub {C4::Barcodes::hbyymmincr->new_object(@_); },
  27         OFF         => sub {C4::Barcodes::OFF->new_object(@_);        },
  28 +       EAN13       => sub {C4::Barcodes::EAN13->new_object(@_);        },
  29  };
  30
  31  sub new {
  32 diff --git a/C4/Barcodes/EAN13.pm b/C4/Barcodes/EAN13.pm
  33 new file mode 100644
  34 index 0000000..2168ae6
  35 --- /dev/null
  36 +++ b/C4/Barcodes/EAN13.pm
  37 @@ -0,0 +1,59 @@
  38 +package C4::Barcodes::EAN13;
  39 +
  40 +# This file is part of Koha.
  41 +#
  42 +# Koha is free software; you can redistribute it and/or modify it under the
  43 +# terms of the GNU General Public License as published by the Free Software
  44 +# Foundation; either version 2 of the License, or (at your option) any later
  45 +# version.
  46 +#
  47 +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  48 +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  49 +# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  50 +#
  51 +# You should have received a copy of the GNU General Public License along
  52 +# with Koha; if not, write to the Free Software Foundation, Inc.,
  53 +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  54 +
  55 +use strict;
  56 +use warnings;
  57 +
  58 +use Carp;
  59 +
  60 +use C4::Context;
  61 +use C4::Debug;
  62 +use C4::Dates;
  63 +
  64 +use Algorithm::CheckDigits;
  65 +
  66 +use vars qw($VERSION @ISA);
  67 +use vars qw($debug $cgi_debug);        # from C4::Debug, of course
  68 +use vars qw($width);
  69 +
  70 +BEGIN {
  71 +    $VERSION = 0.01;
  72 +    @ISA = qw(C4::Barcodes);
  73 +}
  74 +
  75 +sub parse ($;$) {
  76 +       my $self = shift;
  77 +       my $barcode = (@_) ? shift : $self->value;
  78 +       my $ean = CheckDigits('ean');
  79 +       if ( $ean->is_valid($barcode) ) {
  80 +               return ( '', $ean->basenumber($barcode), $ean->checkdigit($barcode) );
  81 +       } else {
  82 +               carp "$barcode not valid EAN-13 barcode";
  83 +       }
  84 +}
  85 +
  86 +sub process_tail($$;$$) {
  87 +       my ( $self,$tail,$whole,$specific ) = @_;
  88 +       my $ean = CheckDigits('ean');
  89 +       my $full = $ean->complete($whole);
  90 +       my $chk  = $ean->checkdigit($full);
  91 +       $debug && warn "# process_tail $tail -> $chk [$whole -> $full] $specific";
  92 +       return $chk;
  93 +}
  94 +
  95 +1;
  96 +__END__
  97 diff --git a/C4/Circulation.pm b/C4/Circulation.pm
  98 index 2869fc6..f2addd8 100644
  99 --- a/C4/Circulation.pm
 100 +++ b/C4/Circulation.pm
 101 @@ -46,6 +46,7 @@ use Date::Calc qw(
 102  use POSIX qw(strftime);
 103  use C4::Branch; # GetBranches
 104  use C4::Log; # logaction
 105 +use Algorithm::CheckDigits;
 106
 107  use Data::Dumper;
 108
 109 @@ -156,6 +157,12 @@ sub barcodedecode {
 110          # FIXME: $barcode could be "T1", causing warning: substr outside of string
 111          # Why drop the nonzero digit after the T?
 112          # Why pass non-digits (or empty string) to "T%07d"?
 113 +       } elsif ($filter eq 'EAN13') {
 114 +               $barcode = sprintf('%013d',$barcode);
 115 +               my $ean = CheckDigits('ean');
 116 +               if ( ! $ean->is_valid($barcode) ) {
 117 +                       warn "[$barcode] not valid EAN-13/UPC-A";
 118 +               }
 119         }
 120      return $barcode;    # return barcode, modified or not
 121  }
 122 diff --git a/C4/Creators/Lib.pm b/C4/Creators/Lib.pm
 123 index 8fd25fd..b26949e 100644
 124 --- a/C4/Creators/Lib.pm
 125 +++ b/C4/Creators/Lib.pm
 126 @@ -90,7 +90,7 @@ my $barcode_types = [
 127      {type => 'CODE39MOD',       name => 'Code 39 + Modulo43',   desc => 'Translates the characters 0-9, A-Z, \'-\', \'*\', \'+\', \'$\', \'%\', \'/\', \'.\' and \' \' to a barcode pattern. Encodes Mod 43 checksum.',         selected => 0},
 128      {type => 'CODE39MOD10',     name => 'Code 39 + Modulo10',   desc => 'Translates the characters 0-9, A-Z, \'-\', \'*\', \'+\', \'$\', \'%\', \'/\', \'.\' and \' \' to a barcode pattern. Encodes Mod 10 checksum.',         selected => 0},
 129      {type => 'COOP2OF5',        name => 'COOP2of5',             desc => 'Creates COOP2of5 barcodes from a string consisting of the numeric characters 0-9',                                                                     selected => 0},
 130 -#    {type => 'EAN13',           name => 'EAN13',                desc => 'Creates EAN13 barcodes from a string of 12 or 13 digits. The check number (the 13:th digit) is calculated if not supplied.',                           selected => 0},
 131 +    {type => 'EAN13',           name => 'EAN13',                desc => 'Creates EAN13 barcodes from a string of 12 or 13 digits. The check number (the 13:th digit) is calculated if not supplied.',                           selected => 0},
 132  #    {type => 'EAN8',            name => 'EAN8',                 desc => 'Translates a string of 7 or 8 digits to EAN8 barcodes. The check number (the 8:th digit) is calculated if not supplied.',                              selected => 0},
 133  #    {type => 'IATA2of5',        name => 'IATA2of5',             desc => 'Creates IATA2of5 barcodes from a string consisting of the numeric characters 0-9',                                                                     selected => 0},
 134      {type => 'INDUSTRIAL2OF5',  name => 'Industrial2of5',       desc => 'Creates Industrial2of5 barcodes from a string consisting of the numeric characters 0-9',                                                               selected => 0},
 135 diff --git a/C4/Labels/Label.pm b/C4/Labels/Label.pm
 136 index 0c98d6f..0abf308 100644
 137 --- a/C4/Labels/Label.pm
 138 +++ b/C4/Labels/Label.pm
 139 @@ -550,6 +550,28 @@ sub barcode {
 140              warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 141          }
 142      }
 143 +    elsif ($params{'barcode_type'} eq 'EAN13') {
 144 +        $bar_length = 4; # FIXME
 145 +       $num_of_bars = 13;
 146 +        $tot_bar_length = ($bar_length * $num_of_bars) + ($guard_length * 2);
 147 +        $x_scale_factor = ($params{'width'} / $tot_bar_length) * 0.9;
 148 +        eval {
 149 +            PDF::Reuse::Barcode::EAN13(
 150 +                x                   => $params{'llx'},
 151 +                y                   => $params{'lly'},
 152 +                value               => sprintf('%013d',$params{barcode_data}),
 153 +#                xSize               => $x_scale_factor,
 154 +#                ySize               => $params{'y_scale_factor'},
 155 +                mode                    => 'graphic',
 156 +            );
 157 +        };
 158 +        if ($@) {
 159 +            warn sprintf('Barcode generation failed for item %s with this error: %s', $self->{'item_number'}, $@);
 160 +        }
 161 +    }
 162 +    else {
 163 +       warn "unknown barcode_type: $params{barcode_type}";
 164 +    }
 165  }
 166
 167  sub csv_data {
 168 @@ -605,6 +627,9 @@ This module provides methods for creating, and otherwise manipulating single lab
 169  =item .
 170              INDUSTRIAL2OF5  = The standard 2 of 5 barcode (a binary level bar code developed by Identicon Corp. and Computer Identics Corp. in 1970)
 171
 172 +=item .
 173 +            EAN13           = The standard EAN-13 barcode
 174 +
 175  =back
 176
 177          C<printing_type>        Defines the general layout to be used on labels. NOTE: At present there are only five printing types supported in the label creator code:
 178 diff --git a/cataloguing/value_builder/barcode.pl b/cataloguing/value_builder/barcode.pl
 179 index c05ec48..9b25bc5 100755
 180 --- a/cataloguing/value_builder/barcode.pl
 181 +++ b/cataloguing/value_builder/barcode.pl
 182 @@ -24,6 +24,8 @@ no warnings 'redefine'; # otherwise loading up multiple plugins fills the log wi
 183  use C4::Context;
 184  require C4::Dates;
 185
 186 +use Algorithm::CheckDigits;
 187 +
 188  my $DEBUG = 0;
 189
 190  =head1
 191 @@ -123,6 +125,26 @@ sub plugin_javascript {
 192          }
 193          ";
 194      }
 195 +       elsif ($autoBarcodeType eq 'EAN13') {
 196 +               # not the best, two catalogers could add the same barcode easily this way :/
 197 +               $query = "select max(abs(barcode)) from items";
 198 +               my $sth = $dbh->prepare($query);
 199 +               $sth->execute();
 200 +               while (my ($count)= $sth->fetchrow_array) {
 201 +                       $nextnum = $count;
 202 +               }
 203 +               my $ean = CheckDigits('ean');
 204 +               if ( $ean->is_valid($nextnum) ) {
 205 +                       my $next = $ean->basenumber( $nextnum ) + 1;
 206 +                       $nextnum = sprintf('%013d',$ean->complete( $next ));
 207 +               } else {
 208 +                       warn "ERROR: invalid EAN-13 $nextnum, using increment";
 209 +                       $nextnum++;
 210 +               }
 211 +       }
 212 +       else {
 213 +               warn "ERROR: unknown autoBarcode: $autoBarcodeType";
 214 +       }
 215
 216      # default js body (if not filled by hbyymmincr)
 217      $scr or $scr = <<END_OF_JS;
 218 diff --git a/installer/data/mysql/en/mandatory/sysprefs.sql b/installer/data/mysql/en/mandatory/sysprefs.sql
 219 index 0aebcb5..a0111a1 100644
 220 --- a/installer/data/mysql/en/mandatory/sysprefs.sql
 221 +++ b/installer/data/mysql/en/mandatory/sysprefs.sql
 222 @@ -146,7 +146,7 @@ INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES
 223  INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('finesMode','test','Choose the fines mode, \'off\', \'test\' (emails admin report) or \'production\' (accrue overdue fines).  Requires accruefines cronjob.','off|test|production','Choice');
 224  INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('globalDueDate','','If set, allows a global static due date for all checkouts','10','free');
 225  INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('ceilingDueDate','','If set, date due will not be past this date.  Enter date according to the dateformat System Preference',NULL,'free');
 226 -INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('itemBarcodeInputFilter','','If set, allows specification of a item barcode input filter','whitespace|T-prefix|cuecat','Choice');
 227 +INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('itemBarcodeInputFilter','','If set, allows specification of a item barcode input filter','whitespace|T-prefix|cuecat|EAN13','Choice');
 228  INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('singleBranchMode',0,'Operate in Single-branch mode, hide branch selection in the OPAC',NULL,'YesNo');
 229  INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('URLLinkText','','Text to display as the link anchor in the OPAC',NULL,'free');
 230  INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('OPACViewOthersSuggestions',0,'If ON, allows all suggestions to be displayed in the OPAC',NULL,'YesNo');
 231 diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl
 232 index 6888b72..0fc6a71 100755
 233 --- a/installer/data/mysql/updatedatabase.pl
 234 +++ b/installer/data/mysql/updatedatabase.pl
 235 @@ -4074,6 +4074,16 @@ if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
 236      SetVersion ($DBversion);
 237  }
 238
 239 +$DBversion = "3.02.09.001"; # FIXME
 240 +if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
 241 +    $dbh->do("UPDATE `systempreferences` SET options='whitespace|t-prefix|cuecat|libsuite8|ean13' WHERE variable='itembarcodeinputfilter'");
 242 +    print "Upgrade to $DBversion done (Add itemBarcodeInputFilter choice EAN13)\n";
 243 +
 244 +    $dbh->do("UPDATE systempreferences SET options = concat(options,'|EAN13'), explanation = concat(explanation,'; EAN13 - incremental') WHERE variable = 'autoBarcode';");
 245 +    print "Upgrade to $DBversion done ( Added EAN13 barcode autogeneration sequence )\n";
 246 +    SetVersion($DBversion);
 247 +}
 248 +
 249  =head1 FUNCTIONS
 250
 251  =head2 DropAllForeignKeys($table)
 252 diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref
 253 index c8dad2c..7466d54 100644
 254 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref
 255 +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref
 256 @@ -77,6 +77,7 @@ Cataloging:
 257                    incremental: generated in the form 1, 2, 3.
 258                    annual: generated in the form &lt;year&gt;-0001, &lt;year&gt;-0002.
 259                    hbyymmincr: generated in the form &lt;branchcode&gt;yymm0001.
 260 +                  EAN13: incremental EAN-13 barcodes
 261                    "OFF": not generated automatically.
 262      Display:
 263          -
 264 diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref
 265 index b948495..4daa2ef 100644
 266 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref
 267 +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/circulation.pref
 268 @@ -14,6 +14,7 @@ Circulation:
 269                    whitespace: Remove spaces from
 270                    cuecat: Convert from CueCat form
 271                    T-prefix: Remove the first number from T-prefix style
 272 +                  EAN13: upgrade 12-digit UPC-A to EAN13 and check validity
 273              - scanned patron barcodes.
 274          -
 275              - Sort previous checkouts on the circulation page from
 276 diff --git a/kohaversion.pl b/kohaversion.pl
 277 index 97617db..2c9321f 100644
 278 --- a/kohaversion.pl
 279 +++ b/kohaversion.pl
 280 @@ -16,7 +16,7 @@ the kohaversion is divided in 4 parts :
 281  use strict;
 282
 283  sub kohaversion {
 284 -    our $VERSION = '3.02.09.000';
 285 +    our $VERSION = '3.02.09.001';
 286      # version needs to be set this way
 287      # so that it can be picked up by Makefile.PL
 288      # during install
 289 diff --git a/t/Barcodes_EAN13.t b/t/Barcodes_EAN13.t
 290 new file mode 100755
 291 index 0000000..a859ade
 292 --- /dev/null
 293 +++ b/t/Barcodes_EAN13.t
 294 @@ -0,0 +1,14 @@
 295 +#!/usr/bin/perl
 296 +#
 297 +# This Koha test module is a stub!
 298 +# Add more tests here!!!
 299 +
 300 +use strict;
 301 +use warnings;
 302 +
 303 +use Test::More tests => 1;
 304 +
 305 +BEGIN {
 306 +        use_ok('C4::Barcodes::EAN13');
 307 +}
 308 +
 309 diff --git a/t/Circulation_barcodedecode.t b/t/Circulation_barcodedecode.t
 310 index 5f2edc2..df007a2 100644
 311 --- a/t/Circulation_barcodedecode.t
 312 +++ b/t/Circulation_barcodedecode.t
 313 @@ -4,7 +4,7 @@
 314  use strict;
 315  use warnings;
 316
 317 -use Test::More tests => 16;
 318 +use Test::More tests => 18;
 319
 320  BEGIN {
 321      use_ok('C4::Circulation');
 322 @@ -15,12 +15,14 @@ our %inputs = (
 323                      'q.C3nZC3nZC3nWDNzYDxf2CNnY.fHmc.C3DWC3nZCNjXD3nW.', '.C3nZC3nZC3nWCxjWE3D1C3nX.cGf2.ENr7C3v7D3T3ENj3C3zYDNnZ.' ],
 324      whitespace => [" 26002315", "26002315 ", "\n\t26002315\n"],
 325      'T-prefix' => [qw(T0031472 T32)],
 326 +    EAN13      => [qw(892685001928 000000695152)],
 327      other      => [qw(26002315 T0031472 T32 Alphanum123), "Alpha Num 345"],
 328  );
 329  our %outputs = (
 330      cuecat     => ["26002315", "046675000808", "046675000808", "043000112403", "978068484914051500"],
 331      whitespace => [qw(26002315 26002315 26002315)],
 332      'T-prefix' => [qw(T0031472 T0000002         )],
 333 +    EAN13      => [qw(0892685001928 0000000695152)],
 334      other      => [qw(26002315 T0031472 T32 Alphanum123), "Alpha Num 345"],
 335  );
 336
 337 diff --git a/t/db_dependent/Barcodes.t b/t/db_dependent/Barcodes.t
 338 index cd50178..3a78452 100755
 339 --- a/t/db_dependent/Barcodes.t
 340 +++ b/t/db_dependent/Barcodes.t
 341 @@ -3,7 +3,7 @@
 342  use strict;
 343  use warnings;
 344
 345 -use Test::More tests => 49;
 346 +use Test::More tests => 66;
 347  BEGIN {
 348         use FindBin;
 349         use lib $FindBin::Bin;
 350 @@ -14,6 +14,7 @@ my %thash = (
 351         incremental => [],
 352         annual => [],
 353         hbyymmincr => ['MAIN'],
 354 +       EAN13 => ['0000000695152','892685001928'],
 355  );
 356
 357  print "\n";