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