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

(-)a/C4/Members.pm (-42 / +29 lines)
Lines 40-45 use DateTime; Link Here
40
use DateTime::Format::DateParse;
40
use DateTime::Format::DateParse;
41
use Koha::DateUtils;
41
use Koha::DateUtils;
42
use Text::Unaccent qw( unac_string );
42
use Text::Unaccent qw( unac_string );
43
use Koha::Sequence;
43
44
44
our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
45
our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
45
46
Lines 908-979 sub changepassword { Link Here
908
909
909
=head2 fixup_cardnumber
910
=head2 fixup_cardnumber
910
911
911
Warning: The caller is responsible for locking the members table in write
912
Previously, there was a gap in time between the insertion of the
912
mode, to avoid database corruption.
913
card number into borrowers and the generation. This gap meant that
914
the same card number could be calculated by two different processes
915
resulting in two different members being added with the same card
916
number.
913
917
914
=cut
918
By creating a Koha::Sequence class, the requests are serialize and
919
prevent duplication.
915
920
916
use vars qw( @weightings );
921
=cut
917
my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
918
922
919
sub fixup_cardnumber {
923
sub fixup_cardnumber {
920
    my ($cardnumber) = @_;
924
    my ($cardnumber) = @_;
921
    my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
925
    my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
922
926
923
    # Find out whether member numbers should be generated
927
    # Find out whether member numbers should be generated
924
    # automatically. Should be either "1" or something else.
928
    # automatically. Should be either "1" or something else.
925
    # Defaults to "0", which is interpreted as "no".
929
    # Defaults to "0", which is interpreted as "no".
930
    my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
926
931
927
    #     if ($cardnumber !~ /\S/ && $autonumber_members) {
932
    # if we don't auto-generate, then there is nothing to fixup.
933
    # So return what was passed.
928
    ($autonumber_members) or return $cardnumber;
934
    ($autonumber_members) or return $cardnumber;
935
936
    # determine which kind of auto-generate we are doing
929
    my $checkdigit = C4::Context->preference('checkdigit');
937
    my $checkdigit = C4::Context->preference('checkdigit');
930
    my $dbh = C4::Context->dbh;
931
    if ( $checkdigit and $checkdigit eq 'katipo' ) {
932
933
        # if checkdigit is selected, calculate katipo-style cardnumber.
934
        # otherwise, just use the max()
935
        # purpose: generate checksum'd member numbers.
936
        # We'll assume we just got the max value of digits 2-8 of member #'s
937
        # from the database and our job is to increment that by one,
938
        # determine the 1st and 9th digits and return the full string.
939
        my $sth = $dbh->prepare(
940
            "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
941
        );
942
        $sth->execute;
943
        my $data = $sth->fetchrow_hashref;
944
        $cardnumber = $data->{new_num};
945
        if ( !$cardnumber ) {    # If DB has no values,
946
            $cardnumber = 1000000;    # start at 1000000
947
        } else {
948
            $cardnumber += 1;
949
        }
950
938
939
    # now calculate the current cardnumber.
940
    my $new_cardnumber;
941
    my $sequence = Koha::Sequence->new('cardnumber_' . $checkdigit);
942
    my $current_cardnumber = $sequence->get_next_value;
943
    if ($checkdigit && $checkdigit eq 'katipo') {
951
        my $sum = 0;
944
        my $sum = 0;
952
        for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
945
        foreach my $i (1..7) {
953
            # read weightings, left to right, 1 char at a time
946
            # read weightings, left to right, 1 char at a time
954
            my $temp1 = $weightings[$i];
947
            my $temp1 = $weightings[$i-1];
955
948
956
            # sequence left to right, 1 char at a time
949
            # sequence left to right, 1 char at a time
957
            my $temp2 = substr( $cardnumber, $i, 1 );
950
            my $temp2 = substr( $current_cardnumber, $i-1, 1 );
958
951
959
            # mult each char 1-7 by its corresponding weighting
952
            # mult each char 1-7 by its corresponding weighting
960
            $sum += $temp1 * $temp2;
953
            $sum += $temp1 * $temp2;
961
        }
954
        }
962
963
        my $rem = ( $sum % 11 );
955
        my $rem = ( $sum % 11 );
964
        $rem = 'X' if $rem == 10;
956
        $rem = 'X' if $rem == 10;
965
957
        $new_cardnumber = "V$current_cardnumber$rem";
966
        return "V$cardnumber$rem";
958
    }
967
     } else {
959
    else {
968
960
        $new_cardnumber = $current_cardnumber;
969
        my $sth = $dbh->prepare(
970
            'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
971
        );
972
        $sth->execute;
973
        my ($result) = $sth->fetchrow;
974
        return $result + 1;
975
    }
961
    }
976
    return $cardnumber;     # just here as a fallback/reminder 
962
963
    return $new_cardnumber;
977
}
964
}
978
965
979
=head2 GetGuarantees
966
=head2 GetGuarantees
(-)a/Koha/Sequence.pm (+466 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
package Koha::Sequence;
4
5
use Modern::Perl;
6
use C4::Context;
7
use Carp;
8
9
# perlcritic wants this?!
10
# In order to get up to perlcritic -2 with only complaints
11
# about CVS headers missing.
12
use strict;
13
use warnings;
14
use Readonly;
15
Readonly my $DEFAULT_CARDNUMBER_KATIPO => 999_999;
16
Readonly my $DEFAULT_CARDNUMBER_NONE   => 0;
17
18
our ($VERSION);
19
20
BEGIN {
21
    $VERSION = 1;
22
}
23
24
=head1 NAME
25
26
Koha::Sequence - Sequence Class for Koha
27
28
=head1 USAGE
29
30
 use Koha::Sequence;
31
32
=head1 DESCRIPTION
33
34
 This module provides functions for handling sequences. This
35
 includes resetting them to defaults, adding new ones,
36
 deleting old ones, getting the next value in the sequence,
37
 and determining if there is such a sequence.
38
39
 Sequences include things like card numbers, borrower numbers,
40
 barcode numbers. This package can be used to do several of
41
 these!
42
43
=head1 DEPENDENCIES
44
45
 C4::Context
46
 Modern::Perl
47
 Carp;
48
49
=head1 REQUIRED ARGUMENTS
50
51
 See the individual methods available for this class to view
52
 examples of parameters to pass in given situations. This
53
 class takes none to instantiate.
54
55
=head1 EXIT STATUS
56
57
 See the return values for each individual method.
58
59
=head1 FUNCTIONS
60
61
=head2 new
62
63
=head3 USAGE
64
65
 use Koha::Sequence;
66
67
 # 41 means that the get_next_value is 42.
68
 my $seq = Koha::Sequence->new('non_existent_sequence',41);
69
 my $rv = $seq->get_next_value;
70
 if ($rv==0) { print "Unable to get next value.\n"; }
71
 else { print "value: $rv\n"; }
72
73
 # 41 has no relevance!
74
 my $seq = Koha::Sequence->new('existent_sequence',41);
75
 my $rv = $seq->get_next_value;
76
 if ($rv==0) { print "Unable to get next value.\n"; }
77
 else { print "value: $rv\n"; }
78
79
=head3 DESCRIPTION
80
81
 This constructor adds the sequence if it doesn't exist. It
82
 sets the value to 0, if $previous_value is not passed,
83
 or the value of $previous_value if it is defined.
84
85
=cut
86
87
sub new {
88
    my ( $class, $sequence_name, $previous_value ) = @_;
89
    my $self;
90
91
    if ($sequence_name) {
92
        $self->{sequence_name} = $sequence_name;
93
94
        # if the sequence exists, it does nothing.
95
        my $rv = _add_sequence( $sequence_name, $previous_value );
96
        return bless $self, $class;
97
    }
98
    else {
99
        croak "Sequence name parameter required!\n";
100
    }
101
}
102
103
=head2 reset_everything
104
105
=head3 USAGE
106
107
 use Koha::Sequence;
108
 # just need to get a sequence handle to trigger reset
109
 # method, since reset_everything just does it!
110
 my $seq = Koha::Sequence->new('blah');
111
 my $rv = $seq->reset_everything;
112
113
=head3 DESCRIPTION
114
115
 This should only be called in an upgrade process!
116
 This function should be revised whenever a sequence is
117
 converted to use this Koha::Sequence class. As of its initial
118
 writing, only two sequences are codedd for. Technically it
119
 is one (cardnumber), but because the checkdigit system
120
 preference changes the format of the auto-generated
121
 cardnumber, two sequences are tracked: cardnumber_katipo
122
 and cardnumber_none.
123
124
=head3 RETURNS
125
126
  0 some sql failure
127
  1 success (non-empty borrowers table)
128
  2 success (empty borrowers table)
129
130
=cut
131
132
sub reset_everything {
133
    my $self = shift;
134
135
    my $rv  = 1;
136
    my $dbh = C4::Context->dbh;
137
138
    # empty the sequence table.
139
    my $trv = $dbh->do('DELETE FROM sequence');
140
    if ( !$trv ) {
141
        $rv = 0;
142
    }
143
144
    # current sequences known are:
145
    # cardnumber_katipo (cardnumber is affected by checkdigit)
146
    # cardnumber_none (cardnumber is affected by checkdigit)
147
148
    # count the number of borrowers
149
    my $sql = 'SELECT COUNT(*) FROM borrowers;';
150
    my $sth = $dbh->prepare($sql);
151
    $trv = $sth->execute();
152
    if ( !$trv ) {
153
        $rv = 0;
154
    }
155
    my $borrowers_count = $sth->fetchrow;
156
157
    # set them so we can default them.
158
    my $none_value   = 0;
159
    my $katipo_value = 0;
160
161
    # only go looking for the values if there are borrowers.
162
    if ($borrowers_count) {
163
164
        # determine max checkdigit=katipo cardnumber.
165
        $sql =
166
q{SELECT MAX(cardnumber) FROM borrowers WHERE SUBSTR(cardnumber,1,1) NOT IN ('0','1','2','3','4','5','6','7','8','9');};
167
        $sth = $dbh->prepare($sql);
168
        $trv = $sth->execute();
169
        if ( !$trv ) {
170
            $rv = 0;
171
        }
172
        $katipo_value = $sth->fetchrow;
173
174
        # determine max checkdigit=none cardnumber.
175
        $sql =
176
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');};
177
        $sth = $dbh->prepare($sql);
178
        $trv = $sth->execute();
179
        if ( !$trv ) {
180
            $rv = 0;
181
        }
182
        $none_value = $sth->fetchrow;
183
        if ( !$none_value && !$katipo_value ) {
184
            $rv = 0;
185
        }
186
    }
187
    else {
188
        $rv = 2;    # indicate we defaulted them
189
    }
190
191
    # fresh install, so default them.
192
    if ( !$katipo_value ) {
193
        $katipo_value = $DEFAULT_CARDNUMBER_KATIPO;
194
    }
195
    if ( !$none_value ) {
196
        $none_value = $DEFAULT_CARDNUMBER_NONE;
197
    }
198
199
    # create the checkdigit=katipo cardnumber sequence.
200
    $trv = _add_sequence( 'cardnumber_katipo', $katipo_value );
201
    if ( !$trv ) {
202
        $rv = 0;
203
    }
204
205
    # create the checkdigit=none cardnumber sequence.
206
    $trv = _add_sequence( 'cardnumber_none', $none_value );
207
    if ( !$trv ) {
208
        $rv = 0;
209
    }
210
211
    return $rv;
212
}
213
214
=head2 is_sequence
215
216
=head3 USAGE
217
218
 use Koha::Sequence;
219
 my $seq = Koha::Sequence->new('doesnotmatter');
220
 my $rv = $seq->reset_everything;
221
 $seq = Koha::Sequence->new('cardnumber_katipo');
222
 print "Checkdigit = katipo sequence exists: " .
223
       $seq->is_sequence . "\n";
224
 $seq = Koha::Sequence->new('cardnumber_none');
225
 print "Checkdigit = none sequence exists: " .
226
       $seq->is_sequence . "\n";
227
228
=head3 DESCRIPTION
229
230
 Determine if the sequence name passed is an existing
231
 sequence in the sequence table.
232
233
=head3 RETURNS
234
235
  1 when a sequence exists in the sequence table.
236
  0 otherwise
237
238
=cut
239
240
sub _is_sequence {
241
    my ($sequence_name) = @_;
242
    my $rv;
243
244
    my $sql =
245
      q{SELECT sequence_name,value FROM sequence WHERE sequence_name=?;};
246
    my $dbh = C4::Context->dbh;
247
    my $sth = $dbh->prepare($sql);
248
    $sth->execute($sequence_name);
249
    my $data = $sth->fetchrow_hashref;
250
    if ($data) {
251
        $rv = 1;
252
    }
253
    else {
254
        $rv = 0;
255
    }
256
257
    return $rv;
258
}
259
260
sub is_sequence {
261
    my ($self) = @_;
262
263
    return _is_sequence( $self->{sequence_name} );
264
}
265
266
=head2 _add_sequence
267
268
=head3 USAGE
269
270
 This is an internal function called by new.
271
272
 use Koha::Sequence;
273
 my $seq = Koha::Sequence->new('AnswerToLTUAE',42);
274
 $seq = Koha::Sequence->new('LazySequence');
275
276
=head3 DESCRIPTION
277
278
 Attempt to add a new sequence into the sequence
279
 table. This may or may not include a previous
280
 numeric value. If no previous value is given, 0 is
281
 assumed. Nothing is done if the sequence already exists.
282
283
=head3 RETURNS
284
285
  1 when a sequence does not exist in the sequence table.
286
  0 when a sequence already exists in the sequence table.
287
288
=cut
289
290
sub _add_sequence {
291
    my ( $sequence_name, $previous_value ) = @_;
292
    my $rv;
293
294
    if ( _is_sequence($sequence_name) == 0 ) {
295
        my $sql   = 'INSERT INTO sequence (sequence_name,value) VALUES (?,?);';
296
        my $dbh   = C4::Context->dbh;
297
        my $sth   = $dbh->prepare($sql);
298
        my $value = ( $previous_value ? $previous_value : 0 );
299
        $rv = $sth->execute( $sequence_name, $value );
300
        $rv = ( $rv ? 1 : 0 );
301
    }
302
    else {
303
        $rv = 0;
304
    }
305
    return $rv;
306
}
307
308
=head2 del_sequence
309
310
=head3 USAGE
311
312
 use Koha::Sequence;
313
 my $seq = Koha::Sequence->new('LazySequence');
314
 my $rv = $seq->del_sequence;
315
316
=head3 DESCRIPTION
317
318
 This will delete an existing sequence.
319
320
=head3 PARAMETERS
321
322
 The only parameter is the sequence name. If it is not
323
 passed, the return value will be 0.
324
325
=head3 RETURNS
326
327
  1 when a sequence is successfully deleted
328
  0 either sql failure, or invalid sequence.
329
330
=cut
331
332
sub del_sequence {
333
    my ($self) = @_;
334
    my $rv;
335
336
    if ( _is_sequence( $self->{sequence_name} ) ) {
337
        my $sql = 'DELETE FROM sequence WHERE sequence_name=?;';
338
        my $dbh = C4::Context->dbh;
339
        my $sth = $dbh->prepare($sql);
340
        $rv = $sth->execute( $self->{sequence_name} );
341
        $rv = ( $rv ? 1 : 0 );
342
    }
343
    else {
344
        $rv = 0;
345
    }
346
    return $rv;
347
}
348
349
=head2 get_next_value
350
351
=head3 USAGE
352
353
 use Koha::Sequence;
354
 my $seq = Koha::Sequence->new('cardnumber_none');
355
 my $rv = $seq->get_next_value;
356
357
=head3 DESCRIPTION
358
359
 Return the next value to use for the sequence specified.
360
361
=head3 PARAMETERS
362
363
 The only parameter is the sequence name to increment
364
 and return.
365
366
=head3 RETURNS
367
368
 value when the sequence is appropriately incremented.
369
     0 failure
370
371
=cut
372
373
sub get_next_value {
374
    my ($self) = @_;
375
    my ( $rv, $value );
376
377
    if ( _is_sequence( $self->{sequence_name} ) ) {
378
379
        $rv = 1;
380
381
        my $sql =
382
q{UPDATE sequence SET value=LAST_INSERT_ID(value+1) WHERE sequence_name = ?};
383
        my $dbh = C4::Context->dbh;
384
        my $sth = $dbh->prepare($sql);
385
        my $trv = $sth->execute( $self->{sequence_name} );
386
        if ( !$trv ) {
387
            $rv = 0;
388
        }
389
390
        $sth = $dbh->prepare('SELECT LAST_INSERT_ID()');
391
        $trv = $sth->execute();
392
        if ( !$trv ) {
393
            $rv = 0;
394
        }
395
396
        $value = $sth->fetchrow;
397
        if ( !$value ) {
398
            $rv = 0;
399
        }
400
    }
401
    else {
402
        $rv = 0;
403
    }
404
405
    return ( $rv ? $value : $rv );
406
}
407
408
=head1 CONFIGURATION
409
410
 No special configuration is needed as this will be included
411
 in the Koha directory.
412
413
=head1 INCOMPATIBILITIES
414
415
 This currently uses MySQLisms in reset_everything
416
 and get_next_value.  It is desired that if work is
417
 done to improve the backend used for Koha that the
418
 code will receive an intelligent constructor, so that
419
 it can call appropriate subclasses as needed. See
420
 C4::Context->db_scheme2dbi which may become useful
421
 eventually in writing such a change.
422
423
=head1 BUGS AND LIMITATIONS
424
425
 This only works for signed, numeric sequences.
426
427
=head1 AUTHOR
428
429
 This code was written by Mark Tompsett with the assistance
430
 and feedback of those in the Koha Community.
431
432
=head1 LICENSE AND COPYRIGHT
433
434
 Copyright 2013 Mark Tompsett.
435
436
 This file is part of Koha.
437
438
 Koha is free software; you can redistribute it and/or
439
 modify it under the terms of the GNU General Public
440
 License as published by the Free Software Foundation;
441
 either version 2 of the License, or (at your option)
442
 any later version.
443
444
 Koha is distributed in the hope that it will be useful,
445
 but WITHOUT ANY WARRANTY; without even the implied warranty
446
 of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
447
448
 See the GNU General Public License for more details.
449
 You should have received a copy of the GNU General Public
450
 License along with Koha; if not, write to them:
451
    Free Software Foundation
452
    51 Franklin Street, Fifth Floor
453
    Boston, MA 02110-1301
454
    USA
455
456
=head1 OPTIONS
457
458
 Not Applicable.
459
460
=head1 DIAGNOSTICS
461
462
 Not Applicable.
463
464
=cut
465
466
1;
(-)a/installer/data/mysql/kohastructure.sql (+10 lines)
Lines 3214-3219 CREATE TABLE IF NOT EXISTS plugin_data ( Link Here
3214
  PRIMARY KEY (plugin_class,plugin_key)
3214
  PRIMARY KEY (plugin_class,plugin_key)
3215
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3215
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3216
3216
3217
--
3218
-- Table structure for table 'sequence'
3219
--
3220
3221
CREATE TABLE IF NOT EXISTS sequence (
3222
  sequence_name varchar(32) NOT NULL,
3223
  value int NOT NULL,
3224
  PRIMARY KEY (sequence_name)
3225
) ENGINE=myisam DEFAULT CHARSET=utf8;
3226
3217
/*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
3227
/*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
3218
/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
3228
/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
3219
/*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;
3229
/*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;
(-)a/installer/data/mysql/updatedatabase.pl (+21 lines)
Lines 7067-7072 if ( CheckVersion($DBversion) ) { Link Here
7067
    SetVersion($DBversion);
7067
    SetVersion($DBversion);
7068
}
7068
}
7069
7069
7070
$DBversion = "3.13.00.XXX";
7071
if ( CheckVersion($DBversion) ) {
7072
7073
    # Create new table used to serialize sequences.
7074
    $dbh->do("
7075
CREATE TABLE IF NOT EXISTS sequence (
7076
  sequence_name varchar(32) NOT NULL,
7077
  value int NOT NULL,
7078
  PRIMARY KEY (sequence_name)
7079
) ENGINE=myisam DEFAULT CHARSET=utf8;
7080
        ");
7081
7082
    use Koha::Sequence;
7083
7084
    my $seq = Koha::Sequence->new('blah');
7085
    my $rv = $seq->reset_everything;
7086
7087
    print "Upgrade to $DBversion done (Bug 10454: Duplicate card numbers may be generated)\n";
7088
    SetVersion($DBversion);
7089
}
7090
7070
=head1 FUNCTIONS
7091
=head1 FUNCTIONS
7071
7092
7072
=head2 TableExists($table)
7093
=head2 TableExists($table)
(-)a/t/Sequence.t (-1 / +45 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
use strict;
4
use warnings;
5
6
use Test::More tests => 17;
7
8
BEGIN {
9
    use_ok( 'Koha::Sequence', 'check to use Koha::Sequence' );
10
}
11
12
my $seq = Koha::Sequence->new('blah');
13
ok( defined($seq), 'created sequence called blah' );
14
my $rv = $seq->reset_everything;
15
ok( $rv, 'triggered reset of everything' );
16
17
$seq = Koha::Sequence->new('id1');
18
ok( defined($seq), 'created sequence called id1' );
19
20
$rv = $seq->del_sequence;
21
ok( $rv, 'deleted sequence called id1' );
22
23
my $seq1 = Koha::Sequence->new('cardnumber_katipo');
24
my $seq2 = Koha::Sequence->new('cardnumber_none');
25
ok( $seq1->is_sequence, 'Confirmed cardnumber_katipo sequence' );
26
ok( $seq2->is_sequence, 'Confirmed cardnumber_none sequence' );
27
28
my $value;
29
ok( $value = $seq1->get_next_value, "Value $value" );
30
ok( $value = $seq1->get_next_value, "Value $value" );
31
ok( $value = $seq2->get_next_value, "Value $value" );
32
ok( $value = $seq2->get_next_value, "Value $value" );
33
34
$seq = Koha::Sequence->new('blah');
35
ok( defined($seq), 'created sequence called blah' );
36
$rv = $seq->reset_everything;
37
ok( $rv, 'triggered reset of everything' );
38
39
ok( $value = $seq1->get_next_value, "Value $value" );
40
ok( $value = $seq2->get_next_value, "Value $value" );
41
42
$seq = Koha::Sequence->new('blah');
43
ok( defined($seq), 'created sequence called blah' );
44
$rv = $seq->reset_everything;
45
ok( $rv, 'triggered reset of everything' );

Return to bug 10454