C4/Barcodes/hbyymmincr.pm

   1 package C4::Barcodes::hbyymmincr;
   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
   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.
  11 #
  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.
  16 #
  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>.
  19
  20 use Modern::Perl;
  21
  22 use Carp;
  23
  24 use C4::Context;
  25 use C4::Debug;
  26
  27 use Koha::DateUtils qw( dt_from_string output_pref );
  28
  29 use constant WIDTH => 4; # FIXME: too small for sizeable or multi-branch libraries?
  30
  31 use vars qw(@ISA);
  32 use vars qw($debug $cgi_debug); # from C4::Debug, of course
  33
  34 BEGIN {
  35     @ISA = qw(C4::Barcodes);
  36 }
  37
  38 # Generates barcode where hb = home branch Code, yymm = year/month catalogued, incr = incremental number,
  39 #       increment resets yearly -fbcit
  40
  41 sub db_max {
  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";
  45         $debug and print STDERR "(hbyymmincr) db_max query: $query\n";
  46         my $sth = C4::Context->dbh->prepare($query);
  47         my ($iso);
  48         if (@_) {
  49                 my $input = shift;
  50                 $iso = output_pref({ dt => dt_from_string( $input, 'iso' ), dateformat => 'iso', dateonly => 1 }); # try to set the date w/ 2nd arg
  51                 unless ($iso) {
  52                         warn "Failed to create 'iso' Dates object with input '$input'.  Reverting to today's date.";
  53                         $iso = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });      # failover back to today
  54                 }
  55         } else {
  56                 $iso = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
  57         }
  58         my $year = substr($iso,2,2);    # i.e. "08" for 2008
  59         my $andtwo = $width+2;
  60         $sth->execute("^[a-zA-Z]{1,}" . $year . "[0-9]{$andtwo}");      # the extra two digits are the month.  we don't care what they are, just that they are there.
  61         unless ($sth->rows) {
  62                 warn "No existing hbyymmincr barcodes found.  Reverting to initial value.";
  63                 return $self->initial;
  64         }
  65         my ($row) = $sth->fetchrow_hashref;
  66         my $max = $row->{barcode};
  67         warn "barcode max (hbyymmincr format): $max" if $debug;
  68         return ($max || 0);
  69 }
  70
  71 sub initial {
  72         my $self = shift;
  73         # FIXME: populated branch?
  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 '' );
  76     my $width = WIDTH;
  77         return $self->branch . substr($iso,2,2) . substr($iso,5,2) . sprintf('%' . "$width.$width" . 'd',1);
  78 }
  79
  80 sub parse {   # return 3 parts of barcode: non-incrementing, incrementing, non-incrementing
  81         my $self = shift;
  82         my $barcode = (@_) ? shift : $self->value;
  83         my $branch = $self->branch;
  84         unless ($barcode =~ /($branch\d{4})(\d+)$/) {
  85                 carp "Barcode '$barcode' has no incrementing part!";
  86                 return ($barcode,undef,undef);
  87         }
  88         $debug and warn "Barcode '$barcode' parses into: '$1', '$2', ''";
  89         return ($1,$2,'');  # the third part is in anticipation of barcodes that include checkdigits
  90 }
  91
  92 sub branch {
  93         my $self = shift;
  94         (@_) and $self->{branch} = shift;
  95         return $self->{branch};
  96 }
  97
  98 # Commented out (BZ 16635)
  99 #sub width {
 100 #    my $self = shift;
 101 #    (@_) and $width = shift;  # hitting the class variable.
 102 #    return $width;
 103 #}
 104
 105 sub process_head {      # (self,head,whole,specific)
 106         my ($self,$head,$whole,$specific) = @_;
 107         $specific and return $head;     # if this is built off an existing barcode, just return the head unchanged.
 108         $head =~ s/\d{4}$//;            # else strip the old yymm
 109     my $iso = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 }); # like "2008-07-02"
 110         return $head . substr($iso,2,2) . substr($iso,5,2);
 111 }
 112
 113 sub new_object {
 114     $debug and warn "hbyymmincr: new_object called";
 115     my $class_or_object = shift;
 116
 117     my $type = ref($class_or_object) || $class_or_object;
 118
 119     my $from_obj =
 120       ref($class_or_object)
 121       ? 1
 122       : 0;    # are we building off another Barcodes object?
 123
 124       my $self = $class_or_object->default_self('hbyymmincr');
 125     bless $self, $type;
 126
 127     $self->branch( @_ ? shift : $from_obj ? $class_or_object->branch : '' );
 128     warn "HBYYMM Barcode created with no branchcode, default is blank" if ( $self->branch() eq '' );
 129
 130     # take the branch from argument, or existing object, or default
 131     use Data::Dumper;
 132     $debug and print STDERR "(hbyymmincr) new_object: ", Dumper($self), "\n";
 133
 134     return $self;
 135 }
 136
 137 1;
 138 __END__
 139
 140 =head1 NOTICE
 141
 142 This format is deprecated and SHOULD NOT BE USED.
 143
 144 It is fairly clear the originator of the format did not intend to accommodate
 145 multiple branch libraries, given that the format caps the available namespace to
 146 10,000 barcodes per year TOTAL.
 147
 148 Also, the question of what to do with an item that changes branch is unsettled.
 149 Nothing prevents the barcode from working fine, but it will look out of place
 150 with the old branchcode in it.  Rebarcoding a single item is trivial, but if you
 151 consider the scenario of branches being consolidated, it is an unnecessary
 152 burden to force the rebarcoding of thousands of items, especially when the format
 153 will limit you to under 10,000 on the year!
 154
 155 The main purpose of the format seems to be to get the branch code into the barcode.
 156 This is wholly unnecessary, since the barcodes can be printed with the branchcode
 157 directly on it, without it being part of the barcode itself.
 158
 159 The API for this module should exist almost exclusively through C4::Barcodes.
 160 One novel aspect of this format is the fact that the barcode is tied to a branch.
 161
 162 =cut