File Coverage

File:C4/Barcodes.pm
Coverage:17.4%

linestmtbrancondsubtimecode
1package C4::Barcodes;
2
3# Copyright 2008 LibLime
4#
5# This file is part of Koha.
6#
7# Koha is free software; you can redistribute it and/or modify it under the
8# terms of the GNU General Public License as published by the Free Software
9# Foundation; either version 2 of the License, or (at your option) any later
10# version.
11#
12# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License along
17# with Koha; if not, write to the Free Software Foundation, Inc.,
18# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
1
1
1
1
311
6
28
use strict;
21
1
1
1
1
9
5
40
use warnings;
22
23
1
1
1
1
9
5
95
use Carp;
24
25
1
1
1
1
9
4
17
use C4::Context;
26
1
1
1
1
10
5
86
use C4::Debug;
27
1
1
1
1
9
4
36
use C4::Dates;
28
1
1
1
1
216
2
27
use C4::Barcodes::hbyymmincr;
29
1
1
1
1
235
2
26
use C4::Barcodes::annual;
30
1
1
1
1
222
1
33
use C4::Barcodes::incremental;
31
32
1
1
1
1
4
2
72
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
33
1
1
1
1
4
2
37
use vars qw($debug $cgi_debug); # from C4::Debug, of course
34
1
1
1
1
4
1
90
use vars qw($max $prefformat);
35
36BEGIN {
37
1
1
2
    $VERSION = 0.01;
38
1
5
        require Exporter;
39
1
18
    @ISA = qw(Exporter);
40
1
2391
    @EXPORT_OK = qw();
41}
42
43sub _prefformat {
44
0
0
0
        unless (defined $prefformat) {
45
0
0
                unless ($prefformat = C4::Context->preference('autoBarcode')) {
46
0
                        carp "The autoBarcode syspref is missing/undefined. Assuming 'incremental'.";
47
0
                        $prefformat = 'incremental';
48                }
49        }
50
0
        return $prefformat;
51}
52
53sub initial {
54
0
0
        return '0000001';
55}
56sub width {
57
0
0
        return undef;
58}
59sub process_head($$;$$) { # (self,head,whole,specific)
60
0
0
        my $self = shift;
61
0
        return shift; # Default: just return the head unchanged.
62}
63sub process_tail($$;$$) { # (self,tail,whole,specific)
64
0
0
        my $self = shift;
65
0
        return shift; # Default: just return the tail unchanged.
66}
67sub is_max ($;$) {
68
0
0
        my $self = shift;
69
0
0
        ref($self) or carp "Called is_max on a non-object: '$self'";
70
0
0
        (@_) and $self->{is_max} = shift;
71
0
0
        return $self->{is_max} || 0;
72}
73sub value ($;$) {
74
0
0
        my $self = shift;
75
0
0
        if (@_) {
76
0
                my $value = shift;
77
0
0
                if (defined $value) {
78
0
0
                        $debug and print STDERR " setting barcode value to $value\n";
79                } else {
80
0
                        warn "Error: UNDEF argument to value";
81                }
82
0
                $self->{value} = $value;
83        }
84
0
        return $self->{value};
85}
86sub autoBarcode (;$) {
87
0
0
0
        (@_) or return _prefformat;
88
0
        my $self = shift;
89
0
0
        my $value = $self->{autoBarcode} or return _prefformat;
90
0
        $value =~ s/^.*:://; # in case we get C4::Barcodes::incremental, we just want 'incremental'
91
0
        return $value;
92}
93sub parse ($;$) { # return 3 parts of barcode: non-incrementing, incrementing, non-incrementing
94
0
0
        my $self = shift;
95
0
0
        my $barcode = (@_) ? shift : $self->value;
96
0
0
        unless ($barcode =~ /(.*?)(\d+)$/) { # non-greedy match in first part
97
0
                carp "Barcode '$barcode' has no incrementing part!";
98
0
                return ($barcode,undef,undef);
99        }
100
0
0
        $debug and warn "Barcode '$barcode' parses into: '$1', '$2', ''";
101
0
        return ($1,$2,''); # the third part is in anticipation of barcodes that include checkdigits
102}
103sub max ($;$) {
104
0
0
        my $self = shift;
105
0
0
        if ($self->{is_max}) {
106
0
0
                $debug and print STDERR "max taken from Barcodes value $self->value\n";
107
0
                return $self->value;
108        }
109
0
0
        $debug and print STDERR "Retrieving max database query.\n";
110
0
        return $self->db_max;
111}
112sub db_max () {
113
0
0
        my $self = shift;
114
0
        my $query = "SELECT max(abs(barcode)) FROM items LIMIT 1"; # Possible problem if multiple barcode types populated
115
0
        my $sth = C4::Context->dbh->prepare($query);
116
0
        $sth->execute();
117
0
0
        return $sth->fetchrow_array || $self->initial;
118}
119sub next_value ($;$) {
120
0
0
        my $self = shift;
121
0
0
        my $specific = (scalar @_) ? 1 : 0;
122
0
0
        my $max = $specific ? shift : $self->max; # optional argument, i.e. next_value after X
123
0
0
        unless ($max) {
124
0
                warn "No max barcode ($self->autoBarcode format) found. Using initial value.";
125
0
                return $self->initial;
126        }
127
0
0
        $debug and print STDERR "(current) max barcode found: $max\n";
128
0
        my ($head,$incr,$tail) = $self->parse($max); # for incremental, you'd get ('',the_whole_barcode,'')
129
0
0
        unless (defined $incr) {
130
0
                warn "No incrementing part of barcode ($max) returned by parse.";
131
0
                return undef;
132        }
133
0
        my $x = length($incr); # number of digits
134
0
0
        $incr =~ /^9+$/ and $x++; # if they're all 9's, we need an extra.
135                # Note, this enlargement might be undesireable for some barcode formats.
136                # Those should override next_value() to work accordingly.
137
0
        $incr++;
138
139
0
0
        $debug and warn "$incr";
140
0
        $head = $self->process_head($head,$max,$specific);
141
0
        $tail = $self->process_tail($tail,$max,$specific);
142
0
        my $next_value = $head . $incr . $tail;
143
0
0
        $debug and print STDERR "( next ) max barcode found: $next_value\n";
144
0
        return $next_value;
145}
146sub next ($;$) {
147
0
0
0
        my $self = shift or return undef;
148
0
0
        (@_) and $self->{next} = shift;
149
0
        return $self->{next};
150}
151sub previous ($;$) {
152
0
0
0
        my $self = shift or return undef;
153
0
0
        (@_) and $self->{previous} = shift;
154
0
        return $self->{previous};
155}
156sub serial ($;$) {
157
0
0
0
        my $self = shift or return undef;
158
0
0
        (@_) and $self->{serial} = shift;
159
0
        return $self->{serial};
160}
161sub default_self (;$) {
162
0
0
0
        (@_) or carp "default_self called with no argument. Reverting to _prefformat.";
163
0
0
        my $autoBarcode = (@_) ? shift : _prefformat;
164
0
        $autoBarcode =~ s/^.*:://; # in case we get C4::Barcodes::incremental, we just want 'incremental'
165        return {
166
0
                is_max => 0,
167                autoBarcode => $autoBarcode,
168                   value => undef,
169                previous => undef,
170                  'next' => undef,
171                serial => 1
172        };
173}
174
175our $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};
181
182sub new {
183
0
0
        my $class_or_object = shift;
184
0
0
        my $type = ref($class_or_object) || $class_or_object;
185
0
0
        my $from_obj = ref($class_or_object) ? 1 : 0; # are we building off another Barcodes object?
186
0
0
        if ($from_obj) {
187
0
0
                $debug and print STDERR "Building new(@_) from old Barcodes object\n";
188        }
189
0
0
0
        my $autoBarcodeType = (@_) ? shift : $from_obj ? $class_or_object->autoBarcode : _prefformat;
190
0
        $autoBarcodeType =~ s/^.*:://; # in case we get C4::Barcodes::incremental, we just want 'incremental'
191
0
0
        unless ($autoBarcodeType) {
192
0
                carp "No autoBarcode format found.";
193
0
                return undef;
194        }
195
0
0
        unless (defined $types->{$autoBarcodeType}) {
196
0
                carp "The autoBarcode format '$autoBarcodeType' is unrecognized.";
197
0
                return undef;
198        }
199
0
0
        carp "autoBarcode format = $autoBarcodeType" if $debug;
200
0
        my $self;
201
0
0
0
        if ($autoBarcodeType eq 'OFF') {
202
0
   $self = $class_or_object->default_self($autoBarcodeType);
203
0
                return bless $self, $class_or_object;
204        } elsif ($from_obj) {
205
0
0
                $class_or_object->autoBarcode eq $autoBarcodeType
206                        or carp "Cannot create Barcodes object (type '$autoBarcodeType') from " . $class_or_object->autoBarcode . " object!";
207
0
                $self = $class_or_object->new_object(@_);
208
0
                $self->serial($class_or_object->serial + 1);
209
0
0
                if ($class_or_object->is_max) {
210
0
0
                        $debug and print STDERR "old object was max: ", $class_or_object->value, "\n";
211
0
                        $self->previous($class_or_object);
212
0
                        $class_or_object->next($self);
213
0
                        $self->value($self->next_value($class_or_object->value));
214
0
0
                        $self->is_max(1) and $class_or_object->is_max(0); # new object is max, old object is no longer max
215                } else {
216
0
                        $self->value($self->next_value);
217                }
218        } else {
219
0
0
                $debug and print STDERR "trying to create new $autoBarcodeType\n";
220
0
0
                $self = &{$types->{$autoBarcodeType}} (@_);
221
0
0
                $self->value($self->next_value) and $self->is_max(1);
222
0
                $self->serial(1);
223        }
224
0
0
        if ($self) {
225
0
                return $self;
226        }
227
0
        carp "Failed new C4::Barcodes::$autoBarcodeType";
228
0
        return undef;
229}
230
231sub new_object {
232
0
0
        my $class_or_object = shift;
233
0
0
        my $type = ref($class_or_object) || $class_or_object;
234
0
0
        my $from_obj = ref($class_or_object) ? 1 : 0; # are we building off another Barcodes object?
235
0
0
        my $self = $class_or_object->default_self($from_obj ? $class_or_object->autoBarcode : 'incremental');
236
0
        bless $self, $type;
237
0
        return $self;
238}
2391;