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>.
26 use C4::Barcodes::hbyymmincr;
27 use C4::Barcodes::annual;
28 use C4::Barcodes::incremental;
29 use C4::Barcodes::EAN13;
31 use vars qw($max $prefformat);
34 unless (defined $prefformat) {
35 unless ($prefformat = C4::Context->preference('autoBarcode')) {
36 carp "The autoBarcode syspref is missing/undefined. Assuming 'incremental'.";
37 $prefformat = 'incremental';
49 sub process_head { # (self,head,whole,specific)
51 return shift; # Default: just return the head unchanged.
53 sub process_tail { # (self,tail,whole,specific)
55 return shift; # Default: just return the tail unchanged.
59 ref($self) or carp "Called is_max on a non-object: '$self'";
60 (@_) and $self->{is_max} = shift;
61 return $self->{is_max} || 0;
67 warn "Error: UNDEF argument to value"
68 unless defined $value;
69 $self->{value} = $value;
71 return $self->{value};
74 (@_) or return _prefformat;
76 my $value = $self->{autoBarcode} or return _prefformat;
77 $value =~ s/^.*:://; # in case we get C4::Barcodes::incremental, we just want 'incremental'
80 sub parse { # return 3 parts of barcode: non-incrementing, incrementing, non-incrementing
82 my $barcode = (@_) ? shift : $self->value;
83 unless ($barcode =~ /(.*?)(\d+)$/) { # non-greedy match in first part
84 carp "Barcode '$barcode' has no incrementing part!";
85 return ($barcode,undef,undef);
87 return ($1,$2,''); # the third part is in anticipation of barcodes that include checkdigits
91 if ($self->{is_max}) {
98 my $query = "SELECT max(abs(barcode)) FROM items LIMIT 1"; # Possible problem if multiple barcode types populated
99 my $sth = C4::Context->dbh->prepare($query);
101 return $sth->fetchrow_array || $self->initial;
105 my $specific = (scalar @_) ? 1 : 0;
106 my $max = $specific ? shift : $self->max; # optional argument, i.e. next_value after X
108 warn "No max barcode ($self->autoBarcode format) found. Using initial value.";
109 return $self->initial;
111 my ($head,$incr,$tail) = $self->parse($max); # for incremental, you'd get ('',the_whole_barcode,'')
112 unless (defined $incr) {
113 warn "No incrementing part of barcode ($max) returned by parse.";
116 my $x = length($incr); # number of digits
117 $incr =~ /^9+$/ and $x++; # if they're all 9's, we need an extra.
118 # Note, this enlargement might be undesirable for some barcode formats.
119 # Those should override next_value() to work accordingly.
122 $head = $self->process_head($head,$max,$specific);
123 $tail = $self->process_tail($tail,$incr,$specific); # XXX use $incr and not $max!
124 my $next_value = $head . $incr . $tail;
128 my $self = shift or return;
129 (@_) and $self->{next} = shift;
130 return $self->{next};
133 my $self = shift or return;
134 (@_) and $self->{previous} = shift;
135 return $self->{previous};
138 my $self = shift or return;
139 (@_) and $self->{serial} = shift;
140 return $self->{serial};
143 (@_) or carp "default_self called with no argument. Reverting to _prefformat.";
144 my $autoBarcode = (@_) ? shift : _prefformat;
145 $autoBarcode =~ s/^.*:://; # in case we get C4::Barcodes::incremental, we just want 'incremental'
148 autoBarcode => $autoBarcode,
157 annual => sub {C4::Barcodes::annual->new_object(@_); },
158 incremental => sub {C4::Barcodes::incremental->new_object(@_);},
159 hbyymmincr => sub {C4::Barcodes::hbyymmincr->new_object(@_); },
160 OFF => sub {C4::Barcodes::OFF->new_object(@_); },
161 EAN13 => sub {C4::Barcodes::EAN13->new_object(@_); },
165 my $class_or_object = shift;
166 my $type = ref($class_or_object) || $class_or_object;
167 my $from_obj = ref($class_or_object) ? 1 : 0; # are we building off another Barcodes object?
168 my $autoBarcodeType = (@_) ? shift : $from_obj ? $class_or_object->autoBarcode : _prefformat;
169 $autoBarcodeType =~ s/^.*:://; # in case we get C4::Barcodes::incremental, we just want 'incremental'
170 unless ($autoBarcodeType) {
171 carp "No autoBarcode format found.";
174 unless (defined $types->{$autoBarcodeType}) {
175 carp "The autoBarcode format '$autoBarcodeType' is unrecognized.";
179 if ($autoBarcodeType eq 'OFF') {
180 $self = $class_or_object->default_self($autoBarcodeType);
181 return bless $self, $class_or_object;
182 } elsif ($from_obj) {
183 $class_or_object->autoBarcode eq $autoBarcodeType
184 or carp "Cannot create Barcodes object (type '$autoBarcodeType') from " . $class_or_object->autoBarcode . " object!";
185 $self = $class_or_object->new_object(@_);
186 $self->serial($class_or_object->serial + 1);
187 if ($class_or_object->is_max) {
188 $self->previous($class_or_object);
189 $class_or_object->next($self);
190 $self->value($self->next_value($class_or_object->value));
191 $self->is_max(1) and $class_or_object->is_max(0); # new object is max, old object is no longer max
193 $self->value($self->next_value);
196 $self = &{$types->{$autoBarcodeType}} (@_);
197 $self->value($self->next_value) and $self->is_max(1);
203 carp "Failed new C4::Barcodes::$autoBarcodeType";
208 my $class_or_object = shift;
209 my $type = ref($class_or_object) || $class_or_object;
210 my $from_obj = ref($class_or_object) ? 1 : 0; # are we building off another Barcodes object?
211 my $self = $class_or_object->default_self($from_obj ? $class_or_object->autoBarcode : 'incremental');
220 Note that the object returned by new is actually of the type requested (or set by syspref).
221 For example, C4::Barcodes::annual
223 The specific C4::Barcodes::* modules correspond to the autoBarcode syspref values.
225 The default behavior here in Barcodes should be essentially a more flexible version of "incremental".
227 =head1 Adding New Barcode Types
229 To add a new barcode format, a developer should:
231 create a module in C4/Barcodes/, like C4/Barcodes/my_new_format.pm;
232 add to the $types hashref in this file;
233 add tests under the "t" directory; and
234 edit autoBarcode syspref to include new type.
236 =head2 Adding a new module
238 Each new module that needs differing behavior must override these subs:
245 Or else the CLASS subs will be used.
247 =head2 $types hashref
249 The hash referenced can be thought of as the constructor farm for all the C4::Barcodes types.
250 Each value should be a reference to a sub that calls the module constructor.
254 You would think it might be easy to handle incremental barcodes, but in practice even commonly used values,
255 like the IBM "Boulder" format can cause problems for sprintf. Basically, the value is too large for the
256 %d version of an integer, and we cannot count on perl having been compiled with support for quads
257 (64-bit integers). So we have to use floats or increment a piece of it and return the rejoined fragments.