Reserves.pm 66.7 KB
Newer Older
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
#
tipaul's avatar
tipaul committed
8
# This file is part of Koha.
9
#
10 11 12 13
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
14
#
15 16 17 18
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
19
#
20 21
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.
22

tipaul's avatar
tipaul committed
23

rangi's avatar
rangi committed
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 34
# for _koha_notify_reserve
use C4::Members::Messaging;
35
use C4::Members qw();
36
use C4::Letters;
37
use C4::Log;
38

39
use Koha::Biblios;
40
use Koha::DateUtils;
41
use Koha::Calendar;
42
use Koha::Database;
43
use Koha::Hold;
44
use Koha::Old::Hold;
45
use Koha::Holds;
46
use Koha::Libraries;
47
use Koha::IssuingRules;
48 49
use Koha::Items;
use Koha::ItemTypes;
50
use Koha::Patrons;
51

52
use List::MoreUtils qw( firstidx any );
53
use Carp;
54
use Data::Dumper;
55

56
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
57

58 59
=head1 NAME

60
C4::Reserves - Koha functions for dealing with reservation.
61 62 63

=head1 SYNOPSIS

64
  use C4::Reserves;
65 66 67

=head1 DESCRIPTION

Andrew Elwell's avatar
Andrew Elwell committed
68 69
This modules provides somes functions to deal with reservations.

70 71 72 73
  Reserves are stored in reserves table.
  The following columns contains important values :
  - priority >0      : then the reserve is at 1st stage, and not yet affected to any item.
             =0      : then the reserve is being dealed
74
  - found : NULL       : means the patron requested the 1st available, and we haven't chosen the item
75 76
            T(ransit)  : the reserve is linked to an item but is in transit to the pickup branch
            W(aiting)  : the reserve is linked to an item, is at the pickup branch, and is waiting on the hold shelf
77 78 79 80 81 82
            F(inished) : the reserve has been completed, and is done
  - itemnumber : empty : the reserve is still unaffected to an item
                 filled: the reserve is attached to an item
  The complete workflow is :
  ==== 1st use case ====
  patron request a document, 1st available :                      P >0, F=NULL, I=NULL
83
  a library having it run "transfertodo", and clic on the list
84
         if there is no transfer to do, the reserve waiting
85
         patron can pick it up                                    P =0, F=W,    I=filled
86
         if there is a transfer to do, write in branchtransfer    P =0, F=T,    I=filled
87
           The pickup library receive the book, it check in       P =0, F=W,    I=filled
88
  The patron borrow the book                                      P =0, F=F,    I=filled
89

90 91 92
  ==== 2nd use case ====
  patron requests a document, a given item,
    If pickup is holding branch                                   P =0, F=W,   I=filled
93 94
    If transfer needed, write in branchtransfer                   P =0, F=T,    I=filled
        The pickup library receive the book, it checks it in      P =0, F=W,    I=filled
95
  The patron borrow the book                                      P =0, F=F,    I=filled
96

Andrew Elwell's avatar
Andrew Elwell committed
97
=head1 FUNCTIONS
98 99 100

=cut

101
BEGIN {
102
    require Exporter;
103 104 105
    @ISA = qw(Exporter);
    @EXPORT = qw(
        &AddReserve
106

107
        &GetReserveStatus
108

109
        &GetOtherReserves
110

111 112 113 114 115 116
        &ModReserveFill
        &ModReserveAffect
        &ModReserve
        &ModReserveStatus
        &ModReserveCancelAll
        &ModReserveMinusPriority
117
        &MoveReserve
118

119
        &CheckReserves
120
        &CanBookBeReserved
121
        &CanItemBeReserved
122
        &CanReserveBeCanceledFromOpac
123
        &CancelExpiredReserves
124

Kyle M Hall's avatar
Kyle M Hall committed
125 126
        &AutoUnsuspendReserves

127
        &IsAvailableForItemLevelRequest
128

129 130
        &AlterPriority
        &ToggleLowestPriority
131 132

        &ReserveSlip
Kyle M Hall's avatar
Kyle M Hall committed
133 134
        &ToggleSuspend
        &SuspendAll
135 136

        &GetReservesControlBranch
137 138

        IsItemOnHoldAndFound
139 140

        GetMaxPatronHoldsForRecord
141
    );
142
    @EXPORT_OK = qw( MergeHolds );
143
}
tipaul's avatar
tipaul committed
144

Andrew Elwell's avatar
Andrew Elwell committed
145
=head2 AddReserve
tipaul's avatar
tipaul committed
146

147
    AddReserve($branch,$borrowernumber,$biblionumber,$bibitems,$priority,$resdate,$expdate,$notes,$title,$checkitem,$found)
tipaul's avatar
tipaul committed
148

149 150 151 152 153 154 155 156 157
Adds reserve and generates HOLDPLACED message.

The following tables are available witin the HOLDPLACED message:

    branches
    borrowers
    biblio
    biblioitems
    items
158
    reserves
159

tipaul's avatar
tipaul committed
160 161
=cut

