View | Details | Raw Unified | Return to bug 6448
Collapse All | Expand All

(-)a/C4/Barcodes.pm (-1 / +3 lines)
Lines 28-33 use C4::Dates; Link Here
28
use C4::Barcodes::hbyymmincr;
28
use C4::Barcodes::hbyymmincr;
29
use C4::Barcodes::annual;
29
use C4::Barcodes::annual;
30
use C4::Barcodes::incremental;
30
use C4::Barcodes::incremental;
31
use C4::Barcodes::EAN13;
31
32
32
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
33
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
33
use vars qw($debug $cgi_debug);	# from C4::Debug, of course
34
use vars qw($debug $cgi_debug);	# from C4::Debug, of course
Lines 138-144 sub next_value ($;$) { Link Here
138
139
139
	$debug and warn "$incr";
140
	$debug and warn "$incr";
140
	$head = $self->process_head($head,$max,$specific);
141
	$head = $self->process_head($head,$max,$specific);
141
	$tail = $self->process_tail($tail,$max,$specific);
142
	$tail = $self->process_tail($tail,$incr,$specific); # XXX use $incr and not $max!
142
	my $next_value = $head . $incr . $tail;
143
	my $next_value = $head . $incr . $tail;
143
	$debug and print STDERR "(  next ) max barcode found: $next_value\n";
144
	$debug and print STDERR "(  next ) max barcode found: $next_value\n";
144
	return $next_value;
145
	return $next_value;
Lines 177-182 our $types = { Link Here
177
	incremental => sub {C4::Barcodes::incremental->new_object(@_);},
178
	incremental => sub {C4::Barcodes::incremental->new_object(@_);},
178
	hbyymmincr  => sub {C4::Barcodes::hbyymmincr->new_object(@_); },
179
	hbyymmincr  => sub {C4::Barcodes::hbyymmincr->new_object(@_); },
179
	OFF         => sub {C4::Barcodes::OFF->new_object(@_);        },
180
	OFF         => sub {C4::Barcodes::OFF->new_object(@_);        },
181
	EAN13       => sub {C4::Barcodes::EAN13->new_object(@_);      },
180
};
182
};
181
183
182
sub new {
184
sub new {
(-)a/C4/Barcodes/EAN13.pm (+55 lines)
Line 0 Link Here
1
package C4::Barcodes::EAN13;
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it under the
6
# terms of the GNU General Public License as published by the Free Software
7
# Foundation; either version 2 of the License, or (at your option) any later
8
# version.
9
#
10
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
11
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13
#
14
# You should have received a copy of the GNU General Public License along
15
# with Koha; if not, write to the Free Software Foundation, Inc.,
16
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17
18
use strict;
19
use warnings;
20
21
use C4::Context;
22
use C4::Debug;
23
24
use Algorithm::CheckDigits;
25
26
use vars qw($VERSION @ISA);
27
use vars qw($debug $cgi_debug);	# from C4::Debug, of course
28
29
BEGIN {
30
    $VERSION = 0.01;
31
    @ISA = qw(C4::Barcodes);
32
}
33
34
sub parse ($;$) {
35
	my $self = shift;
36
	my $barcode = (@_) ? shift : $self->value;
37
	my $ean = CheckDigits('ean');
38
	if ( $ean->is_valid($barcode) ) {
39
		return ( '', $ean->basenumber($barcode), $ean->checkdigit($barcode) );
40
	} else {
41
		die "$barcode not valid EAN-13 barcode";
42
	}
43
}
44
45
sub process_tail($$;$$) {
46
	my ( $self,$tail,$whole,$specific ) = @_;
47
	my $ean = CheckDigits('ean');
48
	my $full = $ean->complete($whole);
49
	my $chk  = $ean->checkdigit($full);
50
	$debug && warn "# process_tail $tail -> $chk [$whole -> $full] $specific";
51
	return $chk;
52
}
53
54
1;
55
__END__
(-)a/cataloguing/value_builder/barcode.pl (+23 lines)
Lines 24-29 no warnings 'redefine'; # otherwise loading up multiple plugins fills the log wi Link Here
24
use C4::Context;
24
use C4::Context;
25
require C4::Dates;
25
require C4::Dates;
26
26
27
use Algorithm::CheckDigits;
28
27
my $DEBUG = 0;
29
my $DEBUG = 0;
28
30
29
=head1
31
=head1
Lines 123-128 sub plugin_javascript { Link Here
123
        }
125
        }
124
        ";
126
        ";
125
    }
