Bug 6448 [2/3] Barcodes::EAN13 autoBarcode

Implement auto-incrementing EAN-13 barcodes

To make this work, C4::Barcodes::next was modified to call process_tail with
new incremented value so that process_tail can generate correct checksum.
Since process_tail is currenlty not used by any barcodes, this change is safe.

C4::Barcodes is used by addbiblio.pl when adding multiple records, while value_builder
is used in all other cases.

Test scenario:

1. prove t/Barcodes_EAN13.t

2. KOHA_CONF=/etc/koha/sites/fer/koha-conf.xml prove t/db_dependent/Barcodes.t
   this will check C4::Barcode implementataion

3. in systempreference change autoBarcode to incremental EAN-13 barcode

4. edit two items of any biblio assigning barcodes and verify that numbers
   are increasing. Have in mind that last digit is check digit, and it
   doesn't increment, but is calculated from barcode itself. Example with
   checksum in brackets: 000000086275[2], 000000086276[9], 000000086277[6]

5. Add Item and verify that it gets assigned next barcode

6. Add & Duplicate item and verify barcode increase

7. Add Multiple Copies and verify that barcode increase for each copy

Signed-off-by: Chris Cormack <chris@bigballofwax.co.nz>
Signed-off-by: Paul Poulain <paul.poulain@biblibre.com>

C4/Barcodes.pm

@@ -28,6 +28,7 @@ use C4::Dates;
 use C4::Barcodes::hbyymmincr;
 use C4::Barcodes::annual;
 use C4::Barcodes::incremental;