162 163
sub AddReserve {
    my (
164 165 166
        $branch,   $borrowernumber, $biblionumber, $bibitems,
        $priority, $resdate,        $expdate,      $notes,
        $title,    $checkitem,      $found,        $itemtype
167
    ) = @_;
168

169 170
    $resdate = output_pref( { str => dt_from_string( $resdate ), dateonly => 1, dateformat => 'iso' })
        or output_pref({ dt => dt_from_string, dateonly => 1, dateformat => 'iso' });
171

172
    $expdate = output_pref({ str => $expdate, dateonly => 1, dateformat => 'iso' });
173 174 175 176 177

    if ( C4::Context->preference('AllowHoldDateInFuture') ) {

        # Make room in reserves for this before those of a later reserve date
        $priority = _ShiftPriorityByDateAndPriority( $biblionumber, $resdate, $priority );
178
    }
179

180
    my $waitingdate;
tipaul's avatar
tipaul committed
181

182 183 184
    # If the reserv had the waiting status, we had the value of the resdate
    if ( $found eq 'W' ) {
        $waitingdate = $resdate;
tipaul's avatar
tipaul committed
185 186
    }

187 188 189
    # Don't add itemtype limit if specific item is selected
    $itemtype = undef if $checkitem;

190
    # updates take place here
191 192 193 194 195 196 197 198 199 200 201
    my $hold = Koha::Hold->new(
        {
            borrowernumber => $borrowernumber,
            biblionumber   => $biblionumber,
            reservedate    => $resdate,
            branchcode     => $branch,
            priority       => $priority,
            reservenotes   => $notes,
            itemnumber     => $checkitem,
            found          => $found,
            waitingdate    => $waitingdate,
202 203
            expirationdate => $expdate,
            itemtype       => $itemtype,
204 205
        }
    )->store();
206 207 208 209

    logaction( 'HOLDS', 'CREATE', $hold->id, Dumper($hold->unblessed) )
        if C4::Context->preference('HoldsLog');

210 211
    my $reserve_id = $hold->id();

212
    # add a reserve fee if needed
213 214 215 216
    if ( C4::Context->preference('HoldFeeMode') ne 'any_time_is_collected' ) {
        my $reserve_fee = GetReserveFee( $borrowernumber, $biblionumber );
        ChargeReserveFee( $borrowernumber, $reserve_fee, $title );
    }
tipaul's avatar
tipaul committed
217

218 219
    _FixPriority({ biblionumber => $biblionumber});

220 221
    # Send e-mail to librarian if syspref is active
    if(C4::Context->preference("emailLibrarianWhenHoldIsPlaced")){
222 223
        my $patron = Koha::Patrons->find( $borrowernumber );
        my $library = $patron->library;
224 225 226 227
        if ( my $letter =  C4::Letters::GetPreparedLetter (
            module => 'reserves',
            letter_code => 'HOLDPLACED',
            branchcode => $branch,
228
            lang => $patron->lang,
229
            tables => {
230 231
                'branches'    => $library->unblessed,
                'borrowers'   => $patron->unblessed,
232 233 234
                'biblio'      => $biblionumber,
                'biblioitems' => $biblionumber,
                'items'       => $checkitem,
235
                'reserves'    => $hold->unblessed,
236 237 238
            },
        ) ) {

239
            my $admin_email_address = $library->branchemail || C4::Context->preference('KohaAdminEmailAddress');
240 241 242 243 244 245 246 247 248

            C4::Letters::EnqueueLetter(
                {   letter                 => $letter,
                    borrowernumber         => $borrowernumber,
                    message_transport_type => 'email',
                    from_address           => $admin_email_address,
                    to_address           => $admin_email_address,
                }
            );
249 250 251
        }
    }

252
    return $reserve_id;
tipaul's avatar
tipaul committed
253 254
}

Andrew Elwell's avatar
Andrew Elwell committed
255
=head2 CanBookBeReserved
256

