Attachment #8091 for bug #7676

View | Details | Raw Unified | Return to bug 7676
Collapse All | Expand All

Lines 28-33 use C4::Dates; Link Here

(-)a/C4/Barcodes.pm (+2 lines)
28	use C4::Barcodes::hbyymmincr;	28	use C4::Barcodes::hbyymmincr;
29	use C4::Barcodes::annual;	29	use C4::Barcodes::annual;
30	use C4::Barcodes::incremental;	30	use C4::Barcodes::incremental;
		31	use C4::Barcodes::prefix;
31		32
32	use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);	33	use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
33	use vars qw($debug $cgi_debug); # from C4::Debug, of course	34	use vars qw($debug $cgi_debug); # from C4::Debug, of course
Lines 173-178 sub default_self (;$) { Link Here
173	}	174	}
174		175
175	our $types = {	176	our $types = {
		177	prefix_incr => sub {C4::Barcodes::prefix->new_object(@_); },
176	annual => sub {C4::Barcodes::annual->new_object(@_); },	178	annual => sub {C4::Barcodes::annual->new_object(@_); },
177	incremental => sub {C4::Barcodes::incremental->new_object(@_);},	179	incremental => sub {C4::Barcodes::incremental->new_object(@_);},
178	hbyymmincr => sub {C4::Barcodes::hbyymmincr->new_object(@_); },	180	hbyymmincr => sub {C4::Barcodes::hbyymmincr->new_object(@_); },




package C4::Barcodes::prefix;

# Copyright 2011 ByWater Solutions
#
# 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.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use strict;
use warnings;
use Carp;

use C4::Context;
use C4::Branch;
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($branch $width);

BEGIN {
    $VERSION = 0.01;
    @ISA = qw(C4::Barcodes);
    $width = C4::Context->preference('itembarcodelength');
    my $prefix = '';
}


# This package generates auto-incrementing barcodes where branch-specific prefixes are being used.
# For a library with 10-digit barcodes, and a prefix of T123, this should generate on a range of
# T123000000 and T123999999
#
# There are a couple of problems with treating barcodes as straight-numerics and just incrementing
# them.  The first, and most-obvious, is that barcodes need not be numeric, particularly in the prefix
# part!  The second, as noted in C4::Barcodes.pm, is that you might not actually be able to handle very
# large ints like that...


sub db_max ($;$) {
        my $self = shift;
        my $sth = C4::Context->dbh->prepare("SELECT MAX(barcode) AS biggest FROM items where barcode LIKE ? AND length(barcode) =?");
        my $prefix_search = $self->prefix . '%';
        $sth->execute($prefix_search, $self->width);
        return $self->initial unless ($sth->rows);
        my ($row) = $sth->fetchrow_hashref();

        my $max = $row->{biggest};
        return ($max || 0);
}

sub initial () {
        my $self = shift;
        my $increment_width = $self->width - length($self->prefix);
        return $self->prefix . sprintf("%"."$increment_width.$increment_width"."d",1);
}

sub parse ($;$) {   # return 3 parts of barcode: non-incrementing, incrementing, non-incrementing
        my $self = shift;
        my $barcode = (@_) ? shift : $self->value;
        my $prefix = $self->prefix;
        unless ($barcode =~ /($prefix)(.+)$/) {
           return($barcode,undef,undef);
        }
        return ($1,$2,'');  # the third part is in anticipation of barcodes that include checkdigits
}

sub prefix ($;$) {
        my $self = shift;
        (@_) and $self->{prefix} = shift;
        return C4::Branch::GetBranchDetail(C4::Context->userenv->{'branch'})->{'itembarcodeprefix'};
}

sub width ($;$) {
       my $self = shift;
       (@_) and $width = shift;        # hitting the class variable.
       return $width;
}

sub next_value ($;$) {
    my $self = shift;
    my $specific = (scalar @_) ? 1 : 0;
    my $max = $specific ? shift : $self->max;
    return $self->initial unless ($max);
    my ($head,$incr,$tail) = $self->parse($max);
    return undef unless (defined $incr);
    my $incremented = '';

    while ($incr =~ /([a-zA-Z]*[0-9]*)\z/ ){
       my $fragment = $1;
       $fragment++;   #yes, you can do that with strings.  Clever.
       if (length($fragment) > length($1)){   #uhoh.  got to carry something over.
          $incremented = substr($fragment,1) . $incremented;
          $incr = $`;    #prematch.  grab everything *before* $1 from above, and go back thru this.
       }
       else {   #we're okay now.
          $incr = $` . $fragment . $incremented;
          last;
       }
    }

    my $next_val = $head . $incr .$tail;
    return $next_val;
}

sub new_object {
        my $class_or_object = shift;
        my $type = ref($class_or_object) || $class_or_object;
        my $self = $type->default_self('prefix_incr');
        # take the prefix from argument, or the existing object, or get it from the userenv, in that order
        return bless $self, $type;
}

1;
__END__

Lines 177-182 sub barcodedecode { Link Here

(-)a/C4/Circulation.pm (+5 lines)
177	}	177	}
178	}	178	}
179	}	179	}
		180	if(C4::Context->preference('itembarcodelength') && (length($barcode) < C4::Context->preference('itembarcodelength'))) {
		181	my $prefix = GetBranchDetail(C4::Context->userenv->{'branch'})->{'itembarcodeprefix'} ;
		182	my $padding = C4::Context->preference('itembarcodelength') - length($prefix) - length($barcode) ;
		183	$barcode = $prefix . '0' x $padding . $barcode if($padding >= 0) ;
		184	}
180	return $barcode; # return barcode, modified or not	185	return $barcode; # return barcode, modified or not
181	}	186	}
182		187

Lines 508-514 sub GetServices { Link Here

(-)a/C4/ILSDI/Services.pm (-1 / +2 lines)
508		508
509	# Issuing management	509	# Issuing management
510	my $barcode = $item->{'barcode'} \|\| '';	510	my $barcode = $item->{'barcode'} \|\| '';
511	$barcode = barcodedecode($barcode) if ( $barcode && C4::Context->preference('itemBarcodeInputFilter') );	511	$barcode = barcodedecode($barcode) if ( $barcode && C4::Context->preference('itemBarcodeInputFilter')
		512	\|\| C4::Context->preference('itembarcodelength') );
512	if ($barcode) {	513	if ($barcode) {
513	my ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, $barcode );	514	my ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, $barcode );
514		515




    $sth->execute( $item->{'biblionumber'} );
    ($item->{'biblioitemnumber'}) = $sth->fetchrow;

    _check_itembarcode($item) if (C4::Context->preference('itembarcodelength'));
    _set_defaults_for_add($item);
    _set_derived_columns_for_add($item);
    $item->{'more_subfields_xml'} = _get_unlinked_subfields_xml($unlinked_item_subfields);

            next ITEMFIELD;
        }

        _check_itembarcode($item) if (C4::Context->preference('itembarcodelength'));
        _set_defaults_for_add($item);
        _set_derived_columns_for_add($item);
        my ( $itemnumber, $error ) = _koha_new_item( $item, $item->{barcode} );

    $holds = $sth->fetchrow;
    return $holds;
}

