C4/Reserves.pm

   1 # -*- tab-width: 8 -*-
   2 # NOTE: This file uses standard 8-character tabs
   3
   4 package C4::Reserves;
   5
   6 # Copyright 2000-2002 Katipo Communications
   7 #           2006 SAN Ouest Provence
   8 #           2007 BibLibre Paul POULAIN
   9 #
  10 # This file is part of Koha.
  11 #
  12 # Koha is free software; you can redistribute it and/or modify it under the
  13 # terms of the GNU General Public License as published by the Free Software
  14 # Foundation; either version 2 of the License, or (at your option) any later
  15 # version.
  16 #
  17 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  18 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  19 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  20 #
  21 # You should have received a copy of the GNU General Public License along with
  22 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  23 # Suite 330, Boston, MA  02111-1307 USA
  24
  25
  26 use strict;
  27 require Exporter;
  28 use C4::Context;
  29 use C4::Biblio;
  30 use C4::Items;
  31 use C4::Search;
  32 use C4::Circulation;
  33 use C4::Accounts;
  34
  35 INIT {
  36     # an ugly hack to ensure that
  37     # various subs get imported
  38     # into C4::Reserves' symbol table
  39     # FIXME: hopefully can remove once
  40     #        we get a better idea of exactly
  41     #        how Exporter/use/require/import
  42     #        should be used with modules
  43     #        that currently call functions
  44     #        from each other.
  45     import C4::Items;
  46 }
  47
  48 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,%EXPORT_TAGS);
  49
  50 my $library_name = C4::Context->preference("LibraryName");
  51
  52 # set the version for version checking
  53 $VERSION = 3.00;
  54
  55 =head1 NAME
  56
  57 C4::Reserves - Koha functions for dealing with reservation.
  58
  59 =head1 SYNOPSIS
  60
  61   use C4::Reserves;
  62
  63 =head1 DESCRIPTION
  64
  65   this modules provides somes functions to deal with reservations.
  66
  67   Reserves are stored in reserves table.
  68   The following columns contains important values :
  69   - priority >0      : then the reserve is at 1st stage, and not yet affected to any item.
  70              =0      : then the reserve is being dealed
  71   - found : NULL       : means the patron requested the 1st available, and we haven't choosen the item
  72             W(aiting)  : the reserve has an itemnumber affected, and is on the way
  73             F(inished) : the reserve has been completed, and is done
  74   - itemnumber : empty : the reserve is still unaffected to an item
  75                  filled: the reserve is attached to an item
  76   The complete workflow is :
  77   ==== 1st use case ====
  78   patron request a document, 1st available :                      P >0, F=NULL, I=NULL
  79   a library having it run "transfertodo", and clic on the list
  80          if there is no transfer to do, the reserve waiting
  81          patron can pick it up                                    P =0, F=W,    I=filled
  82          if there is a transfer to do, write in branchtransfer    P =0, F=NULL, I=filled
  83            The pickup library recieve the book, it check in       P =0, F=W,    I=filled
  84   The patron borrow the book                                      P =0, F=F,    I=filled
  85
  86   ==== 2nd use case ====
  87   patron requests a document, a given item,
  88     If pickup is holding branch                                   P =0, F=W,   I=filled
  89     If transfer needed, write in branchtransfer                   P =0, F=NULL, I=filled
  90         The pickup library recieve the book, it checks it in      P =0, F=W,    I=filled
  91   The patron borrow the book                                      P =0, F=F,    I=filled
  92
  93 =head1 FUNCTIONS
  94
  95 =over 2
  96
  97 =cut
  98
  99 @ISA = qw(Exporter);
 100
 101 @EXPORT = qw(
 102   &AddReserve
 103
 104   &GetReservesFromItemnumber
 105   &GetReservesFromBiblionumber
 106   &GetReservesFromBorrowernumber
 107   &GetReservesForBranch
 108   &GetReservesToBranch
 109   &GetReserveCount
 110   &GetReserveFee
 111
 112   &GetOtherReserves
 113
 114   &ModReserveFill
 115   &ModReserveAffect
 116   &ModReserve
 117   &ModReserveStatus
 118   &ModReserveCancelAll
 119   &ModReserveMinusPriority
 120
 121   &CheckReserves
 122   &CancelReserve
 123 );
 124
 125
 126 =item AddReserve
 127
 128     AddReserve($branch,$borrowernumber,$biblionumber,$constraint,$bibitems,$priority,$notes,$title,$checkitem,$found)
 129
 130 =cut
 131
 132 sub AddReserve {
 133     my (
 134         $branch,    $borrowernumber, $biblionumber,
 135         $constraint, $bibitems,  $priority,       $notes,
 136         $title,      $checkitem, $found
 137     ) = @_;
 138     my $fee =
 139           GetReserveFee($borrowernumber, $biblionumber, $constraint,
 140             $bibitems );
 141     my $dbh     = C4::Context->dbh;
 142     my $const   = lc substr( $constraint, 0, 1 );
 143     my @datearr = localtime(time);
 144     my $resdate =
 145       ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
 146     my $waitingdate;
 147
 148     # If the reserv had the waiting status, we had the value of the resdate
 149     if ( $found eq 'W' ) {
 150         $waitingdate = $resdate;
 151     }
 152
 153     #eval {
 154     # updates take place here
 155     if ( $fee > 0 ) {
 156         my $nextacctno = &getnextacctno( $borrowernumber );
 157         my $query      = qq/
 158         INSERT INTO accountlines
 159             (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
 160         VALUES
 161             (?,?,now(),?,?,'Res',?)
 162     /;
 163         my $usth = $dbh->prepare($query);
 164         $usth->execute( $borrowernumber, $nextacctno, $fee,
 165             "Reserve Charge - $title", $fee );
 166         $usth->finish;
 167     }
 168
 169     #if ($const eq 'a'){
 170     my $query = qq/
 171         INSERT INTO reserves
 172             (borrowernumber,biblionumber,reservedate,branchcode,constrainttype,
 173             priority,reservenotes,itemnumber,found,waitingdate)
 174         VALUES
 175              (?,?,?,?,?,
 176              ?,?,?,?,?)
 177     /;
 178     my $sth = $dbh->prepare($query);
 179     $sth->execute(
 180         $borrowernumber, $biblionumber, $resdate, $branch,
 181         $const,          $priority,     $notes,   $checkitem,
 182         $found,          $waitingdate
 183     );
 184     $sth->finish;
 185
 186     #}
 187     if ( ( $const eq "o" ) || ( $const eq "e" ) ) {
 188         my $numitems = @$bibitems;
 189         my $i        = 0;
 190         while ( $i < $numitems ) {
 191             my $biblioitem = @$bibitems[$i];
 192             my $query      = qq/
 193           INSERT INTO reserveconstraints
 194               (borrowernumber,biblionumber,reservedate,biblioitemnumber)
 195           VALUES
 196             (?,?,?,?)
 197       /;
 198             my $sth = $dbh->prepare("");
 199             $sth->execute( $borrowernumber, $biblionumber, $resdate,
 200                 $biblioitem );
 201             $sth->finish;
 202             $i++;
 203         }
 204     }
 205     return;
 206 }
 207
 208 =item GetReservesFromBiblionumber
 209
 210 @borrowerreserv=&GetReserves($biblionumber,$itemnumber,$borrowernumber);
 211
 212 this function get the list of reservation for an C<$biblionumber>, C<$itemnumber> or C<$borrowernumber>
 213 given on input arg.
 214 Only 1 argument has to be passed.
 215
 216 =cut
 217
 218 sub GetReservesFromBiblionumber {
 219     my ( $biblionumber, $itemnumber, $borrowernumber ) = @_;
 220     my $dbh   = C4::Context->dbh;
 221
 222     # Find the desired items in the reserves
 223     my $query = "
 224         SELECT  branchcode,
 225                 timestamp AS rtimestamp,
 226                 priority,
 227                 biblionumber,
 228                 borrowernumber,
 229                 reservedate,
 230                 constrainttype,
 231                 found,
 232                 itemnumber,
 233                 reservenotes
 234         FROM     reserves
 235         WHERE     cancellationdate IS NULL
 236         AND    (found <> \'F\' OR found IS NULL)
 237         AND biblionumber = ?
 238         ORDER BY priority";
 239     my $sth = $dbh->prepare($query);
 240     $sth->execute($biblionumber);
 241     my @results;
 242     my $i = 0;
 243     while ( my $data = $sth->fetchrow_hashref ) {
 244
 245         # FIXME - What is this if-statement doing? How do constraints work?
 246         if ( $data->{constrainttype} eq 'o' ) {
 247             $query = '
 248                 SELECT biblioitemnumber
 249                 FROM reserveconstraints
 250                 WHERE biblionumber   = ?
 251                     AND borrowernumber = ?
 252                 AND reservedate    = ?
 253             ';
 254             my $csth = $dbh->prepare($query);
 255             $csth->execute( $data->{biblionumber}, $data->{borrowernumber},
 256                 $data->{reservedate}, );
 257
 258             my @bibitemno;
 259             while ( my $bibitemnos = $csth->fetchrow_array ) {
 260                 push( @bibitemno, $bibitemnos );
 261             }
 262             my $count = @bibitemno;
 263
 264             # if we have two or more different specific itemtypes
 265             # reserved by same person on same day
 266             my $bdata;
 267             if ( $count > 1 ) {
 268                 $bdata = GetBiblioItemData( $bibitemno[$i] );
 269                 $i++;
 270             }
 271             else {
 272
 273                 # Look up the book we just found.
 274                 $bdata = GetBiblioItemData( $bibitemno[0] );
 275             }
 276             $csth->finish;
 277
 278             # Add the results of this latest search to the current
 279             # results.
 280             # FIXME - An 'each' would probably be more efficient.
 281             foreach my $key ( keys %$bdata ) {
 282                 $data->{$key} = $bdata->{$key};
 283             }
 284         }
 285         push @results, $data;
 286     }
 287     $sth->finish;
 288     return ( $#results + 1, \@results );
 289 }
 290
 291 =item GetReservesFromItemnumber
 292
 293  ( $reservedate, $borrowernumber, $branchcode ) = GetReservesFromItemnumber($itemnumber);
 294
 295    TODO :: Description here
 296
 297 =cut
 298
 299 sub GetReservesFromItemnumber {
 300     my ( $itemnumber ) = @_;
 301     my $dbh   = C4::Context->dbh;
 302     my $query = "
 303     SELECT reservedate,borrowernumber,branchcode
 304     FROM   reserves
 305     WHERE  itemnumber=?
 306         AND  cancellationdate IS NULL
 307         AND  (found <> 'F' OR found IS NULL)
 308     ";
 309     my $sth_res = $dbh->prepare($query);
 310     $sth_res->execute($itemnumber);
 311     my ( $reservedate, $borrowernumber,$branchcode ) = $sth_res->fetchrow_array;
 312     return ( $reservedate, $borrowernumber, $branchcode );
 313 }
 314
 315 =item GetReservesFromBorrowernumber
 316
 317     $borrowerreserv = GetReservesFromBorrowernumber($borrowernumber,$tatus);
 318
 319     TODO :: Descritpion
 320
 321 =cut
 322
 323 sub GetReservesFromBorrowernumber {
 324     my ( $borrowernumber, $status ) = @_;
 325     my $dbh   = C4::Context->dbh;
 326     my $sth;
 327     if ($status) {
 328         $sth = $dbh->prepare("
 329             SELECT *
 330             FROM   reserves
 331             WHERE  borrowernumber=?
 332                 AND  cancellationdate IS NULL
 333                 AND found =?
 334             ORDER BY reservedate
 335         ");
 336         $sth->execute($borrowernumber,$status);
 337     } else {
 338         $sth = $dbh->prepare("
 339             SELECT *
 340             FROM   reserves
 341             WHERE  borrowernumber=?
 342                 AND  cancellationdate IS NULL
 343                 AND (found != 'F' or found is null)
 344             ORDER BY reservedate
 345         ");
 346         $sth->execute($borrowernumber);
 347     }
 348     my $data = $sth->fetchall_arrayref({});
 349     return @$data;
 350 }
 351 #-------------------------------------------------------------------------------------
 352
 353 =item GetReserveCount
 354
 355 $number = &GetReserveCount($borrowernumber);
 356
 357 this function returns the number of reservation for a borrower given on input arg.
 358
 359 =cut
 360
 361 sub GetReserveCount {
 362     my ($borrowernumber) = @_;
 363
 364     my $dbh = C4::Context->dbh;
 365
 366     my $query = '
 367         SELECT COUNT(*) AS counter
 368         FROM reserves
 369           WHERE borrowernumber = ?
 370           AND cancellationdate IS NULL
 371           AND (found != \'F\' OR found IS NULL)
 372     ';
 373     my $sth = $dbh->prepare($query);
 374     $sth->execute($borrowernumber);
 375     my $row = $sth->fetchrow_hashref;
 376     $sth->finish;
 377
 378     return $row->{counter};
 379 }
 380
 381 =item GetOtherReserves
 382
 383 ($messages,$nextreservinfo)=$GetOtherReserves(itemnumber);
 384
 385 Check queued list of this document and check if this document must be  transfered
 386
 387 =cut
 388
 389 sub GetOtherReserves {
 390     my ($itemnumber) = @_;
 391     my $messages;
 392     my $nextreservinfo;
 393     my ( $restype, $checkreserves ) = CheckReserves($itemnumber);
 394     if ($checkreserves) {
 395         my $iteminfo = GetItem($itemnumber);
 396         if ( $iteminfo->{'holdingbranch'} ne $checkreserves->{'branchcode'} ) {
 397             $messages->{'transfert'} = $checkreserves->{'branchcode'};
 398             #minus priorities of others reservs
 399             ModReserveMinusPriority(
 400                 $itemnumber,
 401                 $checkreserves->{'borrowernumber'},
 402                 $iteminfo->{'biblionumber'}
 403             );
 404
 405             #launch the subroutine dotransfer
 406             C4::Circulation::ModItemTransfer(
 407                 $itemnumber,
 408                 $iteminfo->{'holdingbranch'},
 409                 $checkreserves->{'branchcode'}
 410               ),
 411               ;
 412         }
 413
 414      #step 2b : case of a reservation on the same branch, set the waiting status
 415         else {
 416             $messages->{'waiting'} = 1;
 417             ModReserveMinusPriority(
 418                 $itemnumber,
 419                 $checkreserves->{'borrowernumber'},
 420                 $iteminfo->{'biblionumber'}
 421             );
 422             ModReserveStatus($itemnumber,'W');
 423         }
 424
 425         $nextreservinfo = $checkreserves->{'borrowernumber'};
 426     }
 427
 428     return ( $messages, $nextreservinfo );
 429 }
 430
 431 =item GetReserveFee
 432
 433 $fee = GetReserveFee($borrowernumber,$biblionumber,$constraint,$biblionumber);
 434
 435 Calculate the fee for a reserve
 436
 437 =cut
 438
 439 sub GetReserveFee {
 440     my ($borrowernumber, $biblionumber, $constraint, $bibitems ) = @_;
 441
 442     #check for issues;
 443     my $dbh   = C4::Context->dbh;
 444     my $const = lc substr( $constraint, 0, 1 );
 445     my $query = qq/
 446       SELECT * FROM borrowers
 447     LEFT JOIN categories ON borrowers.categorycode = categories.categorycode
 448     WHERE borrowernumber = ?
 449     /;
 450     my $sth = $dbh->prepare($query);
 451     $sth->execute($borrowernumber);
 452     my $data = $sth->fetchrow_hashref;
 453     $sth->finish();
 454     my $fee      = $data->{'reservefee'};
 455     my $cntitems = @- > $bibitems;
 456
 457     if ( $fee > 0 ) {
 458
 459         # check for items on issue
 460         # first find biblioitem records
 461         my @biblioitems;
 462         my $sth1 = $dbh->prepare(
 463             "SELECT * FROM biblio LEFT JOIN biblioitems on biblio.biblionumber = biblioitems.biblionumber
 464                    WHERE (biblio.biblionumber = ?)"
 465         );
 466         $sth1->execute($biblionumber);
 467         while ( my $data1 = $sth1->fetchrow_hashref ) {
 468             if ( $const eq "a" ) {
 469                 push @biblioitems, $data1;
 470             }
 471             else {
 472                 my $found = 0;
 473                 my $x     = 0;
 474                 while ( $x < $cntitems ) {
 475                     if ( @$bibitems->{'biblioitemnumber'} ==
 476                         $data->{'biblioitemnumber'} )
 477                     {
 478                         $found = 1;
 479                     }
 480                     $x++;
 481                 }
 482                 if ( $const eq 'o' ) {
 483                     if ( $found == 1 ) {
 484                         push @biblioitems, $data1;
 485                     }
 486                 }
 487                 else {
 488                     if ( $found == 0 ) {
 489                         push @biblioitems, $data1;
 490                     }
 491                 }
 492             }
 493         }
 494         $sth1->finish;
 495         my $cntitemsfound = @biblioitems;
 496         my $issues        = 0;
 497         my $x             = 0;
 498         my $allissued     = 1;
 499         while ( $x < $cntitemsfound ) {
 500             my $bitdata = $biblioitems[$x];
 501             my $sth2    = $dbh->prepare(
 502                 "SELECT * FROM items
 503                      WHERE biblioitemnumber = ?"
 504             );
 505             $sth2->execute( $bitdata->{'biblioitemnumber'} );
 506             while ( my $itdata = $sth2->fetchrow_hashref ) {
 507                 my $sth3 = $dbh->prepare(
 508                     "SELECT * FROM issues
 509                        WHERE itemnumber = ?
 510                          AND returndate IS NULL"
 511                 );
 512                 $sth3->execute( $itdata->{'itemnumber'} );
 513                 if ( my $isdata = $sth3->fetchrow_hashref ) {
 514                 }
 515                 else {
 516                     $allissued = 0;
 517                 }
 518             }
 519             $x++;
 520         }
 521         if ( $allissued == 0 ) {
 522             my $rsth =
 523               $dbh->prepare("SELECT * FROM reserves WHERE biblionumber = ?");
 524             $rsth->execute($biblionumber);
 525             if ( my $rdata = $rsth->fetchrow_hashref ) {
 526             }
 527             else {
 528                 $fee = 0;
 529             }
 530         }
 531     }
 532     return $fee;
 533 }
 534
 535 =item GetReservesToBranch
 536
 537 @transreserv = GetReservesToBranch( $frombranch );
 538
 539 Get reserve list for a given branch
 540
 541 =cut
 542
 543 sub GetReservesToBranch {
 544     my ( $frombranch ) = @_;
 545     my $dbh = C4::Context->dbh;
 546     my $sth = $dbh->prepare(
 547         "SELECT borrowernumber,reservedate,itemnumber,timestamp
 548          FROM reserves
 549          WHERE priority='0' AND cancellationdate is null
 550            AND branchcode=?
 551            AND found IS NULL "
 552     );
 553     $sth->execute( $frombranch );
 554     my @transreserv;
 555     my $i = 0;
 556     while ( my $data = $sth->fetchrow_hashref ) {
 557         $transreserv[$i] = $data;
 558         $i++;
 559     }
 560     $sth->finish;
 561     return (@transreserv);
 562 }
 563
 564 =item GetReservesForBranch
 565
 566 @transreserv = GetReservesForBranch($frombranch);
 567
 568 =cut
 569
 570 sub GetReservesForBranch {
 571     my ($frombranch) = @_;
 572     my $dbh          = C4::Context->dbh;
 573         my $query        = "SELECT borrowernumber,reservedate,itemnumber,waitingdate
 574         FROM   reserves
 575         WHERE   priority='0'
 576             AND cancellationdate IS NULL
 577             AND found='W' ";
 578     if ($frombranch){
 579         $query .= " AND branchcode=? ";
 580         }
 581     $query .= "ORDER BY waitingdate" ;
 582     my $sth = $dbh->prepare($query);
 583     if ($frombranch){
 584                 $sth->execute($frombranch);
 585         }
 586     else {
 587                 $sth->execute();
 588         }
 589     my @transreserv;
 590     my $i = 0;
 591     while ( my $data = $sth->fetchrow_hashref ) {
 592         $transreserv[$i] = $data;
 593         $i++;
 594     }
 595     $sth->finish;
 596     return (@transreserv);
 597 }
 598
 599 =item CheckReserves
 600
 601   ($status, $reserve) = &CheckReserves($itemnumber);
 602
 603 Find a book in the reserves.
 604
 605 C<$itemnumber> is the book's item number.
 606
 607 As I understand it, C<&CheckReserves> looks for the given item in the
 608 reserves. If it is found, that's a match, and C<$status> is set to
 609 C<Waiting>.
 610
 611 Otherwise, it finds the most important item in the reserves with the
 612 same biblio number as this book (I'm not clear on this) and returns it
 613 with C<$status> set to C<Reserved>.
 614
 615 C<&CheckReserves> returns a two-element list:
 616
 617 C<$status> is either C<Waiting>, C<Reserved> (see above), or 0.
 618
 619 C<$reserve> is the reserve item that matched. It is a
 620 reference-to-hash whose keys are mostly the fields of the reserves
 621 table in the Koha database.
 622
 623 =cut
 624
 625 sub CheckReserves {
 626     my ( $item, $barcode ) = @_;
 627     my $dbh = C4::Context->dbh;
 628     my $sth;
 629     if ($item) {
 630         my $qitem = $dbh->quote($item);
 631         # Look up the item by itemnumber
 632         my $query = "
 633             SELECT items.biblionumber, items.biblioitemnumber, itemtypes.notforloan
 634             FROM   items
 635             LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 636             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
 637             WHERE  itemnumber=$qitem
 638         ";
 639         $sth = $dbh->prepare($query);
 640     }
 641     else {
 642         my $qbc = $dbh->quote($barcode);
 643         # Look up the item by barcode
 644         my $query = "
 645             SELECT items.biblionumber, items.biblioitemnumber, itemtypes.notforloan
 646             FROM   items
 647             LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 648             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
 649             WHERE  items.biblioitemnumber = biblioitems.biblioitemnumber
 650               AND biblioitems.itemtype = itemtypes.itemtype
 651               AND barcode=$qbc
 652         ";
 653         $sth = $dbh->prepare($query);
 654
 655         # FIXME - This function uses $item later on. Ought to set it here.
 656     }
 657     $sth->execute;
 658     my ( $biblio, $bibitem, $notforloan ) = $sth->fetchrow_array;
 659     $sth->finish;
 660
 661     # if item is not for loan it cannot be reserved either.....
 662     return ( 0, 0 ) if $notforloan;
 663
 664     # get the reserves...
 665     # Find this item in the reserves
 666     my @reserves = _Findgroupreserve( $bibitem, $biblio );
 667     my $count    = scalar @reserves;
 668
 669     # $priority and $highest are used to find the most important item
 670     # in the list returned by &_Findgroupreserve. (The lower $priority,
 671     # the more important the item.)
 672     # $highest is the most important item we've seen so far.
 673     my $priority = 10000000;
 674     my $highest;
 675     if ($count) {
 676         foreach my $res (@reserves) {
 677             # FIXME - $item might be undefined or empty: the caller
 678             # might be searching by barcode.
 679             if ( $res->{'itemnumber'} == $item ) {
 680                 # Found it
 681                 return ( "Waiting", $res );
 682             }
 683             else {
 684                 # See if this item is more important than what we've got
 685                 # so far.
 686                 if ( $res->{'priority'} != 0 && $res->{'priority'} < $priority )
 687                 {
 688                     $priority = $res->{'priority'};
 689                     $highest  = $res;
 690                 }
 691             }
 692         }
 693     }
 694
 695     # If we get this far, then no exact match was found. Print the
 696     # most important item on the list. I think this tells us who's
 697     # next in line to get this book.
 698     if ($highest) {    # FIXME - $highest might be undefined
 699         $highest->{'itemnumber'} = $item;
 700         return ( "Reserved", $highest );
 701     }
 702     else {
 703         return ( 0, 0 );
 704     }
 705 }
 706
 707 =item CancelReserve
 708
 709   &CancelReserve($biblionumber, $itemnumber, $borrowernumber);
 710
 711 Cancels a reserve.
 712
 713 Use either C<$biblionumber> or C<$itemnumber> to specify the item to
 714 cancel, but not both: if both are given, C<&CancelReserve> does
 715 nothing.
 716
 717 C<$borrowernumber> is the borrower number of the patron on whose
 718 behalf the book was reserved.
 719
 720 If C<$biblionumber> was given, C<&CancelReserve> also adjusts the
 721 priorities of the other people who are waiting on the book.
 722
 723 =cut
 724
 725 sub CancelReserve {
 726     my ( $biblio, $item, $borr ) = @_;
 727     my $dbh = C4::Context->dbh;
 728         if ( $item and $borr ) {
 729         # removing a waiting reserve record....
 730         # update the database...
 731         my $query = "
 732             UPDATE reserves
 733             SET    cancellationdate = now(),
 734                    found            = Null,
 735                    priority         = 0
 736             WHERE  itemnumber       = ?
 737              AND   borrowernumber   = ?
 738         ";
 739         my $sth = $dbh->prepare($query);
 740         $sth->execute( $item, $borr );
 741         $sth->finish;
 742     }
 743     else {
 744         # removing a reserve record....
 745         # get the prioritiy on this record....
 746         my $priority;
 747         my $query = qq/
 748             SELECT priority FROM reserves
 749             WHERE biblionumber   = ?
 750               AND borrowernumber = ?
 751               AND cancellationdate IS NULL
 752               AND itemnumber IS NULL
 753               AND (found <> 'F' OR found IS NULL)
 754         /;
 755         my $sth = $dbh->prepare($query);
 756         $sth->execute( $biblio, $borr );
 757         ($priority) = $sth->fetchrow_array;
 758         $sth->finish;
 759         $query = qq/
 760             UPDATE reserves
 761             SET    cancellationdate = now(),
 762                    found            = Null,
 763                    priority         = 0
 764             WHERE  biblionumber     = ?
 765               AND  borrowernumber   = ?
 766               AND cancellationdate IS NULL
 767               AND (found <> 'F' or found IS NULL)
 768         /;
 769
 770         # update the database, removing the record...
 771         $sth = $dbh->prepare($query);
 772         $sth->execute( $biblio, $borr );
 773         $sth->finish;
 774
 775         # now fix the priority on the others....
 776         _FixPriority( $priority, $biblio );
 777     }
 778 }
 779
 780 =item ModReserve
 781
 782 &ModReserve($rank,$biblio,$borrower,$branch)
 783
 784 =cut
 785
 786 sub ModReserve {
 787     #subroutine to update a reserve
 788     my ( $rank, $biblio, $borrower, $branch , $itemnumber) = @_;
 789      return if $rank eq "W";
 790      return if $rank eq "n";
 791     my $dbh = C4::Context->dbh;
 792     if ( $rank eq "del" ) {
 793         my $query = qq/
 794             UPDATE reserves
 795             SET    cancellationdate=now()
 796             WHERE  biblionumber   = ?
 797              AND   borrowernumber = ?
 798              AND   cancellationdate is NULL
 799              AND   (found <> 'F' or found is NULL)
 800         /;
 801         my $sth = $dbh->prepare($query);
 802         $sth->execute( $biblio, $borrower );
 803         $sth->finish;
 804
 805     }
 806     else {
 807         my $query = qq/
 808         UPDATE reserves SET priority = ? ,branchcode = ?, itemnumber = ?, found = NULL
 809             WHERE biblionumber   = ?
 810              AND borrowernumber = ?
 811              AND cancellationdate is NULL
 812              AND (found <> 'F' or found is NULL)
 813         /;
 814         my $sth = $dbh->prepare($query);
 815         $sth->execute( $rank, $branch,$itemnumber, $biblio, $borrower);
 816         $sth->finish;
 817         _FixPriority( $biblio, $borrower, $rank);
 818     }
 819 }
 820
 821 =item ModReserveFill
 822
 823   &ModReserveFill($reserve);
 824
 825 Fill a reserve. If I understand this correctly, this means that the
 826 reserved book has been found and given to the patron who reserved it.
 827
 828 C<$reserve> specifies the reserve to fill. It is a reference-to-hash
 829 whose keys are fields from the reserves table in the Koha database.
 830
 831 =cut
 832
 833 sub ModReserveFill {
 834     my ($res) = @_;
 835     my $dbh = C4::Context->dbh;
 836     # fill in a reserve record....
 837     my $biblionumber = $res->{'biblionumber'};
 838     my $borrowernumber    = $res->{'borrowernumber'};
 839     my $resdate = $res->{'reservedate'};
 840
 841     # get the priority on this record....
 842     my $priority;
 843     my $query = "SELECT priority
 844                  FROM   reserves
 845                  WHERE  biblionumber   = ?
 846                   AND   borrowernumber = ?
 847                   AND   reservedate    = ?";
 848     my $sth = $dbh->prepare($query);
 849     $sth->execute( $biblionumber, $borrowernumber, $resdate );
 850     ($priority) = $sth->fetchrow_array;
 851     $sth->finish;
 852
 853     # update the database...
 854     $query = "UPDATE reserves
 855                   SET    found            = 'F',
 856                          priority         = 0
 857                  WHERE  biblionumber     = ?
 858                     AND reservedate      = ?
 859                     AND borrowernumber   = ?
 860                 ";
 861     $sth = $dbh->prepare($query);
 862     $sth->execute( $biblionumber, $resdate, $borrowernumber );
 863     $sth->finish;
 864
 865     # now fix the priority on the others (if the priority wasn't
 866     # already sorted!)....
 867     unless ( $priority == 0 ) {
 868         _FixPriority( $priority, $biblionumber );
 869     }
 870 }
 871
 872 =item ModReserveStatus
 873
 874 &ModReserveStatus($itemnumber, $newstatus);
 875
 876 Update the reserve status for the active (priority=0) reserve.
 877
 878 $itemnumber is the itemnumber the reserve is on
 879
 880 $newstatus is the new status.
 881
 882 =cut
 883
 884 sub ModReserveStatus {
 885
 886     #first : check if we have a reservation for this item .
 887     my ($itemnumber, $newstatus) = @_;
 888     my $dbh          = C4::Context->dbh;
 889     my $query = " UPDATE reserves
 890     SET    found=?,waitingdate = now()
 891     WHERE itemnumber=?
 892       AND found IS NULL
 893       AND priority = 0
 894     ";
 895     my $sth_set = $dbh->prepare($query);
 896     $sth_set->execute( $newstatus, $itemnumber );
 897     $sth_set->finish;
 898 }
 899
 900 =item ModReserveAffect
 901
 902 &ModReserveAffect($itemnumber,$borrowernumber,$diffBranchSend);
 903
 904 This function affect an item and a status for a given reserve
 905 The itemnumber parameter is used to find the biblionumber.
 906 with the biblionumber & the borrowernumber, we can affect the itemnumber
 907 to the correct reserve.
 908
 909 if $transferToDo is not set, then the status is set to "Waiting" as well.
 910 otherwise, a transfer is on the way, and the end of the transfer will
 911 take care of the waiting status
 912 =cut
 913
 914 sub ModReserveAffect {
 915     my ( $itemnumber, $borrowernumber,$transferToDo ) = @_;
 916     my $dbh = C4::Context->dbh;
 917
 918     # we want to attach $itemnumber to $borrowernumber, find the biblionumber
 919     # attached to $itemnumber
 920     my $sth = $dbh->prepare("SELECT biblionumber FROM items WHERE itemnumber=?");
 921     $sth->execute($itemnumber);
 922     my ($biblionumber) = $sth->fetchrow;
 923     # If we affect a reserve that has to be transfered, don't set to Waiting
 924     my $query;
 925     if ($transferToDo) {
 926     $query = "
 927         UPDATE reserves
 928         SET    priority = 0,
 929                itemnumber = ?
 930         WHERE borrowernumber = ?
 931           AND biblionumber = ?
 932           AND reserves.cancellationdate IS NULL
 933           AND (reserves.found <> 'F' OR reserves.found IS NULL)
 934     ";
 935     }
 936     else {
 937     # affect the reserve to Waiting as well.
 938     $query = "
 939         UPDATE reserves
 940         SET     priority = 0,
 941                 found = 'W',
 942                 waitingdate=now(),
 943                 itemnumber = ?
 944         WHERE borrowernumber = ?
 945           AND biblionumber = ?
 946           AND reserves.cancellationdate IS NULL
 947           AND (reserves.found <> 'F' OR reserves.found IS NULL)
 948     ";
 949     }
 950     $sth = $dbh->prepare($query);
 951     $sth->execute( $itemnumber, $borrowernumber,$biblionumber);
 952     $sth->finish;
 953     return;
 954 }
 955
 956 =item ModReserveCancelAll
 957
 958 ($messages,$nextreservinfo) = &ModReserveCancelAll($itemnumber,$borrowernumber);
 959
 960     function to cancel reserv,check other reserves, and transfer document if it's necessary
 961
 962 =cut
 963
 964 sub ModReserveCancelAll {
 965     my $messages;
 966     my $nextreservinfo;
 967     my ( $itemnumber, $borrowernumber ) = @_;
 968
 969     #step 1 : cancel the reservation
 970     my $CancelReserve = CancelReserve( undef, $itemnumber, $borrowernumber );
 971
 972     #step 2 launch the subroutine of the others reserves
 973     ( $messages, $nextreservinfo ) = GetOtherReserves($itemnumber);
 974
 975     return ( $messages, $nextreservinfo );
 976 }
 977
 978 =item ModReserveMinusPriority
 979
 980 &ModReserveMinusPriority($itemnumber,$borrowernumber,$biblionumber)
 981
 982 Reduce the values of queuded list
 983
 984 =cut
 985
 986 sub ModReserveMinusPriority {
 987     my ( $itemnumber, $borrowernumber, $biblionumber ) = @_;
 988
 989     #first step update the value of the first person on reserv
 990     my $dbh   = C4::Context->dbh;
 991     my $query = "
 992         UPDATE reserves
 993         SET    priority = 0 , itemnumber = ?
 994         WHERE  cancellationdate IS NULL
 995           AND  borrowernumber=?
 996           AND  biblionumber=?
 997     ";
 998     my $sth_upd = $dbh->prepare($query);
 999     $sth_upd->execute( $itemnumber, $borrowernumber, $biblionumber );
1000     $sth_upd->finish;
1001     # second step update all others reservs
1002     $query = "
1003             UPDATE reserves
1004             SET    priority = priority-1
1005             WHERE  biblionumber = ?
1006             AND priority > 0
1007             AND cancellationdate IS NULL
1008     ";
1009     $sth_upd = $dbh->prepare($query);
1010     $sth_upd->execute( $biblionumber );
1011     $sth_upd->finish;
1012     $sth_upd->finish;
1013 }
1014
1015 =item _FixPriority
1016
1017 &_FixPriority($biblio,$borrowernumber,$rank);
1018
1019  Only used internally (so don't export it)
1020  Changed how this functions works #
1021  Now just gets an array of reserves in the rank order and updates them with
1022  the array index (+1 as array starts from 0)
1023  and if $rank is supplied will splice item from the array and splice it back in again
1024  in new priority rank
1025
1026 =cut
1027
1028 sub _FixPriority {
1029     my ( $biblio, $borrowernumber, $rank ) = @_;
1030     my $dbh = C4::Context->dbh;
1031      if ( $rank eq "del" ) {
1032          CancelReserve( $biblio, undef, $borrowernumber );
1033      }
1034     if ( $rank eq "W" || $rank eq "0" ) {
1035
1036         # make sure priority for waiting items is 0
1037         my $query = qq/
1038             UPDATE reserves
1039             SET    priority = 0
1040             WHERE biblionumber = ?
1041               AND borrowernumber = ?
1042               AND cancellationdate IS NULL
1043               AND found ='W'
1044         /;
1045         my $sth = $dbh->prepare($query);
1046         $sth->execute( $biblio, $borrowernumber );
1047     }
1048     my @priority;
1049     my @reservedates;
1050
1051     # get whats left
1052 # FIXME adding a new security in returned elements for changing priority,
1053 # now, we don't care anymore any reservations with itemnumber linked (suppose a waiting reserve)
1054         # This is wrong a waiting reserve has W set
1055         # The assumption that having an itemnumber set means waiting is wrong and should be corrected any place it occurs
1056     my $query = qq/
1057         SELECT borrowernumber, reservedate, constrainttype
1058         FROM   reserves
1059         WHERE  biblionumber   = ?
1060           AND  cancellationdate IS NULL
1061           AND  ((found <> 'F' and found <> 'W') or found is NULL)
1062         ORDER BY priority ASC
1063     /;
1064     my $sth = $dbh->prepare($query);
1065     $sth->execute($biblio);
1066     while ( my $line = $sth->fetchrow_hashref ) {
1067         push( @reservedates, $line );
1068         push( @priority,     $line );
1069     }
1070
1071     # To find the matching index
1072     my $i;
1073     my $key = -1;    # to allow for 0 to be a valid result
1074     for ( $i = 0 ; $i < @priority ; $i++ ) {
1075         if ( $borrowernumber == $priority[$i]->{'borrowernumber'} ) {
1076             $key = $i;    # save the index
1077             last;
1078         }
1079     }
1080
1081     # if index exists in array then move it to new position
1082     if ( $key > -1 && $rank ne 'del' && $rank > 0 ) {
1083         my $new_rank = $rank -
1084           1;    # $new_rank is what you want the new index to be in the array
1085         my $moving_item = splice( @priority, $key, 1 );
1086         splice( @priority, $new_rank, 0, $moving_item );
1087     }
1088
1089     # now fix the priority on those that are left....
1090     $query = "
1091             UPDATE reserves
1092             SET    priority = ?
1093                 WHERE  biblionumber = ?
1094                  AND borrowernumber   = ?
1095                  AND reservedate = ?
1096          AND found IS NULL
1097     ";
1098     $sth = $dbh->prepare($query);
1099     for ( my $j = 0 ; $j < @priority ; $j++ ) {
1100         $sth->execute(
1101             $j + 1, $biblio,
1102             $priority[$j]->{'borrowernumber'},
1103             $priority[$j]->{'reservedate'}
1104         );
1105         $sth->finish;
1106     }
1107 }
1108
1109 =item _Findgroupreserve
1110
1111   @results = &_Findgroupreserve($biblioitemnumber, $biblionumber);
1112
1113 ****** FIXME ******
1114 I don't know what this does, because I don't understand how reserve
1115 constraints work. I think the idea is that you reserve a particular
1116 biblio, and the constraint allows you to restrict it to a given
1117 biblioitem (e.g., if you want to borrow the audio book edition of "The
1118 Prophet", rather than the first available publication).
1119
1120 C<&_Findgroupreserve> returns :
1121 C<@results> is an array of references-to-hash whose keys are mostly
1122 fields from the reserves table of the Koha database, plus
1123 C<biblioitemnumber>.
1124
1125 =cut
1126
1127 sub _Findgroupreserve {
1128     my ( $bibitem, $biblio ) = @_;
1129     my $dbh   = C4::Context->dbh;
1130     my $query = qq/
1131         SELECT reserves.biblionumber AS biblionumber,
1132                reserves.borrowernumber AS borrowernumber,
1133                reserves.reservedate AS reservedate,
1134                reserves.branchcode AS branchcode,
1135                reserves.cancellationdate AS cancellationdate,
1136                reserves.found AS found,
1137                reserves.reservenotes AS reservenotes,
1138                reserves.priority AS priority,
1139                reserves.timestamp AS timestamp,
1140                reserveconstraints.biblioitemnumber AS biblioitemnumber,
1141                reserves.itemnumber AS itemnumber
1142         FROM reserves
1143           LEFT JOIN reserveconstraints ON reserves.biblionumber = reserveconstraints.biblionumber
1144         WHERE reserves.biblionumber = ?
1145           AND ( ( reserveconstraints.biblioitemnumber = ?
1146           AND reserves.borrowernumber = reserveconstraints.borrowernumber
1147           AND reserves.reservedate    =reserveconstraints.reservedate )
1148           OR  reserves.constrainttype='a' )
1149           AND reserves.cancellationdate is NULL
1150           AND (reserves.found <> 'F' or reserves.found is NULL)
1151     /;
1152     my $sth = $dbh->prepare($query);
1153     $sth->execute( $biblio, $bibitem );
1154     my @results;
1155     while ( my $data = $sth->fetchrow_hashref ) {
1156         push( @results, $data );
1157     }
1158     $sth->finish;
1159     return @results;
1160 }
1161
1162 =back
1163
1164 =head1 AUTHOR
1165
1166 Koha Developement team <info@koha.org>
1167
1168 =cut
1169