257 258 259 260
  $canReserve = &CanBookBeReserved($borrowernumber, $biblionumber)
  if ($canReserve eq 'OK') { #We can reserve this Item! }

See CanItemBeReserved() for possible return values.
261 262 263 264 265 266

=cut

sub CanBookBeReserved{
    my ($borrowernumber, $biblionumber) = @_;

267
    my $items = GetItemnumbersForBiblio($biblionumber);
268 269 270
    #get items linked via host records
    my @hostitems = get_hostitemnumbers_of($biblionumber);
    if (@hostitems){
271
    push (@$items,@hostitems);
272
    }
273

274 275 276
    my $canReserve;
    foreach my $item (@$items) {
        $canReserve = CanItemBeReserved( $borrowernumber, $item );
277
        return 'OK' if $canReserve eq 'OK';
278
    }
279
    return $canReserve;
280 281
}

Andrew Elwell's avatar
Andrew Elwell committed
282
=head2 CanItemBeReserved
283

284 285
  $canReserve = &CanItemBeReserved($borrowernumber, $itemnumber)
  if ($canReserve eq 'OK') { #We can reserve this Item! }
286

287 288 289 290 291
@RETURNS OK,              if the Item can be reserved.
         ageRestricted,   if the Item is age restricted for this borrower.
         damaged,         if the Item is damaged.
         cannotReserveFromOtherBranches, if syspref 'canreservefromotherbranches' is OK.
         tooManyReserves, if the borrower has exceeded his maximum reserve amount.
292
         notReservable,   if holds on this item are not allowed
293 294 295

=cut

296 297
sub CanItemBeReserved {
    my ( $borrowernumber, $itemnumber ) = @_;
298

299 300
    my $dbh = C4::Context->dbh;
    my $ruleitemtype;    # itemtype of the matching issuing rule
301 302
    my $allowedreserves  = 0; # Total number of holds allowed across all records
    my $holds_per_record = 1; # Total number of holds allowed for this one given record
303

304
    # we retrieve borrowers and items informations #
305
    # item->{itype} will come for biblioitems if necessery
306
    my $item       = GetItem($itemnumber);
307
    my $biblio     = Koha::Biblios->find( $item->{biblionumber} );
308 309
    my $patron = Koha::Patrons->find( $borrowernumber );
    my $borrower = $patron->unblessed;
310 311

    # If an item is damaged and we don't allow holds on damaged items, we can stop right here
312 313 314
    return 'damaged'
      if ( $item->{damaged}
        && !C4::Context->preference('AllowHoldsOnDamagedItems') );
315

316
    # Check for the age restriction
317
    my ( $ageRestriction, $daysToAgeRestriction ) =
318
      C4::Circulation::GetAgeRestriction( $biblio->biblioitem->agerestriction, $borrower );
319
    return 'ageRestricted' if $daysToAgeRestriction && $daysToAgeRestriction > 0;
320

321 322 323
    # Check that the patron doesn't have an item level hold on this item already
    return 'itemAlreadyOnHold'
      if Koha::Holds->search( { borrowernumber => $borrowernumber, itemnumber => $itemnumber } )->count();
324

325
    my $controlbranch = C4::Context->preference('ReservesControlBranch');
326 327 328 329 330 331 332 333 334 335 336 337 338 339

    my $querycount = q{
        SELECT count(*) AS count
          FROM reserves
     LEFT JOIN items USING (itemnumber)
     LEFT JOIN biblioitems ON (reserves.biblionumber=biblioitems.biblionumber)
     LEFT JOIN borrowers USING (borrowernumber)
         WHERE borrowernumber = ?
    };

    my $branchcode  = "";
    my $branchfield = "reserves.branchcode";

    if ( $controlbranch eq "ItemHomeLibrary" ) {
340
        $branchfield = "items.homebranch";
341 342 343
        $branchcode  = $item->{homebranch};
    }
    elsif ( $controlbranch eq "PatronLibrary" ) {
344
        $branchfield = "borrowers.branchcode";
345
        $branchcode  = $borrower->{branchcode};
346
    }
347 348

    # we retrieve rights
349 350 351 352
    if ( my $rights = GetHoldRule( $borrower->{'categorycode'}, $item->{'itype'}, $branchcode ) ) {
        $ruleitemtype     = $rights->{itemtype};
        $allowedreserves  = $rights->{reservesallowed};
        $holds_per_record = $rights->{holds_per_record};
353 354
    }
    else {
355
        $ruleitemtype = '*';
356
    }
357

358
    $item = Koha::Items->find( $itemnumber );
359 360 361 362 363 364 365 366 367 368 369
    my $holds = Koha::Holds->search(
        {
            borrowernumber => $borrowernumber,
            biblionumber   => $item->biblionumber,
            found          => undef, # Found holds don't count against a patron's holds limit
        }
    );
    if ( $holds->count() >= $holds_per_record ) {
        return "tooManyHoldsForThisRecord";
    }

370
    # we retrieve count
371

372
    $querycount .= "AND $branchfield = ?";
373

374 375 376 377
    # If using item-level itypes, fall back to the record
    # level itemtype if the hold has no associated item
    $querycount .=
      C4::Context->preference('item-level_itypes')
378 379
      ? " AND COALESCE( items.itype, biblioitems.itemtype ) = ?"
      : " AND biblioitems.itemtype = ?"
380 381
      if ( $ruleitemtype ne "*" );

382
    my $sthcount = $dbh->prepare($querycount);
383 384 385 386 387 388

    if ( $ruleitemtype eq "*" ) {
        $sthcount->execute( $borrowernumber, $branchcode );
    }
    else {
        $sthcount->execute( $borrowernumber, $branchcode, $ruleitemtype );
389
    }
390

391
    my $reservecount = "0";
392
    if ( my $rowcount = $sthcount->fetchrow_hashref() ) {
393 394
        $reservecount = $rowcount->{count};
    }
395

396
    # we check if it's ok or not
397
    if ( $reservecount >= $allowedreserves ) {
398
        return 'tooManyReserves';
399
    }
400

401
    my $circ_control_branch =
402
      C4::Circulation::_GetCircControlBranch( $item->unblessed(), $borrower );
403
    my $branchitemrule =
404
      C4::Circulation::GetBranchItemRule( $circ_control_branch, $item->itype );
405 406 407 408 409 410

    if ( $branchitemrule->{holdallowed} == 0 ) {
        return 'notReservable';
    }

    if (   $branchitemrule->{holdallowed} == 1
411
        && $borrower->{branchcode} ne $item->homebranch )
412
    {
413
        return 'cannotReserveFromOtherBranches';
414 415
    }

416 417 418 419 420
    # If reservecount is ok, we check item branch if IndependentBranches is ON
    # and canreservefromotherbranches is OFF
    if ( C4::Context->preference('IndependentBranches')
        and !C4::Context->preference('canreservefromotherbranches') )
    {
421
        my $itembranch = $item->homebranch;
422
        if ( $itembranch ne $borrower->{branchcode} ) {
423
            return 'cannotReserveFromOtherBranches';
424 425 426
        }
    }

427
    return 'OK';
428
}
429 430 431 432 433 434 435 436 437 438 439 440 441 442

=head2 CanReserveBeCanceledFromOpac

    $number = CanReserveBeCanceledFromOpac($reserve_id, $borrowernumber);

    returns 1 if reserve can be cancelled by user from OPAC.
    First check if reserve belongs to user, next checks if reserve is not in
    transfer or waiting status

=cut

sub CanReserveBeCanceledFromOpac {
    my ($reserve_id, $borrowernumber) = @_;

443
    return unless $reserve_id and $borrowernumber;
444
    my $reserve = Koha::Holds->find($reserve_id);
445

446 447
    return 0 unless $reserve->borrowernumber == $borrowernumber;
    return 0 if ( $reserve->found eq 'W' ) or ( $reserve->found eq 'T' );
448 449 450 451 452

    return 1;

}

Andrew Elwell's avatar
Andrew Elwell committed
453
=head2 GetOtherReserves
tipaul's avatar
tipaul committed
454

Andrew Elwell's avatar
Andrew Elwell committed
455
  ($messages,$nextreservinfo)=$GetOtherReserves(itemnumber);
tipaul's avatar
tipaul committed
456

457
Check queued list of this document and check if this document must be transferred
458 459

=cut
tipaul's avatar
tipaul committed
460

461
sub GetOtherReserves {
tipaul's avatar
tipaul committed
462
    my ($itemnumber) = @_;
463 464
    my $messages;
    my $nextreservinfo;
465
    my ( undef, $checkreserves, undef ) = CheckReserves($itemnumber);
466
    if ($checkreserves) {
467 468 469 470 471 472
        my $iteminfo = GetItem($itemnumber);
        if ( $iteminfo->{'holdingbranch'} ne $checkreserves->{'branchcode'} ) {
            $messages->{'transfert'} = $checkreserves->{'branchcode'};
            #minus priorities of others reservs
            ModReserveMinusPriority(
                $itemnumber,
473
                $checkreserves->{'reserve_id'},
474
            );
tipaul's avatar
tipaul committed
475

476
            #launch the subroutine dotransfer
477
            C4::Items::ModItemTransfer(
478 479 480 481 482 483
                $itemnumber,
                $iteminfo->{'holdingbranch'},
                $checkreserves->{'branchcode'}
              ),
              ;
        }
rangi's avatar
rangi committed
484

485 486 487 488 489
     #step 2b : case of a reservation on the same branch, set the waiting status
        else {
            $messages->{'waiting'} = 1;
            ModReserveMinusPriority(
                $itemnumber,
490
                $checkreserves->{'reserve_id'},
491 492 493 494 495 496 497 498 499 500
            );
            ModReserveStatus($itemnumber,'W');
        }

        $nextreservinfo = $checkreserves->{'borrowernumber'};
    }

    return ( $messages, $nextreservinfo );
}

501 502 503 504 505 506 507 508 509 510
=head2 ChargeReserveFee

    $fee = ChargeReserveFee( $borrowernumber, $fee, $title );

    Charge the fee for a reserve (if $fee > 0)

=cut

sub ChargeReserveFee {
    my ( $borrowernumber, $fee, $title ) = @_;
511
    return if !$fee || $fee==0; # the last test is needed to include 0.00
512 513 514 515 516 517 518 519
    my $accquery = qq{
INSERT INTO accountlines ( borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding ) VALUES (?, ?, NOW(), ?, ?, 'Res', ?)
    };
    my $dbh = C4::Context->dbh;
    my $nextacctno = &getnextacctno( $borrowernumber );
    $dbh->do( $accquery, undef, ( $borrowernumber, $nextacctno, $fee, "Reserve Charge - $title", $fee ) );
}

Andrew Elwell's avatar
Andrew Elwell committed
520
=head2 GetReserveFee
521

522
    $fee = GetReserveFee( $borrowernumber, $biblionumber );
523

524
    Calculate the fee for a reserve (if applicable).
525 526 527

=cut

528
sub GetReserveFee {
529 530 531
    my ( $borrowernumber, $biblionumber ) = @_;
    my $borquery = qq{
SELECT reservefee FROM borrowers LEFT JOIN categories ON borrowers.categorycode = categories.categorycode WHERE borrowernumber = ?
532
    };
533 534 535 536 537 538 539 540
    my $issue_qry = qq{
SELECT COUNT(*) FROM items
LEFT JOIN issues USING (itemnumber)
WHERE items.biblionumber=? AND issues.issue_id IS NULL
    };
    my $holds_qry = qq{
SELECT COUNT(*) FROM reserves WHERE biblionumber=? AND borrowernumber<>?
    };
541

542 543
    my $dbh = C4::Context->dbh;
    my ( $fee ) = $dbh->selectrow_array( $borquery, undef, ($borrowernumber) );
544
    my $hold_fee_mode = C4::Context->preference('HoldFeeMode') || 'not_always';
joubu's avatar
joubu committed
545
    if( $fee and $fee > 0 and $hold_fee_mode eq 'not_always' ) {
546
        # This is a reconstruction of the old code:
547
        # Compare number of items with items issued, and optionally check holds
548 549
        # If not all items are issued and there are no holds: charge no fee
        # NOTE: Lost, damaged, not-for-loan, etc. are just ignored here
550 551 552 553 554 555 556 557
        my ( $notissued, $reserved );
        ( $notissued ) = $dbh->selectrow_array( $issue_qry, undef,
            ( $biblionumber ) );
        if( $notissued ) {
            ( $reserved ) = $dbh->selectrow_array( $holds_qry, undef,
                ( $biblionumber, $borrowernumber ) );
            $fee = 0 if $reserved == 0;
        }
558 559 560 561
    }
    return $fee;
}

562 563
=head2 GetReserveStatus

564
  $reservestatus = GetReserveStatus($itemnumber);
565

566
Takes an itemnumber and returns the status of the reserve placed on it.
567 568 569 570
If several reserves exist, the reserve with the lower priority is given.

=cut

571 572 573 574
## FIXME: I don't think this does what it thinks it does.
## It only ever checks the first reserve result, even though
## multiple reserves for that bib can have the itemnumber set
## the sub is only used once in the codebase.
575
sub GetReserveStatus {
576
    my ($itemnumber) = @_;
577

578
    my $dbh = C4::Context->dbh;
579

580
    my ($sth, $found, $priority);
581 582 583
    if ( $itemnumber ) {
        $sth = $dbh->prepare("SELECT found, priority FROM reserves WHERE itemnumber = ? order by priority LIMIT 1");
        $sth->execute($itemnumber);
584
        ($found, $priority) = $sth->fetchrow_array;
585 586
    }

587 588 589 590
    if(defined $found) {
        return 'Waiting'  if $found eq 'W' and $priority == 0;
        return 'Finished' if $found eq 'F';
    }
591 592 593 594

    return 'Reserved' if $priority > 0;

    return ''; # empty string here will remove need for checking undef, or less log lines
595 596
}

Andrew Elwell's avatar
Andrew Elwell committed
597
=head2 CheckReserves
598

599 600
  ($status, $reserve, $all_reserves) = &CheckReserves($itemnumber);
  ($status, $reserve, $all_reserves) = &CheckReserves(undef, $barcode);
601
  ($status, $reserve, $all_reserves) = &CheckReserves($itemnumber,undef,$lookahead);
602 603 604

Find a book in the reserves.

605
C<$itemnumber> is the book's item number.
606
C<$lookahead> is the number of days to look in advance for future reserves.
607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624

As I understand it, C<&CheckReserves> looks for the given item in the
reserves. If it is found, that's a match, and C<$status> is set to
C<Waiting>.

Otherwise, it finds the most important item in the reserves with the
same biblio number as this book (I'm not clear on this) and returns it
with C<$status> set to C<Reserved>.

C<&CheckReserves> returns a two-element list:

C<$status> is either C<Waiting>, C<Reserved> (see above), or 0.

C<$reserve> is the reserve item that matched. It is a
reference-to-hash whose keys are mostly the fields of the reserves
table in the Koha database.

=cut
tipaul's avatar
tipaul committed
625

finlayt's avatar
finlayt committed
626
sub CheckReserves {
627
    my ( $item, $barcode, $lookahead_days, $ignore_borrowers) = @_;
628
    my $dbh = C4::Context->dbh;
finlayt's avatar
finlayt committed
629
    my $sth;
630 631 632 633
    my $select;
    if (C4::Context->preference('item-level_itypes')){
	$select = "
           SELECT items.biblionumber,
634 635 636
           items.biblioitemnumber,
           itemtypes.notforloan,
           items.notforloan AS itemnotforloan,
637
           items.itemnumber,
638 639 640
           items.damaged,
           items.homebranch,
           items.holdingbranch
641 642 643 644 645 646 647 648 649 650 651
           FROM   items
           LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
           LEFT JOIN itemtypes   ON items.itype   = itemtypes.itemtype
        ";
    }
    else {
	$select = "
           SELECT items.biblionumber,
           items.biblioitemnumber,
           itemtypes.notforloan,
           items.notforloan AS itemnotforloan,
652
           items.itemnumber,
653 654 655
           items.damaged,
           items.homebranch,
           items.holdingbranch
656 657 658 659 660
           FROM   items
           LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
           LEFT JOIN itemtypes   ON biblioitems.itemtype   = itemtypes.itemtype
        ";
    }
661

finlayt's avatar
finlayt committed
662
    if ($item) {
663
        $sth = $dbh->prepare("$select WHERE itemnumber = ?");
664
        $sth->execute($item);
tipaul's avatar
tipaul committed
665 666
    }
    else {
667
        $sth = $dbh->prepare("$select WHERE barcode = ?");
668
        $sth->execute($barcode);
669
    }
670
    # note: we get the itemnumber because we might have started w/ just the barcode.  Now we know for sure we have it.
671
    my ( $biblio, $bibitem, $notforloan_per_itemtype, $notforloan_per_item, $itemnumber, $damaged, $item_homebranch, $item_holdingbranch ) = $sth->fetchrow_array;
672 673

    return if ( $damaged && !C4::Context->preference('AllowHoldsOnDamagedItems') );
674

675
    return unless $itemnumber; # bail if we got nothing.
676

tipaul's avatar
tipaul committed
677
    # if item is not for loan it cannot be reserved either.....
678
    # except where items.notforloan < 0 :  This indicates the item is holdable.
679
    return if  ( $notforloan_per_item > 0 ) or $notforloan_per_itemtype;
tipaul's avatar
tipaul committed
680

681
    # Find this item in the reserves
682
    my @reserves = _Findgroupreserve( $bibitem, $biblio, $itemnumber, $lookahead_days, $ignore_borrowers);
tipaul's avatar
tipaul committed
683

684
    # $priority and $highest are used to find the most important item
685
    # in the list returned by &_Findgroupreserve. (The lower $priority,
686 687
    # the more important the item.)
    # $highest is the most important item we've seen so far.
finlayt's avatar
finlayt committed
688
    my $highest;
689
    if (scalar @reserves) {
690 691 692 693
        my $LocalHoldsPriority = C4::Context->preference('LocalHoldsPriority');
        my $LocalHoldsPriorityPatronControl = C4::Context->preference('LocalHoldsPriorityPatronControl');
        my $LocalHoldsPriorityItemControl = C4::Context->preference('LocalHoldsPriorityItemControl');

694
        my $priority = 10000000;
tipaul's avatar
tipaul committed
695
        foreach my $res (@reserves) {
696
            if ( $res->{'itemnumber'} == $itemnumber && $res->{'priority'} == 0) {
697 698 699 700 701
                if ($res->{'found'} eq 'W') {
                    return ( "Waiting", $res, \@reserves ); # Found it, it is waiting
                } else {
                    return ( "Reserved", $res, \@reserves ); # Found determinated hold, e. g. the tranferred one
                }
702
            } else {
703
                my $patron;
704 705
                my $iteminfo;
                my $local_hold_match;
joubu's avatar
joubu committed
706

707
                if ($LocalHoldsPriority) {
708
                    $patron = Koha::Patrons->find( $res->{borrowernumber} );
709 710 711 712 713 714 715 716
                    $iteminfo = C4::Items::GetItem($itemnumber);

                    my $local_holds_priority_item_branchcode =
                      $iteminfo->{$LocalHoldsPriorityItemControl};
                    my $local_holds_priority_patron_branchcode =
                      ( $LocalHoldsPriorityPatronControl eq 'PickupLibrary' )
                      ? $res->{branchcode}
                      : ( $LocalHoldsPriorityPatronControl eq 'HomeLibrary' )
717
                      ? $patron->branchcode
718 719 720 721 722 723
                      : undef;
                    $local_hold_match =
                      $local_holds_priority_item_branchcode eq
                      $local_holds_priority_patron_branchcode;
                }

724
                # See if this item is more important than what we've got so far
725 726
                if ( ( $res->{'priority'} && $res->{'priority'} < $priority ) || $local_hold_match ) {
                    $iteminfo ||= C4::Items::GetItem($itemnumber);
727
                    next if $res->{itemtype} && $res->{itemtype} ne _get_itype( $iteminfo );
728 729
                    $patron ||= Koha::Patrons->find( $res->{borrowernumber} );
                    my $branch = GetReservesControlBranch( $iteminfo, $patron->unblessed );
730 731
                    my $branchitemrule = C4::Circulation::GetBranchItemRule($branch,$iteminfo->{'itype'});
                    next if ($branchitemrule->{'holdallowed'} == 0);
732
                    next if (($branchitemrule->{'holdallowed'} == 1) && ($branch ne $patron->branchcode));
733
                    next if ( ($branchitemrule->{hold_fulfillment_policy} ne 'any') && ($res->{branchcode} ne $iteminfo->{ $branchitemrule->{hold_fulfillment_policy} }) );
tipaul's avatar
tipaul committed
734 735
                    $priority = $res->{'priority'};
                    $highest  = $res;
736
                    last if $local_hold_match;
tipaul's avatar
tipaul committed
737 738 739
                }
            }
        }
finlayt's avatar
finlayt committed
740
    }
741

742 743 744
    # If we get this far, then no exact match was found.
    # We return the most important (i.e. next) reservation.
    if ($highest) {
tipaul's avatar
tipaul committed
745
        $highest->{'itemnumber'} = $item;
746
        return ( "Reserved", $highest, \@reserves );
finlayt's avatar
finlayt committed
747
    }
748 749

    return ( '' );
finlayt's avatar
finlayt committed
750 751
}

Andrew Elwell's avatar
Andrew Elwell committed
752
=head2 CancelExpiredReserves
753 754

  CancelExpiredReserves();
Andrew Elwell's avatar
Andrew Elwell committed
755 756 757

Cancels all reserves with an expiration date from before today.

758 759 760
=cut

sub CancelExpiredReserves {
761 762
    my $today = dt_from_string();
    my $cancel_on_holidays = C4::Context->preference('ExpireReservesOnHolidays');
763
    my $expireWaiting = C4::Context->preference('ExpireReservesMaxPickUpDelay');
764

765
    my $dtf = Koha::Database->new->schema->storage->datetime_parser;
766 767 768
    my $params = { expirationdate => { '<', $dtf->format_date($today) } };
    $params->{found} = undef unless $expireWaiting;

769
    # FIXME To move to Koha::Holds->search_expired (?)
770
    my $holds = Koha::Holds->search( $params );
771 772 773

    while ( my $hold = $holds->next ) {
        my $calendar = Koha::Calendar->new( branchcode => $hold->branchcode );
774

775
        next if !$cancel_on_holidays && $calendar->is_holiday( $today );
776

777
        my $cancel_params = {};
778
        if ( $hold->found eq 'W' ) {
779
            $cancel_params->{charge_cancel_fee} = 1;
780
        }
781
        $hold->cancel( $cancel_params );
782
    }
783 784
}

Kyle M Hall's avatar
Kyle M Hall committed
785 786 787 788 789 790 791 792 793
=head2 AutoUnsuspendReserves

  AutoUnsuspendReserves();

Unsuspends all suspended reserves with a suspend_until date from before today.

=cut

sub AutoUnsuspendReserves {
794
    my $today = dt_from_string();
Kyle M Hall's avatar
Kyle M Hall committed
795

796
    my @holds = Koha::Holds->search( { suspend_until => { '<' => $today->ymd() } } );
Kyle M Hall's avatar
Kyle M Hall committed
797

798
    map { $_->suspend(0)->suspend_until(undef)->store() } @holds;
Kyle M Hall's avatar
Kyle M Hall committed
799 800
}

Andrew Elwell's avatar
Andrew Elwell committed
801
=head2 ModReserve
802

803 804 805 806 807 808
  ModReserve({ rank => $rank,
               reserve_id => $reserve_id,
               branchcode => $branchcode
               [, itemnumber => $itemnumber ]
               [, biblionumber => $biblionumber, $borrowernumber => $borrowernumber ]
              });
809 810 811 812 813 814 815 816 817 818 819 820

Change a hold request's priority or cancel it.

C<$rank> specifies the effect of the change.  If C<$rank>
is 'W' or 'n', nothing happens.  This corresponds to leaving a
request alone when changing its priority in the holds queue
for a bib.

If C<$rank> is 'del', the hold request is cancelled.

If C<$rank> is an integer greater than zero, the priority of
the request is set to that value.  Since priority != 0 means
821
that the item is not waiting on the hold shelf, setting the
822
priority to a non-zero value also sets the request's found
823
status and waiting date to NULL.
824 825

The optional C<$itemnumber> parameter is used only when
826
C<$rank> is a non-zero integer; if supplied, the itemnumber
827 828 829
of the hold request is set accordingly; if omitted, the itemnumber
is cleared.

Andrew Elwell's avatar
Andrew Elwell committed
830
B<FIXME:> Note that the forgoing can have the effect of causing
831 832 833
item-level hold requests to turn into title-level requests.  This
will be fixed once reserves has separate columns for requested
itemnumber and supplying itemnumber.
834 835 836 837

=cut

sub ModReserve {
838 839 840 841 842 843 844 845 846 847 848 849 850 851
    my ( $params ) = @_;

    my $rank = $params->{'rank'};
    my $reserve_id = $params->{'reserve_id'};
    my $branchcode = $params->{'branchcode'};
    my $itemnumber = $params->{'itemnumber'};
    my $suspend_until = $params->{'suspend_until'};
    my $borrowernumber = $params->{'borrowernumber'};
    my $biblionumber = $params->{'biblionumber'};

    return if $rank eq "W";
    return if $rank eq "n";

    return unless ( $reserve_id || ( $borrowernumber && ( $biblionumber || $itemnumber ) ) );
852 853 854

    my $hold;
    unless ( $reserve_id ) {
855 856 857
        my $holds = Koha::Holds->search({ biblionumber => $biblionumber, borrowernumber => $borrowernumber, itemnumber => $itemnumber });
        return unless $holds->count; # FIXME Should raise an exception
        $hold = $holds->next;
858 859
        $reserve_id = $hold->reserve_id;
    }
860

861 862
    $hold ||= Koha::Holds->find($reserve_id);

863
    if ( $rank eq "del" ) {
864
        $hold->cancel;
865
    }
866
    elsif ($rank =~ /^\d+/ and $rank > 0) {
867 868
        logaction( 'HOLDS', 'MODIFY', $hold->reserve_id, Dumper($hold->unblessed) )
            if C4::Context->preference('HoldsLog');
869 870 871 872 873 874 875 876 877 878

        $hold->set(
            {
                priority    => $rank,
                branchcode  => $branchcode,
                itemnumber  => $itemnumber,
                found       => undef,
                waitingdate => undef
            }
        )->store();
Kyle M Hall's avatar
Kyle M Hall committed
879 880 881

        if ( defined( $suspend_until ) ) {
            if ( $suspend_until ) {
882 883
                $suspend_until = eval { dt_from_string( $suspend_until ) };
                $hold->suspend_hold( $suspend_until );
Kyle M Hall's avatar
Kyle M Hall committed
884
            } else {
885 886
                # If the hold is suspended leave the hold suspended, but convert it to an indefinite hold.
                # If the hold is not suspended, this does nothing.
887
                $hold->set( { suspend_until => undef } )->store();
Kyle M Hall's avatar
Kyle M Hall committed
888 889 890
            }
        }

891
        _FixPriority({ reserve_id => $reserve_id, rank =>$rank });
892 893
    }
}
tipaul's avatar
tipaul committed
894

Andrew Elwell's avatar
Andrew Elwell committed
895
=head2 ModReserveFill
896

897
  &ModReserveFill($reserve);
898 899 900

Fill a reserve. If I understand this correctly, this means that the
reserved book has been found and given to the patron who reserved it.
finlayt's avatar
finlayt committed
901

tipaul's avatar
tipaul committed
902 903
C<$reserve> specifies the reserve to fill. It is a reference-to-hash
whose keys are fields from the reserves table in the Koha database.
904 905

=cut
tipaul's avatar
tipaul committed
906

907
sub ModReserveFill {
finlayt's avatar
finlayt committed
908
    my ($res) = @_;
909
    my $reserve_id = $res->{'reserve_id'};
910 911

    my $hold = Koha::Holds->find($reserve_id);
912

913
    # get the priority on this record....
914 915 916 917 918 919 920 921 922 923
    my $priority = $hold->priority;

    # update the hold statuses, no need to store it though, we will be deleting it anyway
    $hold->set(
        {
            found    => 'F',
            priority => 0,
        }
    );

924
    # FIXME Must call Koha::Hold->cancel ? => No, should call ->filled and add the correct log
925
    Koha::Old::Hold->new( $hold->unblessed() )->store();
926 927

    $hold->delete();
928

929
    if ( C4::Context->preference('HoldFeeMode') eq 'any_time_is_collected' ) {
930
        my $reserve_fee = GetReserveFee( $hold->borrowernumber, $hold->biblionumber );
931 932 933
        ChargeReserveFee( $hold->borrowernumber, $reserve_fee, $hold->biblio->title );
    }

934 935
    # now fix the priority on the others (if the priority wasn't
    # already sorted!)....
tipaul's avatar
tipaul committed
936
    unless ( $priority == 0 ) {
937
        _FixPriority( { reserve_id => $reserve_id, biblionumber => $hold->biblionumber } );
finlayt's avatar
finlayt committed
938
    }
finlayt's avatar
finlayt committed
939 940
}

Andrew Elwell's avatar
Andrew Elwell committed
941
=head2 ModReserveStatus
tipaul's avatar
tipaul committed
942

Andrew Elwell's avatar
Andrew Elwell committed
943
  &ModReserveStatus($itemnumber, $newstatus);
tipaul's avatar
tipaul committed
944

945
Update the reserve status for the active (priority=0) reserve.
tipaul's avatar
tipaul committed
946

947
$itemnumber is the itemnumber the reserve is on
tipaul's avatar
tipaul committed
948

949
$newstatus is the new status.
tipaul's avatar
tipaul committed
950

951
=cut
tipaul's avatar
tipaul committed
952

953
sub ModReserveStatus {
tipaul's avatar
tipaul committed
954

955 956
    #first : check if we have a reservation for this item .
    my ($itemnumber, $newstatus) = @_;
957 958 959
    my $dbh = C4::Context->dbh;

    my $query = "UPDATE reserves SET found = ?, waitingdate = NOW() WHERE itemnumber = ? AND found IS NULL AND priority = 0";
960 961
    my $sth_set = $dbh->prepare($query);
    $sth_set->execute( $newstatus, $itemnumber );
962 963 964 965

    if ( C4::Context->preference("ReturnToShelvingCart") && $newstatus ) {
      CartToShelf( $itemnumber );
    }
finlayt's avatar
finlayt committed
966 967
}

Andrew Elwell's avatar
Andrew Elwell committed
968
=head2 ModReserveAffect
tipaul's avatar
tipaul committed
969

970
  &ModReserveAffect($itemnumber,$borrowernumber,$diffBranchSend,$reserve_id);
tipaul's avatar
tipaul committed
971

972 973 974 975
This function affect an item and a status for a given reserve, either fetched directly
by record_id, or by borrowernumber and itemnumber or biblionumber. If only biblionumber
is given, only first reserve returned is affected, which is ok for anything but
multi-item holds.
tipaul's avatar
tipaul committed
976

977
if $transferToDo is not set, then the status is set to "Waiting" as well.
978
otherwise, a transfer is on the way, and the end of the transfer will
979
take care of the waiting status
Andrew Elwell's avatar
Andrew Elwell committed
980

tipaul's avatar
tipaul committed
981 982
=cut

983
sub ModReserveAffect {
984
    my ( $itemnumber, $borrowernumber, $transferToDo, $reserve_id ) = @_;
tipaul's avatar
tipaul committed
985 986
    my $dbh = C4::Context->dbh;

987 988 989 990 991
    # we want to attach $itemnumber to $borrowernumber, find the biblionumber
    # attached to $itemnumber
    my $sth = $dbh->prepare("SELECT biblionumber FROM items WHERE itemnumber=?");
    $sth->execute($itemnumber);
    my ($biblionumber) = $sth->fetchrow;
992 993 994

    # get request - need to find out if item is already
    # waiting in order to not send duplicate hold filled notifications
995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006

    my $hold;
    # Find hold by id if we have it
    $hold = Koha::Holds->find( $reserve_id ) if $reserve_id;
    # Find item level hold for this item if there is one
    $hold ||= Koha::Holds->search( { borrowernumber => $borrowernumber, itemnumber => $itemnumber } )->next();
    # Find record level hold if there is no item level hold
    $hold ||= Koha::Holds->search( { borrowernumber => $borrowernumber, biblionumber => $biblionumber } )->next();

    return unless $hold;

    my $already_on_shelf = $hold->found && $hold->found eq 'W';
1007

1008 1009
    $hold->itemnumber($itemnumber);
    $hold->set_waiting($transferToDo);
1010

1011
    _koha_notify_reserve( $hold->reserve_id )
1012 1013
      if ( !$transferToDo && !$already_on_shelf );

1014
    _FixPriority( { biblionumber => $biblionumber } );
1015

1016
    if ( C4::Context->preference("ReturnToShelvingCart") ) {
1017
        CartToShelf($itemnumber);
1018 1019
    }

1020
    return;
finlayt's avatar
finlayt committed
1021 1022
}

Andrew Elwell's avatar
Andrew Elwell committed
1023
=head2 ModReserveCancelAll
1024

Andrew Elwell's avatar
Andrew Elwell committed
1025
  ($messages,$nextreservinfo) = &ModReserveCancelAll($itemnumber,$borrowernumber);
1026

Andrew Elwell's avatar
Andrew Elwell committed
1027
function to cancel reserv,check other reserves, and transfer document if it's necessary
1028 1029

=cut
tipaul's avatar
tipaul committed
1030

1031 1032 1033 1034 1035 1036
sub ModReserveCancelAll {
    my $messages;
    my $nextreservinfo;
    my ( $itemnumber, $borrowernumber ) = @_;

    #step 1 : cancel the reservation
1037 1038 1039
    my $holds = Koha::Holds->search({ itemnumber => $itemnumber, borrowernumber => $borrowernumber });
    return unless $holds->count;
    $holds->next->cancel;
1040 1041 1042

    #step 2 launch the subroutine of the others reserves
    ( $messages, $nextreservinfo ) = GetOtherReserves($itemnumber);
tipaul's avatar
tipaul committed
1043

1044 1045 1046
    return ( $messages, $nextreservinfo );
}

Andrew Elwell's avatar
Andrew Elwell committed
1047
=head2 ModReserveMinusPriority
1048

Andrew Elwell's avatar
Andrew Elwell committed
1049
  &ModReserveMinusPriority($itemnumber,$borrowernumber,$biblionumber)
tipaul's avatar
tipaul committed
1050

1051
Reduce the values of queued list
tipaul's avatar
tipaul committed
1052 1053 1054

=cut

1055
sub ModReserveMinusPriority {
1056
    my ( $itemnumber, $reserve_id ) = @_;
1057 1058 1059

    #first step update the value of the first person on reserv
    my $dbh   = C4::Context->dbh;
1060
    my $query = "
1061
        UPDATE reserves
1062
        SET    priority = 0 , itemnumber = ?
1063
        WHERE  reserve_id = ?
1064 1065
    ";
    my $sth_upd = $dbh->prepare($query);
1066
    $sth_upd->execute( $itemnumber, $reserve_id );
1067
    # second step update all others reserves
1068
    _FixPriority({ reserve_id => $reserve_id, rank => '0' });
1069 1070
}

Andrew Elwell's avatar
Andrew Elwell committed
1071
=head2 IsAvailableForItemLevelRequest
1072

1073
  my $is_available = IsAvailableForItemLevelRequest($item_record,$borrower_record);
1074 1075 1076 1077

Checks whether a given item record is available for an
item-level hold request.  An item is available if

1078 1079 1080
* it is not lost AND
* it is not damaged AND
* it is not withdrawn AND
1081
* a waiting or in transit reserve is placed on
1082
* does not have a not for loan value > 0
1083

1084 1085
Need to check the issuingrules onshelfholds column,
if this is set items on the shelf can be placed on hold
1086 1087 1088 1089

Note that IsAvailableForItemLevelRequest() does not
check if the staff operator is authorized to place
a request on the item - in particular,
1090
this routine does not check IndependentBranches
1091 1092 1093 1094 1095
and canreservefromotherbranches.

=cut

sub IsAvailableForItemLevelRequest {
1096 1097
    my $item = shift;
    my $borrower = shift;
1098

1099
    my $dbh = C4::Context->dbh;
1100 1101 1102 1103
    # must check the notforloan setting of the itemtype
    # FIXME - a lot of places in the code do this
    #         or something similar - need to be
    #         consolidated
1104 1105 1106
    my $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
    my $item_object = Koha::Items->find( $item->{itemnumber } );
    my $itemtype = $item_object->effective_itemtype;
1107 1108
    my $notforloan_per_itemtype
      = $dbh->selectrow_array("SELECT notforloan FROM itemtypes WHERE itemtype = ?",
1109
                              undef, $itemtype);
1110 1111 1112 1113 1114

    return 0 if
        $notforloan_per_itemtype ||
        $item->{itemlost}        ||
        $item->{notforloan} > 0  ||