Bug 15358: Fix authorities merge
[koha.git] / C4 / Barcodes.pm
blob35c5d6a97ba4ddda35ee34facaccccba825a4768
1 package C4::Barcodes;
3 # Copyright 2008 LibLime
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
20 use strict;
21 use warnings;
23 use Carp;
25 use C4::Context;
26 use C4::Debug;
27 use C4::Barcodes::hbyymmincr;
28 use C4::Barcodes::annual;
29 use C4::Barcodes::incremental;
30 use C4::Barcodes::EAN13;
32 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($max $prefformat);
36 BEGIN {
37 $VERSION = 3.07.00.049;
38 require Exporter;
39 @ISA = qw(Exporter);
40 @EXPORT_OK = qw();
43 sub _prefformat {
44 unless (defined $prefformat) {
45 unless ($prefformat = C4::Context->preference('autoBarcode')) {
46 carp "The autoBarcode syspref is missing/undefined. Assuming 'incremental'.";
47 $prefformat = 'incremental';
50 return $prefformat;
53 sub initial {
54 return '0000001';
56 sub width {
57 return;
59 sub process_head { # (self,head,whole,specific)
60 my $self = shift;
61 return shift; # Default: just return the head unchanged.
63 sub process_tail { # (self,tail,whole,specific)
64 my $self = shift;
65 return shift; # Default: just return the tail unchanged.
67 sub is_max {
68 my $self = shift;
69 ref($self) or carp "Called is_max on a non-object: '$self'";
70 (@_) and $self->{is_max} = shift;
71 return $self->{is_max} || 0;
73 sub value {
74 my $self = shift;
75 if (@_) {
76 my $value = shift;
77 if (defined $value) {
78 $debug and print STDERR " setting barcode value to $value\n";
79 } else {
80 warn "Error: UNDEF argument to value";
82 $self->{value} = $value;
84 return $self->{value};
86 sub autoBarcode {
87 (@_) or return _prefformat;
88 my $self = shift;
89 my $value = $self->{autoBarcode} or return _prefformat;
90 $value =~ s/^.*:://; # in case we get C4::Barcodes::incremental, we just want 'incremental'
91 return $value;
93 sub parse { # return 3 parts of barcode: non-incrementing, incrementing, non-incrementing
94 my $self = shift;
95 my $barcode = (@_) ? shift : $self->value;
96 unless ($barcode =~ /(.*?)(\d+)$/) { # non-greedy match in first part
97 carp "Barcode '$barcode' has no incrementing part!";
98 return ($barcode,undef,undef);
100 $debug and warn "Barcode '$barcode' parses into: '$1', '$2', ''";
101 return ($1,$2,''); # the third part is in anticipation of barcodes that include checkdigits
103 sub max {
104 my $self = shift;
105 if ($self->{is_max}) {
106 $debug and print STDERR "max taken from Barcodes value $self->value\n";
107 return $self->value;
109 $debug and print STDERR "Retrieving max database query.\n";
110 return $self->db_max;
112 sub db_max {
113 my $self = shift;
114 my $query = "SELECT max(abs(barcode)) FROM items LIMIT 1"; # Possible problem if multiple barcode types populated
115 my $sth = C4::Context->dbh->prepare($query);
116 $sth->execute();
117 return $sth->fetchrow_array || $self->initial;
119 sub next_value {
120 my $self = shift;
121 my $specific = (scalar @_) ? 1 : 0;
122 my $max = $specific ? shift : $self->max; # optional argument, i.e. next_value after X
123 unless ($max) {
124 warn "No max barcode ($self->autoBarcode format) found. Using initial value.";
125 return $self->initial;
127 $debug and print STDERR "(current) max barcode found: $max\n";
128 my ($head,$incr,$tail) = $self->parse($max); # for incremental, you'd get ('',the_whole_barcode,'')
129 unless (defined $incr) {
130 warn "No incrementing part of barcode ($max) returned by parse.";
131 return;
133 my $x = length($incr); # number of digits
134 $incr =~ /^9+$/ and $x++; # if they're all 9's, we need an extra.
135 # Note, this enlargement might be undesirable for some barcode formats.
136 # Those should override next_value() to work accordingly.
137 $incr++;
139 $debug and warn "$incr";
140 $head = $self->process_head($head,$max,$specific);
141 $tail = $self->process_tail($tail,$incr,$specific); # XXX use $incr and not $max!
142 my $next_value = $head . $incr . $tail;
143 $debug and print STDERR "( next ) max barcode found: $next_value\n";
144 return $next_value;
146 sub next {
147 my $self = shift or return;
148 (@_) and $self->{next} = shift;
149 return $self->{next};
151 sub previous {
152 my $self = shift or return;
153 (@_) and $self->{previous} = shift;
154 return $self->{previous};
156 sub serial {
157 my $self = shift or return;
158 (@_) and $self->{serial} = shift;
159 return $self->{serial};
161 sub default_self {
162 (@_) or carp "default_self called with no argument. Reverting to _prefformat.";
163 my $autoBarcode = (@_) ? shift : _prefformat;
164 $autoBarcode =~ s/^.*:://; # in case we get C4::Barcodes::incremental, we just want 'incremental'
165 return {
166 is_max => 0,
167 autoBarcode => $autoBarcode,
168 value => undef,
169 previous => undef,
170 'next' => undef,
171 serial => 1
175 our $types = {
176 annual => sub {C4::Barcodes::annual->new_object(@_); },
177 incremental => sub {C4::Barcodes::incremental->new_object(@_);},
178 hbyymmincr => sub {C4::Barcodes::hbyymmincr->new_object(@_); },
179 OFF => sub {C4::Barcodes::OFF->new_object(@_); },
180 EAN13 => sub {C4::Barcodes::EAN13->new_object(@_); },
183 sub new {
184 my $class_or_object = shift;
185 my $type = ref($class_or_object) || $class_or_object;
186 my $from_obj = ref($class_or_object) ? 1 : 0; # are we building off another Barcodes object?
187 if ($from_obj) {
188 $debug and print STDERR "Building new(@_) from old Barcodes object\n";
190 my $autoBarcodeType = (@_) ? shift : $from_obj ? $class_or_object->autoBarcode : _prefformat;
191 $autoBarcodeType =~ s/^.*:://; # in case we get C4::Barcodes::incremental, we just want 'incremental'
192 unless ($autoBarcodeType) {
193 carp "No autoBarcode format found.";
194 return;
196 unless (defined $types->{$autoBarcodeType}) {
197 carp "The autoBarcode format '$autoBarcodeType' is unrecognized.";
198 return;
200 carp "autoBarcode format = $autoBarcodeType" if $debug;
201 my $self;
202 if ($autoBarcodeType eq 'OFF') {
203 $self = $class_or_object->default_self($autoBarcodeType);
204 return bless $self, $class_or_object;
205 } elsif ($from_obj) {
206 $class_or_object->autoBarcode eq $autoBarcodeType
207 or carp "Cannot create Barcodes object (type '$autoBarcodeType') from " . $class_or_object->autoBarcode . " object!";
208 $self = $class_or_object->new_object(@_);
209 $self->serial($class_or_object->serial + 1);
210 if ($class_or_object->is_max) {
211 $debug and print STDERR "old object was max: ", $class_or_object->value, "\n";
212 $self->previous($class_or_object);
213 $class_or_object->next($self);
214 $self->value($self->next_value($class_or_object->value));
215 $self->is_max(1) and $class_or_object->is_max(0); # new object is max, old object is no longer max
216 } else {
217 $self->value($self->next_value);
219 } else {
220 $debug and print STDERR "trying to create new $autoBarcodeType\n";
221 $self = &{$types->{$autoBarcodeType}} (@_);
222 $self->value($self->next_value) and $self->is_max(1);
223 $self->serial(1);
225 if ($self) {
226 return $self;
228 carp "Failed new C4::Barcodes::$autoBarcodeType";
229 return;
232 sub new_object {
233 my $class_or_object = shift;
234 my $type = ref($class_or_object) || $class_or_object;
235 my $from_obj = ref($class_or_object) ? 1 : 0; # are we building off another Barcodes object?
236 my $self = $class_or_object->default_self($from_obj ? $class_or_object->autoBarcode : 'incremental');
237 bless $self, $type;
238 return $self;
241 __END__
243 =head1 Barcodes
245 Note that the object returned by new is actually of the type requested (or set by syspref).
246 For example, C4::Barcodes::annual
248 The specific C4::Barcodes::* modules correspond to the autoBarcode syspref values.
250 The default behavior here in Barcodes should be essentially a more flexible version of "incremental".
252 =head1 Adding New Barcode Types
254 To add a new barcode format, a developer should:
256 create a module in C4/Barcodes/, like C4/Barcodes/my_new_format.pm;
257 add to the $types hashref in this file;
258 add tests under the "t" directory; and
259 edit autoBarcode syspref to include new type.
261 =head2 Adding a new module
263 Each new module that needs differing behavior must override these subs:
265 new_object
266 initial
267 db_max
268 parse
270 Or else the CLASS subs will be used.
272 =head2 $types hashref
274 The hash referenced can be thought of as the constructor farm for all the C4::Barcodes types.
275 Each value should be a reference to a sub that calls the module constructor.
277 =head1 Notes
279 You would think it might be easy to handle incremental barcodes, but in practice even commonly used values,
280 like the IBM "Boulder" format can cause problems for sprintf. Basically, the value is too large for the
281 %d version of an integer, and we cannot count on perl having been compiled with support for quads
282 (64-bit integers). So we have to use floats or increment a piece of it and return the rejoined fragments.
284 =cut