C4/RotatingCollections.pm

   1 package C4::RotatingCollections;
   2
   3 # $Id: RotatingCollections.pm,v 0.1 2007/04/20 kylemhall
   4
   5 # This package is inteded to keep track of what library
   6 # Items of a certain collection should be at.
   7
   8 # Copyright 2007 Kyle Hall
   9 #
  10 # This file is part of Koha.
  11 #
  12 # Koha is free software; you can redistribute it and/or modify it
  13 # under the terms of the GNU General Public License as published by
  14 # the Free Software Foundation; either version 3 of the License, or
  15 # (at your option) any later version.
  16 #
  17 # Koha is distributed in the hope that it will be useful, but
  18 # WITHOUT ANY WARRANTY; without even the implied warranty of
  19 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  20 # GNU General Public License for more details.
  21 #
  22 # You should have received a copy of the GNU General Public License
  23 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  24
  25 use Modern::Perl;
  26
  27 use C4::Context;
  28 use Koha::Database;
  29
  30 use Try::Tiny qw( catch try );
  31
  32 use vars qw(@ISA @EXPORT);
  33
  34
  35 =head1 NAME
  36
  37 C4::RotatingCollections - Functions for managing rotating collections
  38
  39 =head1 FUNCTIONS
  40
  41 =cut
  42
  43 BEGIN {
  44     require Exporter;
  45     @ISA    = qw( Exporter );
  46     @EXPORT = qw(
  47       CreateCollection
  48       UpdateCollection
  49       DeleteCollection
  50
  51       GetItemsInCollection
  52
  53       GetCollection
  54       GetCollections
  55
  56       AddItemToCollection
  57       RemoveItemFromCollection
  58       TransferCollection
  59
  60       GetCollectionItemBranches
  61       isItemInAnyCollection
  62       isItemInThisCollection
  63     );
  64 }
  65
  66 =head2  CreateCollection
  67  ( $success, $errorcode, $errormessage ) = CreateCollection( $title, $description );
  68
  69 Creates a new collection
  70
  71  Input:
  72    $title: short description of the club or service
  73    $description: long description of the club or service
  74
  75  Output:
  76    $success: 1 if all database operations were successful, 0 otherwise
  77    $errorCode: Code for reason of failure, good for translating errors in templates
  78    $errorMessage: English description of error
  79
  80 =cut
  81
  82 sub CreateCollection {
  83     my ( $title, $description ) = @_;
  84
  85     my $schema = Koha::Database->new()->schema();
  86     my $duplicate_titles = $schema->resultset('Collection')->count({ colTitle => $title });
  87
  88     ## Check for all necessary parameters
  89     if ( !$title ) {
  90         return ( 0, 1, "NO_TITLE" );
  91     } elsif ( $duplicate_titles ) {
  92         return ( 0, 2, "DUPLICATE_TITLE" );
  93     }
  94
  95     $description ||= q{};
  96
  97     my $success = 1;
  98
  99     my $dbh = C4::Context->dbh;
 100
 101     my $sth;
 102     $sth = $dbh->prepare(
 103         "INSERT INTO collections ( colId, colTitle, colDesc )
 104                         VALUES ( NULL, ?, ? )"
 105     );
 106     $sth->execute( $title, $description ) or return ( 0, 3, $sth->errstr() );
 107
 108     return 1;
 109
 110 }
 111
 112 =head2 UpdateCollection
 113
 114  ( $success, $errorcode, $errormessage ) = UpdateCollection( $colId, $title, $description );
 115
 116 Updates a collection
 117
 118  Input:
 119    $colId: id of the collection to be updated
 120    $title: short description of the club or service
 121    $description: long description of the club or service
 122
 123  Output:
 124    $success: 1 if all database operations were successful, 0 otherwise
 125    $errorCode: Code for reason of failure, good for translating errors in templates
 126    $errorMessage: English description of error
 127
 128 =cut
 129
 130 sub UpdateCollection {
 131     my ( $colId, $title, $description ) = @_;
 132
 133     my $schema = Koha::Database->new()->schema();
 134     my $duplicate_titles = $schema->resultset('Collection')->count({ colTitle => $title,  -not => { colId => $colId } });
 135
 136     ## Check for all necessary parameters
 137     if ( !$colId ) {
 138         return ( 0, 1, "NO_ID" );
 139     }
 140     if ( !$title ) {
 141         return ( 0, 2, "NO_TITLE" );
 142     }
 143     if ( $duplicate_titles ) {
 144         return ( 0, 3, "DUPLICATE_TITLE" );
 145     }
 146
 147     my $dbh = C4::Context->dbh;
 148
 149     $description ||= q{};
 150
 151     my $sth;
 152     $sth = $dbh->prepare(
 153         "UPDATE collections
 154                         SET
 155                         colTitle = ?, colDesc = ?
 156                         WHERE colId = ?"
 157     );
 158     $sth->execute( $title, $description, $colId )
 159       or return ( 0, 4, $sth->errstr() );
 160
 161     return 1;
 162
 163 }
 164
 165 =head2 DeleteCollection
 166
 167  ( $success, $errorcode, $errormessage ) = DeleteCollection( $colId );
 168
 169 Deletes a collection of the given id
 170
 171  Input:
 172    $colId : id of the Archetype to be deleted
 173
 174  Output:
 175    $success: 1 if all database operations were successful, 0 otherwise
 176    $errorCode: Code for reason of failure, good for translating errors in templates
 177    $errorMessage: English description of error
 178
 179 =cut
 180
 181 sub DeleteCollection {
 182     my ($colId) = @_;
 183
 184     ## Parameter check
 185     if ( !$colId ) {
 186         return ( 0, 1, "NO_ID" );
 187     }
 188
 189     my $dbh = C4::Context->dbh;
 190
 191     my $sth;
 192
 193     $sth = $dbh->prepare("DELETE FROM collections WHERE colId = ?");
 194     $sth->execute($colId) or return ( 0, 4, $sth->errstr() );
 195
 196     return 1;
 197 }
 198
 199 =head2 GetCollections
 200
 201  $collections = GetCollections();
 202
 203 Returns data about all collections
 204
 205  Output:
 206   On Success:
 207    $results: Reference to an array of associated arrays
 208   On Failure:
 209    $errorCode: Code for reason of failure, good for translating errors in templates
 210    $errorMessage: English description of error
 211
 212 =cut
 213
 214 sub GetCollections {
 215
 216     my $dbh = C4::Context->dbh;
 217
 218     my $sth = $dbh->prepare("SELECT * FROM collections");
 219     $sth->execute() or return ( 1, $sth->errstr() );
 220
 221     my @results;
 222     while ( my $row = $sth->fetchrow_hashref ) {
 223         push( @results, $row );
 224     }
 225
 226     return \@results;
 227 }
 228
 229 =head2 GetItemsInCollection
 230
 231  ( $results, $success, $errorcode, $errormessage ) = GetItemsInCollection( $colId );
 232
 233 Returns information about the items in the given collection
 234
 235  Input:
 236    $colId: The id of the collection
 237
 238  Output:
 239    $results: Reference to an array of associated arrays
 240    $success: 1 if all database operations were successful, 0 otherwise
 241    $errorCode: Code for reason of failure, good for translating errors in templates
 242    $errorMessage: English description of error
 243
 244 =cut
 245
 246 sub GetItemsInCollection {
 247     my ($colId) = @_;
 248
 249     ## Parameter check
 250     if ( !$colId ) {
 251         return ( 0, 0, 1, "NO_ID" );
 252     }
 253
 254     my $dbh = C4::Context->dbh;
 255
 256     my $sth = $dbh->prepare(
 257         "SELECT
 258                              biblio.title,
 259                              biblio.biblionumber,
 260                              items.itemcallnumber,
 261                              items.barcode
 262                            FROM collections, collections_tracking, items, biblio
 263                            WHERE collections.colId = collections_tracking.colId
 264                            AND collections_tracking.itemnumber = items.itemnumber
 265                            AND items.biblionumber = biblio.biblionumber
 266                            AND collections.colId = ? ORDER BY biblio.title"
 267     );
 268     $sth->execute($colId) or return ( 0, 0, 2, $sth->errstr() );
 269
 270     my @results;
 271     while ( my $row = $sth->fetchrow_hashref ) {
 272         push( @results, $row );
 273     }
 274
 275     return \@results;
 276 }
 277
 278 =head2 GetCollection
 279
 280  ( $colId, $colTitle, $colDesc, $colBranchcode ) = GetCollection( $colId );
 281
 282 Returns information about a collection
 283
 284  Input:
 285    $colId: Id of the collection
 286  Output:
 287    $colId, $colTitle, $colDesc, $colBranchcode
 288
 289 =cut
 290
 291 sub GetCollection {
 292     my ($colId) = @_;
 293
 294     my $dbh = C4::Context->dbh;
 295
 296     my ( $sth, @results );
 297     $sth = $dbh->prepare("SELECT * FROM collections WHERE colId = ?");
 298     $sth->execute($colId) or return 0;
 299
 300     my $row = $sth->fetchrow_hashref;
 301
 302     return (
 303         $$row{'colId'},   $$row{'colTitle'},
 304         $$row{'colDesc'}, $$row{'colBranchcode'}
 305     );
 306
 307 }
 308
 309 =head2 AddItemToCollection
 310
 311  ( $success, $errorcode, $errormessage ) = AddItemToCollection( $colId, $itemnumber );
 312
 313 Adds an item to a rotating collection.
 314
 315  Input:
 316    $colId: Collection to add the item to.
 317    $itemnumber: Item to be added to the collection
 318  Output:
 319    $success: 1 if all database operations were successful, 0 otherwise
 320    $errorCode: Code for reason of failure, good for translating errors in templates
 321    $errorMessage: English description of error
 322
 323 =cut
 324
 325 sub AddItemToCollection {
 326     my ( $colId, $itemnumber ) = @_;
 327
 328     ## Check for all necessary parameters
 329     if ( !$colId ) {
 330         return ( 0, 1, "NO_ID" );
 331     }
 332     if ( !$itemnumber ) {
 333         return ( 0, 2, "NO_ITEM" );
 334     }
 335
 336     if ( isItemInThisCollection( $itemnumber, $colId ) ) {
 337         return ( 0, 2, "IN_COLLECTION" );
 338     }
 339     elsif ( isItemInAnyCollection($itemnumber) ) {
 340         return ( 0, 3, "IN_COLLECTION_OTHER" );
 341     }
 342
 343     my $dbh = C4::Context->dbh;
 344
 345     my $sth;
 346     $sth = $dbh->prepare("
 347         INSERT INTO collections_tracking (
 348             colId,
 349             itemnumber
 350         ) VALUES ( ?, ? )
 351     ");
 352     $sth->execute( $colId, $itemnumber ) or return ( 0, 3, $sth->errstr() );
 353
 354     return 1;
 355
 356 }
 357
 358 =head2  RemoveItemFromCollection
 359
 360  ( $success, $errorcode, $errormessage ) = RemoveItemFromCollection( $colId, $itemnumber );
 361
 362 Removes an item to a collection
 363
 364  Input:
 365    $colId: Collection to add the item to.
 366    $itemnumber: Item to be removed from collection
 367
 368  Output:
 369    $success: 1 if all database operations were successful, 0 otherwise
 370    $errorCode: Code for reason of failure, good for translating errors in templates
 371    $errorMessage: English description of error
 372
 373 =cut
 374
 375 sub RemoveItemFromCollection {
 376     my ( $colId, $itemnumber ) = @_;
 377
 378     ## Check for all necessary parameters
 379     if ( !$itemnumber ) {
 380         return ( 0, 2, "NO_ITEM" );
 381     }
 382
 383     if ( !isItemInThisCollection( $itemnumber, $colId ) ) {
 384         return ( 0, 2, "NOT_IN_COLLECTION" );
 385     }
 386
 387     my $dbh = C4::Context->dbh;
 388
 389     my $sth;
 390     $sth = $dbh->prepare(
 391         "DELETE FROM collections_tracking
 392                         WHERE itemnumber = ?"
 393     );
 394     $sth->execute($itemnumber) or return ( 0, 3, $sth->errstr() );
 395
 396     return 1;
 397 }
 398
 399 =head2 TransferCollection
 400
 401  ( $success, $messages ) = TransferCollection( $colId, $colBranchcode );
 402
 403 Transfers a collection to another branch
 404
 405  Input:
 406    $colId: id of the collection to be updated
 407    $colBranchcode: branch where collection is moving to
 408
 409  Output:
 410    $success: 1 if all database operations were successful, 0 otherwise
 411    $messages: Arrayref of messages for user feedback
 412
 413 =cut
 414
 415 sub TransferCollection {
 416     my ( $colId, $colBranchcode ) = @_;
 417
 418     ## Check for all necessary parameters
 419     if ( !$colId ) {
 420         return ( 0, [{ type => 'error', code => 'NO_ID' }] );
 421     }
 422     if ( !$colBranchcode ) {
 423         return ( 0, [{ type => 'error', code => 'NO_BRANCHCODE' }] );
 424     }
 425
 426     my $dbh = C4::Context->dbh;
 427
 428     my $sth;
 429     $sth = $dbh->prepare(
 430         "UPDATE collections
 431                         SET
 432                         colBranchcode = ?
 433                         WHERE colId = ?"
 434     );
 435     $sth->execute( $colBranchcode, $colId ) or return 0;
 436     my $to_library = Koha::Libraries->find( $colBranchcode );
 437
 438     $sth = $dbh->prepare(q{
 439         SELECT items.itemnumber, items.barcode FROM collections_tracking
 440         LEFT JOIN items ON collections_tracking.itemnumber = items.itemnumber
 441         LEFT JOIN issues ON items.itemnumber = issues.itemnumber
 442         WHERE issues.borrowernumber IS NULL
 443           AND collections_tracking.colId = ?
 444     });
 445     $sth->execute($colId) or return 0;
 446     my $messages;
 447     while ( my $item = $sth->fetchrow_hashref ) {
 448         my $item_object = Koha::Items->find( $item->{itemnumber} );
 449         try {
 450             $item_object->request_transfer(
 451                 {
 452                     to            => $to_library,
 453                     reason        => 'RotatingCollection',
 454                     ignore_limits => 0
 455                 }
 456             );    # Request transfer
 457         }
 458         catch {
 459             if ( $_->isa('Koha::Exceptions::Item::Transfer::InQueue') ) {
 460                 my $exception      = $_;
 461                 my $found_transfer = $_->transfer;
 462                 if (   $found_transfer->in_transit
 463                     || $found_transfer->reason eq 'Reserve' )
 464                 {
 465                     my $transfer = $item_object->request_transfer(
 466                         {
 467                             to            => $to_library,
 468                             reason        => "RotatingCollection",
 469                             ignore_limits => 0,
 470                             enqueue       => 1
 471                         }
 472                     );    # Queue transfer
 473                     push @{$messages},
 474                       {
 475                         type           => 'alert',
 476                         code           => 'enqueued',
 477                         item           => $item_object,
 478                         found_transfer => $found_transfer
 479                       };
 480                 }
 481                 else {
 482                     my $transfer = $item_object->request_transfer(
 483                         {
 484                             to            => $to_library,
 485                             reason        => "RotatingCollection",
 486                             ignore_limits => 0,
 487                             replace       => 1
 488                         }
 489                     );    # Replace transfer
 490                     # NOTE: If we just replaced a StockRotationAdvance,
 491                     # it will get enqueued afresh on the next cron run
 492                 }
 493             }
 494             elsif ( $_->isa('Koha::Exceptions::Item::Transfer::Limit') ) {
 495                 push @{$messages},
 496                   {
 497                     type => 'error',
 498                     code => 'limits',
 499                     item => $item_object
 500                   };
 501             }
 502             else {
 503                 $_->rethrow();
 504             }
 505         };
 506     }
 507
 508     return (1, $messages);
 509 }
 510
 511 =head2 GetCollectionItemBranches
 512
 513   my ( $holdingBranch, $collectionBranch ) = GetCollectionItemBranches( $itemnumber );
 514
 515 =cut
 516
 517 sub GetCollectionItemBranches {
 518     my ($itemnumber) = @_;
 519
 520     if ( !$itemnumber ) {
 521         return;
 522     }
 523
 524     my $dbh = C4::Context->dbh;
 525
 526     my ( $sth, @results );
 527     $sth = $dbh->prepare(
 528 "SELECT holdingbranch, colBranchcode FROM items, collections, collections_tracking
 529                         WHERE items.itemnumber = collections_tracking.itemnumber
 530                         AND collections.colId = collections_tracking.colId
 531                         AND items.itemnumber = ?"
 532     );
 533     $sth->execute($itemnumber);
 534
 535     my $row = $sth->fetchrow_hashref;
 536
 537     return ( $$row{'holdingbranch'}, $$row{'colBranchcode'}, );
 538 }
 539
 540 =head2 isItemInThisCollection
 541
 542   $inCollection = isItemInThisCollection( $itemnumber, $colId );
 543
 544 =cut
 545
 546 sub isItemInThisCollection {
 547     my ( $itemnumber, $colId ) = @_;
 548
 549     my $dbh = C4::Context->dbh;
 550
 551     my $sth = $dbh->prepare(
 552 "SELECT COUNT(*) as inCollection FROM collections_tracking WHERE itemnumber = ? AND colId = ?"
 553     );
 554     $sth->execute( $itemnumber, $colId ) or return (0);
 555
 556     my $row = $sth->fetchrow_hashref;
 557
 558     return $$row{'inCollection'};
 559 }
 560
 561 =head2 isItemInAnyCollection
 562
 563   my $inCollection = isItemInAnyCollection( $itemnumber );
 564
 565 =cut
 566
 567 sub isItemInAnyCollection {
 568     my ($itemnumber) = @_;
 569
 570     my $dbh = C4::Context->dbh;
 571
 572     my $sth = $dbh->prepare(
 573         "SELECT itemnumber FROM collections_tracking JOIN collections USING (colId) WHERE itemnumber = ?");
 574     $sth->execute($itemnumber) or return (0);
 575
 576     my $row = $sth->fetchrow_hashref;
 577
 578     $itemnumber = $row->{itemnumber};
 579     if ($itemnumber) {
 580         return 1;
 581     }
 582     else {
 583         return 0;
 584     }
 585 }
 586
 587 1;
 588
 589 __END__
 590
 591 =head1 AUTHOR
 592
 593 Kyle Hall <kylemhall@gmail.com>
 594
 595 =cut