Koha/C4/Barcodes/annual.pm
Joe Atzberger 46a43c0a93 Barcodes - OO replacements, extensible module, tests.
This code is intended to replace current value_builder code in 3.2, but
it does not affect it directly (yet) and is safe to include in 3.0.
This structure will be used to handle more complicated formats, like those
with checkdigits.  Please note that "incremental" format is still STRONGLY
recommended because it will always perform the best, and most flexibly.
The desire to include other information (like branchcode) should compel
the proper use of the barcode generator to print the info ON the barcode,
not IN the barcode.

One of the nicer features of this structure is that you are able to
create a new barcode (of the same type) based on any previous Barcodes object.
That means you can create an array of 51 consecutive barcodes like:
	my $x = C4::Barcodes->new('annual'); # for example
	my @set = ($x);
	for (1..50) {
		push @set, $x=$x->new;
	}
Importantly, this can happen without referencing the database after the
first constructor.

Signed-off-by: Joshua Ferraro <jmf@liblime.com>
2008-07-04 09:22:22 -05:00

99 lines
2.9 KiB
Perl
Executable file

#!/usr/bin/perl
package C4::Barcodes::annual;
# Copyright 2008 LibLime
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
use strict;
use warnings;
use Carp;
use C4::Context;
use C4::Debug;
use C4::Dates;
use vars qw($VERSION @ISA);
use vars qw($debug $cgi_debug); # from C4::Debug, of course
use vars qw($width);
BEGIN {
$VERSION = 0.01;
@ISA = qw(C4::Barcodes);
$width = 4;
}
sub db_max ($;$) {
my $self = shift;
my $query = "SELECT max(substring_index(barcode,'-',-1)) AS chunk,barcode FROM items WHERE barcode LIKE ? GROUP BY barcode";
# FIXME: unreasonably expensive query on large datasets
my $sth = C4::Context->dbh->prepare($query);
my ($iso);
if (@_) {
my $input = shift;
$iso = C4::Dates->new($input,'iso')->output('iso'); # try to set the date w/ 2nd arg
unless ($iso) {
warn "Failed to create 'iso' Dates object with input '$input'. Reverting to today's date.";
$iso = C4::Dates->new->output('iso'); # failover back to today
}
} else {
$iso = C4::Dates->new->output('iso');
}
my $year = substr($iso,0,4); # YYYY
$sth->execute("$year-%");
my $row = $sth->fetchrow_hashref;
warn "barcode db_max (annual format, year $year): $row->{barcode}" if $debug;
return $row->{barcode};
}
sub initial () {
my $self = shift;
return substr(C4::Dates->new->output('iso'),0,4) .'-'. sprintf('%'."$width.$width".'d', 1);
}
sub parse ($;$) {
my $self = shift;
my $barcode = (@_) ? shift : $self->value;
unless ($barcode =~ /(\d{4}-)(\d+)$/) { # non-greedy match in first part
carp "Barcode '$barcode' has no incrementing part!";
return ($barcode,undef,undef);
}
$debug and warn "Barcode '$barcode' parses into: '$1', '$2', ''";
return ($1,$2,''); # the third part is in anticipation of barcodes that include checkdigits
}
sub width ($;$) {
my $self = shift;
(@_) and $width = shift; # hitting the class variable.
return $width;
}
sub process_head($$;$$) { # (self,head,whole,specific)
my ($self,$head,$whole,$specific) = @_;
$specific and return $head; # if this is built off an existing barcode, just return the head unchanged.
return substr(C4::Dates->new->output('iso'),0,4) . '-'; # else get new YYYY-
}
sub new_object {
my $class = shift;
my $type = ref($class) || $class;
my $self = $type->default_self('annual');
return bless $self, $type;
}
1;
__END__