|
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 |
- |
|
|