--- a/C4/Members.pm +++ a/C4/Members.pm @@ -40,6 +40,7 @@ use DateTime; use DateTime::Format::DateParse; use Koha::DateUtils; use Text::Unaccent qw( unac_string ); +use Koha::Sequence; our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug); @@ -881,72 +882,58 @@ sub changepassword { =head2 fixup_cardnumber -Warning: The caller is responsible for locking the members table in write -mode, to avoid database corruption. +Previously, there was a gap in time between the insertion of the +card number into borrowers and the generation. This gap meant that +the same card number could be calculated by two different processes +resulting in two different members being added with the same card +number. -=cut +By creating a Koha::Sequence class, the requests are serialize and +prevent duplication. -use vars qw( @weightings ); -my @weightings = ( 8, 4, 6, 3, 5, 2, 1 ); +=cut sub fixup_cardnumber { my ($cardnumber) = @_; - my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0; + my @weightings = ( 8, 4, 6, 3, 5, 2, 1 ); # Find out whether member numbers should be generated # automatically. Should be either "1" or something else. # Defaults to "0", which is interpreted as "no". + my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0; - # if ($cardnumber !~ /\S/ && $autonumber_members) { + # if we don't auto-generate, then there is nothing to fixup. + # So return what was passed. ($autonumber_members) or return $cardnumber; + + # determine which kind of auto-generate we are doing my $checkdigit = C4::Context->preference('checkdigit'); - my $dbh = C4::Context->dbh; - if ( $checkdigit and $checkdigit eq 'katipo' ) { - - # if checkdigit is selected, calculate katipo-style cardnumber. - # otherwise, just use the max() - # purpose: generate checksum'd member numbers. - # We'll assume we just got the max value of digits 2-8 of member #'s - # from the database and our job is to increment that by one, - # determine the 1st and 9th digits and return the full string. - my $sth = $dbh->prepare( - "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers" - ); - $sth->execute; - my $data = $sth->fetchrow_hashref; - $cardnumber = $data->{new_num}; - if ( !$cardnumber ) { # If DB has no values, - $cardnumber = 1000000; # start at 1000000 - } else { - $cardnumber += 1; - } + # now calculate the current cardnumber. + my $new_cardnumber; + my $sequence = Koha::Sequence->new('cardnumber_' . $checkdigit); + my $current_cardnumber = $sequence->get_next_value; + if ($checkdigit && $checkdigit eq 'katipo') { my $sum = 0; - for ( my $i = 0 ; $i < 8 ; $i += 1 ) { + foreach my $i (1..7) { # read weightings, left to right, 1 char at a time - my $temp1 = $weightings[$i]; + my $temp1 = $weightings[$i-1]; # sequence left to right, 1 char at a time - my $temp2 = substr( $cardnumber, $i, 1 ); + my $temp2 = substr( $current_cardnumber, $i-1, 1 ); # mult each char 1-7 by its corresponding weighting $sum += $temp1 * $temp2; } - my $rem = ( $sum % 11 ); $rem = 'X' if $rem == 10; - - return "V$cardnumber$rem"; - } else { - - my $sth = $dbh->prepare( - 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"' - ); - $sth->execute; - my ($result) = $sth->fetchrow; - return $result + 1; + $new_cardnumber = "V$current_cardnumber$rem"; + } + else { + $new_cardnumber = $current_cardnumber; } - return $cardnumber; # just here as a fallback/reminder + + return $new_cardnumber; } =head2 GetGuarantees --- a/Koha/Sequence.pm +++ a/Koha/Sequence.pm @@ -0,0 +1,466 @@ +#!/usr/bin/perl + +package Koha::Sequence; + +use Modern::Perl; +use C4::Context; +use Carp; + +# perlcritic wants this?! +# In order to get up to perlcritic -2 with only complaints +# about CVS headers missing. +use strict; +use warnings; +use Readonly; +Readonly my $DEFAULT_CARDNUMBER_KATIPO => 999_999; +Readonly my $DEFAULT_CARDNUMBER_NONE => 0; + +our ($VERSION); + +BEGIN { + $VERSION = 1; +} + +=head1 NAME + +Koha::Sequence - Sequence Class for Koha + +=head1 USAGE + + use Koha::Sequence; + +=head1 DESCRIPTION + + This module provides functions for handling sequences. This + includes resetting them to defaults, adding new ones, + deleting old ones, getting the next value in the sequence, + and determining if there is such a sequence. + + Sequences include things like card numbers, borrower numbers, + barcode numbers. This package can be used to do several of + these! + +=head1 DEPENDENCIES + + C4::Context + Modern::Perl + Carp; + +=head1 REQUIRED ARGUMENTS + + See the individual methods available for this class to view + examples of parameters to pass in given situations. This + class takes none to instantiate. + +=head1 EXIT STATUS + + See the return values for each individual method. + +=head1 FUNCTIONS + +=head2 new + +=head3 USAGE + + use Koha::Sequence; + + # 41 means that the get_next_value is 42. + my $seq = Koha::Sequence->new('non_existent_sequence',41); + my $rv = $seq->get_next_value; + if ($rv==0) { print "Unable to get next value.\n"; } + else { print "value: $rv\n"; } + + # 41 has no relevance! + my $seq = Koha::Sequence->new('existent_sequence',41); + my $rv = $seq->get_next_value; + if ($rv==0) { print "Unable to get next value.\n"; } + else { print "value: $rv\n"; } + +=head3 DESCRIPTION + + This constructor adds the sequence if it doesn't exist. It + sets the value to 0, if $previous_value is not passed, + or the value of $previous_value if it is defined. + +=cut + +sub new { + my ( $class, $sequence_name, $previous_value ) = @_; + my $self; + + if ($sequence_name) { + $self->{sequence_name} = $sequence_name; + + # if the sequence exists, it does nothing. + my $rv = _add_sequence( $sequence_name, $previous_value ); + return bless $self, $class; + } + else { + croak "Sequence name parameter required!\n"; + } +} + +=head2 reset_everything + +=head3 USAGE + + use Koha::Sequence; + # just need to get a sequence handle to trigger reset + # method, since reset_everything just does it! + my $seq = Koha::Sequence->new('blah'); + my $rv = $seq->reset_everything; + +=head3 DESCRIPTION + + This should only be called in an upgrade process! + This function should be revised whenever a sequence is + converted to use this Koha::Sequence class. As of its initial + writing, only two sequences are codedd for. Technically it + is one (cardnumber), but because the checkdigit system + preference changes the format of the auto-generated + cardnumber, two sequences are tracked: cardnumber_katipo + and cardnumber_none. + +=head3 RETURNS + + 0 some sql failure + 1 success (non-empty borrowers table) + 2 success (empty borrowers table) + +=cut + +sub reset_everything { + my $self = shift; + + my $rv = 1; + my $dbh = C4::Context->dbh; + + # empty the sequence table. + my $trv = $dbh->do('DELETE FROM sequence'); + if ( !$trv ) { + $rv = 0; + } + + # current sequences known are: + # cardnumber_katipo (cardnumber is affected by checkdigit) + # cardnumber_none (cardnumber is affected by checkdigit) + + # count the number of borrowers + my $sql = 'SELECT COUNT(*) FROM borrowers;'; + my $sth = $dbh->prepare($sql); + $trv = $sth->execute(); + if ( !$trv ) { + $rv = 0; + } + my $borrowers_count = $sth->fetchrow; + + # set them so we can default them. + my $none_value = 0; + my $katipo_value = 0; + + # only go looking for the values if there are borrowers. + if ($borrowers_count) { + + # determine max checkdigit=katipo cardnumber. + $sql = +q{SELECT MAX(cardnumber) FROM borrowers WHERE SUBSTR(cardnumber,1,1) NOT IN ('0','1','2','3','4','5','6','7','8','9');}; + $sth = $dbh->prepare($sql); + $trv = $sth->execute(); + if ( !$trv ) { + $rv = 0; + } + $katipo_value = $sth->fetchrow; + + # determine max checkdigit=none cardnumber. + $sql = +q{SELECT MAX(CAST(cardnumber AS UNSIGNED)) FROM borrowers WHERE SUBSTR(cardnumber,1,1) IN ('0','1','2','3','4','5','6','7','8','9');}; + $sth = $dbh->prepare($sql); + $trv = $sth->execute(); + if ( !$trv ) { + $rv = 0; + } + $none_value = $sth->fetchrow; + if ( !$none_value && !$katipo_value ) { + $rv = 0; + } + } + else { + $rv = 2; # indicate we defaulted them + } + + # fresh install, so default them. + if ( !$katipo_value ) { + $katipo_value = $DEFAULT_CARDNUMBER_KATIPO; + } + if ( !$none_value ) { + $none_value = $DEFAULT_CARDNUMBER_NONE; + } + + # create the checkdigit=katipo cardnumber sequence. + $trv = _add_sequence( 'cardnumber_katipo', $katipo_value ); + if ( !$trv ) { + $rv = 0; + } + + # create the checkdigit=none cardnumber sequence. + $trv = _add_sequence( 'cardnumber_none', $none_value ); + if ( !$trv ) { + $rv = 0; + } + + return $rv; +} + +=head2 is_sequence + +=head3 USAGE + + use Koha::Sequence; + my $seq = Koha::Sequence->new('doesnotmatter'); + my $rv = $seq->reset_everything; + $seq = Koha::Sequence->new('cardnumber_katipo'); + print "Checkdigit = katipo sequence exists: " . + $seq->is_sequence . "\n"; + $seq = Koha::Sequence->new('cardnumber_none'); + print "Checkdigit = none sequence exists: " . + $seq->is_sequence . "\n"; + +=head3 DESCRIPTION + + Determine if the sequence name passed is an existing + sequence in the sequence table. + +=head3 RETURNS + + 1 when a sequence exists in the sequence table. + 0 otherwise + +=cut + +sub _is_sequence { + my ($sequence_name) = @_; + my $rv; + + my $sql = + q{SELECT sequence_name,value FROM sequence WHERE sequence_name=?;}; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare($sql); + $sth->execute($sequence_name); + my $data = $sth->fetchrow_hashref; + if ($data) { + $rv = 1; + } + else { + $rv = 0; + } + + return $rv; +} + +sub is_sequence { + my ($self) = @_; + + return _is_sequence( $self->{sequence_name} ); +} + +=head2 _add_sequence + +=head3 USAGE + + This is an internal function called by new. + + use Koha::Sequence; + my $seq = Koha::Sequence->new('AnswerToLTUAE',42); + $seq = Koha::Sequence->new('LazySequence'); + +=head3 DESCRIPTION + + Attempt to add a new sequence into the sequence + table. This may or may not include a previous + numeric value. If no previous value is given, 0 is + assumed. Nothing is done if the sequence already exists. + +=head3 RETURNS + + 1 when a sequence does not exist in the sequence table. + 0 when a sequence already exists in the sequence table. + +=cut + +sub _add_sequence { + my ( $sequence_name, $previous_value ) = @_; + my $rv; + + if ( _is_sequence($sequence_name) == 0 ) { + my $sql = 'INSERT INTO sequence (sequence_name,value) VALUES (?,?);'; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare($sql); + my $value = ( $previous_value ? $previous_value : 0 ); + $rv = $sth->execute( $sequence_name, $value ); + $rv = ( $rv ? 1 : 0 ); + } + else { + $rv = 0; + } + return $rv; +} + +=head2 del_sequence + +=head3 USAGE + + use Koha::Sequence; + my $seq = Koha::Sequence->new('LazySequence'); + my $rv = $seq->del_sequence; + +=head3 DESCRIPTION + + This will delete an existing sequence. + +=head3 PARAMETERS + + The only parameter is the sequence name. If it is not + passed, the return value will be 0. + +=head3 RETURNS + + 1 when a sequence is successfully deleted + 0 either sql failure, or invalid sequence. + +=cut + +sub del_sequence { + my ($self) = @_; + my $rv; + + if ( _is_sequence( $self->{sequence_name} ) ) { + my $sql = 'DELETE FROM sequence WHERE sequence_name=?;'; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare($sql); + $rv = $sth->execute( $self->{sequence_name} ); + $rv = ( $rv ? 1 : 0 ); + } + else { + $rv = 0; + } + return $rv; +} + +=head2 get_next_value + +=head3 USAGE + + use Koha::Sequence; + my $seq = Koha::Sequence->new('cardnumber_none'); + my $rv = $seq->get_next_value; + +=head3 DESCRIPTION + + Return the next value to use for the sequence specified. + +=head3 PARAMETERS + + The only parameter is the sequence name to increment + and return. + +=head3 RETURNS + + value when the sequence is appropriately incremented. + 0 failure + +=cut + +sub get_next_value { + my ($self) = @_; + my ( $rv, $value ); + + if ( _is_sequence( $self->{sequence_name} ) ) { + + $rv = 1; + + my $sql = +q{UPDATE sequence SET value=LAST_INSERT_ID(value+1) WHERE sequence_name = ?}; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare($sql); + my $trv = $sth->execute( $self->{sequence_name} ); + if ( !$trv ) { + $rv = 0; + } + + $sth = $dbh->prepare('SELECT LAST_INSERT_ID()'); + $trv = $sth->execute(); + if ( !$trv ) { + $rv = 0; + } + + $value = $sth->fetchrow; + if ( !$value ) { + $rv = 0; + } + } + else { + $rv = 0; + } + + return ( $rv ? $value : $rv ); +} + +=head1 CONFIGURATION + + No special configuration is needed as this will be included + in the Koha directory. + +=head1 INCOMPATIBILITIES + + This currently uses MySQLisms in reset_everything + and get_next_value. It is desired that if work is + done to improve the backend used for Koha that the + code will receive an intelligent constructor, so that + it can call appropriate subclasses as needed. See + C4::Context->db_scheme2dbi which may become useful + eventually in writing such a change. + +=head1 BUGS AND LIMITATIONS + + This only works for signed, numeric sequences. + +=head1 AUTHOR + + This code was written by Mark Tompsett with the assistance + and feedback of those in the Koha Community. + +=head1 LICENSE AND COPYRIGHT + + Copyright 2013 Mark Tompsett. + + 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 them: + Free Software Foundation + 51 Franklin Street, Fifth Floor + Boston, MA 02110-1301 + USA + +=head1 OPTIONS + + Not Applicable. + +=head1 DIAGNOSTICS + + Not Applicable. + +=cut + +1; --- a/installer/data/mysql/kohastructure.sql +++ a/installer/data/mysql/kohastructure.sql @@ -3215,6 +3215,16 @@ CREATE TABLE IF NOT EXISTS plugin_data ( PRIMARY KEY (plugin_class,plugin_key) ) ENGINE=InnoDB DEFAULT CHARSET=utf8; +-- +-- Table structure for table 'sequence' +-- + +CREATE TABLE IF NOT EXISTS sequence ( + sequence_name varchar(32) NOT NULL, + value int NOT NULL, + PRIMARY KEY (sequence_name) +) ENGINE=myisam DEFAULT CHARSET=utf8; + /*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */; /*!40101 SET SQL_MODE=@OLD_SQL_MODE */; /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */; --- a/installer/data/mysql/updatedatabase.pl +++ a/installer/data/mysql/updatedatabase.pl @@ -7010,6 +7010,27 @@ CREATE TABLE IF NOT EXISTS borrower_files ( SetVersion($DBversion); } +$DBversion = "3.13.00.XXX"; +if ( CheckVersion($DBversion) ) { + + # Create new table used to serialize sequences. + $dbh->do(" +CREATE TABLE IF NOT EXISTS sequence ( + sequence_name varchar(32) NOT NULL, + value int NOT NULL, + PRIMARY KEY (sequence_name) +) ENGINE=myisam DEFAULT CHARSET=utf8; + "); + + use Koha::Sequence; + + my $seq = Koha::Sequence->new('blah'); + my $rv = $seq->reset_everything; + + print "Upgrade to $DBversion done (Bug 10454: Duplicate card numbers may be generated)\n"; + SetVersion($DBversion); +} + =head1 FUNCTIONS =head2 TableExists($table) --- a/t/Sequence.t +++ a/t/Sequence.t @@ -0,0 +1,45 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 17; + +BEGIN { + use_ok( 'Koha::Sequence', 'check to use Koha::Sequence' ); +} + +my $seq = Koha::Sequence->new('blah'); +ok( defined($seq), 'created sequence called blah' ); +my $rv = $seq->reset_everything; +ok( $rv, 'triggered reset of everything' ); + +$seq = Koha::Sequence->new('id1'); +ok( defined($seq), 'created sequence called id1' ); + +$rv = $seq->del_sequence; +ok( $rv, 'deleted sequence called id1' ); + +my $seq1 = Koha::Sequence->new('cardnumber_katipo'); +my $seq2 = Koha::Sequence->new('cardnumber_none'); +ok( $seq1->is_sequence, 'Confirmed cardnumber_katipo sequence' ); +ok( $seq2->is_sequence, 'Confirmed cardnumber_none sequence' ); + +my $value; +ok( $value = $seq1->get_next_value, "Value $value" ); +ok( $value = $seq1->get_next_value, "Value $value" ); +ok( $value = $seq2->get_next_value, "Value $value" ); +ok( $value = $seq2->get_next_value, "Value $value" ); + +$seq = Koha::Sequence->new('blah'); +ok( defined($seq), 'created sequence called blah' ); +$rv = $seq->reset_everything; +ok( $rv, 'triggered reset of everything' ); + +ok( $value = $seq1->get_next_value, "Value $value" ); +ok( $value = $seq2->get_next_value, "Value $value" ); + +$seq = Koha::Sequence->new('blah'); +ok( defined($seq), 'created sequence called blah' ); +$rv = $seq->reset_everything; +ok( $rv, 'triggered reset of everything' ); --