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