From 6d8217436c08f53a9d26668b3338786f52df1c16 Mon Sep 17 00:00:00 2001 From: Mark Tompsett Date: Thu, 27 Jun 2013 09:56:09 -0400 Subject: [PATCH] Bug 10454 - Duplicate card numbers may be generated 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. By creating a Koha::Sequence class, the requests are serialized and prevent duplication. And this class allows for flexibility with other sequences that may wish to be maintained. The fixup_cardnumber now merely uses the Koha::Sequence to get the next numerical portion of the cardnumber. If checkdigit is 'katipo', the new cardnumber is calculated out of the numeric portion. Perfect serialization leads to another problem: gaps. Gaps which are generated by deletion of old records are to be expected, but gaps generated by continually clicking refresh are not. This is an outstanding problem to now solve on the patron entry screen. This is beyond the scope of this bug. --- C4/Members.pm | 71 ++--- Koha/Sequence.pm | 466 ++++++++++++++++++++++++++++++++ installer/data/mysql/kohastructure.sql | 10 + installer/data/mysql/updatedatabase.pl | 21 ++ kohaversion.pl | 2 +- t/Sequence.t | 45 +++ 6 files changed, 572 insertions(+), 43 deletions(-) create mode 100644 Koha/Sequence.pm create mode 100644 t/Sequence.t diff --git a/C4/Members.pm b/C4/Members.pm index 3221f53..545881f 100644 --- a/C4/Members.pm +++ b/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 diff --git a/Koha/Sequence.pm b/Koha/Sequence.pm new file mode 100644 index 0000000..d9df511 --- /dev/null +++ b/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; diff --git a/installer/data/mysql/kohastructure.sql b/installer/data/mysql/kohastructure.sql index d7eebdd..1234928 100644 --- a/installer/data/mysql/kohastructure.sql +++ b/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 */; diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl index 5963d24..840d659 100755 --- a/installer/data/mysql/updatedatabase.pl +++ b/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) diff --git a/kohaversion.pl b/kohaversion.pl index 71938e4..863d91f 100644 --- a/kohaversion.pl +++ b/kohaversion.pl @@ -16,7 +16,7 @@ the kohaversion is divided in 4 parts : use strict; sub kohaversion { - our $VERSION = '3.13.00.008'; + our $VERSION = '3.13.00.XXX'; # version needs to be set this way # so that it can be picked up by Makefile.PL # during install diff --git a/t/Sequence.t b/t/Sequence.t new file mode 100644 index 0000000..b0c4fcc --- /dev/null +++ b/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' ); -- 1.7.9.5