+use C4::Barcodes::EAN13;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 use vars qw($debug $cgi_debug);	# from C4::Debug, of course
@@ -138,7 +139,7 @@ sub next_value {
 
 	$debug and warn "$incr";
 	$head = $self->process_head($head,$max,$specific);
-	$tail = $self->process_tail($tail,$max,$specific);
+    $tail = $self->process_tail($tail,$incr,$specific); # XXX use $incr and not $max!
 	my $next_value = $head . $incr . $tail;
 	$debug and print STDERR "(  next ) max barcode found: $next_value\n";
 	return $next_value;
@@ -177,6 +178,7 @@ our $types = {
 	incremental => sub {C4::Barcodes::incremental->new_object(@_);},
 	hbyymmincr  => sub {C4::Barcodes::hbyymmincr->new_object(@_); },
 	OFF         => sub {C4::Barcodes::OFF->new_object(@_);        },
+    EAN13       => sub {C4::Barcodes::EAN13->new_object(@_);      },
 };
 
 sub new {

C4/Barcodes/EAN13.pm

@@ -0,0 +1,57 @@
+package C4::Barcodes::EAN13;
+
+# Copyright 2012 Koha Development team
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+use strict;
+use warnings;
+
+use C4::Context;
+use C4::Debug;
+
+use Algorithm::CheckDigits;
+
+use vars qw($VERSION @ISA);
+use vars qw($debug $cgi_debug);	# from C4::Debug, of course
+
+BEGIN {
+    $VERSION = 0.01;
+    @ISA = qw(C4::Barcodes);
+}
+
+sub parse {
+    my $self = shift;
+    my $barcode = (@_) ? shift : $self->value;
+    my $ean = CheckDigits('ean');
+    if ( $ean->is_valid($barcode) ) {
+        return ( '', $ean->basenumber($barcode), $ean->checkdigit($barcode) );
+    } else {
+        die "$barcode not valid EAN-13 barcode";
+    }
+}
+
+sub process_tail {
+    my ( $self,$tail,$whole,$specific ) = @_;
+    my $ean = CheckDigits('ean');
+    my $full = $ean->complete($whole);
+    my $chk  = $ean->checkdigit($full);
+    $debug && warn "# process_tail $tail -> $chk [$whole -> $full] $specific";
+    return $chk;
+}
+
+1;
+__END__

cataloguing/value_builder/barcode.pl

@@ -24,6 +24,8 @@ no warnings 'redefine'; # otherwise loading up multiple plugins fills the log wi
 use C4::Context;
 require C4::Dates;
 
+use Algorithm::CheckDigits;
+
 my $DEBUG = 0;
 
 =head1
@@ -123,6 +125,27 @@ sub plugin_javascript {
         }
         ";
     }
+    elsif ($autoBarcodeType eq 'EAN13') {
+        # not the best, two catalogers could add the same barcode easily this way :/
+        $query = "select max(abs(barcode)) from items";
+        my $sth = $dbh->prepare($query);
+        $sth->execute();
+        while (my ($last)= $sth->fetchrow_array) {
+            $nextnum = $last;
+        }
+        my $ean = CheckDigits('ean');
+        if ( $ean->is_valid($nextnum) ) {
+            my $next = $ean->basenumber( $nextnum ) + 1;
+            $nextnum = $ean->complete( $next );
+            $nextnum = '0' x ( 13 - length($nextnum) ) . $nextnum; # pad zeros
+        } else {
+            warn "ERROR: invalid EAN-13 $nextnum, using increment";
+            $nextnum++;
+        }
+    }
+    else {
+        warn "ERROR: unknown autoBarcode: $autoBarcodeType";
+    }
 
     # default js body (if not filled by hbyymmincr)
     $scr or $scr = <<END_OF_JS;

installer/data/mysql/sysprefs.sql

@@ -15,7 +15,7 @@ INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES
 INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('Babeltheque',0,'Turn ON Babeltheque content  - See babeltheque.com to subscribe to this service','','YesNo');
 
 INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('authoritysep','--','Used to separate a list of authorities in a display. Usually --',10,'free');
-INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('autoBarcode','OFF','Used to autogenerate a barcode: incremental will be of the form 1, 2, 3; annual of the form 2007-0001, 2007-0002; hbyymmincr of the form HB08010001 where HB=Home Branch','incremental|annual|hbyymmincr|OFF','Choice');
+INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('autoBarcode','OFF','Used to autogenerate a barcode: incremental will be of the form 1, 2, 3; annual of the form 2007-0001, 2007-0002; hbyymmincr of the form HB08010001 where HB=Home Branch','incremental|annual|hbyymmincr|EAN13|OFF','Choice');
 INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('AutoLocation',0,'If ON, IP authentication is enabled, blocking access to the staff client from unauthorized IP addresses',NULL,'YesNo');
 INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('AutomaticItemReturn',1,'If ON, Koha will automatically set up a transfer of this item to its homebranch',NULL,'YesNo');
 INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('autoMemberNum',1,'If ON, patron number is auto-calculated','','YesNo');

installer/data/mysql/updatedatabase.pl

@@ -5614,6 +5614,10 @@ $DBversion = "3.09.00.XXX"; # FIXME
 if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
     $dbh->do("UPDATE systempreferences SET options=concat(options,'|EAN13') WHERE variable='itemBarcodeInputFilter' AND options NOT LIKE '%EAN13%'");
     print "Upgrade to $DBversion done (Add itemBarcodeInputFilter choice EAN13)\n";
+
+    $dbh->do("UPDATE systempreferences SET options = concat(options,'|EAN13'), explanation = concat(explanation,'; EAN13 - incremental') WHERE variable = 'autoBarcode' AND options NOT LIKE '%EAN13%'");
+    print "Upgrade to $DBversion done ( Added EAN13 barcode autogeneration sequence )\n";
+
     SetVersion($DBversion);
 }
 

koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref

@@ -93,6 +93,7 @@ Cataloging:
                   incremental: generated in the form 1, 2, 3.
                   annual: generated in the form <year>-0001, <year>-0002.
                   hbyymmincr: generated in the form <branchcode>yymm0001.
+                  EAN13: incremental EAN-13 barcodes
                   "OFF": not generated automatically.
     Display:
         -

t/Barcodes_EAN13.t

@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+#
+# implementation tests are in t/db_dependent/Barcodes.t
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN {
+        use_ok('C4::Barcodes::EAN13');
+}

t/db_dependent/Barcodes.t

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 49;
+use Test::More tests => 66;
 BEGIN {
 	use FindBin;
 	use lib $FindBin::Bin;
@@ -14,6 +14,7 @@ my %thash = (
 	incremental => [],
 	annual => [],
 	hbyymmincr => ['MAIN'],
+    EAN13 => ['0000000695152','892685001928'],
 );
 
 print "\n";