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