C4/Reserves.pm

   1 package C4::Reserves;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #           2006 SAN Ouest Provence
   5 #           2007-2010 BibLibre Paul POULAIN
   6 #           2011 Catalyst IT
   7 #
   8 # This file is part of Koha.
   9 #
  10 # Koha is free software; you can redistribute it and/or modify it
  11 # under the terms of the GNU General Public License as published by
  12 # the Free Software Foundation; either version 3 of the License, or
  13 # (at your option) any later version.
  14 #
  15 # Koha is distributed in the hope that it will be useful, but
  16 # WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  18 # GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License
  21 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  22
  23
  24 use strict;
  25 #use warnings; FIXME - Bug 2505
  26 use C4::Context;
  27 use C4::Biblio;
  28 use C4::Members;
  29 use C4::Items;
  30 use C4::Circulation;
  31 use C4::Accounts;
  32
  33 # for _koha_notify_reserve
  34 use C4::Members::Messaging;
  35 use C4::Members qw();
  36 use C4::Letters;
  37 use C4::Log;
  38
  39 use Koha::DateUtils;
  40 use Koha::Calendar;
  41 use Koha::Database;
  42 use Koha::Hold;
  43 use Koha::Holds;
  44 use Koha::Libraries;
  45 use Koha::Items;
  46 use Koha::ItemTypes;
  47 use Koha::Patrons;
  48
  49 use List::MoreUtils qw( firstidx any );
  50 use Carp;
  51 use Data::Dumper;
  52
  53 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  54
  55 =head1 NAME
  56
  57 C4::Reserves - Koha functions for dealing with reservation.
  58
  59 =head1 SYNOPSIS
  60
  61   use C4::Reserves;
  62
  63 =head1 DESCRIPTION
  64
  65 This modules provides somes functions to deal with reservations.
  66
  67   Reserves are stored in reserves table.
  68   The following columns contains important values :
  69   - priority >0      : then the reserve is at 1st stage, and not yet affected to any item.
  70              =0      : then the reserve is being dealed
  71   - found : NULL       : means the patron requested the 1st available, and we haven't chosen the item
  72             T(ransit)  : the reserve is linked to an item but is in transit to the pickup branch
  73             W(aiting)  : the reserve is linked to an item, is at the pickup branch, and is waiting on the hold shelf
  74             F(inished) : the reserve has been completed, and is done
  75   - itemnumber : empty : the reserve is still unaffected to an item
  76                  filled: the reserve is attached to an item
  77   The complete workflow is :
  78   ==== 1st use case ====
  79   patron request a document, 1st available :                      P >0, F=NULL, I=NULL
  80   a library having it run "transfertodo", and clic on the list
  81          if there is no transfer to do, the reserve waiting
  82          patron can pick it up                                    P =0, F=W,    I=filled
  83          if there is a transfer to do, write in branchtransfer    P =0, F=T,    I=filled
  84            The pickup library receive the book, it check in       P =0, F=W,    I=filled
  85   The patron borrow the book                                      P =0, F=F,    I=filled
  86
  87   ==== 2nd use case ====
  88   patron requests a document, a given item,
  89     If pickup is holding branch                                   P =0, F=W,   I=filled
  90     If transfer needed, write in branchtransfer                   P =0, F=T,    I=filled
  91         The pickup library receive the book, it checks it in      P =0, F=W,    I=filled
  92   The patron borrow the book                                      P =0, F=F,    I=filled
  93
  94 =head1 FUNCTIONS
  95
  96 =cut
  97
  98 BEGIN {
  99     require Exporter;
 100     @ISA = qw(Exporter);
 101     @EXPORT = qw(
 102         &AddReserve
 103
 104         &GetReserve
 105         &GetReservesFromItemnumber
 106         &GetReservesFromBiblionumber
 107         &GetReservesFromBorrowernumber
 108         &GetReservesForBranch
 109         &GetReservesToBranch
 110         &GetReserveCount
 111         &GetReserveInfo
 112         &GetReserveStatus
 113
 114         &GetOtherReserves
 115
 116         &ModReserveFill
 117         &ModReserveAffect
 118         &ModReserve
 119         &ModReserveStatus
 120         &ModReserveCancelAll
 121         &ModReserveMinusPriority
 122         &MoveReserve
 123
 124         &CheckReserves
 125         &CanBookBeReserved
 126         &CanItemBeReserved
 127         &CanReserveBeCanceledFromOpac
 128         &CancelReserve
 129         &CancelExpiredReserves
 130
 131         &AutoUnsuspendReserves
 132
 133         &IsAvailableForItemLevelRequest
 134
 135         &OPACItemHoldsAllowed
 136
 137         &AlterPriority
 138         &ToggleLowestPriority
 139
 140         &ReserveSlip
 141         &ToggleSuspend
 142         &SuspendAll
 143
 144         &GetReservesControlBranch
 145
 146         IsItemOnHoldAndFound
 147
 148         GetMaxPatronHoldsForRecord
 149     );
 150     @EXPORT_OK = qw( MergeHolds );
 151 }
 152
 153 =head2 AddReserve
 154
 155     AddReserve($branch,$borrowernumber,$biblionumber,$bibitems,$priority,$resdate,$expdate,$notes,$title,$checkitem,$found)
 156
 157 Adds reserve and generates HOLDPLACED message.
 158
 159 The following tables are available witin the HOLDPLACED message:
 160
 161     branches
 162     borrowers
 163     biblio
 164     biblioitems
 165     items
 166
 167 =cut
 168
 169 sub AddReserve {
 170     my (
 171         $branch,   $borrowernumber, $biblionumber, $bibitems,
 172         $priority, $resdate,        $expdate,      $notes,
 173         $title,    $checkitem,      $found,        $itemtype
 174     ) = @_;
 175
 176     my $dbh = C4::Context->dbh;
 177
 178     $resdate = output_pref( { str => dt_from_string( $resdate ), dateonly => 1, dateformat => 'iso' })
 179         or output_pref({ dt => dt_from_string, dateonly => 1, dateformat => 'iso' });
 180
 181     $expdate = output_pref({ str => $expdate, dateonly => 1, dateformat => 'iso' });
 182
 183     if ( C4::Context->preference('AllowHoldDateInFuture') ) {
 184
 185         # Make room in reserves for this before those of a later reserve date
 186         $priority = _ShiftPriorityByDateAndPriority( $biblionumber, $resdate, $priority );
 187     }
 188
 189     my $waitingdate;
 190
 191     # If the reserv had the waiting status, we had the value of the resdate
 192     if ( $found eq 'W' ) {
 193         $waitingdate = $resdate;
 194     }
 195
 196     # Don't add itemtype limit if specific item is selected
 197     $itemtype = undef if $checkitem;
 198
 199     # updates take place here
 200     my $hold = Koha::Hold->new(
 201         {
 202             borrowernumber => $borrowernumber,
 203             biblionumber   => $biblionumber,
 204             reservedate    => $resdate,
 205             branchcode     => $branch,
 206             priority       => $priority,
 207             reservenotes   => $notes,
 208             itemnumber     => $checkitem,
 209             found          => $found,
 210             waitingdate    => $waitingdate,
 211             expirationdate => $expdate,
 212             itemtype       => $itemtype,
 213         }
 214     )->store();
 215
 216     logaction( 'HOLDS', 'CREATE', $hold->id, Dumper($hold->unblessed) )
 217         if C4::Context->preference('HoldsLog');
 218
 219     my $reserve_id = $hold->id();
 220
 221     # add a reserve fee if needed
 222     my $fee = GetReserveFee( $borrowernumber, $biblionumber );
 223     ChargeReserveFee( $borrowernumber, $fee, $title );
 224
 225     _FixPriority({ biblionumber => $biblionumber});
 226
 227     # Send e-mail to librarian if syspref is active
 228     if(C4::Context->preference("emailLibrarianWhenHoldIsPlaced")){
 229         my $borrower = C4::Members::GetMember(borrowernumber => $borrowernumber);
 230         my $library = Koha::Libraries->find($borrower->{branchcode})->unblessed;
 231         if ( my $letter =  C4::Letters::GetPreparedLetter (
 232             module => 'reserves',
 233             letter_code => 'HOLDPLACED',
 234             branchcode => $branch,
 235             tables => {
 236                 'branches'    => $library,
 237                 'borrowers'   => $borrower,
 238                 'biblio'      => $biblionumber,
 239                 'biblioitems' => $biblionumber,
 240                 'items'       => $checkitem,
 241             },
 242         ) ) {
 243
 244             my $admin_email_address = $library->{'branchemail'} || C4::Context->preference('KohaAdminEmailAddress');
 245
 246             C4::Letters::EnqueueLetter(
 247                 {   letter                 => $letter,
 248                     borrowernumber         => $borrowernumber,
 249                     message_transport_type => 'email',
 250                     from_address           => $admin_email_address,
 251                     to_address           => $admin_email_address,
 252                 }
 253             );
 254         }
 255     }
 256
 257     return $reserve_id;
 258 }
 259
 260 =head2 GetReserve
 261
 262     $res = GetReserve( $reserve_id );
 263
 264     Return the current reserve.
 265
 266 =cut
 267
 268 sub GetReserve {
 269     my ($reserve_id) = @_;
 270
 271     my $dbh = C4::Context->dbh;
 272
 273     my $query = "SELECT * FROM reserves WHERE reserve_id = ?";
 274     my $sth = $dbh->prepare( $query );
 275     $sth->execute( $reserve_id );
 276     return $sth->fetchrow_hashref();
 277 }
 278
 279 =head2 GetReservesFromBiblionumber
 280
 281   my $reserves = GetReservesFromBiblionumber({
 282     biblionumber => $biblionumber,
 283     [ itemnumber => $itemnumber, ]
 284     [ all_dates => 1|0 ]
 285   });
 286
 287 This function gets the list of reservations for one C<$biblionumber>,
 288 returning an arrayref pointing to the reserves for C<$biblionumber>.
 289
 290 By default, only reserves whose start date falls before the current
 291 time are returned.  To return all reserves, including future ones,
 292 the C<all_dates> parameter can be included and set to a true value.
 293
 294 If the C<itemnumber> parameter is supplied, reserves must be targeted
 295 to that item or not targeted to any item at all; otherwise, they
 296 are excluded from the list.
 297
 298 =cut
 299
 300 sub GetReservesFromBiblionumber {
 301     my ( $params ) = @_;
 302     my $biblionumber = $params->{biblionumber} or return [];
 303     my $itemnumber = $params->{itemnumber};
 304     my $all_dates = $params->{all_dates} // 0;
 305     my $dbh   = C4::Context->dbh;
 306
 307     # Find the desired items in the reserves
 308     my @params;
 309     my $query = "
 310         SELECT  reserve_id,
 311                 branchcode,
 312                 timestamp AS rtimestamp,
 313                 priority,
 314                 biblionumber,
 315                 borrowernumber,
 316                 reservedate,
 317                 found,
 318                 itemnumber,
 319                 reservenotes,
 320                 expirationdate,
 321                 lowestPriority,
 322                 suspend,
 323                 suspend_until,
 324                 itemtype
 325         FROM     reserves
 326         WHERE biblionumber = ? ";
 327     push( @params, $biblionumber );
 328     unless ( $all_dates ) {
 329         $query .= " AND reservedate <= CAST(NOW() AS DATE) ";
 330     }
 331     if ( $itemnumber ) {
 332         $query .= " AND ( itemnumber IS NULL OR itemnumber = ? )";
 333         push( @params, $itemnumber );
 334     }
 335     $query .= "ORDER BY priority";
 336     my $sth = $dbh->prepare($query);
 337     $sth->execute( @params );
 338     my @results;
 339     while ( my $data = $sth->fetchrow_hashref ) {
 340         push @results, $data;
 341     }
 342     return \@results;
 343 }
 344
 345 =head2 GetReservesFromItemnumber
 346
 347  ( $reservedate, $borrowernumber, $branchcode, $reserve_id, $waitingdate ) = GetReservesFromItemnumber($itemnumber);
 348
 349 Get the first reserve for a specific item number (based on priority). Returns the abovementioned values for that reserve.
 350
 351 The routine does not look at future reserves (read: item level holds), but DOES include future waits (a confirmed future hold).
 352
 353 =cut
 354
 355 sub GetReservesFromItemnumber {
 356     my ($itemnumber) = @_;
 357
 358     my $schema = Koha::Database->new()->schema();
 359
 360     my $r = $schema->resultset('Reserve')->search(
 361         {
 362             itemnumber => $itemnumber,
 363             suspend    => 0,
 364             -or        => [
 365                 reservedate => \'<= CAST( NOW() AS DATE )',
 366                 waitingdate => { '!=', undef }
 367             ]
 368         },
 369         {
 370             order_by => 'priority',
 371         }
 372     )->first();
 373
 374     return unless $r;
 375
 376     return (
 377         $r->reservedate(),
 378         $r->get_column('borrowernumber'),
 379         $r->get_column('branchcode'),
 380         $r->reserve_id(),
 381         $r->waitingdate(),
 382     );
 383 }
 384
 385 =head2 GetReservesFromBorrowernumber
 386
 387     $borrowerreserv = GetReservesFromBorrowernumber($borrowernumber,$tatus);
 388
 389 TODO :: Descritpion
 390
 391 =cut
 392
 393 sub GetReservesFromBorrowernumber {
 394     my ( $borrowernumber, $status ) = @_;
 395     my $dbh   = C4::Context->dbh;
 396     my $sth;
 397     if ($status) {
 398         $sth = $dbh->prepare("
 399             SELECT *
 400             FROM   reserves
 401             WHERE  borrowernumber=?
 402                 AND found =?
 403             ORDER BY reservedate
 404         ");
 405         $sth->execute($borrowernumber,$status);
 406     } else {
 407         $sth = $dbh->prepare("
 408             SELECT *
 409             FROM   reserves
 410             WHERE  borrowernumber=?
 411             ORDER BY reservedate
 412         ");
 413         $sth->execute($borrowernumber);
 414     }
 415     my $data = $sth->fetchall_arrayref({});
 416     return @$data;
 417 }
 418
 419 =head2 CanBookBeReserved
 420
 421   $canReserve = &CanBookBeReserved($borrowernumber, $biblionumber)
 422   if ($canReserve eq 'OK') { #We can reserve this Item! }
 423
 424 See CanItemBeReserved() for possible return values.
 425
 426 =cut
 427
 428 sub CanBookBeReserved{
 429     my ($borrowernumber, $biblionumber) = @_;
 430
 431     my $items = GetItemnumbersForBiblio($biblionumber);
 432     #get items linked via host records
 433     my @hostitems = get_hostitemnumbers_of($biblionumber);
 434     if (@hostitems){
 435     push (@$items,@hostitems);
 436     }
 437
 438     my $canReserve;
 439     foreach my $item (@$items) {
 440         $canReserve = CanItemBeReserved( $borrowernumber, $item );
 441         return 'OK' if $canReserve eq 'OK';
 442     }
 443     return $canReserve;
 444 }
 445
 446 =head2 CanItemBeReserved
 447
 448   $canReserve = &CanItemBeReserved($borrowernumber, $itemnumber)
 449   if ($canReserve eq 'OK') { #We can reserve this Item! }
 450
 451 @RETURNS OK,              if the Item can be reserved.
 452          ageRestricted,   if the Item is age restricted for this borrower.
 453          damaged,         if the Item is damaged.
 454          cannotReserveFromOtherBranches, if syspref 'canreservefromotherbranches' is OK.
 455          tooManyReserves, if the borrower has exceeded his maximum reserve amount.
 456          notReservable,   if holds on this item are not allowed
 457
 458 =cut
 459
 460 sub CanItemBeReserved {
 461     my ( $borrowernumber, $itemnumber ) = @_;
 462
 463     my $dbh = C4::Context->dbh;
 464     my $ruleitemtype;    # itemtype of the matching issuing rule
 465     my $allowedreserves  = 0; # Total number of holds allowed across all records
 466     my $holds_per_record = 1; # Total number of holds allowed for this one given record
 467
 468     # we retrieve borrowers and items informations #
 469     # item->{itype} will come for biblioitems if necessery
 470     my $item       = GetItem($itemnumber);
 471     my $biblioData = C4::Biblio::GetBiblioData( $item->{biblionumber} );
 472     my $borrower   = C4::Members::GetMember( 'borrowernumber' => $borrowernumber );
 473
 474     # If an item is damaged and we don't allow holds on damaged items, we can stop right here
 475     return 'damaged'
 476       if ( $item->{damaged}
 477         && !C4::Context->preference('AllowHoldsOnDamagedItems') );
 478
 479     # Check for the age restriction
 480     my ( $ageRestriction, $daysToAgeRestriction ) =
 481       C4::Circulation::GetAgeRestriction( $biblioData->{agerestriction}, $borrower );
 482     return 'ageRestricted' if $daysToAgeRestriction && $daysToAgeRestriction > 0;
 483
 484     # Check that the patron doesn't have an item level hold on this item already
 485     return 'itemAlreadyOnHold'
 486       if Koha::Holds->search( { borrowernumber => $borrowernumber, itemnumber => $itemnumber } )->count();
 487
 488     my $controlbranch = C4::Context->preference('ReservesControlBranch');
 489
 490     my $querycount = q{
 491         SELECT count(*) AS count
 492           FROM reserves
 493      LEFT JOIN items USING (itemnumber)
 494      LEFT JOIN biblioitems ON (reserves.biblionumber=biblioitems.biblionumber)
 495      LEFT JOIN borrowers USING (borrowernumber)
 496          WHERE borrowernumber = ?
 497     };
 498
 499     my $branchcode  = "";
 500     my $branchfield = "reserves.branchcode";
 501
 502     if ( $controlbranch eq "ItemHomeLibrary" ) {
 503         $branchfield = "items.homebranch";
 504         $branchcode  = $item->{homebranch};
 505     }
 506     elsif ( $controlbranch eq "PatronLibrary" ) {
 507         $branchfield = "borrowers.branchcode";
 508         $branchcode  = $borrower->{branchcode};
 509     }
 510
 511     # we retrieve rights
 512     if ( my $rights = GetHoldRule( $borrower->{'categorycode'}, $item->{'itype'}, $branchcode ) ) {
 513         $ruleitemtype     = $rights->{itemtype};
 514         $allowedreserves  = $rights->{reservesallowed};
 515         $holds_per_record = $rights->{holds_per_record};
 516     }
 517     else {
 518         $ruleitemtype = '*';
 519     }
 520
 521     my $item = Koha::Items->find( $itemnumber );
 522     my $holds = Koha::Holds->search(
 523         {
 524             borrowernumber => $borrowernumber,
 525             biblionumber   => $item->biblionumber,
 526             found          => undef, # Found holds don't count against a patron's holds limit
 527         }
 528     );
 529     if ( $holds->count() >= $holds_per_record ) {
 530         return "tooManyHoldsForThisRecord";
 531     }
 532
 533     # we retrieve count
 534
 535     $querycount .= "AND $branchfield = ?";
 536
 537     # If using item-level itypes, fall back to the record
 538     # level itemtype if the hold has no associated item
 539     $querycount .=
 540       C4::Context->preference('item-level_itypes')
 541       ? " AND COALESCE( items.itype, biblioitems.itemtype ) = ?"
 542       : " AND biblioitems.itemtype = ?"
 543       if ( $ruleitemtype ne "*" );
 544
 545     my $sthcount = $dbh->prepare($querycount);
 546
 547     if ( $ruleitemtype eq "*" ) {
 548         $sthcount->execute( $borrowernumber, $branchcode );
 549     }
 550     else {
 551         $sthcount->execute( $borrowernumber, $branchcode, $ruleitemtype );
 552     }
 553
 554     my $reservecount = "0";
 555     if ( my $rowcount = $sthcount->fetchrow_hashref() ) {
 556         $reservecount = $rowcount->{count};
 557     }
 558
 559     # we check if it's ok or not
 560     if ( $reservecount >= $allowedreserves ) {
 561         return 'tooManyReserves';
 562     }
 563
 564     my $circ_control_branch =
 565       C4::Circulation::_GetCircControlBranch( $item, $borrower );
 566     my $branchitemrule =
 567       C4::Circulation::GetBranchItemRule( $circ_control_branch, $item->{itype} );
 568
 569     if ( $branchitemrule->{holdallowed} == 0 ) {
 570         return 'notReservable';
 571     }
 572
 573     if (   $branchitemrule->{holdallowed} == 1
 574         && $borrower->{branchcode} ne $item->{homebranch} )
 575     {
 576         return 'cannotReserveFromOtherBranches';
 577     }
 578
 579     # If reservecount is ok, we check item branch if IndependentBranches is ON
 580     # and canreservefromotherbranches is OFF
 581     if ( C4::Context->preference('IndependentBranches')
 582         and !C4::Context->preference('canreservefromotherbranches') )
 583     {
 584         my $itembranch = $item->{homebranch};
 585         if ( $itembranch ne $borrower->{branchcode} ) {
 586             return 'cannotReserveFromOtherBranches';
 587         }
 588     }
 589
 590     return 'OK';
 591 }
 592
 593 =head2 CanReserveBeCanceledFromOpac
 594
 595     $number = CanReserveBeCanceledFromOpac($reserve_id, $borrowernumber);
 596
 597     returns 1 if reserve can be cancelled by user from OPAC.
 598     First check if reserve belongs to user, next checks if reserve is not in
 599     transfer or waiting status
 600
 601 =cut
 602
 603 sub CanReserveBeCanceledFromOpac {
 604     my ($reserve_id, $borrowernumber) = @_;
 605
 606     return unless $reserve_id and $borrowernumber;
 607     my $reserve = GetReserve($reserve_id);
 608
 609     return 0 unless $reserve->{borrowernumber} == $borrowernumber;
 610     return 0 if ( $reserve->{found} eq 'W' ) or ( $reserve->{found} eq 'T' );
 611
 612     return 1;
 613
 614 }
 615
 616 =head2 GetReserveCount
 617
 618   $number = &GetReserveCount($borrowernumber);
 619
 620 this function returns the number of reservation for a borrower given on input arg.
 621
 622 =cut
 623
 624 sub GetReserveCount {
 625     my ($borrowernumber) = @_;
 626
 627     my $dbh = C4::Context->dbh;
 628
 629     my $query = "
 630         SELECT COUNT(*) AS counter
 631         FROM reserves
 632         WHERE borrowernumber = ?
 633     ";
 634     my $sth = $dbh->prepare($query);
 635     $sth->execute($borrowernumber);
 636     my $row = $sth->fetchrow_hashref;
 637     return $row->{counter};
 638 }
 639
 640 =head2 GetOtherReserves
 641
 642   ($messages,$nextreservinfo)=$GetOtherReserves(itemnumber);
 643
 644 Check queued list of this document and check if this document must be transferred
 645
 646 =cut
 647
 648 sub GetOtherReserves {
 649     my ($itemnumber) = @_;
 650     my $messages;
 651     my $nextreservinfo;
 652     my ( undef, $checkreserves, undef ) = CheckReserves($itemnumber);
 653     if ($checkreserves) {
 654         my $iteminfo = GetItem($itemnumber);
 655         if ( $iteminfo->{'holdingbranch'} ne $checkreserves->{'branchcode'} ) {
 656             $messages->{'transfert'} = $checkreserves->{'branchcode'};
 657             #minus priorities of others reservs
 658             ModReserveMinusPriority(
 659                 $itemnumber,
 660                 $checkreserves->{'reserve_id'},
 661             );
 662
 663             #launch the subroutine dotransfer
 664             C4::Items::ModItemTransfer(
 665                 $itemnumber,
 666                 $iteminfo->{'holdingbranch'},
 667                 $checkreserves->{'branchcode'}
 668               ),
 669               ;
 670         }
 671
 672      #step 2b : case of a reservation on the same branch, set the waiting status
 673         else {
 674             $messages->{'waiting'} = 1;
 675             ModReserveMinusPriority(
 676                 $itemnumber,
 677                 $checkreserves->{'reserve_id'},
 678             );
 679             ModReserveStatus($itemnumber,'W');
 680         }
 681
 682         $nextreservinfo = $checkreserves->{'borrowernumber'};
 683     }
 684
 685     return ( $messages, $nextreservinfo );
 686 }
 687
 688 =head2 ChargeReserveFee
 689
 690     $fee = ChargeReserveFee( $borrowernumber, $fee, $title );
 691
 692     Charge the fee for a reserve (if $fee > 0)
 693
 694 =cut
 695
 696 sub ChargeReserveFee {
 697     my ( $borrowernumber, $fee, $title ) = @_;
 698     return if !$fee || $fee==0; # the last test is needed to include 0.00
 699     my $accquery = qq{
 700 INSERT INTO accountlines ( borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding ) VALUES (?, ?, NOW(), ?, ?, 'Res', ?)
 701     };
 702     my $dbh = C4::Context->dbh;
 703     my $nextacctno = &getnextacctno( $borrowernumber );
 704     $dbh->do( $accquery, undef, ( $borrowernumber, $nextacctno, $fee, "Reserve Charge - $title", $fee ) );
 705 }
 706
 707 =head2 GetReserveFee
 708
 709     $fee = GetReserveFee( $borrowernumber, $biblionumber );
 710
 711     Calculate the fee for a reserve (if applicable).
 712
 713 =cut
 714
 715 sub GetReserveFee {
 716     my ( $borrowernumber, $biblionumber ) = @_;
 717     my $borquery = qq{
 718 SELECT reservefee FROM borrowers LEFT JOIN categories ON borrowers.categorycode = categories.categorycode WHERE borrowernumber = ?
 719     };
 720     my $issue_qry = qq{
 721 SELECT COUNT(*) FROM items
 722 LEFT JOIN issues USING (itemnumber)
 723 WHERE items.biblionumber=? AND issues.issue_id IS NULL
 724     };
 725     my $holds_qry = qq{
 726 SELECT COUNT(*) FROM reserves WHERE biblionumber=? AND borrowernumber<>?
 727     };
 728
 729     my $dbh = C4::Context->dbh;
 730     my ( $fee ) = $dbh->selectrow_array( $borquery, undef, ($borrowernumber) );
 731     my $hold_fee_mode = C4::Context->preference('HoldFeeMode') || 'not_always';
 732     if( $fee and $fee > 0 and $hold_fee_mode ne 'always' ) {
 733         # This is a reconstruction of the old code:
 734         # Compare number of items with items issued, and optionally check holds
 735         # If not all items are issued and there are no holds: charge no fee
 736         # NOTE: Lost, damaged, not-for-loan, etc. are just ignored here
 737         my ( $notissued, $reserved );
 738         ( $notissued ) = $dbh->selectrow_array( $issue_qry, undef,
 739             ( $biblionumber ) );
 740         if( $notissued ) {
 741             ( $reserved ) = $dbh->selectrow_array( $holds_qry, undef,
 742                 ( $biblionumber, $borrowernumber ) );
 743             $fee = 0 if $reserved == 0;
 744         }
 745     }
 746     return $fee;
 747 }
 748
 749 =head2 GetReservesToBranch
 750
 751   @transreserv = GetReservesToBranch( $frombranch );
 752
 753 Get reserve list for a given branch
 754
 755 =cut
 756
 757 sub GetReservesToBranch {
 758     my ( $frombranch ) = @_;
 759     my $dbh = C4::Context->dbh;
 760     my $sth = $dbh->prepare(
 761         "SELECT reserve_id,borrowernumber,reservedate,itemnumber,timestamp
 762          FROM reserves
 763          WHERE priority='0'
 764            AND branchcode=?"
 765     );
 766     $sth->execute( $frombranch );
 767     my @transreserv;
 768     my $i = 0;
 769     while ( my $data = $sth->fetchrow_hashref ) {
 770         $transreserv[$i] = $data;
 771         $i++;
 772     }
 773     return (@transreserv);
 774 }
 775
 776 =head2 GetReservesForBranch
 777
 778   @transreserv = GetReservesForBranch($frombranch);
 779
 780 =cut
 781
 782 sub GetReservesForBranch {
 783     my ($frombranch) = @_;
 784     my $dbh = C4::Context->dbh;
 785
 786     my $query = "
 787         SELECT reserve_id,borrowernumber,reservedate,itemnumber,waitingdate
 788         FROM   reserves
 789         WHERE   priority='0'
 790         AND found='W'
 791     ";
 792     $query .= " AND branchcode=? " if ( $frombranch );
 793     $query .= "ORDER BY waitingdate" ;
 794
 795     my $sth = $dbh->prepare($query);
 796     if ($frombranch){
 797      $sth->execute($frombranch);
 798     } else {
 799         $sth->execute();
 800     }
 801
 802     my @transreserv;
 803     my $i = 0;
 804     while ( my $data = $sth->fetchrow_hashref ) {
 805         $transreserv[$i] = $data;
 806         $i++;
 807     }
 808     return (@transreserv);
 809 }
 810
 811 =head2 GetReserveStatus
 812
 813   $reservestatus = GetReserveStatus($itemnumber);
 814
 815 Takes an itemnumber and returns the status of the reserve placed on it.
 816 If several reserves exist, the reserve with the lower priority is given.
 817
 818 =cut
 819
 820 ## FIXME: I don't think this does what it thinks it does.
 821 ## It only ever checks the first reserve result, even though
 822 ## multiple reserves for that bib can have the itemnumber set
 823 ## the sub is only used once in the codebase.
 824 sub GetReserveStatus {
 825     my ($itemnumber) = @_;
 826
 827     my $dbh = C4::Context->dbh;
 828
 829     my ($sth, $found, $priority);
 830     if ( $itemnumber ) {
 831         $sth = $dbh->prepare("SELECT found, priority FROM reserves WHERE itemnumber = ? order by priority LIMIT 1");
 832         $sth->execute($itemnumber);
 833         ($found, $priority) = $sth->fetchrow_array;
 834     }
 835
 836     if(defined $found) {
 837         return 'Waiting'  if $found eq 'W' and $priority == 0;
 838         return 'Finished' if $found eq 'F';
 839     }
 840
 841     return 'Reserved' if $priority > 0;
 842
 843     return ''; # empty string here will remove need for checking undef, or less log lines
 844 }
 845
 846 =head2 CheckReserves
 847
 848   ($status, $reserve, $all_reserves) = &CheckReserves($itemnumber);
 849   ($status, $reserve, $all_reserves) = &CheckReserves(undef, $barcode);
 850   ($status, $reserve, $all_reserves) = &CheckReserves($itemnumber,undef,$lookahead);
 851
 852 Find a book in the reserves.
 853
 854 C<$itemnumber> is the book's item number.
 855 C<$lookahead> is the number of days to look in advance for future reserves.
 856
 857 As I understand it, C<&CheckReserves> looks for the given item in the
 858 reserves. If it is found, that's a match, and C<$status> is set to
 859 C<Waiting>.
 860
 861 Otherwise, it finds the most important item in the reserves with the
 862 same biblio number as this book (I'm not clear on this) and returns it
 863 with C<$status> set to C<Reserved>.
 864
 865 C<&CheckReserves> returns a two-element list:
 866
 867 C<$status> is either C<Waiting>, C<Reserved> (see above), or 0.
 868
 869 C<$reserve> is the reserve item that matched. It is a
 870 reference-to-hash whose keys are mostly the fields of the reserves
 871 table in the Koha database.
 872
 873 =cut
 874
 875 sub CheckReserves {
 876     my ( $item, $barcode, $lookahead_days, $ignore_borrowers) = @_;
 877     my $dbh = C4::Context->dbh;
 878     my $sth;
 879     my $select;
 880     if (C4::Context->preference('item-level_itypes')){
 881         $select = "
 882            SELECT items.biblionumber,
 883            items.biblioitemnumber,
 884            itemtypes.notforloan,
 885            items.notforloan AS itemnotforloan,
 886            items.itemnumber,
 887            items.damaged,
 888            items.homebranch,
 889            items.holdingbranch
 890            FROM   items
 891            LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 892            LEFT JOIN itemtypes   ON items.itype   = itemtypes.itemtype
 893         ";
 894     }
 895     else {
 896         $select = "
 897            SELECT items.biblionumber,
 898            items.biblioitemnumber,
 899            itemtypes.notforloan,
 900            items.notforloan AS itemnotforloan,
 901            items.itemnumber,
 902            items.damaged,
 903            items.homebranch,
 904            items.holdingbranch
 905            FROM   items
 906            LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 907            LEFT JOIN itemtypes   ON biblioitems.itemtype   = itemtypes.itemtype
 908         ";
 909     }
 910
 911     if ($item) {
 912         $sth = $dbh->prepare("$select WHERE itemnumber = ?");
 913         $sth->execute($item);
 914     }
 915     else {
 916         $sth = $dbh->prepare("$select WHERE barcode = ?");
 917         $sth->execute($barcode);
 918     }
 919     # note: we get the itemnumber because we might have started w/ just the barcode.  Now we know for sure we have it.
 920     my ( $biblio, $bibitem, $notforloan_per_itemtype, $notforloan_per_item, $itemnumber, $damaged, $item_homebranch, $item_holdingbranch ) = $sth->fetchrow_array;
 921
 922     return if ( $damaged && !C4::Context->preference('AllowHoldsOnDamagedItems') );
 923
 924     return unless $itemnumber; # bail if we got nothing.
 925
 926     # if item is not for loan it cannot be reserved either.....
 927     # except where items.notforloan < 0 :  This indicates the item is holdable.
 928     return if  ( $notforloan_per_item > 0 ) or $notforloan_per_itemtype;
 929
 930     # Find this item in the reserves
 931     my @reserves = _Findgroupreserve( $bibitem, $biblio, $itemnumber, $lookahead_days, $ignore_borrowers);
 932
 933     # $priority and $highest are used to find the most important item
 934     # in the list returned by &_Findgroupreserve. (The lower $priority,
 935     # the more important the item.)
 936     # $highest is the most important item we've seen so far.
 937     my $highest;
 938     if (scalar @reserves) {
 939         my $LocalHoldsPriority = C4::Context->preference('LocalHoldsPriority');
 940         my $LocalHoldsPriorityPatronControl = C4::Context->preference('LocalHoldsPriorityPatronControl');
 941         my $LocalHoldsPriorityItemControl = C4::Context->preference('LocalHoldsPriorityItemControl');
 942
 943         my $priority = 10000000;
 944         foreach my $res (@reserves) {
 945             if ( $res->{'itemnumber'} == $itemnumber && $res->{'priority'} == 0) {
 946                 return ( "Waiting", $res, \@reserves ); # Found it
 947             } else {
 948                 my $borrowerinfo;
 949                 my $iteminfo;
 950                 my $local_hold_match;
 951
 952                 if ($LocalHoldsPriority) {
 953                     $borrowerinfo = C4::Members::GetMember( borrowernumber => $res->{'borrowernumber'} );
 954                     $iteminfo = C4::Items::GetItem($itemnumber);
 955
 956                     my $local_holds_priority_item_branchcode =
 957                       $iteminfo->{$LocalHoldsPriorityItemControl};
 958                     my $local_holds_priority_patron_branchcode =
 959                       ( $LocalHoldsPriorityPatronControl eq 'PickupLibrary' )
 960                       ? $res->{branchcode}
 961                       : ( $LocalHoldsPriorityPatronControl eq 'HomeLibrary' )
 962                       ? $borrowerinfo->{branchcode}
 963                       : undef;
 964                     $local_hold_match =
 965                       $local_holds_priority_item_branchcode eq
 966                       $local_holds_priority_patron_branchcode;
 967                 }
 968
 969                 # See if this item is more important than what we've got so far
 970                 if ( ( $res->{'priority'} && $res->{'priority'} < $priority ) || $local_hold_match ) {
 971                     $iteminfo ||= C4::Items::GetItem($itemnumber);
 972                     next if $res->{itemtype} && $res->{itemtype} ne _get_itype( $iteminfo );
 973                     $borrowerinfo ||= C4::Members::GetMember( borrowernumber => $res->{'borrowernumber'} );
 974                     my $branch = GetReservesControlBranch( $iteminfo, $borrowerinfo );
 975                     my $branchitemrule = C4::Circulation::GetBranchItemRule($branch,$iteminfo->{'itype'});
 976                     next if ($branchitemrule->{'holdallowed'} == 0);
 977                     next if (($branchitemrule->{'holdallowed'} == 1) && ($branch ne $borrowerinfo->{'branchcode'}));
 978                     next if ( ($branchitemrule->{hold_fulfillment_policy} ne 'any') && ($res->{branchcode} ne $iteminfo->{ $branchitemrule->{hold_fulfillment_policy} }) );
 979                     $priority = $res->{'priority'};
 980                     $highest  = $res;
 981                     last if $local_hold_match;
 982                 }
 983             }
 984         }
 985     }
 986
 987     # If we get this far, then no exact match was found.
 988     # We return the most important (i.e. next) reservation.
 989     if ($highest) {
 990         $highest->{'itemnumber'} = $item;
 991         return ( "Reserved", $highest, \@reserves );
 992     }
 993
 994     return ( '' );
 995 }
 996
 997 =head2 CancelExpiredReserves
 998
 999   CancelExpiredReserves();
1000
1001 Cancels all reserves with an expiration date from before today.
1002
1003 =cut
1004
1005 sub CancelExpiredReserves {
1006
1007     # Cancel reserves that have passed their expiration date.
1008     my $dbh = C4::Context->dbh;
1009     my $sth = $dbh->prepare( "
1010         SELECT * FROM reserves WHERE DATE(expirationdate) < DATE( CURDATE() )
1011         AND expirationdate IS NOT NULL
1012         AND found IS NULL
1013     " );
1014     $sth->execute();
1015
1016     while ( my $res = $sth->fetchrow_hashref() ) {
1017         CancelReserve({ reserve_id => $res->{'reserve_id'} });
1018     }
1019
1020     # Cancel reserves that have been waiting too long
1021     if ( C4::Context->preference("ExpireReservesMaxPickUpDelay") ) {
1022         my $max_pickup_delay = C4::Context->preference("ReservesMaxPickUpDelay");
1023         my $cancel_on_holidays = C4::Context->preference('ExpireReservesOnHolidays');
1024
1025         my $today = dt_from_string();
1026
1027         my $query = "SELECT * FROM reserves WHERE TO_DAYS( NOW() ) - TO_DAYS( waitingdate ) > ? AND found = 'W' AND priority = 0";
1028         $sth = $dbh->prepare( $query );
1029         $sth->execute( $max_pickup_delay );
1030
1031         while ( my $res = $sth->fetchrow_hashref ) {
1032             my $do_cancel = 1;
1033             unless ( $cancel_on_holidays ) {
1034                 my $calendar = Koha::Calendar->new( branchcode => $res->{'branchcode'} );
1035                 my $is_holiday = $calendar->is_holiday( $today );
1036
1037                 if ( $is_holiday ) {
1038                     $do_cancel = 0;
1039                 }
1040             }
1041
1042             if ( $do_cancel ) {
1043                 CancelReserve({ reserve_id => $res->{'reserve_id'}, charge_cancel_fee => 1 });
1044             }
1045         }
1046     }
1047
1048 }
1049
1050 =head2 AutoUnsuspendReserves
1051
1052   AutoUnsuspendReserves();
1053
1054 Unsuspends all suspended reserves with a suspend_until date from before today.
1055
1056 =cut
1057
1058 sub AutoUnsuspendReserves {
1059     my $today = dt_from_string();
1060
1061     my @holds = Koha::Holds->search( { suspend_until => { '<' => $today->ymd() } } );
1062
1063     map { $_->suspend(0)->suspend_until(undef)->store() } @holds;
1064 }
1065
1066 =head2 CancelReserve
1067
1068   CancelReserve({ reserve_id => $reserve_id, [ biblionumber => $biblionumber, borrowernumber => $borrrowernumber, itemnumber => $itemnumber, ] [ charge_cancel_fee => 1 ] });
1069
1070 Cancels a reserve. If C<charge_cancel_fee> is passed and the C<ExpireReservesMaxPickUpDelayCharge> syspref is set, charge that fee to the patron's account.
1071
1072 =cut
1073
1074 sub CancelReserve {
1075     my ( $params ) = @_;
1076
1077     my $reserve_id = $params->{'reserve_id'};
1078     # Filter out only the desired keys; this will insert undefined values for elements missing in
1079     # \%params, but GetReserveId filters them out anyway.
1080     $reserve_id = GetReserveId( { biblionumber => $params->{'biblionumber'}, borrowernumber => $params->{'borrowernumber'}, itemnumber => $params->{'itemnumber'} } ) unless ( $reserve_id );
1081
1082     return unless ( $reserve_id );
1083
1084     my $dbh = C4::Context->dbh;
1085
1086     my $reserve = GetReserve( $reserve_id );
1087     if ($reserve) {
1088
1089         my $hold = Koha::Holds->find( $reserve_id );
1090         logaction( 'HOLDS', 'CANCEL', $hold->reserve_id, Dumper($hold->unblessed) )
1091             if C4::Context->preference('HoldsLog');
1092
1093         my $query = "
1094             UPDATE reserves
1095             SET    cancellationdate = now(),
1096                    priority         = 0
1097             WHERE  reserve_id = ?
1098         ";
1099         my $sth = $dbh->prepare($query);
1100         $sth->execute( $reserve_id );
1101
1102         $query = "
1103             INSERT INTO old_reserves
1104             SELECT * FROM reserves
1105             WHERE  reserve_id = ?
1106         ";
1107         $sth = $dbh->prepare($query);
1108         $sth->execute( $reserve_id );
1109
1110         $query = "
1111             DELETE FROM reserves
1112             WHERE  reserve_id = ?
1113         ";
1114         $sth = $dbh->prepare($query);
1115         $sth->execute( $reserve_id );
1116
1117         # now fix the priority on the others....
1118         _FixPriority({ biblionumber => $reserve->{biblionumber} });
1119
1120         # and, if desired, charge a cancel fee
1121         my $charge = C4::Context->preference("ExpireReservesMaxPickUpDelayCharge");
1122         if ( $charge && $params->{'charge_cancel_fee'} ) {
1123             manualinvoice($reserve->{'borrowernumber'}, $reserve->{'itemnumber'}, '', 'HE', $charge);
1124         }
1125     }
1126
1127     return $reserve;
1128 }
1129
1130 =head2 ModReserve
1131
1132   ModReserve({ rank => $rank,
1133                reserve_id => $reserve_id,
1134                branchcode => $branchcode
1135                [, itemnumber => $itemnumber ]
1136                [, biblionumber => $biblionumber, $borrowernumber => $borrowernumber ]
1137               });
1138
1139 Change a hold request's priority or cancel it.
1140
1141 C<$rank> specifies the effect of the change.  If C<$rank>
1142 is 'W' or 'n', nothing happens.  This corresponds to leaving a
1143 request alone when changing its priority in the holds queue
1144 for a bib.
1145
1146 If C<$rank> is 'del', the hold request is cancelled.
1147
1148 If C<$rank> is an integer greater than zero, the priority of
1149 the request is set to that value.  Since priority != 0 means
1150 that the item is not waiting on the hold shelf, setting the
1151 priority to a non-zero value also sets the request's found
1152 status and waiting date to NULL.
1153
1154 The optional C<$itemnumber> parameter is used only when
1155 C<$rank> is a non-zero integer; if supplied, the itemnumber
1156 of the hold request is set accordingly; if omitted, the itemnumber
1157 is cleared.
1158
1159 B<FIXME:> Note that the forgoing can have the effect of causing
1160 item-level hold requests to turn into title-level requests.  This
1161 will be fixed once reserves has separate columns for requested
1162 itemnumber and supplying itemnumber.
1163
1164 =cut
1165
1166 sub ModReserve {
1167     my ( $params ) = @_;
1168
1169     my $rank = $params->{'rank'};
1170     my $reserve_id = $params->{'reserve_id'};
1171     my $branchcode = $params->{'branchcode'};
1172     my $itemnumber = $params->{'itemnumber'};
1173     my $suspend_until = $params->{'suspend_until'};
1174     my $borrowernumber = $params->{'borrowernumber'};
1175     my $biblionumber = $params->{'biblionumber'};
1176
1177     return if $rank eq "W";
1178     return if $rank eq "n";
1179
1180     return unless ( $reserve_id || ( $borrowernumber && ( $biblionumber || $itemnumber ) ) );
1181     $reserve_id = GetReserveId({ biblionumber => $biblionumber, borrowernumber => $borrowernumber, itemnumber => $itemnumber }) unless ( $reserve_id );
1182
1183     my $dbh = C4::Context->dbh;
1184     if ( $rank eq "del" ) {
1185         CancelReserve({ reserve_id => $reserve_id });
1186     }
1187     elsif ($rank =~ /^\d+/ and $rank > 0) {
1188         my $hold = Koha::Holds->find($reserve_id);
1189         logaction( 'HOLDS', 'MODIFY', $hold->reserve_id, Dumper($hold->unblessed) )
1190             if C4::Context->preference('HoldsLog');
1191
1192         $hold->set(
1193             {
1194                 priority    => $rank,
1195                 branchcode  => $branchcode,
1196                 itemnumber  => $itemnumber,
1197                 found       => undef,
1198                 waitingdate => undef
1199             }
1200         )->store();
1201
1202         if ( defined( $suspend_until ) ) {
1203             if ( $suspend_until ) {
1204                 $suspend_until = eval { dt_from_string( $suspend_until ) };
1205                 $hold->suspend_hold( $suspend_until );
1206             } else {
1207                 # If the hold is suspended leave the hold suspended, but convert it to an indefinite hold.
1208                 # If the hold is not suspended, this does nothing.
1209                 $hold->set( { suspend_until => undef } )->store();
1210             }
1211         }
1212
1213         _FixPriority({ reserve_id => $reserve_id, rank =>$rank });
1214     }
1215 }
1216
1217 =head2 ModReserveFill
1218
1219   &ModReserveFill($reserve);
1220
1221 Fill a reserve. If I understand this correctly, this means that the
1222 reserved book has been found and given to the patron who reserved it.
1223
1224 C<$reserve> specifies the reserve to fill. It is a reference-to-hash
1225 whose keys are fields from the reserves table in the Koha database.
1226
1227 =cut
1228
1229 sub ModReserveFill {
1230     my ($res) = @_;
1231     my $dbh = C4::Context->dbh;
1232     # fill in a reserve record....
1233     my $reserve_id = $res->{'reserve_id'};
1234     my $biblionumber = $res->{'biblionumber'};
1235     my $borrowernumber    = $res->{'borrowernumber'};
1236     my $resdate = $res->{'reservedate'};
1237
1238     # get the priority on this record....
1239     my $priority;
1240     my $query = "SELECT priority
1241                  FROM   reserves
1242                  WHERE  biblionumber   = ?
1243                   AND   borrowernumber = ?
1244                   AND   reservedate    = ?";
1245     my $sth = $dbh->prepare($query);
1246     $sth->execute( $biblionumber, $borrowernumber, $resdate );
1247     ($priority) = $sth->fetchrow_array;
1248
1249     # update the database...
1250     $query = "UPDATE reserves
1251                   SET    found            = 'F',
1252                          priority         = 0
1253                  WHERE  biblionumber     = ?
1254                     AND reservedate      = ?
1255                     AND borrowernumber   = ?
1256                 ";
1257     $sth = $dbh->prepare($query);
1258     $sth->execute( $biblionumber, $resdate, $borrowernumber );
1259
1260     # move to old_reserves
1261     $query = "INSERT INTO old_reserves
1262                  SELECT * FROM reserves
1263                  WHERE  biblionumber     = ?
1264                     AND reservedate      = ?
1265                     AND borrowernumber   = ?
1266                 ";
1267     $sth = $dbh->prepare($query);
1268     $sth->execute( $biblionumber, $resdate, $borrowernumber );
1269     $query = "DELETE FROM reserves
1270                  WHERE  biblionumber     = ?
1271                     AND reservedate      = ?
1272                     AND borrowernumber   = ?
1273                 ";
1274     $sth = $dbh->prepare($query);
1275     $sth->execute( $biblionumber, $resdate, $borrowernumber );
1276
1277     # now fix the priority on the others (if the priority wasn't
1278     # already sorted!)....
1279     unless ( $priority == 0 ) {
1280         _FixPriority({ reserve_id => $reserve_id, biblionumber => $biblionumber });
1281     }
1282 }
1283
1284 =head2 ModReserveStatus
1285
1286   &ModReserveStatus($itemnumber, $newstatus);
1287
1288 Update the reserve status for the active (priority=0) reserve.
1289
1290 $itemnumber is the itemnumber the reserve is on
1291
1292 $newstatus is the new status.
1293
1294 =cut
1295
1296 sub ModReserveStatus {
1297
1298     #first : check if we have a reservation for this item .
1299     my ($itemnumber, $newstatus) = @_;
1300     my $dbh = C4::Context->dbh;
1301
1302     my $query = "UPDATE reserves SET found = ?, waitingdate = NOW() WHERE itemnumber = ? AND found IS NULL AND priority = 0";
1303     my $sth_set = $dbh->prepare($query);
1304     $sth_set->execute( $newstatus, $itemnumber );
1305
1306     if ( C4::Context->preference("ReturnToShelvingCart") && $newstatus ) {
1307       CartToShelf( $itemnumber );
1308     }
1309 }
1310
1311 =head2 ModReserveAffect
1312
1313   &ModReserveAffect($itemnumber,$borrowernumber,$diffBranchSend);
1314
1315 This function affect an item and a status for a given reserve
1316 The itemnumber parameter is used to find the biblionumber.
1317 with the biblionumber & the borrowernumber, we can affect the itemnumber
1318 to the correct reserve.
1319
1320 if $transferToDo is not set, then the status is set to "Waiting" as well.
1321 otherwise, a transfer is on the way, and the end of the transfer will
1322 take care of the waiting status
1323
1324 =cut
1325
1326 sub ModReserveAffect {
1327     my ( $itemnumber, $borrowernumber, $transferToDo, $reserve_id ) = @_;
1328     my $dbh = C4::Context->dbh;
1329
1330     # we want to attach $itemnumber to $borrowernumber, find the biblionumber
1331     # attached to $itemnumber
1332     my $sth = $dbh->prepare("SELECT biblionumber FROM items WHERE itemnumber=?");
1333     $sth->execute($itemnumber);
1334     my ($biblionumber) = $sth->fetchrow;
1335
1336     # get request - need to find out if item is already
1337     # waiting in order to not send duplicate hold filled notifications
1338
1339     my $hold;
1340     # Find hold by id if we have it
1341     $hold = Koha::Holds->find( $reserve_id ) if $reserve_id;
1342     # Find item level hold for this item if there is one
1343     $hold ||= Koha::Holds->search( { borrowernumber => $borrowernumber, itemnumber => $itemnumber } )->next();
1344     # Find record level hold if there is no item level hold
1345     $hold ||= Koha::Holds->search( { borrowernumber => $borrowernumber, biblionumber => $biblionumber } )->next();
1346
1347     return unless $hold;
1348
1349     $reserve_id = $hold->id();
1350
1351     my $already_on_shelf = $hold->found && $hold->found eq 'W';
1352
1353     # If we affect a reserve that has to be transferred, don't set to Waiting
1354     my $query;
1355     if ($transferToDo) {
1356         $hold->set(
1357             {
1358                 priority   => 0,
1359                 itemnumber => $itemnumber,
1360                 found      => 'T',
1361             }
1362         );
1363     }
1364     else {
1365         # affect the reserve to Waiting as well.
1366         $hold->set(
1367             {
1368                 priority    => 0,
1369                 itemnumber  => $itemnumber,
1370                 found       => 'W',
1371                 waitingdate => dt_from_string(),
1372             }
1373         );
1374     }
1375     $hold->store();
1376
1377     _koha_notify_reserve( $itemnumber, $borrowernumber, $biblionumber )
1378       if ( !$transferToDo && !$already_on_shelf );
1379
1380     _FixPriority( { biblionumber => $biblionumber } );
1381
1382     if ( C4::Context->preference("ReturnToShelvingCart") ) {
1383         CartToShelf($itemnumber);
1384     }
1385
1386     return;
1387 }
1388
1389 =head2 ModReserveCancelAll
1390
1391   ($messages,$nextreservinfo) = &ModReserveCancelAll($itemnumber,$borrowernumber);
1392
1393 function to cancel reserv,check other reserves, and transfer document if it's necessary
1394
1395 =cut
1396
1397 sub ModReserveCancelAll {
1398     my $messages;
1399     my $nextreservinfo;
1400     my ( $itemnumber, $borrowernumber ) = @_;
1401
1402     #step 1 : cancel the reservation
1403     my $CancelReserve = CancelReserve({ itemnumber => $itemnumber, borrowernumber => $borrowernumber });
1404
1405     #step 2 launch the subroutine of the others reserves
1406     ( $messages, $nextreservinfo ) = GetOtherReserves($itemnumber);
1407
1408     return ( $messages, $nextreservinfo );
1409 }
1410
1411 =head2 ModReserveMinusPriority
1412
1413   &ModReserveMinusPriority($itemnumber,$borrowernumber,$biblionumber)
1414
1415 Reduce the values of queued list
1416
1417 =cut
1418
1419 sub ModReserveMinusPriority {
1420     my ( $itemnumber, $reserve_id ) = @_;
1421
1422     #first step update the value of the first person on reserv
1423     my $dbh   = C4::Context->dbh;
1424     my $query = "
1425         UPDATE reserves
1426         SET    priority = 0 , itemnumber = ?
1427         WHERE  reserve_id = ?
1428     ";
1429     my $sth_upd = $dbh->prepare($query);
1430     $sth_upd->execute( $itemnumber, $reserve_id );
1431     # second step update all others reserves
1432     _FixPriority({ reserve_id => $reserve_id, rank => '0' });
1433 }
1434
1435 =head2 GetReserveInfo
1436
1437   &GetReserveInfo($reserve_id);
1438
1439 Get item and borrower details for a current hold.
1440 Current implementation this query should have a single result.
1441
1442 =cut
1443
1444 sub GetReserveInfo {
1445     my ( $reserve_id ) = @_;
1446     my $dbh = C4::Context->dbh;
1447     my $strsth="SELECT
1448                    reserve_id,
1449                    reservedate,
1450                    reservenotes,
1451                    reserves.borrowernumber,
1452                    reserves.biblionumber,
1453                    reserves.branchcode,
1454                    reserves.waitingdate,
1455                    notificationdate,
1456                    reminderdate,
1457                    priority,
1458                    found,
1459                    firstname,
1460                    surname,
1461                    phone,
1462                    email,
1463                    address,
1464                    address2,
1465                    cardnumber,
1466                    city,
1467                    zipcode,
1468                    biblio.title,
1469                    biblio.author,
1470                    items.holdingbranch,
1471                    items.itemcallnumber,
1472                    items.itemnumber,
1473                    items.location,
1474                    barcode,
1475                    notes
1476                 FROM reserves
1477                 LEFT JOIN items USING(itemnumber)
1478                 LEFT JOIN borrowers USING(borrowernumber)
1479                 LEFT JOIN biblio ON  (reserves.biblionumber=biblio.biblionumber)
1480                 WHERE reserves.reserve_id = ?";
1481     my $sth = $dbh->prepare($strsth);
1482     $sth->execute($reserve_id);
1483
1484     my $data = $sth->fetchrow_hashref;
1485     return $data;
1486 }
1487
1488 =head2 IsAvailableForItemLevelRequest
1489
1490   my $is_available = IsAvailableForItemLevelRequest($item_record,$borrower_record);
1491
1492 Checks whether a given item record is available for an
1493 item-level hold request.  An item is available if
1494
1495 * it is not lost AND
1496 * it is not damaged AND
1497 * it is not withdrawn AND
1498 * does not have a not for loan value > 0
1499
1500 Need to check the issuingrules onshelfholds column,
1501 if this is set items on the shelf can be placed on hold
1502
1503 Note that IsAvailableForItemLevelRequest() does not
1504 check if the staff operator is authorized to place
1505 a request on the item - in particular,
1506 this routine does not check IndependentBranches
1507 and canreservefromotherbranches.
1508
1509 =cut
1510
1511 sub IsAvailableForItemLevelRequest {
1512     my $item = shift;
1513     my $borrower = shift;
1514
1515     my $dbh = C4::Context->dbh;
1516     # must check the notforloan setting of the itemtype
1517     # FIXME - a lot of places in the code do this
1518     #         or something similar - need to be
1519     #         consolidated
1520     my $itype = _get_itype($item);
1521     my $notforloan_per_itemtype
1522       = $dbh->selectrow_array("SELECT notforloan FROM itemtypes WHERE itemtype = ?",
1523                               undef, $itype);
1524
1525     return 0 if
1526         $notforloan_per_itemtype ||
1527         $item->{itemlost}        ||
1528         $item->{notforloan} > 0  ||
1529         $item->{withdrawn}        ||
1530         ($item->{damaged} && !C4::Context->preference('AllowHoldsOnDamagedItems'));
1531
1532     my $on_shelf_holds = _OnShelfHoldsAllowed($itype,$borrower->{categorycode},$item->{holdingbranch});
1533
1534     if ( $on_shelf_holds == 1 ) {
1535         return 1;
1536     } elsif ( $on_shelf_holds == 2 ) {
1537         my @items =
1538           Koha::Items->search( { biblionumber => $item->{biblionumber} } );
1539
1540         my $any_available = 0;
1541
1542         foreach my $i (@items) {
1543             $any_available = 1
1544               unless $i->itemlost
1545               || $i->{notforloan} > 0
1546               || $i->withdrawn
1547               || $i->onloan
1548               || IsItemOnHoldAndFound( $i->id )
1549               || ( $i->damaged
1550                 && !C4::Context->preference('AllowHoldsOnDamagedItems') )
1551               || Koha::ItemTypes->find( $i->effective_itemtype() )->notforloan;
1552         }
1553
1554         return $any_available ? 0 : 1;
1555     }
1556
1557     return $item->{onloan} || GetReserveStatus($item->{itemnumber}) eq "Waiting";
1558 }
1559
1560 =head2 OnShelfHoldsAllowed
1561
1562   OnShelfHoldsAllowed($itemtype,$borrowercategory,$branchcode);
1563
1564 Checks issuingrules, using the borrowers categorycode, the itemtype, and branchcode to see if onshelf
1565 holds are allowed, returns true if so.
1566
1567 =cut
1568
1569 sub OnShelfHoldsAllowed {
1570     my ($item, $borrower) = @_;
1571
1572     my $itype = _get_itype($item);
1573     return _OnShelfHoldsAllowed($itype,$borrower->{categorycode},$item->{holdingbranch});
1574 }
1575
1576 sub _get_itype {
1577     my $item = shift;
1578
1579     my $itype;
1580     if (C4::Context->preference('item-level_itypes')) {
1581         # We can't trust GetItem to honour the syspref, so safest to do it ourselves
1582         # When GetItem is fixed, we can remove this
1583         $itype = $item->{itype};
1584     }
1585     else {
1586         # XXX This is a bit dodgy. It relies on biblio itemtype column having different name.
1587         # So if we already have a biblioitems join when calling this function,
1588         # we don't need to access the database again
1589         $itype = $item->{itemtype};
1590     }
1591     unless ($itype) {
1592         my $dbh = C4::Context->dbh;
1593         my $query = "SELECT itemtype FROM biblioitems WHERE biblioitemnumber = ? ";
1594         my $sth = $dbh->prepare($query);
1595         $sth->execute($item->{biblioitemnumber});
1596         if (my $data = $sth->fetchrow_hashref()){
1597             $itype = $data->{itemtype};
1598         }
1599     }
1600     return $itype;
1601 }
1602
1603 sub _OnShelfHoldsAllowed {
1604     my ($itype,$borrowercategory,$branchcode) = @_;
1605
1606     my $rule = C4::Circulation::GetIssuingRule($borrowercategory, $itype, $branchcode);
1607     return $rule->{onshelfholds};
1608 }
1609
1610 =head2 AlterPriority
1611
1612   AlterPriority( $where, $reserve_id );
1613
1614 This function changes a reserve's priority up, down, to the top, or to the bottom.
1615 Input: $where is 'up', 'down', 'top' or 'bottom'. Biblionumber, Date reserve was placed
1616
1617 =cut
1618
1619 sub AlterPriority {
1620     my ( $where, $reserve_id ) = @_;
1621
1622     my $dbh = C4::Context->dbh;
1623
1624     my $reserve = GetReserve( $reserve_id );
1625
1626     if ( $reserve->{cancellationdate} ) {
1627         warn "I cannot alter the priority for reserve_id $reserve_id, the reserve has been cancelled (".$reserve->{cancellationdate}.')';
1628         return;
1629     }
1630
1631     if ( $where eq 'up' || $where eq 'down' ) {
1632
1633       my $priority = $reserve->{'priority'};
1634       $priority = $where eq 'up' ? $priority - 1 : $priority + 1;
1635       _FixPriority({ reserve_id => $reserve_id, rank => $priority })
1636
1637     } elsif ( $where eq 'top' ) {
1638
1639       _FixPriority({ reserve_id => $reserve_id, rank => '1' })
1640
1641     } elsif ( $where eq 'bottom' ) {
1642
1643       _FixPriority({ reserve_id => $reserve_id, rank => '999999' });
1644
1645     }
1646 }
1647
1648 =head2 ToggleLowestPriority
1649
1650   ToggleLowestPriority( $borrowernumber, $biblionumber );
1651
1652 This function sets the lowestPriority field to true if is false, and false if it is true.
1653
1654 =cut
1655
1656 sub ToggleLowestPriority {
1657     my ( $reserve_id ) = @_;
1658
1659     my $dbh = C4::Context->dbh;
1660
1661     my $sth = $dbh->prepare( "UPDATE reserves SET lowestPriority = NOT lowestPriority WHERE reserve_id = ?");
1662     $sth->execute( $reserve_id );
1663
1664     _FixPriority({ reserve_id => $reserve_id, rank => '999999' });
1665 }
1666
1667 =head2 ToggleSuspend
1668
1669   ToggleSuspend( $reserve_id );
1670
1671 This function sets the suspend field to true if is false, and false if it is true.
1672 If the reserve is currently suspended with a suspend_until date, that date will
1673 be cleared when it is unsuspended.
1674
1675 =cut
1676
1677 sub ToggleSuspend {
1678     my ( $reserve_id, $suspend_until ) = @_;
1679
1680     $suspend_until = dt_from_string($suspend_until) if ($suspend_until);
1681
1682     my $hold = Koha::Holds->find( $reserve_id );
1683
1684     if ( $hold->is_suspended ) {
1685         $hold->resume()
1686     } else {
1687         $hold->suspend_hold( $suspend_until );
1688     }
1689 }
1690
1691 =head2 SuspendAll
1692
1693   SuspendAll(
1694       borrowernumber   => $borrowernumber,
1695       [ biblionumber   => $biblionumber, ]
1696       [ suspend_until  => $suspend_until, ]
1697       [ suspend        => $suspend ]
1698   );
1699
1700   This function accepts a set of hash keys as its parameters.
1701   It requires either borrowernumber or biblionumber, or both.
1702
1703   suspend_until is wholly optional.
1704
1705 =cut
1706
1707 sub SuspendAll {
1708     my %params = @_;
1709
1710     my $borrowernumber = $params{'borrowernumber'} || undef;
1711     my $biblionumber   = $params{'biblionumber'}   || undef;
1712     my $suspend_until  = $params{'suspend_until'}  || undef;
1713     my $suspend = defined( $params{'suspend'} ) ? $params{'suspend'} : 1;
1714
1715     $suspend_until = eval { dt_from_string($suspend_until) }
1716       if ( defined($suspend_until) );
1717
1718     return unless ( $borrowernumber || $biblionumber );
1719
1720     my $params;
1721     $params->{found}          = undef;
1722     $params->{borrowernumber} = $borrowernumber if $borrowernumber;
1723     $params->{biblionumber}   = $biblionumber if $biblionumber;
1724
1725     my @holds = Koha::Holds->search($params);
1726
1727     if ($suspend) {
1728         map { $_->suspend_hold($suspend_until) } @holds;
1729     }
1730     else {
1731         map { $_->resume() } @holds;
1732     }
1733 }
1734
1735
1736 =head2 _FixPriority
1737
1738   _FixPriority({
1739     reserve_id => $reserve_id,
1740     [rank => $rank,]
1741     [ignoreSetLowestRank => $ignoreSetLowestRank]
1742   });
1743
1744   or
1745
1746   _FixPriority({ biblionumber => $biblionumber});
1747
1748 This routine adjusts the priority of a hold request and holds
1749 on the same bib.
1750
1751 In the first form, where a reserve_id is passed, the priority of the
1752 hold is set to supplied rank, and other holds for that bib are adjusted
1753 accordingly.  If the rank is "del", the hold is cancelled.  If no rank
1754 is supplied, all of the holds on that bib have their priority adjusted
1755 as if the second form had been used.
1756
1757 In the second form, where a biblionumber is passed, the holds on that
1758 bib (that are not captured) are sorted in order of increasing priority,
1759 then have reserves.priority set so that the first non-captured hold
1760 has its priority set to 1, the second non-captured hold has its priority
1761 set to 2, and so forth.
1762
1763 In both cases, holds that have the lowestPriority flag on are have their
1764 priority adjusted to ensure that they remain at the end of the line.
1765
1766 Note that the ignoreSetLowestRank parameter is meant to be used only
1767 when _FixPriority calls itself.
1768
1769 =cut
1770
1771 sub _FixPriority {
1772     my ( $params ) = @_;
1773     my $reserve_id = $params->{reserve_id};
1774     my $rank = $params->{rank} // '';
1775     my $ignoreSetLowestRank = $params->{ignoreSetLowestRank};
1776     my $biblionumber = $params->{biblionumber};
1777
1778     my $dbh = C4::Context->dbh;
1779
1780     unless ( $biblionumber ) {
1781         my $res = GetReserve( $reserve_id );
1782         $biblionumber = $res->{biblionumber};
1783     }
1784
1785     if ( $rank eq "del" ) {
1786          CancelReserve({ reserve_id => $reserve_id });
1787     }
1788     elsif ( $rank eq "W" || $rank eq "0" ) {
1789
1790         # make sure priority for waiting or in-transit items is 0
1791         my $query = "
1792             UPDATE reserves
1793             SET    priority = 0
1794             WHERE reserve_id = ?
1795             AND found IN ('W', 'T')
1796         ";
1797         my $sth = $dbh->prepare($query);
1798         $sth->execute( $reserve_id );
1799     }
1800     my @priority;
1801
1802     # get whats left
1803     my $query = "
1804         SELECT reserve_id, borrowernumber, reservedate
1805         FROM   reserves
1806         WHERE  biblionumber   = ?
1807           AND  ((found <> 'W' AND found <> 'T') OR found IS NULL)
1808         ORDER BY priority ASC
1809     ";
1810     my $sth = $dbh->prepare($query);
1811     $sth->execute( $biblionumber );
1812     while ( my $line = $sth->fetchrow_hashref ) {
1813         push( @priority,     $line );
1814     }
1815
1816     # To find the matching index
1817     my $i;
1818     my $key = -1;    # to allow for 0 to be a valid result
1819     for ( $i = 0 ; $i < @priority ; $i++ ) {
1820         if ( $reserve_id == $priority[$i]->{'reserve_id'} ) {
1821             $key = $i;    # save the index
1822             last;
1823         }
1824     }
1825
1826     # if index exists in array then move it to new position
1827     if ( $key > -1 && $rank ne 'del' && $rank > 0 ) {
1828         my $new_rank = $rank -
1829           1;    # $new_rank is what you want the new index to be in the array
1830         my $moving_item = splice( @priority, $key, 1 );
1831         splice( @priority, $new_rank, 0, $moving_item );
1832     }
1833
1834     # now fix the priority on those that are left....
1835     $query = "
1836         UPDATE reserves
1837         SET    priority = ?
1838         WHERE  reserve_id = ?
1839     ";
1840     $sth = $dbh->prepare($query);
1841     for ( my $j = 0 ; $j < @priority ; $j++ ) {
1842         $sth->execute(
1843             $j + 1,
1844             $priority[$j]->{'reserve_id'}
1845         );
1846     }
1847
1848     $sth = $dbh->prepare( "SELECT reserve_id FROM reserves WHERE lowestPriority = 1 ORDER BY priority" );
1849     $sth->execute();
1850
1851     unless ( $ignoreSetLowestRank ) {
1852       while ( my $res = $sth->fetchrow_hashref() ) {
1853         _FixPriority({
1854             reserve_id => $res->{'reserve_id'},
1855             rank => '999999',
1856             ignoreSetLowestRank => 1
1857         });
1858       }
1859     }
1860 }
1861
1862 =head2 _Findgroupreserve
1863
1864   @results = &_Findgroupreserve($biblioitemnumber, $biblionumber, $itemnumber, $lookahead, $ignore_borrowers);
1865
1866 Looks for a holds-queue based item-specific match first, then for a holds-queue title-level match, returning the
1867 first match found.  If neither, then we look for non-holds-queue based holds.
1868 Lookahead is the number of days to look in advance.
1869
1870 C<&_Findgroupreserve> returns :
1871 C<@results> is an array of references-to-hash whose keys are mostly
1872 fields from the reserves table of the Koha database, plus
1873 C<biblioitemnumber>.
1874
1875 =cut
1876
1877 sub _Findgroupreserve {
1878     my ( $bibitem, $biblio, $itemnumber, $lookahead, $ignore_borrowers) = @_;
1879     my $dbh   = C4::Context->dbh;
1880
1881     # TODO: consolidate at least the SELECT portion of the first 2 queries to a common $select var.
1882     # check for exact targeted match
1883     my $item_level_target_query = qq{
1884         SELECT reserves.biblionumber        AS biblionumber,
1885                reserves.borrowernumber      AS borrowernumber,
1886                reserves.reservedate         AS reservedate,
1887                reserves.branchcode          AS branchcode,
1888                reserves.cancellationdate    AS cancellationdate,
1889                reserves.found               AS found,
1890                reserves.reservenotes        AS reservenotes,
1891                reserves.priority            AS priority,
1892                reserves.timestamp           AS timestamp,
1893                biblioitems.biblioitemnumber AS biblioitemnumber,
1894                reserves.itemnumber          AS itemnumber,
1895                reserves.reserve_id          AS reserve_id,
1896                reserves.itemtype            AS itemtype
1897         FROM reserves
1898         JOIN biblioitems USING (biblionumber)
1899         JOIN hold_fill_targets USING (biblionumber, borrowernumber, itemnumber)
1900         WHERE found IS NULL
1901         AND priority > 0
1902         AND item_level_request = 1
1903         AND itemnumber = ?
1904         AND reservedate <= DATE_ADD(NOW(),INTERVAL ? DAY)
1905         AND suspend = 0
1906         ORDER BY priority
1907     };
1908     my $sth = $dbh->prepare($item_level_target_query);
1909     $sth->execute($itemnumber, $lookahead||0);
1910     my @results;
1911     if ( my $data = $sth->fetchrow_hashref ) {
1912         push( @results, $data )
1913           unless any{ $data->{borrowernumber} eq $_ } @$ignore_borrowers ;
1914     }
1915     return @results if @results;
1916
1917     # check for title-level targeted match
1918     my $title_level_target_query = qq{
1919         SELECT reserves.biblionumber        AS biblionumber,
1920                reserves.borrowernumber      AS borrowernumber,
1921                reserves.reservedate         AS reservedate,
1922                reserves.branchcode          AS branchcode,
1923                reserves.cancellationdate    AS cancellationdate,
1924                reserves.found               AS found,
1925                reserves.reservenotes        AS reservenotes,
1926                reserves.priority            AS priority,
1927                reserves.timestamp           AS timestamp,
1928                biblioitems.biblioitemnumber AS biblioitemnumber,
1929                reserves.itemnumber          AS itemnumber,
1930                reserves.reserve_id          AS reserve_id,
1931                reserves.itemtype            AS itemtype
1932         FROM reserves
1933         JOIN biblioitems USING (biblionumber)
1934         JOIN hold_fill_targets USING (biblionumber, borrowernumber)
1935         WHERE found IS NULL
1936         AND priority > 0
1937         AND item_level_request = 0
1938         AND hold_fill_targets.itemnumber = ?
1939         AND reservedate <= DATE_ADD(NOW(),INTERVAL ? DAY)
1940         AND suspend = 0
1941         ORDER BY priority
1942     };
1943     $sth = $dbh->prepare($title_level_target_query);
1944     $sth->execute($itemnumber, $lookahead||0);
1945     @results = ();
1946     if ( my $data = $sth->fetchrow_hashref ) {
1947         push( @results, $data )
1948           unless any{ $data->{borrowernumber} eq $_ } @$ignore_borrowers ;
1949     }
1950     return @results if @results;
1951
1952     my $query = qq{
1953         SELECT reserves.biblionumber               AS biblionumber,
1954                reserves.borrowernumber             AS borrowernumber,
1955                reserves.reservedate                AS reservedate,
1956                reserves.waitingdate                AS waitingdate,
1957                reserves.branchcode                 AS branchcode,
1958                reserves.cancellationdate           AS cancellationdate,
1959                reserves.found                      AS found,
1960                reserves.reservenotes               AS reservenotes,
1961                reserves.priority                   AS priority,
1962                reserves.timestamp                  AS timestamp,
1963                reserves.itemnumber                 AS itemnumber,
1964                reserves.reserve_id                 AS reserve_id,
1965                reserves.itemtype                   AS itemtype
1966         FROM reserves
1967         WHERE reserves.biblionumber = ?
1968           AND (reserves.itemnumber IS NULL OR reserves.itemnumber = ?)
1969           AND reserves.reservedate <= DATE_ADD(NOW(),INTERVAL ? DAY)
1970           AND suspend = 0
1971           ORDER BY priority
1972     };
1973     $sth = $dbh->prepare($query);
1974     $sth->execute( $biblio, $itemnumber, $lookahead||0);
1975     @results = ();
1976     while ( my $data = $sth->fetchrow_hashref ) {
1977         push( @results, $data )
1978           unless any{ $data->{borrowernumber} eq $_ } @$ignore_borrowers ;
1979     }
1980     return @results;
1981 }
1982
1983 =head2 _koha_notify_reserve
1984
1985   _koha_notify_reserve( $itemnumber, $borrowernumber, $biblionumber );
1986
1987 Sends a notification to the patron that their hold has been filled (through
1988 ModReserveAffect, _not_ ModReserveFill)
1989
1990 The letter code for this notice may be found using the following query:
1991
1992     select distinct letter_code
1993     from message_transports
1994     inner join message_attributes using (message_attribute_id)
1995     where message_name = 'Hold_Filled'
1996
1997 This will probably sipmly be 'HOLD', but because it is defined in the database,
1998 it is subject to addition or change.
1999
2000 The following tables are availalbe witin the notice:
2001
2002     branches
2003     borrowers
2004     biblio
2005     biblioitems
2006     reserves
2007     items
2008
2009 =cut
2010
2011 sub _koha_notify_reserve {
2012     my ($itemnumber, $borrowernumber, $biblionumber) = @_;
2013
2014     my $dbh = C4::Context->dbh;
2015     my $borrower = C4::Members::GetMember(borrowernumber => $borrowernumber);
2016
2017     # Try to get the borrower's email address
2018     my $to_address = C4::Members::GetNoticeEmailAddress($borrowernumber);
2019
2020     my $messagingprefs = C4::Members::Messaging::GetMessagingPreferences( {
2021             borrowernumber => $borrowernumber,
2022             message_name => 'Hold_Filled'
2023     } );
2024
2025     my $sth = $dbh->prepare("
2026         SELECT *
2027         FROM   reserves
2028         WHERE  borrowernumber = ?
2029             AND biblionumber = ?
2030     ");
2031     $sth->execute( $borrowernumber, $biblionumber );
2032     my $reserve = $sth->fetchrow_hashref;
2033     my $library = Koha::Libraries->find( $reserve->{branchcode} )->unblessed;
2034
2035     my $admin_email_address = $library->{branchemail} || C4::Context->preference('KohaAdminEmailAddress');
2036
2037     my %letter_params = (
2038         module => 'reserves',
2039         branchcode => $reserve->{branchcode},
2040         tables => {
2041             'branches'       => $library,
2042             'borrowers'      => $borrower,
2043             'biblio'         => $biblionumber,
2044             'biblioitems'    => $biblionumber,
2045             'reserves'       => $reserve,
2046             'items'          => $reserve->{'itemnumber'},
2047         },
2048         substitute => { today => output_pref( { dt => dt_from_string, dateonly => 1 } ) },
2049     );
2050
2051     my $notification_sent = 0; #Keeping track if a Hold_filled message is sent. If no message can be sent, then default to a print message.
2052     my $send_notification = sub {
2053         my ( $mtt, $letter_code ) = (@_);
2054         return unless defined $letter_code;
2055         $letter_params{letter_code} = $letter_code;
2056         $letter_params{message_transport_type} = $mtt;
2057         my $letter =  C4::Letters::GetPreparedLetter ( %letter_params );
2058         unless ($letter) {
2059             warn "Could not find a letter called '$letter_params{'letter_code'}' for $mtt in the 'reserves' module";
2060             return;
2061         }
2062
2063         C4::Letters::EnqueueLetter( {
2064             letter => $letter,
2065             borrowernumber => $borrowernumber,
2066             from_address => $admin_email_address,
2067             message_transport_type => $mtt,
2068         } );
2069     };
2070
2071     while ( my ( $mtt, $letter_code ) = each %{ $messagingprefs->{transports} } ) {
2072         next if (
2073                ( $mtt eq 'email' and not $to_address ) # No email address
2074             or ( $mtt eq 'sms'   and not $borrower->{smsalertnumber} ) # No SMS number
2075             or ( $mtt eq 'phone' and C4::Context->preference('TalkingTechItivaPhoneNotification') ) # Notice is handled by TalkingTech_itiva_outbound.pl
2076         );
2077
2078         &$send_notification($mtt, $letter_code);
2079         $notification_sent++;
2080     }
2081     #Making sure that a print notification is sent if no other transport types can be utilized.
2082     if (! $notification_sent) {
2083         &$send_notification('print', 'HOLD');
2084     }
2085
2086 }
2087
2088 =head2 _ShiftPriorityByDateAndPriority
2089
2090   $new_priority = _ShiftPriorityByDateAndPriority( $biblionumber, $reservedate, $priority );
2091
2092 This increments the priority of all reserves after the one
2093 with either the lowest date after C<$reservedate>
2094 or the lowest priority after C<$priority>.
2095
2096 It effectively makes room for a new reserve to be inserted with a certain
2097 priority, which is returned.
2098
2099 This is most useful when the reservedate can be set by the user.  It allows
2100 the new reserve to be placed before other reserves that have a later
2101 reservedate.  Since priority also is set by the form in reserves/request.pl
2102 the sub accounts for that too.
2103
2104 =cut
2105
2106 sub _ShiftPriorityByDateAndPriority {
2107     my ( $biblio, $resdate, $new_priority ) = @_;
2108
2109     my $dbh = C4::Context->dbh;
2110     my $query = "SELECT priority FROM reserves WHERE biblionumber = ? AND ( reservedate > ? OR priority > ? ) ORDER BY priority ASC LIMIT 1";
2111     my $sth = $dbh->prepare( $query );
2112     $sth->execute( $biblio, $resdate, $new_priority );
2113     my $min_priority = $sth->fetchrow;
2114     # if no such matches are found, $new_priority remains as original value
2115     $new_priority = $min_priority if ( $min_priority );
2116
2117     # Shift the priority up by one; works in conjunction with the next SQL statement
2118     $query = "UPDATE reserves
2119               SET priority = priority+1
2120               WHERE biblionumber = ?
2121               AND borrowernumber = ?
2122               AND reservedate = ?
2123               AND found IS NULL";
2124     my $sth_update = $dbh->prepare( $query );
2125
2126     # Select all reserves for the biblio with priority greater than $new_priority, and order greatest to least
2127     $query = "SELECT borrowernumber, reservedate FROM reserves WHERE priority >= ? AND biblionumber = ? ORDER BY priority DESC";
2128     $sth = $dbh->prepare( $query );
2129     $sth->execute( $new_priority, $biblio );
2130     while ( my $row = $sth->fetchrow_hashref ) {
2131         $sth_update->execute( $biblio, $row->{borrowernumber}, $row->{reservedate} );
2132     }
2133
2134     return $new_priority;  # so the caller knows what priority they wind up receiving
2135 }
2136
2137 =head2 OPACItemHoldsAllowed
2138
2139   OPACItemHoldsAllowed($item_record,$borrower_record);
2140
2141 Checks issuingrules, using the borrowers categorycode, the itemtype, and branchcode to see
2142 if specific item holds are allowed, returns true if so.
2143
2144 =cut
2145
2146 sub OPACItemHoldsAllowed {
2147     my ($item,$borrower) = @_;
2148
2149     my $branchcode = $item->{homebranch} or die "No homebranch";
2150     my $itype;
2151     my $dbh = C4::Context->dbh;
2152     if (C4::Context->preference('item-level_itypes')) {
2153        # We can't trust GetItem to honour the syspref, so safest to do it ourselves
2154        # When GetItem is fixed, we can remove this
2155        $itype = $item->{itype};
2156     }
2157     else {
2158        my $query = "SELECT itemtype FROM biblioitems WHERE biblioitemnumber = ? ";
2159        my $sth = $dbh->prepare($query);
2160        $sth->execute($item->{biblioitemnumber});
2161        if (my $data = $sth->fetchrow_hashref()){
2162            $itype = $data->{itemtype};
2163        }
2164     }
2165
2166     my $query = "SELECT opacitemholds,categorycode,itemtype,branchcode FROM issuingrules WHERE
2167           (issuingrules.categorycode = ? OR issuingrules.categorycode = '*')
2168         AND
2169           (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
2170         AND
2171           (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')
2172         ORDER BY
2173           issuingrules.categorycode desc,
2174           issuingrules.itemtype desc,
2175           issuingrules.branchcode desc
2176        LIMIT 1";
2177     my $sth = $dbh->prepare($query);
2178     $sth->execute($borrower->{categorycode},$itype,$branchcode);
2179     my $data = $sth->fetchrow_hashref;
2180     my $opacitemholds = uc substr ($data->{opacitemholds}, 0, 1);
2181     return '' if $opacitemholds eq 'N';
2182     return $opacitemholds;
2183 }
2184
2185 =head2 MoveReserve
2186
2187   MoveReserve( $itemnumber, $borrowernumber, $cancelreserve )
2188
2189 Use when checking out an item to handle reserves
2190 If $cancelreserve boolean is set to true, it will remove existing reserve
2191
2192 =cut
2193
2194 sub MoveReserve {
2195     my ( $itemnumber, $borrowernumber, $cancelreserve ) = @_;
2196
2197     my $lookahead = C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2198     my ( $restype, $res, $all_reserves ) = CheckReserves( $itemnumber, undef, $lookahead );
2199     return unless $res;
2200
2201     my $biblionumber     =  $res->{biblionumber};
2202     my $biblioitemnumber = $res->{biblioitemnumber};
2203
2204     if ($res->{borrowernumber} == $borrowernumber) {
2205         ModReserveFill($res);
2206     }
2207     else {
2208         # warn "Reserved";
2209         # The item is reserved by someone else.
2210         # Find this item in the reserves
2211
2212         my $borr_res;
2213         foreach (@$all_reserves) {
2214             $_->{'borrowernumber'} == $borrowernumber or next;
2215             $_->{'biblionumber'}   == $biblionumber   or next;
2216
2217             $borr_res = $_;
2218             last;
2219         }
2220
2221         if ( $borr_res ) {
2222             # The item is reserved by the current patron
2223             ModReserveFill($borr_res);
2224         }
2225
2226         if ( $cancelreserve eq 'revert' ) { ## Revert waiting reserve to priority 1
2227             RevertWaitingStatus({ itemnumber => $itemnumber });
2228         }
2229         elsif ( $cancelreserve eq 'cancel' || $cancelreserve ) { # cancel reserves on this item
2230             CancelReserve( { reserve_id => $res->{'reserve_id'} } );
2231         }
2232     }
2233 }
2234
2235 =head2 MergeHolds
2236
2237   MergeHolds($dbh,$to_biblio, $from_biblio);
2238
2239 This shifts the holds from C<$from_biblio> to C<$to_biblio> and reorders them by the date they were placed
2240
2241 =cut
2242
2243 sub MergeHolds {
2244     my ( $dbh, $to_biblio, $from_biblio ) = @_;
2245     my $sth = $dbh->prepare(
2246         "SELECT count(*) as reserve_count FROM reserves WHERE biblionumber = ?"
2247     );
2248     $sth->execute($from_biblio);
2249     if ( my $data = $sth->fetchrow_hashref() ) {
2250
2251         # holds exist on old record, if not we don't need to do anything
2252         $sth = $dbh->prepare(
2253             "UPDATE reserves SET biblionumber = ? WHERE biblionumber = ?");
2254         $sth->execute( $to_biblio, $from_biblio );
2255
2256         # Reorder by date
2257         # don't reorder those already waiting
2258
2259         $sth = $dbh->prepare(
2260 "SELECT * FROM reserves WHERE biblionumber = ? AND (found <> ? AND found <> ? OR found is NULL) ORDER BY reservedate ASC"
2261         );
2262         my $upd_sth = $dbh->prepare(
2263 "UPDATE reserves SET priority = ? WHERE biblionumber = ? AND borrowernumber = ?
2264         AND reservedate = ? AND (itemnumber = ? or itemnumber is NULL) "
2265         );
2266         $sth->execute( $to_biblio, 'W', 'T' );
2267         my $priority = 1;
2268         while ( my $reserve = $sth->fetchrow_hashref() ) {
2269             $upd_sth->execute(
2270                 $priority,                    $to_biblio,
2271                 $reserve->{'borrowernumber'}, $reserve->{'reservedate'},
2272                 $reserve->{'itemnumber'}
2273             );
2274             $priority++;
2275         }
2276     }
2277 }
2278
2279 =head2 RevertWaitingStatus
2280
2281   RevertWaitingStatus({ itemnumber => $itemnumber });
2282
2283   Reverts a 'waiting' hold back to a regular hold with a priority of 1.
2284
2285   Caveat: Any waiting hold fixed with RevertWaitingStatus will be an
2286           item level hold, even if it was only a bibliolevel hold to
2287           begin with. This is because we can no longer know if a hold
2288           was item-level or bib-level after a hold has been set to
2289           waiting status.
2290
2291 =cut
2292
2293 sub RevertWaitingStatus {
2294     my ( $params ) = @_;
2295     my $itemnumber = $params->{'itemnumber'};
2296
2297     return unless ( $itemnumber );
2298
2299     my $dbh = C4::Context->dbh;
2300
2301     ## Get the waiting reserve we want to revert
2302     my $query = "
2303         SELECT * FROM reserves
2304         WHERE itemnumber = ?
2305         AND found IS NOT NULL
2306     ";
2307     my $sth = $dbh->prepare( $query );
2308     $sth->execute( $itemnumber );
2309     my $reserve = $sth->fetchrow_hashref();
2310
2311     ## Increment the priority of all other non-waiting
2312     ## reserves for this bib record
2313     $query = "
2314         UPDATE reserves
2315         SET
2316           priority = priority + 1
2317         WHERE
2318           biblionumber =  ?
2319         AND
2320           priority > 0
2321     ";
2322     $sth = $dbh->prepare( $query );
2323     $sth->execute( $reserve->{'biblionumber'} );
2324
2325     ## Fix up the currently waiting reserve
2326     $query = "
2327     UPDATE reserves
2328     SET
2329       priority = 1,
2330       found = NULL,
2331       waitingdate = NULL
2332     WHERE
2333       reserve_id = ?
2334     ";
2335     $sth = $dbh->prepare( $query );
2336     $sth->execute( $reserve->{'reserve_id'} );
2337     _FixPriority( { biblionumber => $reserve->{biblionumber} } );
2338 }
2339
2340 =head2 GetReserveId
2341
2342   $reserve_id = GetReserveId({ biblionumber => $biblionumber, borrowernumber => $borrowernumber [, itemnumber => $itemnumber ] });
2343
2344   Returnes the first reserve id that matches the given criteria
2345
2346 =cut
2347
2348 sub GetReserveId {
2349     my ( $params ) = @_;
2350
2351     return unless ( ( $params->{'biblionumber'} || $params->{'itemnumber'} ) && $params->{'borrowernumber'} );
2352
2353     foreach my $key ( keys %$params ) {
2354         delete $params->{$key} unless defined( $params->{$key} );
2355     }
2356
2357     my $hold = Koha::Holds->search( $params )->next();
2358
2359     return $hold->id();
2360 }
2361
2362 =head2 ReserveSlip
2363
2364   ReserveSlip($branchcode, $borrowernumber, $biblionumber)
2365
2366 Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
2367
2368 The letter code will be HOLD_SLIP, and the following tables are
2369 available within the slip:
2370
2371     reserves
2372     branches
2373     borrowers
2374     biblio
2375     biblioitems
2376     items
2377
2378 =cut
2379
2380 sub ReserveSlip {
2381     my ($branch, $borrowernumber, $biblionumber) = @_;
2382
2383 #   return unless ( C4::Context->boolean_preference('printreserveslips') );
2384
2385     my $reserve_id = GetReserveId({
2386         biblionumber => $biblionumber,
2387         borrowernumber => $borrowernumber
2388     }) or return;
2389     my $reserve = GetReserveInfo($reserve_id) or return;
2390
2391     return  C4::Letters::GetPreparedLetter (
2392         module => 'circulation',
2393         letter_code => 'HOLD_SLIP',
2394         branchcode => $branch,
2395         tables => {
2396             'reserves'    => $reserve,
2397             'branches'    => $reserve->{branchcode},
2398             'borrowers'   => $reserve->{borrowernumber},
2399             'biblio'      => $reserve->{biblionumber},
2400             'biblioitems' => $reserve->{biblionumber},
2401             'items'       => $reserve->{itemnumber},
2402         },
2403     );
2404 }
2405
2406 =head2 GetReservesControlBranch
2407
2408   my $reserves_control_branch = GetReservesControlBranch($item, $borrower);
2409
2410   Return the branchcode to be used to determine which reserves
2411   policy applies to a transaction.
2412
2413   C<$item> is a hashref for an item. Only 'homebranch' is used.
2414
2415   C<$borrower> is a hashref to borrower. Only 'branchcode' is used.
2416
2417 =cut
2418
2419 sub GetReservesControlBranch {
2420     my ( $item, $borrower ) = @_;
2421
2422     my $reserves_control = C4::Context->preference('ReservesControlBranch');
2423
2424     my $branchcode =
2425         ( $reserves_control eq 'ItemHomeLibrary' ) ? $item->{'homebranch'}
2426       : ( $reserves_control eq 'PatronLibrary' )   ? $borrower->{'branchcode'}
2427       :                                              undef;
2428
2429     return $branchcode;
2430 }
2431
2432 =head2 CalculatePriority
2433
2434     my $p = CalculatePriority($biblionumber, $resdate);
2435
2436 Calculate priority for a new reserve on biblionumber, placing it at
2437 the end of the line of all holds whose start date falls before
2438 the current system time and that are neither on the hold shelf
2439 or in transit.
2440
2441 The reserve date parameter is optional; if it is supplied, the
2442 priority is based on the set of holds whose start date falls before
2443 the parameter value.
2444
2445 After calculation of this priority, it is recommended to call
2446 _ShiftPriorityByDateAndPriority. Note that this is currently done in
2447 AddReserves.
2448
2449 =cut
2450
2451 sub CalculatePriority {
2452     my ( $biblionumber, $resdate ) = @_;
2453
2454     my $sql = q{
2455         SELECT COUNT(*) FROM reserves
2456         WHERE biblionumber = ?
2457         AND   priority > 0
2458         AND   (found IS NULL OR found = '')
2459     };
2460     #skip found==W or found==T (waiting or transit holds)
2461     if( $resdate ) {
2462         $sql.= ' AND ( reservedate <= ? )';
2463     }
2464     else {
2465         $sql.= ' AND ( reservedate < NOW() )';
2466     }
2467     my $dbh = C4::Context->dbh();
2468     my @row = $dbh->selectrow_array(
2469         $sql,
2470         undef,
2471         $resdate ? ($biblionumber, $resdate) : ($biblionumber)
2472     );
2473
2474     return @row ? $row[0]+1 : 1;
2475 }
2476
2477 =head2 IsItemOnHoldAndFound
2478
2479     my $bool = IsItemFoundHold( $itemnumber );
2480
2481     Returns true if the item is currently on hold
2482     and that hold has a non-null found status ( W, T, etc. )
2483
2484 =cut
2485
2486 sub IsItemOnHoldAndFound {
2487     my ($itemnumber) = @_;
2488
2489     my $rs = Koha::Database->new()->schema()->resultset('Reserve');
2490
2491     my $found = $rs->count(
2492         {
2493             itemnumber => $itemnumber,
2494             found      => { '!=' => undef }
2495         }
2496     );
2497
2498     return $found;
2499 }
2500
2501 =head2 GetMaxPatronHoldsForRecord
2502
2503 my $holds_per_record = ReservesControlBranch( $borrowernumber, $biblionumber );
2504
2505 For multiple holds on a given record for a given patron, the max
2506 number of record level holds that a patron can be placed is the highest
2507 value of the holds_per_record rule for each item if the record for that
2508 patron. This subroutine finds and returns the highest holds_per_record
2509 rule value for a given patron id and record id.
2510
2511 =cut
2512
2513 sub GetMaxPatronHoldsForRecord {
2514     my ( $borrowernumber, $biblionumber ) = @_;
2515
2516     my $patron = Koha::Patrons->find($borrowernumber);
2517     my @items = Koha::Items->search( { biblionumber => $biblionumber } );
2518
2519     my $controlbranch = C4::Context->preference('ReservesControlBranch');
2520
2521     my $categorycode = $patron->categorycode;
2522     my $branchcode;
2523     $branchcode = $patron->branchcode if ( $controlbranch eq "PatronLibrary" );
2524
2525     my $max = 0;
2526     foreach my $item (@items) {
2527         my $itemtype = $item->effective_itemtype();
2528
2529         $branchcode = $item->homebranch if ( $controlbranch eq "ItemHomeLibrary" );
2530
2531         my $rule = GetHoldRule( $categorycode, $itemtype, $branchcode );
2532         my $holds_per_record = $rule ? $rule->{holds_per_record} : 0;
2533         $max = $holds_per_record if $holds_per_record > $max;
2534     }
2535
2536     return $max;
2537 }
2538
2539 =head2 GetHoldRule
2540
2541 my $rule = GetHoldRule( $categorycode, $itemtype, $branchcode );
2542
2543 Returns the matching hold related issuingrule fields for a given
2544 patron category, itemtype, and library.
2545
2546 =cut
2547
2548 sub GetHoldRule {
2549     my ( $categorycode, $itemtype, $branchcode ) = @_;
2550
2551     my $dbh = C4::Context->dbh;
2552
2553     my $sth = $dbh->prepare(
2554         q{
2555          SELECT categorycode, itemtype, branchcode, reservesallowed, holds_per_record
2556            FROM issuingrules
2557           WHERE (categorycode in (?,'*') )
2558             AND (itemtype IN (?,'*'))
2559             AND (branchcode IN (?,'*'))
2560        ORDER BY categorycode DESC,
2561                 itemtype     DESC,
2562                 branchcode   DESC
2563         }
2564     );
2565
2566     $sth->execute( $categorycode, $itemtype, $branchcode );
2567
2568     return $sth->fetchrow_hashref();
2569 }
2570
2571 =head1 AUTHOR
2572
2573 Koha Development Team <http://koha-community.org/>
2574
2575 =cut
2576
2577 1;