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