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(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
32 use vars qw($max $prefformat);
41 unless (defined $prefformat) {
42 unless ($prefformat = C4::Context->preference('autoBarcode')) {
43 carp "The autoBarcode syspref is missing/undefined. Assuming 'incremental'.";
44 $prefformat = 'incremental';
56 sub process_head { # (self,head,whole,specific)
58 return shift; # Default: just return the head unchanged.
60 sub process_tail { # (self,tail,whole,specific)
62 return shift; # Default: just return the tail unchanged.
66 ref($self) or carp "Called is_max on a non-object: '$self'";
67 (@_) and $self->{is_max} = shift;
68 return $self->{is_max} || 0;
74 warn "Error: UNDEF argument to value"
75 unless defined $value;
76 $self->{value} = $value;
78 return $self->{value};
81 (@_) or return _prefformat;
83 my $value = $self->{autoBarcode} or return _prefformat;
84 $value =~ s/^.*:://; # in case we get C4::Barcodes::incremental, we just want 'incremental'
87 sub parse { # return 3 parts of barcode: non-incrementing, incrementing, non-incrementing
89 my $barcode = (@_) ? shift : $self->value;
90 unless ($barcode =~ /(.*?)(\d+)$/) { # non-greedy match in first part
91 carp "Barcode '$barcode' has no incrementing part!";
92 return ($barcode,undef,undef);
94 return ($1,$2,''); # the third part is in anticipation of barcodes that include checkdigits
98 if ($self->{is_max}) {
101 return $self->db_max;
105 my $query = "SELECT max(abs(barcode)) FROM items LIMIT 1"; # Possible problem if multiple barcode types populated
106 my $sth = C4::Context->dbh->prepare($query);
108 return $sth->fetchrow_array || $self->initial;
112 my $specific = (scalar @_) ? 1 : 0;
113 my $max = $specific ? shift : $self->max; # optional argument, i.e. next_value after X
115 warn "No max barcode ($self->autoBarcode format) found. Using initial value.";
116 return $self->initial;
118 my ($head,$incr,$tail) = $self->parse($max); # for incremental, you'd get ('',the_whole_barcode,'')
119 unless (defined $incr) {
120 warn "No incrementing part of barcode ($max) returned by parse.";
123 my $x = length($incr); # number of digits
124 $incr =~ /^9+$/ and $x++; # if they're all 9's, we need an extra.
125 # Note, this enlargement might be undesirable for some barcode formats.
126 # Those should override next_value() to work accordingly.
129 $head = $self->process_head($head,$max,$specific);
130 $tail = $self->process_tail($tail,$incr,$specific); # XXX use $incr and not $max!
131 my $next_value = $head . $incr . $tail;
135 my $self = shift or return;
136 (@_) and $self->{next} = shift;
137 return $self->{next};
140 my $self = shift or return;
141 (@_) and $self->{previous} = shift;
142 return $self->{previous};
145 my $self = shift or return;
146 (@_) and $self->{serial} = shift;
147 return $self->{serial};
150 (@_) or carp "default_self called with no argument. Reverting to _prefformat.";
151 my $autoBarcode = (@_) ? shift : _prefformat;
152 $autoBarcode =~ s/^.*:://; # in case we get C4::Barcodes::incremental, we just want 'incremental'
155 autoBarcode => $autoBarcode,
164 annual => sub {C4::Barcodes::annual->new_object(@_); },
165 incremental => sub {C4::Barcodes::incremental->new_object(@_);},
166 hbyymmincr => sub {C4::Barcodes::hbyymmincr->new_object(@_); },
167 OFF => sub {C4::Barcodes::OFF->new_object(@_); },
168 EAN13 => sub {C4::Barcodes::EAN13->new_object(@_); },
172 my $class_or_object = shift;
173 my $type = ref($class_or_object) || $class_or_object;
174 my $from_obj = ref($class_or_object) ? 1 : 0; # are we building off another Barcodes object?
175 my $autoBarcodeType = (@_) ? shift : $from_obj ? $class_or_object->autoBarcode : _prefformat;
176 $autoBarcodeType =~ s/^.*:://; # in case we get C4::Barcodes::incremental, we just want 'incremental'
177 unless ($autoBarcodeType) {
178 carp "No autoBarcode format found.";
181 unless (defined $types->{$autoBarcodeType}) {
182 carp "The autoBarcode format '$autoBarcodeType' is unrecognized.";
186 if ($autoBarcodeType eq 'OFF') {
187 $self = $class_or_object->default_self($autoBarcodeType);
188 return bless $self, $class_or_object;
189 } elsif ($from_obj) {
190 $class_or_object->autoBarcode eq $autoBarcodeType
191 or carp "Cannot create Barcodes object (type '$autoBarcodeType') from " . $class_or_object->autoBarcode . " object!";
192 $self = $class_or_object->new_object(@_);
193 $self->serial($class_or_object->serial + 1);
194 if ($class_or_object->is_max) {
195 $self->previous($class_or_object);
196 $class_or_object->next($self);
197 $self->value($self->next_value($class_or_object->value));
198 $self->is_max(1) and $class_or_object->is_max(0); # new object is max, old object is no longer max
200 $self->value($self->next_value);
203 $self = &{$types->{$autoBarcodeType}} (@_);
204 $self->value($self->next_value) and $self->is_max(1);
210 carp "Failed new C4::Barcodes::$autoBarcodeType";
215 my $class_or_object = shift;
216 my $type = ref($class_or_object) || $class_or_object;
217 my $from_obj = ref($class_or_object) ? 1 : 0; # are we building off another Barcodes object?
218 my $self = $class_or_object->default_self($from_obj ? $class_or_object->autoBarcode : 'incremental');
227 Note that the object returned by new is actually of the type requested (or set by syspref).
228 For example, C4::Barcodes::annual
230 The specific C4::Barcodes::* modules correspond to the autoBarcode syspref values.
232 The default behavior here in Barcodes should be essentially a more flexible version of "incremental".
234 =head1 Adding New Barcode Types
236 To add a new barcode format, a developer should:
238 create a module in C4/Barcodes/, like C4/Barcodes/my_new_format.pm;
239 add to the $types hashref in this file;
240 add tests under the "t" directory; and
241 edit autoBarcode syspref to include new type.
243 =head2 Adding a new module
245 Each new module that needs differing behavior must override these subs:
252 Or else the CLASS subs will be used.
254 =head2 $types hashref
256 The hash referenced can be thought of as the constructor farm for all the C4::Barcodes types.
257 Each value should be a reference to a sub that calls the module constructor.
261 You would think it might be easy to handle incremental barcodes, but in practice even commonly used values,
262 like the IBM "Boulder" format can cause problems for sprintf. Basically, the value is too large for the
263 %d version of an integer, and we cannot count on perl having been compiled with support for quads
264 (64-bit integers). So we have to use floats or increment a piece of it and return the rejoined fragments.