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