127
    }
128
	elsif ($autoBarcodeType eq 'EAN13') {
129
		# not the best, two catalogers could add the same barcode easily this way :/
130
		$query = "select max(abs(barcode)) from items";
131
		my $sth = $dbh->prepare($query);
132
		$sth->execute();
133
		while (my ($last)= $sth->fetchrow_array) {
134
			$nextnum = $last;
135
		}
136
		my $ean = CheckDigits('ean');
137
		if ( $ean->is_valid($nextnum) ) {
138
			my $next = $ean->basenumber( $nextnum ) + 1;
139
			$nextnum = $ean->complete( $next );
140
			$nextnum = '0' x ( 13 - length($nextnum) ) . $nextnum; # pad zeros
141
		} else {
142
			warn "ERROR: invalid EAN-13 $nextnum, using increment";
143
			$nextnum++;
144
		}
145
	}
146
	else {
147
		warn "ERROR: unknown autoBarcode: $autoBarcodeType";
148
	}
126
149
127
    # default js body (if not filled by hbyymmincr)
150
    # default js body (if not filled by hbyymmincr)
128
    $scr or $scr = <<END_OF_JS;
151
    $scr or $scr = <<END_OF_JS;
(-)a/installer/data/mysql/updatedatabase.pl (+4 lines)
Lines 5090-5095 $DBversion = "XXX"; # FIXME Link Here
5090
if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
5090
if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
5091
    $dbh->do("UPDATE systempreferences SET options=concat(options,'|EAN13') WHERE variable='itembarcodeinputfilter' AND options NOT LIKE '%EAN13%'");
5091
    $dbh->do("UPDATE systempreferences SET options=concat(options,'|EAN13') WHERE variable='itembarcodeinputfilter' AND options NOT LIKE '%EAN13%'");
5092
    print "Upgrade to $DBversion done (Add itemBarcodeInputFilter choice EAN13)\n";
5092
    print "Upgrade to $DBversion done (Add itemBarcodeInputFilter choice EAN13)\n";
5093
5094
    $dbh->do("UPDATE systempreferences SET options = concat(options,'|EAN13'), explanation = concat(explanation,'; EAN13 - incremental') WHERE variable = 'autoBarcode' AND options NOT LIKE '%EAN13%'");
5095
    print "Upgrade to $DBversion done ( Added EAN13 barcode autogeneration sequence )\n";
5096
5093
    SetVersion($DBversion);
5097
    SetVersion($DBversion);
5094
}
5098
}
5095
5099
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref (+1 lines)
Lines 89-94 Cataloging: Link Here
89
                  incremental: generated in the form 1, 2, 3.
89
                  incremental: generated in the form 1, 2, 3.
90
                  annual: generated in the form &lt;year&gt;-0001, &lt;year&gt;-0002.
90
                  annual: generated in the form &lt;year&gt;-0001, &lt;year&gt;-0002.
91
                  hbyymmincr: generated in the form &lt;branchcode&gt;yymm0001.
91
                  hbyymmincr: generated in the form &lt;branchcode&gt;yymm0001.
92
                  EAN13: incremental EAN-13 barcodes
92
                  "OFF": not generated automatically.
93
                  "OFF": not generated automatically.
93
    Display:
94
    Display:
94
        -
95
        -
(-)a/t/Barcodes_EAN13.t (+14 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
#
3
# This Koha test module is a stub!  
4
# Add more tests here!!!
5
6
use strict;
7
use warnings;
8
9
use Test::More tests => 1;
10
11
BEGIN {
12
        use_ok('C4::Barcodes::EAN13');
13
}
14
(-)a/t/db_dependent/Barcodes.t (-2 / +2 lines)
Lines 3-9 Link Here
3
use strict;
3
use strict;
4
use warnings;
4
use warnings;
5
5
6
use Test::More tests => 49;
6
use Test::More tests => 66;
7
BEGIN {
7
BEGIN {
8
	use FindBin;
8
	use FindBin;
9
	use lib $FindBin::Bin;
9
	use lib $FindBin::Bin;
Lines 14-19 my %thash = ( Link Here
14
	incremental => [],
14
	incremental => [],
15
	annual => [],
15
	annual => [],
16
	hbyymmincr => ['MAIN'],
16
	hbyymmincr => ['MAIN'],
17
	EAN13 => ['0000000695152','892685001928'],
17
);
18
);
18
19
19
print "\n";
20
print "\n";
20
- 

Return to bug 6448