Lines 17-24
package C4::Barcodes::hbyymmincr;
Link Here
|
17 |
# You should have received a copy of the GNU General Public License |
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>. |
18 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
19 |
|
19 |
|
20 |
use strict; |
20 |
use Modern::Perl; |
21 |
use warnings; |
|
|
22 |
|
21 |
|
23 |
use Carp; |
22 |
use Carp; |
24 |
|
23 |
|
Lines 27-36
use C4::Debug;
Link Here
|
27 |
|
26 |
|
28 |
use Koha::DateUtils qw( dt_from_string output_pref ); |
27 |
use Koha::DateUtils qw( dt_from_string output_pref ); |
29 |
|
28 |
|
|
|
29 |
use constant WIDTH => 4; # FIXME: too small for sizeable or multi-branch libraries? |
30 |
|
30 |
use vars qw(@ISA); |
31 |
use vars qw(@ISA); |
31 |
use vars qw($debug $cgi_debug); # from C4::Debug, of course |
32 |
use vars qw($debug $cgi_debug); # from C4::Debug, of course |
32 |
our $branch = ''; |
|
|
33 |
our $width = 4; # FIXME: 4 is too small for sizeable or multi-branch libraries. |
34 |
|
33 |
|
35 |
BEGIN { |
34 |
BEGIN { |
36 |
@ISA = qw(C4::Barcodes); |
35 |
@ISA = qw(C4::Barcodes); |
Lines 41-46
BEGIN {
Link Here
|
41 |
|
40 |
|
42 |
sub db_max { |
41 |
sub db_max { |
43 |
my $self = shift; |
42 |
my $self = shift; |
|
|
43 |
my $width = WIDTH; |
44 |
my $query = "SELECT SUBSTRING(barcode,-$width) AS chunk, barcode FROM items WHERE barcode REGEXP ? ORDER BY chunk DESC LIMIT 1"; |
44 |
my $query = "SELECT SUBSTRING(barcode,-$width) AS chunk, barcode FROM items WHERE barcode REGEXP ? ORDER BY chunk DESC LIMIT 1"; |
45 |
$debug and print STDERR "(hbyymmincr) db_max query: $query\n"; |
45 |
$debug and print STDERR "(hbyymmincr) db_max query: $query\n"; |
46 |
my $sth = C4::Context->dbh->prepare($query); |
46 |
my $sth = C4::Context->dbh->prepare($query); |
Lines 73-78
sub initial {
Link Here
|
73 |
# FIXME: populated branch? |
73 |
# FIXME: populated branch? |
74 |
my $iso = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 }); # like "2008-07-02" |
74 |
my $iso = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 }); # like "2008-07-02" |
75 |
warn "HBYYMM Barcode was not passed a branch, default is blank" if ( $self->branch eq '' ); |
75 |
warn "HBYYMM Barcode was not passed a branch, default is blank" if ( $self->branch eq '' ); |
|
|
76 |
my $width = WIDTH; |
76 |
return $self->branch . substr($iso,2,2) . substr($iso,5,2) . sprintf('%' . "$width.$width" . 'd',1); |
77 |
return $self->branch . substr($iso,2,2) . substr($iso,5,2) . sprintf('%' . "$width.$width" . 'd',1); |
77 |
} |
78 |
} |
78 |
|
79 |
|
Lines 93-103
sub branch {
Link Here
|
93 |
(@_) and $self->{branch} = shift; |
94 |
(@_) and $self->{branch} = shift; |
94 |
return $self->{branch}; |
95 |
return $self->{branch}; |
95 |
} |
96 |
} |
96 |
sub width { |
97 |
|
97 |
my $self = shift; |
98 |
# Commented out (BZ 16635) |
98 |
(@_) and $width = shift; # hitting the class variable. |
99 |
#sub width { |
99 |
return $width; |
100 |
# my $self = shift; |
100 |
} |
101 |
# (@_) and $width = shift; # hitting the class variable. |
|
|
102 |
# return $width; |
103 |
#} |
104 |
|
101 |
sub process_head { # (self,head,whole,specific) |
105 |
sub process_head { # (self,head,whole,specific) |
102 |
my ($self,$head,$whole,$specific) = @_; |
106 |
my ($self,$head,$whole,$specific) = @_; |
103 |
$specific and return $head; # if this is built off an existing barcode, just return the head unchanged. |
107 |
$specific and return $head; # if this is built off an existing barcode, just return the head unchanged. |
Lines 120-126
sub new_object {
Link Here
|
120 |
my $self = $class_or_object->default_self('hbyymmincr'); |
124 |
my $self = $class_or_object->default_self('hbyymmincr'); |
121 |
bless $self, $type; |
125 |
bless $self, $type; |
122 |
|
126 |
|
123 |
$self->branch( @_ ? shift : $from_obj ? $class_or_object->branch : $branch ); |
127 |
$self->branch( @_ ? shift : $from_obj ? $class_or_object->branch : '' ); |
124 |
warn "HBYYMM Barcode created with no branchcode, default is blank" if ( $self->branch() eq '' ); |
128 |
warn "HBYYMM Barcode created with no branchcode, default is blank" if ( $self->branch() eq '' ); |
125 |
|
129 |
|
126 |
# take the branch from argument, or existing object, or default |
130 |
# take the branch from argument, or existing object, or default |
127 |
- |
|
|