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; |