=head1  OTHER FUNCTIONS

=head2 _find_value

    };
}

=head2 _check_itembarcode

=over 4

&_check_itembarcode

=back

Modifies item barcode value to include prefix defined in branches.itembarcodeprefix
if the length is less than the syspref itembarcodelength .

=cut
sub _check_itembarcode($) {
    my $item = shift;
    return(0) unless $item->{'barcode'}; # only modify if we've been passed a barcode.
    # check item barcode prefix
    # note this doesn't enforce barcodelength.
    my $branch_prefix = GetBranchDetail($item->{'homebranch'})->{'itembarcodeprefix'};
    if(length($item->{'barcode'}) < C4::Context->preference('itembarcodelength')) {
        my $padding = C4::Context->preference('itembarcodelength') - length($branch_prefix) - length($item->{'barcode'}) ;
        $item->{'barcode'} = $branch_prefix .  '0' x $padding . $item->{'barcode'} if($padding >= 0) ;
    } else {
      #  $errors{'invalid_barcode'} = $item->{'barcode'};
    }
}

1;




use C4::Biblio;
use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
use C4::Members::Attributes qw(SearchIdMatchingAttribute);
use C4::Branch qw(GetBranchDetail);

our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);


    # so we can check an exact match first, if that works return, otherwise do the rest
    my $dbh   = C4::Context->dbh;
    my $query = "SELECT borrowernumber FROM borrowers WHERE cardnumber = ?";
    my $cardnum = _prefix_cardnum($filter);
    if ( my $borrowernumber = $dbh->selectrow_array($query, undef, $cardnum) ) {
        return( {"borrowernumber"=>$borrowernumber} );
    }

    my ($search_on_fields, $searchtype);
    if ( length($filter) == 1 ) {
        $search_on_fields = [ qw(surname) ];

            $data{password} = md5_base64($data{password});
        }
    }

    # modify cardnumber with prefix, if needed.
    if(C4::Context->preference('patronbarcodelength') && exists($data{'cardnumber'})){
        $data{'cardnumber'} = _prefix_cardnum($data{'cardnumber'});
    }

	my $execute_success=UpdateInTable("borrowers",\%data);
    if ($execute_success) { # only proceed if the update was a success
        # ok if its an adult (type) it may have borrowers that depend on it as a guarantor

	$data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
	# create a disabled account if no password provided
	$data{'password'} = ($data{'password'})? md5_base64($data{'password'}) : '!';
        $data{'cardnumber'} = _prefix_cardnum($data{'cardnumber'}) if(C4::Context->preference('patronbarcodelength'));

	$data{'borrowernumber'}=InsertInTable("borrowers",\%data);	
    # mysql_insertid is probably bad.  not necessarily accurate and mysql-specific at best.
    logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");

use vars qw( @weightings );
my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );

sub fixup_cardnumber {
    my ($cardnumber,$branch) = @_;
    my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;

    # Find out whether member numbers should be generated


        return "V$cardnumber$rem";
     } else {
        my $cardlength = C4::Context->preference('patronbarcodelength');
        if (defined($cardnumber) && (length($cardnumber) == $cardlength) && $cardnumber =~ m/^$branch->{'patronbarcodeprefix'}/ ) {
           return $cardnumber;
        }

     # increment operator without cast(int) should be safe, and should properly increment
     # whether the string is numeric or not.
     # FIXME : This needs to be pulled out into an ajax function, since the interface allows on-the-fly changing of patron home library.
     #
         my $query =  "select max(borrowers.cardnumber) from borrowers ";
         my @bind;
         my $firstnumber = 0;
         if($branch->{'patronbarcodeprefix'} && $cardlength) {
             my $cardnum_search = $branch->{'patronbarcodeprefix'} . '%';
             $query .= " WHERE cardnumber LIKE ?";
             $query .= " AND length(cardnumber) = ?";
             @bind = ($cardnum_search,$cardlength ) ;
         }
         my $sth= $dbh->prepare($query);
         $sth->execute(@bind);
         my ($result) = $sth->fetchrow;
         $sth->finish;
         if($result) {
             my $cnt = 0;
             $result =~ s/^$branch->{'patronbarcodeprefix'}//;
             while ( $result =~ /([a-zA-Z]*[0-9]*)\z/ ) {   # use perl's magical stringcrement behavior (++).
                 my $incrementable = $1;
                 $incrementable++;
                 if ( length($incrementable) > length($1) ) { # carry a digit to next incrementable fragment
                     $cardnumber = substr($incrementable,1) . $cardnumber;
                     $result = $`;
                 } else {
                     $cardnumber = $branch->{'patronbarcodeprefix'} . $` . $incrementable . $cardnumber ;
                     last;
                 }
                 last if(++$cnt>10);
             }
         } else {
             $cardnumber =  ++$firstnumber ;
         }
     }
    return $cardnumber;     # just here as a fallback/reminder 
}


    logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
}

=head2 _prefix_cardnum

=over 4

$cardnum = _prefix_cardnum($cardnum,$branchcode);

If a system-wide barcode length is defined, and a prefix defined for the passed branch or the user's branch,
modify the barcode by prefixing and padding.

=back
=cut

sub _prefix_cardnum{
    my ($cardnum,$branchcode) = @_;

    if(C4::Context->preference('patronbarcodelength') && (length($cardnum) < C4::Context->preference('patronbarcodelength'))) {
        #if we have a system-wide cardnum length and a branch prefix, prepend the prefix.
        if( ! $branchcode && defined(C4::Context->userenv) ) {
            $branchcode = C4::Context->userenv->{'branch'};
        }
        return $cardnum unless $branchcode;
        my $branch = GetBranchDetail( $branchcode );
        return $cardnum unless( defined($branch) && defined($branch->{'patronbarcodeprefix'}) );
        my $prefix = $branch->{'patronbarcodeprefix'} ;
        my $padding = C4::Context->preference('patronbarcodelength') - length($prefix) - length($cardnum) ;
        $cardnum = $prefix . '0' x $padding . $cardnum if($padding >= 0) ;
   }
    return $cardnum;
}

END { }    # module clean-up code here (global destructor)

1;




    }
);
$template->param(
     script_name         => $script_name,
     action              => $script_name,
     itembarcodelength   => C4::Context->preference('itembarcodelength'),
     patronbarcodelength => C4::Context->preference('patronbarcodelength'),
);
$template->param( ($op || 'else') => 1 );


sub _branch_to_template {
    my ($data, $template) = @_;
    $template->param( 
         branchcode           => $data->{'branchcode'},
         branch_name          => $data->{'branchname'},
         branchaddress1       => $data->{'branchaddress1'},
         branchaddress2       => $data->{'branchaddress2'},
         branchaddress3       => $data->{'branchaddress3'},
         branchzip            => $data->{'branchzip'},
         branchcity           => $data->{'branchcity'},
         branchstate          => $data->{'branchstate'},
         branchcountry        => $data->{'branchcountry'},
         branchphone          => $data->{'branchphone'},
         branchfax            => $data->{'branchfax'},
         branchemail          => $data->{'branchemail'},
         branchurl            => $data->{'branchurl'},
         branchip             => $data->{'branchip'},
         branchnotes          => $data->{'branchnotes'}, 
         itembarcodeprefix    => $data->{'itembarcodeprefix'},
         patronbarcodeprefix  => $data->{'patronbarcodeprefix'},
    );
}


Lines 124-129 $tabsysprefs{soundon} = "Admin"; Link Here

(-)a/admin/systempreferences.pl (+2 lines)
124	$tabsysprefs{SpineLabelShowPrintOnBibDetails} = "Admin";	124	$tabsysprefs{SpineLabelShowPrintOnBibDetails} = "Admin";
125	$tabsysprefs{WebBasedSelfCheckHeader} = "Admin";	125	$tabsysprefs{WebBasedSelfCheckHeader} = "Admin";
126	$tabsysprefs{WebBasedSelfCheckTimeout} = "Admin";	126	$tabsysprefs{WebBasedSelfCheckTimeout} = "Admin";
		127	$tabsysprefs{itembarcodelength} = "Admin";
		128	$tabsysprefs{patronbarcodelength} = "Admin";
127		129
128	# Authorities	130	# Authorities
129	$tabsysprefs{authoritysep} = "Authorities";	131	$tabsysprefs{authoritysep} = "Authorities";

Lines 348-353 if ($op eq "additem") { Link Here

(-)a/cataloguing/additem.pl (+8 lines)
348	push @errors,"barcode_not_unique" if($exist_itemnumber);	348	push @errors,"barcode_not_unique" if($exist_itemnumber);
349	# if barcode exists, don't create, but report The problem.	349	# if barcode exists, don't create, but report The problem.
350	unless ($exist_itemnumber) {	350	unless ($exist_itemnumber) {
		351	unless ($addedolditem->{'barcode'}) {
		352	use C4::Barcodes;
		353	my $barcodeobj = C4::Barcodes->new();
		354	my $db_max = $barcodeobj->db_max();
		355	my $nextbarcode = $barcodeobj->next_value($db_max);
		356	my ($tagfield,$tagsubfield) = &GetMarcFromKohaField("items.barcode",$frameworkcode);
		357	$record->field($tagfield)->update($tagsubfield => "$nextbarcode") if ($nextbarcode);
		358	}
351	my ($oldbiblionumber,$oldbibnum,$oldbibitemnum) = AddItemFromMarc($record,$biblionumber);	359	my ($oldbiblionumber,$oldbibnum,$oldbibitemnum) = AddItemFromMarc($record,$biblionumber);
352	set_item_default_location($oldbibitemnum);	360	set_item_default_location($oldbibitemnum);
353	}	361	}

Lines 119-125 if (C4::Context->preference("UseTablesortForCirc")) { Link Here

(-)a/circ/circulation.pl (-1 / +2 lines)
119	my $barcode = $query->param('barcode') \|\| '';	119	my $barcode = $query->param('barcode') \|\| '';
120	$barcode =~ s/^\s\|\s$//g; # remove leading/trailing whitespace	120	$barcode =~ s/^\s\|\s$//g; # remove leading/trailing whitespace
121		121
122	$barcode = barcodedecode($barcode) if( $barcode && C4::Context->preference('itemBarcodeInputFilter'));	122	$barcode = barcodedecode($barcode) if( $barcode && (C4::Context->preference('itemBarcodeInputFilter')
		123	\|\| C4::Context->preference('itembarcodelength')));
123	my $stickyduedate = $query->param('stickyduedate') \|\| $session->param('stickyduedate');	124	my $stickyduedate = $query->param('stickyduedate') \|\| $session->param('stickyduedate');
124	my $duedatespec = $query->param('duedatespec') \|\| $session->param('stickyduedate');	125	my $duedatespec = $query->param('duedatespec') \|\| $session->param('stickyduedate');
125	my $issueconfirmed = $query->param('issueconfirmed');	126	my $issueconfirmed = $query->param('issueconfirmed');





    # decode barcode    ## Didn't we already decode them before passing them back last time??
    $barcode =~ s/^\s*|\s*$//g; # remove leading/trailing whitespace
    $barcode = barcodedecode($barcode) if(C4::Context->preference('itemBarcodeInputFilter') 
                                          || C4::Context->preference('itembarcodelength'));

    ######################
    #Are these lines still useful ?

# actually return book and prepare item table.....
if ($barcode) {
    $barcode =~ s/^\s*|\s*$//g; # remove leading/trailing whitespace
    $barcode = barcodedecode($barcode) if (C4::Context->preference('itemBarcodeInputFilter')
                                           || C4::Context->preference('itembarcodelength'));
    $itemnumber = GetItemnumberFromBarcode($barcode);

    if ( C4::Context->preference("InProcessingToShelvingCart") ) {

Lines 361-366 CREATE TABLE `branches` ( -- information about your libraries or branches are st Link Here

(-)a/installer/data/mysql/kohastructure.sql (+2 lines)
361	`branchip` varchar(15) default NULL, -- the IP address for your library or branch	361	`branchip` varchar(15) default NULL, -- the IP address for your library or branch
362	`branchprinter` varchar(100) default NULL, -- unused in Koha	362	`branchprinter` varchar(100) default NULL, -- unused in Koha
363	`branchnotes` mediumtext, -- notes related to your library or branch	363	`branchnotes` mediumtext, -- notes related to your library or branch
		364	`itembarcodeprefix` varchar(10) default NULL, -- branch's item barcode prefix
		365	`patronbarcodeprefix` varchar(10) default NULL, -- branch's patron barcode prefix
364	UNIQUE KEY `branchcode` (`branchcode`)	366	UNIQUE KEY `branchcode` (`branchcode`)
365	) ENGINE=InnoDB DEFAULT CHARSET=utf8;	367	) ENGINE=InnoDB DEFAULT CHARSET=utf8;
366		368

Lines 123-128 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/branches.tt (+6 lines)
123	<li><label for="branchemail">Email</label><input type="text" name="branchemail" id="branchemail" value="[% branchemail \|html %]" /></li>	123	<li><label for="branchemail">Email</label><input type="text" name="branchemail" id="branchemail" value="[% branchemail \|html %]" /></li>
124	<li><label for="branchurl">url</label><input type="text" name="branchurl" id="branchurl" value="[% branchurl \|html %]" /></li>	124	<li><label for="branchurl">url</label><input type="text" name="branchurl" id="branchurl" value="[% branchurl \|html %]" /></li>
125	<li><label for="branchip">IP</label><input type="text" name="branchip" id="branchip" value="[% branchip \|html %]" /> <span class="hint">Can be entered as a single IP, or a subnet such as 192.168.1.*</span></li>	125	<li><label for="branchip">IP</label><input type="text" name="branchip" id="branchip" value="[% branchip \|html %]" /> <span class="hint">Can be entered as a single IP, or a subnet such as 192.168.1.*</span></li>
		126	[% IF ( itembarcodelength ) %]
		127	<li><label for="itembarcodeprefix">Item Barcode Prefix</label><input type="text" name="itembarcodeprefix" id="itembarcodeprefix" value="[% itembarcodeprefix \|html %]" /></li>
		128	[% END %]
		129	[% IF ( patronbarcodelength ) %]
		130	<li><label for="patronbarcodeprefix">Patron Barcode Prefix</label><input type="text" name="patronbarcodeprefix" id="patronbarcodeprefix" value="[% patronbarcodeprefix \|html %]" /></li>
		131	[% END %]
126	<!--	132	<!--
127	<li><label for="branchprinter">Library Printer</label>	133	<li><label for="branchprinter">Library Printer</label>
128	<select id="branchprinter" name="branchprinter">	134	<select id="branchprinter" name="branchprinter">




                  yes: Allow
                  no: "Don't allow"
            - staff and patrons to create and view saved lists of books.
        -   
            - Use branch prefixes to ensure that item barcodes are
            - pref: itembarcodelength
              class: integer
            - digits long 
        -   
            - Use branch prefixes to ensure that patron barcodes are
            - pref: patronbarcodelength
              class: integer
            - digits long 
    Login options:
        -
            - pref: insecure

Lines 86-91 Cataloging: Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref (+1 lines)
86	- Barcodes are	86	- Barcodes are
87	- pref: autoBarcode	87	- pref: autoBarcode
88	choices:	88	choices:
		89	prefix_incr: generated with the branch prefix, followed by a zero-padded form of 1, 2, 3.
89	incremental: generated in the form 1, 2, 3.	90	incremental: generated in the form 1, 2, 3.
90	annual: generated in the form <year>-0001, <year>-0002.	91	annual: generated in the form <year>-0001, <year>-0002.
91	hbyymmincr: generated in the form <branchcode>yymm0001.	92	hbyymmincr: generated in the form <branchcode>yymm0001.




    $template->param( step_1 => 1, step_2 => 1, step_3 => 1, step_4 => 1, step_5 => 1, step_6 => 1 ) unless $step;
}

my $onlymine=(C4::Context->preference('IndependantBranches') && 
              C4::Context->userenv && 
              C4::Context->userenv->{flags} % 2 !=1  && 
              C4::Context->userenv->{branch}?1:0);
              
my $branches=GetBranches($onlymine);
$data{'cardnumber'}=fixup_cardnumber( $data{'cardnumber'}, $branches->{C4::Context->userenv->{'branch'}} ) if $op eq 'add';

if(!defined($data{'sex'})){
    $template->param( none => 1);
} elsif($data{'sex'} eq 'F'){

my @select_branch;
my %select_branches;

my $onlymine=(C4::Context->preference('IndependantBranches') && 
              C4::Context->userenv && 
              C4::Context->userenv->{flags} % 2 !=1  && 
              C4::Context->userenv->{branch}?1:0);
              
my $branches=GetBranches($onlymine);
my $default;
my $CGIbranch;
for my $branch (sort { $branches->{$a}->{branchname} cmp $branches->{$b}->{branchname} } keys %$branches) {

Lines 240-246 sub arguments_for_command { Link Here

(-)a/offline_circ/process_koc.pl (-2 / +2 lines)
240	sub kocIssueItem {	240	sub kocIssueItem {
241	my $circ = shift;	241	my $circ = shift;
242		242
243	$circ->{ 'barcode' } = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));	243	$circ->{ 'barcode' } = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && (C4::Context->preference('itemBarcodeInputFilter') \|\| C4::Context->preference('itembarcodelength')));
244	my $branchcode = C4::Context->userenv->{branch};	244	my $branchcode = C4::Context->userenv->{branch};
245	my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );	245	my $borrower = GetMember( 'cardnumber'=>$circ->{ 'cardnumber' } );
246	my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );	246	my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
Lines 318-324 sub kocIssueItem { Link Here
318		318
319	sub kocReturnItem {	319	sub kocReturnItem {
320	my ( $circ ) = @_;	320	my ( $circ ) = @_;
321	$circ->{'barcode'} = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && C4::Context->preference('itemBarcodeInputFilter'));	321	$circ->{'barcode'} = barcodedecode($circ->{'barcode'}) if( $circ->{'barcode'} && (C4::Context->preference('itemBarcodeInputFilter') \|\| C4::Context->preference('itembarcodelength')));
322	my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );	322	my $item = GetBiblioFromItemNumber( undef, $circ->{ 'barcode' } );
323	#warn( Data::Dumper->Dump( [ $circ, $item ], [ qw( circ item ) ] ) );	323	#warn( Data::Dumper->Dump( [ $circ, $item ], [ qw( circ item ) ] ) );
324	my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );	324	my $borrowernumber = _get_borrowernumber_from_barcode( $circ->{'barcode'} );

Lines 41-47 use C4::Auth; Link Here

(-)a/tools/import_borrowers.pl (-2 / +8 lines)
41	use C4::Output;	41	use C4::Output;
42	use C4::Dates qw(format_date_in_iso);	42	use C4::Dates qw(format_date_in_iso);
43	use C4::Context;	43	use C4::Context;
44	use C4::Branch qw(GetBranchName);	44	use C4::Branch qw(GetBranchName GetBranches);
45	use C4::Members;	45	use C4::Members;
46	use C4::Members::Attributes qw(:all);	46	use C4::Members::Attributes qw(:all);
47	use C4::Members::AttributeTypes;	47	use C4::Members::AttributeTypes;
Lines 271-277 if ( $uploadborrowers && length($uploadborrowers) > 0 ) { Link Here
271	# FIXME: fixup_cardnumber says to lock table, but the web interface doesn't so this doesn't either.	271	# FIXME: fixup_cardnumber says to lock table, but the web interface doesn't so this doesn't either.
272	# At least this is closer to AddMember than in members/memberentry.pl	272	# At least this is closer to AddMember than in members/memberentry.pl
273	if (!$borrower{'cardnumber'}) {	273	if (!$borrower{'cardnumber'}) {
274	$borrower{'cardnumber'} = fixup_cardnumber(undef);	274	my $onlymine=(C4::Context->preference('IndependantBranches') &&
		275	C4::Context->userenv &&
		276	C4::Context->userenv->{flags} % 2 !=1 &&
		277	C4::Context->userenv->{branch}?1:0);
		278
		279	my $branches=GetBranches($onlymine);
		280	$borrower{'cardnumber'} = fixup_cardnumber(undef,$branches->{$borrower{'branchcode'}});
275	}	281	}
276	if ($borrowernumber = AddMember(%borrower)) {	282	if ($borrowernumber = AddMember(%borrower)) {
277	if ($extended) {	283	if ($extended) {

Lines 150-155 if ($uploadbarcodes && length($uploadbarcodes)>0){ Link Here

(-)a/tools/inventory.pl (-1 / +6 lines)
150	my $count=0;	150	my $count=0;
151	while (my $barcode=<$uploadbarcodes>){	151	while (my $barcode=<$uploadbarcodes>){
152	$barcode =~ s/\r?\n$//;	152	$barcode =~ s/\r?\n$//;
		153	if(C4::Context->preference('itembarcodelength') && (length($barcode) < C4::Context->preference('itembarcodelength'))) {
		154	my $prefix = GetBranchDetail(C4::Context->userenv->{'branch'})->{'itembarcodeprefix'} ;
		155	my $padding = C4::Context->preference('itembarcodelength') - length($prefix) - length($barcode) ;
		156	$barcode = $prefix . '0' x $padding . $barcode if($padding >= 0) ;
		157	}
		158
153	if ($qwthdrawn->execute($barcode) &&$qwthdrawn->rows){	159	if ($qwthdrawn->execute($barcode) &&$qwthdrawn->rows){
154	push @errorloop, {'barcode'=>$barcode,'ERR_WTHDRAWN'=>1};	160	push @errorloop, {'barcode'=>$barcode,'ERR_WTHDRAWN'=>1};
155	}else{	161	}else{
156	-

Return to bug 7676

Lines 255-260 sub AddItem { Link Here

(-)a/C4/Items.pm (+29 lines)
255	$sth->execute( $item->{'biblionumber'} );	255	$sth->execute( $item->{'biblionumber'} );
256	($item->{'biblioitemnumber'}) = $sth->fetchrow;	256	($item->{'biblioitemnumber'}) = $sth->fetchrow;
257		257
		258	_check_itembarcode($item) if (C4::Context->preference('itembarcodelength'));
258	_set_defaults_for_add($item);	259	_set_defaults_for_add($item);
259	_set_derived_columns_for_add($item);	260	_set_derived_columns_for_add($item);
260	$item->{'more_subfields_xml'} = _get_unlinked_subfields_xml($unlinked_item_subfields);	261	$item->{'more_subfields_xml'} = _get_unlinked_subfields_xml($unlinked_item_subfields);
Lines 355-360 sub AddItemBatchFromMarc { Link Here
355	next ITEMFIELD;	356	next ITEMFIELD;
356	}	357	}
357		358
		359	_check_itembarcode($item) if (C4::Context->preference('itembarcodelength'));
358	_set_defaults_for_add($item);	360	_set_defaults_for_add($item);
359	_set_derived_columns_for_add($item);	361	_set_derived_columns_for_add($item);
360	my ( $itemnumber, $error ) = _koha_new_item( $item, $item->{barcode} );	362	my ( $itemnumber, $error ) = _koha_new_item( $item, $item->{barcode} );
Lines 2489-2494 sub GetItemHolds { Link Here
2489	$holds = $sth->fetchrow;	2491	$holds = $sth->fetchrow;
2490	return $holds;	2492	return $holds;
2491	}	2493	}
		2494
2492	=head1 OTHER FUNCTIONS	2495	=head1 OTHER FUNCTIONS
2493		2496
2494	=head2 _find_value	2497	=head2 _find_value
Lines 2755-2758 sub PrepareItemrecordDisplay { Link Here
2755	};	2758	};
2756	}	2759	}
2757		2760
		2761	=head2 _check_itembarcode
		2762
		2763	=over 4
		2764
		2765	&_check_itembarcode
		2766
		2767	=back
		2768
		2769	Modifies item barcode value to include prefix defined in branches.itembarcodeprefix
		2770	if the length is less than the syspref itembarcodelength .
		2771
		2772	=cut
		2773	sub _check_itembarcode($) {
		2774	my $item = shift;
		2775	return(0) unless $item->{'barcode'}; # only modify if we've been passed a barcode.
		2776	# check item barcode prefix
		2777	# note this doesn't enforce barcodelength.
		2778	my $branch_prefix = GetBranchDetail($item->{'homebranch'})->{'itembarcodeprefix'};
		2779	if(length($item->{'barcode'}) < C4::Context->preference('itembarcodelength')) {
		2780	my $padding = C4::Context->preference('itembarcodelength') - length($branch_prefix) - length($item->{'barcode'}) ;
		2781	$item->{'barcode'} = $branch_prefix . '0' x $padding . $item->{'barcode'} if($padding >= 0) ;
		2782	} else {
		2783	# $errors{'invalid_barcode'} = $item->{'barcode'};
		2784	}
		2785	}
		2786
2758	1;	2787	1;

Lines 33-38 use C4::Accounts; Link Here

(-)a/C4/Members.pm (-14 / +83 lines)
33	use C4::Biblio;	33	use C4::Biblio;
34	use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);	34	use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
35	use C4::Members::Attributes qw(SearchIdMatchingAttribute);	35	use C4::Members::Attributes qw(SearchIdMatchingAttribute);
		36	use C4::Branch qw(GetBranchDetail);
36		37
37	our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);	38	our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
38		39
Lines 168-177 sub _express_member_find { Link Here
168	# so we can check an exact match first, if that works return, otherwise do the rest	169	# so we can check an exact match first, if that works return, otherwise do the rest
169	my $dbh = C4::Context->dbh;	170	my $dbh = C4::Context->dbh;
170	my $query = "SELECT borrowernumber FROM borrowers WHERE cardnumber = ?";	171	my $query = "SELECT borrowernumber FROM borrowers WHERE cardnumber = ?";
171	if ( my $borrowernumber = $dbh->selectrow_array($query, undef, $filter) ) {	172	my $cardnum = _prefix_cardnum($filter);
		173	if ( my $borrowernumber = $dbh->selectrow_array($query, undef, $cardnum) ) {
172	return( {"borrowernumber"=>$borrowernumber} );	174	return( {"borrowernumber"=>$borrowernumber} );
173	}	175	}
174
175	my ($search_on_fields, $searchtype);	176	my ($search_on_fields, $searchtype);
176	if ( length($filter) == 1 ) {	177	if ( length($filter) == 1 ) {
177	$search_on_fields = [ qw(surname) ];	178	$search_on_fields = [ qw(surname) ];
Lines 710-715 sub ModMember { Link Here
710	$data{password} = md5_base64($data{password});	711	$data{password} = md5_base64($data{password});
711	}	712	}
712	}	713	}
		714
		715	# modify cardnumber with prefix, if needed.
		716	if(C4::Context->preference('patronbarcodelength') && exists($data{'cardnumber'})){
		717	$data{'cardnumber'} = _prefix_cardnum($data{'cardnumber'});
		718	}
		719
713	my $execute_success=UpdateInTable("borrowers",\%data);	720	my $execute_success=UpdateInTable("borrowers",\%data);
714	if ($execute_success) { # only proceed if the update was a success	721	if ($execute_success) { # only proceed if the update was a success
715	# ok if its an adult (type) it may have borrowers that depend on it as a guarantor	722	# ok if its an adult (type) it may have borrowers that depend on it as a guarantor
Lines 745-750 sub AddMember { Link Here
745	$data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';	752	$data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
746	# create a disabled account if no password provided	753	# create a disabled account if no password provided
747	$data{'password'} = ($data{'password'})? md5_base64($data{'password'}) : '!';	754	$data{'password'} = ($data{'password'})? md5_base64($data{'password'}) : '!';
		755	$data{'cardnumber'} = _prefix_cardnum($data{'cardnumber'}) if(C4::Context->preference('patronbarcodelength'));
		756
748	$data{'borrowernumber'}=InsertInTable("borrowers",\%data);	757	$data{'borrowernumber'}=InsertInTable("borrowers",\%data);
749	# mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.	758	# mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
750	logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");	759	logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
Lines 838-845 mode, to avoid database corruption. Link Here
838	use vars qw( @weightings );	847	use vars qw( @weightings );
839	my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );	848	my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
840		849
841	sub fixup_cardnumber ($) {	850	sub fixup_cardnumber {
842	my ($cardnumber) = @_;	851	my ($cardnumber,$branch) = @_;
843	my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') \|\| 0;	852	my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') \|\| 0;
844		853
845	# Find out whether member numbers should be generated	854	# Find out whether member numbers should be generated
Lines 887-903 sub fixup_cardnumber ($) { Link Here
887		896
888	return "V$cardnumber$rem";	897	return "V$cardnumber$rem";
889	} else {	898	} else {
		899	my $cardlength = C4::Context->preference('patronbarcodelength');
		900	if (defined($cardnumber) && (length($cardnumber) == $cardlength) && $cardnumber =~ m/^$branch->{'patronbarcodeprefix'}/ ) {
		901	return $cardnumber;
		902	}
890		903
891	# MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably	904	# increment operator without cast(int) should be safe, and should properly increment
892	# better. I'll leave the original in in case it needs to be changed for you	905	# whether the string is numeric or not.
893	# my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");	906	# FIXME : This needs to be pulled out into an ajax function, since the interface allows on-the-fly changing of patron home library.
894	my $sth = $dbh->prepare(	907	#
895	"select max(cast(cardnumber as signed)) from borrowers"	908	my $query = "select max(borrowers.cardnumber) from borrowers ";
896	);	909	my @bind;
897	$sth->execute;	910	my $firstnumber = 0;
898	my ($result) = $sth->fetchrow;	911	if($branch->{'patronbarcodeprefix'} && $cardlength) {
899	return $result + 1;	912	my $cardnum_search = $branch->{'patronbarcodeprefix'} . '%';
900	}	913	$query .= " WHERE cardnumber LIKE ?";
		914	$query .= " AND length(cardnumber) = ?";
		915	@bind = ($cardnum_search,$cardlength ) ;
		916	}
		917	my $sth= $dbh->prepare($query);
		918	$sth->execute(@bind);
		919	my ($result) = $sth->fetchrow;
		920	$sth->finish;
		921	if($result) {
		922	my $cnt = 0;
		923	$result =~ s/^$branch->{'patronbarcodeprefix'}//;
		924	while ( $result =~ /([a-zA-Z][0-9])\z/ ) { # use perl's magical stringcrement behavior (++).
		925	my $incrementable = $1;
		926	$incrementable++;
		927	if ( length($incrementable) > length($1) ) { # carry a digit to next incrementable fragment
		928	$cardnumber = substr($incrementable,1) . $cardnumber;
		929	$result = $`;
		930	} else {
		931	$cardnumber = $branch->{'patronbarcodeprefix'} . $` . $incrementable . $cardnumber ;
		932	last;
		933	}
		934	last if(++$cnt>10);
		935	}
		936	} else {
		937	$cardnumber = ++$firstnumber ;
		938	}
		939	}
901	return $cardnumber; # just here as a fallback/reminder	940	return $cardnumber; # just here as a fallback/reminder
902	}	941	}
903		942
Lines 2229-2234 sub DeleteMessage { Link Here
2229	logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");	2268	logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2230	}	2269	}
2231		2270
		2271	=head2 _prefix_cardnum
		2272
		2273	=over 4
		2274
		2275	$cardnum = _prefix_cardnum($cardnum,$branchcode);
		2276
		2277	If a system-wide barcode length is defined, and a prefix defined for the passed branch or the user's branch,
		2278	modify the barcode by prefixing and padding.
		2279
		2280	=back
		2281	=cut
		2282
		2283	sub _prefix_cardnum{
		2284	my ($cardnum,$branchcode) = @_;
		2285
		2286	if(C4::Context->preference('patronbarcodelength') && (length($cardnum) < C4::Context->preference('patronbarcodelength'))) {
		2287	#if we have a system-wide cardnum length and a branch prefix, prepend the prefix.
		2288	if( ! $branchcode && defined(C4::Context->userenv) ) {
		2289	$branchcode = C4::Context->userenv->{'branch'};
		2290	}
		2291	return $cardnum unless $branchcode;
		2292	my $branch = GetBranchDetail( $branchcode );
		2293	return $cardnum unless( defined($branch) && defined($branch->{'patronbarcodeprefix'}) );
		2294	my $prefix = $branch->{'patronbarcodeprefix'} ;
		2295	my $padding = C4::Context->preference('patronbarcodelength') - length($prefix) - length($cardnum) ;
		2296	$cardnum = $prefix . '0' x $padding . $cardnum if($padding >= 0) ;
		2297	}
		2298	return $cardnum;
		2299	}
		2300
2232	END { } # module clean-up code here (global destructor)	2301	END { } # module clean-up code here (global destructor)
2233		2302
2234	1;	2303	1;

Lines 107-113 foreach ( $query->param ) { Link Here

(-)a/circ/returns.pl (-2 / +4 lines)
107		107
108	# decode barcode ## Didn't we already decode them before passing them back last time??	108	# decode barcode ## Didn't we already decode them before passing them back last time??
109	$barcode =~ s/^\s\|\s$//g; # remove leading/trailing whitespace	109	$barcode =~ s/^\s\|\s$//g; # remove leading/trailing whitespace
110	$barcode = barcodedecode($barcode) if(C4::Context->preference('itemBarcodeInputFilter'));	110	$barcode = barcodedecode($barcode) if(C4::Context->preference('itemBarcodeInputFilter')
		111	\|\| C4::Context->preference('itembarcodelength'));
111		112
112	######################	113	######################
113	#Are these lines still useful ?	114	#Are these lines still useful ?
Lines 201-207 if ($canceltransfer){ Link Here
201	# actually return book and prepare item table.....	202	# actually return book and prepare item table.....
202	if ($barcode) {	203	if ($barcode) {
203	$barcode =~ s/^\s\|\s$//g; # remove leading/trailing whitespace	204	$barcode =~ s/^\s\|\s$//g; # remove leading/trailing whitespace
204	$barcode = barcodedecode($barcode) if C4::Context->preference('itemBarcodeInputFilter');	205	$barcode = barcodedecode($barcode) if (C4::Context->preference('itemBarcodeInputFilter')
		206	\|\| C4::Context->preference('itembarcodelength'));
205	$itemnumber = GetItemnumberFromBarcode($barcode);	207	$itemnumber = GetItemnumberFromBarcode($barcode);
206		208
207	if ( C4::Context->preference("InProcessingToShelvingCart") ) {	209	if ( C4::Context->preference("InProcessingToShelvingCart") ) {

Lines 422-428 if ( $op eq "duplicate" ) { Link Here

(-)a/members/memberentry.pl (-7 / +8 lines)
422	$template->param( step_1 => 1, step_2 => 1, step_3 => 1, step_4 => 1, step_5 => 1, step_6 => 1 ) unless $step;	422	$template->param( step_1 => 1, step_2 => 1, step_3 => 1, step_4 => 1, step_5 => 1, step_6 => 1 ) unless $step;
423	}	423	}
424		424
425	$data{'cardnumber'}=fixup_cardnumber($data{'cardnumber'}) if $op eq 'add';	425	my $onlymine=(C4::Context->preference('IndependantBranches') &&
		426	C4::Context->userenv &&
		427	C4::Context->userenv->{flags} % 2 !=1 &&
		428	C4::Context->userenv->{branch}?1:0);
		429
		430	my $branches=GetBranches($onlymine);
		431	$data{'cardnumber'}=fixup_cardnumber( $data{'cardnumber'}, $branches->{C4::Context->userenv->{'branch'}} ) if $op eq 'add';
		432
426	if(!defined($data{'sex'})){	433	if(!defined($data{'sex'})){
427	$template->param( none => 1);	434	$template->param( none => 1);
428	} elsif($data{'sex'} eq 'F'){	435	} elsif($data{'sex'} eq 'F'){
Lines 559-570 my @branches; Link Here
559	my @select_branch;	566	my @select_branch;
560	my %select_branches;	567	my %select_branches;
561		568
562	my $onlymine=(C4::Context->preference('IndependantBranches') &&
563	C4::Context->userenv &&
564	C4::Context->userenv->{flags} % 2 !=1 &&
565	C4::Context->userenv->{branch}?1:0);
566
567	my $branches=GetBranches($onlymine);
568	my $default;	569	my $default;
569	my $CGIbranch;	570	my $CGIbranch;
570	for my $branch (sort { $branches->{$a}->{branchname} cmp $branches->{$b}->{branchname} } keys %$branches) {	571	for my $branch (sort { $branches->{$a}->{branchname} cmp $branches->{$b}->{branchname} } keys %$branches) {

Line 0 Link Here

(-)a/C4/Barcodes/prefix.pm (+126 lines)
		1	package C4::Barcodes::prefix;
		2
		3	# Copyright 2011 ByWater Solutions
		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	use strict;
		21	use warnings;
		22	use Carp;
		23
		24	use C4::Context;
		25	use C4::Branch;
		26	use C4::Debug;
		27	use C4::Dates;
		28
		29	use vars qw($VERSION @ISA);
		30	use vars qw($debug $cgi_debug); # from C4::Debug, of course
		31	use vars qw($branch $width);
		32
		33	BEGIN {
		34	$VERSION = 0.01;
		35	@ISA = qw(C4::Barcodes);
		36	$width = C4::Context->preference('itembarcodelength');
		37	my $prefix = '';
		38	}
		39
		40
		41	# This package generates auto-incrementing barcodes where branch-specific prefixes are being used.
		42	# For a library with 10-digit barcodes, and a prefix of T123, this should generate on a range of
		43	# T123000000 and T123999999
		44	#
		45	# There are a couple of problems with treating barcodes as straight-numerics and just incrementing
		46	# them. The first, and most-obvious, is that barcodes need not be numeric, particularly in the prefix
		47	# part! The second, as noted in C4::Barcodes.pm, is that you might not actually be able to handle very
		48	# large ints like that...
		49
		50
		51	sub db_max ($;$) {
		52	my $self = shift;
		53	my $sth = C4::Context->dbh->prepare("SELECT MAX(barcode) AS biggest FROM items where barcode LIKE ? AND length(barcode) =?");
		54	my $prefix_search = $self->prefix . '%';
		55	$sth->execute($prefix_search, $self->width);
		56	return $self->initial unless ($sth->rows);
		57	my ($row) = $sth->fetchrow_hashref();
		58
		59	my $max = $row->{biggest};
		60	return ($max \|\| 0);
		61	}
		62
		63	sub initial () {
		64	my $self = shift;
65	my $increment_width = $self->width - length($self->prefix);
66	return $self->prefix . sprintf("%"."$increment_width.$increment_width"."d",1);
67	}
68
69	sub parse ($;$) { # return 3 parts of barcode: non-incrementing, incrementing, non-incrementing
70	my $self = shift;
71	my $barcode = (@_) ? shift : $self->value;
72	my $prefix = $self->prefix;
73	unless ($barcode =~ /($prefix)(.+)$/) {
74	return($barcode,undef,undef);
75	}
76	return ($1,$2,''); # the third part is in anticipation of barcodes that include checkdigits
77	}
78
79	sub prefix ($;$) {
80	my $self = shift;
81	(@_) and $self->{prefix} = shift;
82	return C4::Branch::GetBranchDetail(C4::Context->userenv->{'branch'})->{'itembarcodeprefix'};
83	}
84
85	sub width ($;$) {
86	my $self = shift;
87	(@_) and $width = shift; # hitting the class variable.
88	return $width;
89	}
90
91	sub next_value ($;$) {
92	my $self = shift;
93	my $specific = (scalar @_) ? 1 : 0;
94	my $max = $specific ? shift : $self->max;
95	return $self->initial unless ($max);
96	my ($head,$incr,$tail) = $self->parse($max);
97	return undef unless (defined $incr);
98	my $incremented = '';
99
100	while ($incr =~ /([a-zA-Z][0-9])\z/ ){
101	my $fragment = $1;
102	$fragment++; #yes, you can do that with strings. Clever.
103	if (length($fragment) > length($1)){ #uhoh. got to carry something over.
104	$incremented = substr($fragment,1) . $incremented;
105	$incr = $`; #prematch. grab everything before $1 from above, and go back thru this.
106	}
107	else { #we're okay now.
108	$incr = $` . $fragment . $incremented;
109	last;
110	}
111	}
112
113	my $next_val = $head . $incr .$tail;
114	return $next_val;
115	}
116
117	sub new_object {
118	my $class_or_object = shift;
119	my $type = ref($class_or_object) \|\| $class_or_object;
120	my $self = $type->default_self('prefix_incr');
121	# take the prefix from argument, or the existing object, or get it from the userenv, in that order
122	return bless $self, $type;
123	}
124
125	1;
126	__END__

Lines 68-75 my ( $template, $borrowernumber, $cookie ) = get_template_and_user( Link Here

(-)a/admin/branches.pl (-17 / +21 lines)
68	}	68	}
69	);	69	);
70	$template->param(	70	$template->param(
71	script_name => $script_name,	71	script_name => $script_name,
72	action => $script_name,	72	action => $script_name,
		73	itembarcodelength => C4::Context->preference('itembarcodelength'),
		74	patronbarcodelength => C4::Context->preference('patronbarcodelength'),
73	);	75	);
74	$template->param( ($op \|\| 'else') => 1 );	76	$template->param( ($op \|\| 'else') => 1 );
75		77
Lines 393-413 sub branchinfotable { Link Here
393	sub _branch_to_template {	395	sub _branch_to_template {
394	my ($data, $template) = @_;	396	my ($data, $template) = @_;
395	$template->param(	397	$template->param(
396	branchcode => $data->{'branchcode'},	398	branchcode => $data->{'branchcode'},
397	branch_name => $data->{'branchname'},	399	branch_name => $data->{'branchname'},
398	branchaddress1 => $data->{'branchaddress1'},	400	branchaddress1 => $data->{'branchaddress1'},
399	branchaddress2 => $data->{'branchaddress2'},	401	branchaddress2 => $data->{'branchaddress2'},
400	branchaddress3 => $data->{'branchaddress3'},	402	branchaddress3 => $data->{'branchaddress3'},
401	branchzip => $data->{'branchzip'},	403	branchzip => $data->{'branchzip'},
402	branchcity => $data->{'branchcity'},	404	branchcity => $data->{'branchcity'},
403	branchstate => $data->{'branchstate'},	405	branchstate => $data->{'branchstate'},
404	branchcountry => $data->{'branchcountry'},	406	branchcountry => $data->{'branchcountry'},
405	branchphone => $data->{'branchphone'},	407	branchphone => $data->{'branchphone'},
406	branchfax => $data->{'branchfax'},	408	branchfax => $data->{'branchfax'},
407	branchemail => $data->{'branchemail'},	409	branchemail => $data->{'branchemail'},
408	branchurl => $data->{'branchurl'},	410	branchurl => $data->{'branchurl'},
409	branchip => $data->{'branchip'},	411	branchip => $data->{'branchip'},
410	branchnotes => $data->{'branchnotes'},	412	branchnotes => $data->{'branchnotes'},
		413	itembarcodeprefix => $data->{'itembarcodeprefix'},
		414	patronbarcodeprefix => $data->{'patronbarcodeprefix'},
411	);	415	);
412	}	416	}
413		417

Lines 53-58 INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES Link Here

(-)a/installer/data/mysql/sysprefs.sql (+2 lines)
53	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('IssuingInProcess',0,'If ON, disables fines if the patron is issuing item that accumulate debt',NULL,'YesNo');	53	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('IssuingInProcess',0,'If ON, disables fines if the patron is issuing item that accumulate debt',NULL,'YesNo');
54	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('item-level_itypes',1,'If ON, enables Item-level Itemtype / Issuing Rules','','YesNo');	54	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('item-level_itypes',1,'If ON, enables Item-level Itemtype / Issuing Rules','','YesNo');
55	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('itemcallnumber','082ab','The MARC field/subfield that is used to calculate the itemcallnumber (Dewey would be 082ab or 092ab; LOC would be 050ab or 090ab) could be 852hi from an item record',NULL,'free');	55	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('itemcallnumber','082ab','The MARC field/subfield that is used to calculate the itemcallnumber (Dewey would be 082ab or 092ab; LOC would be 050ab or 090ab) could be 852hi from an item record',NULL,'free');
		56	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('itembarcodelength','','Number of characters in system-wide barcode schema (item barcodes).','','Integer');
56	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('DefaultClassificationSource','ddc','Default classification scheme used by the collection. E.g., Dewey, LCC, etc.', NULL,'ClassSources');	57	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('DefaultClassificationSource','ddc','Default classification scheme used by the collection. E.g., Dewey, LCC, etc.', NULL,'ClassSources');
57	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('KohaAdminEmailAddress','root@localhost','Define the email address where patron modification requests are sent','','free');	58	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('KohaAdminEmailAddress','root@localhost','Define the email address where patron modification requests are sent','','free');
58	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('LabelMARCView','standard','Define how a MARC record will display','standard\|economical','Choice');	59	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('LabelMARCView','standard','Define how a MARC record will display','standard\|economical','Choice');
Lines 95-100 INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES Link Here
95	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('OpacPublic',1,'Turn on/off public OPAC',NULL,'YesNo');	96	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('OpacPublic',1,'Turn on/off public OPAC',NULL,'YesNo');
96	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('opacuserjs','','Define custom javascript for inclusion in OPAC','70\|10','Textarea');	97	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('opacuserjs','','Define custom javascript for inclusion in OPAC','70\|10','Textarea');
97	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('opacuserlogin',1,'Enable or disable display of user login features',NULL,'YesNo');	98	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('opacuserlogin',1,'Enable or disable display of user login features',NULL,'YesNo');
		99	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('patronbarcodelength','','Number of characters in system-wide barcode schema (patron cardnumbers).','','Integer');
98	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('patronimages',0,'Enable patron images for the Staff Client',NULL,'YesNo');	100	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('patronimages',0,'Enable patron images for the Staff Client',NULL,'YesNo');
99	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('printcirculationslips',1,'If ON, enable printing circulation receipts','','YesNo');	101	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('printcirculationslips',1,'If ON, enable printing circulation receipts','','YesNo');
100	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('RecordLocalUseOnReturn',0,'If ON, statistically record returns of unissued items as local use, instead of return',NULL,'YesNo');	102	INSERT INTO `systempreferences` (variable,value,explanation,options,type) VALUES('RecordLocalUseOnReturn',0,'If ON, statistically record returns of unissued items as local use, instead of return',NULL,'YesNo');

Lines 40-45 Administration: Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/admin.pref (+10 lines)
40	yes: Allow	40	yes: Allow
41	no: "Don't allow"	41	no: "Don't allow"
42	- staff and patrons to create and view saved lists of books.	42	- staff and patrons to create and view saved lists of books.
		43	-
		44	- Use branch prefixes to ensure that item barcodes are
		45	- pref: itembarcodelength
		46	class: integer
		47	- digits long
		48	-
		49	- Use branch prefixes to ensure that patron barcodes are
		50	- pref: patronbarcodelength
		51	class: integer
		52	- digits long
43	Login options:	53	Login options:
44	-	54	-
45	- pref: insecure	55	- pref: insecure