Bug 15494: Add _items_denied_renewal sub to C4:Circulation::CanBookBeRenewed
[koha.git] / C4 / Circulation.pm
bloba929c6ca25ede5f1ea5aa90e8012b767151a64be
1 package C4::Circulation;
3 # Copyright 2000-2002 Katipo Communications
4 # copyright 2010 BibLibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use strict;
23 #use warnings; FIXME - Bug 2505
24 use DateTime;
25 use POSIX qw( floor );
26 use Koha::DateUtils;
27 use C4::Context;
28 use C4::Stats;
29 use C4::Reserves;
30 use C4::Biblio;
31 use C4::Items;
32 use C4::Members;
33 use C4::Accounts;
34 use C4::ItemCirculationAlertPreference;
35 use C4::Message;
36 use C4::Debug;
37 use C4::Log; # logaction
38 use C4::Overdues qw(CalcFine UpdateFine get_chargeable_units);
39 use C4::RotatingCollections qw(GetCollectionItemBranches);
40 use Algorithm::CheckDigits;
42 use Data::Dumper;
43 use Koha::Account;
44 use Koha::AuthorisedValues;
45 use Koha::Biblioitems;
46 use Koha::DateUtils;
47 use Koha::Calendar;
48 use Koha::Checkouts;
49 use Koha::IssuingRules;
50 use Koha::Items;
51 use Koha::Patrons;
52 use Koha::Patron::Debarments;
53 use Koha::Database;
54 use Koha::Libraries;
55 use Koha::Holds;
56 use Koha::RefundLostItemFeeRule;
57 use Koha::RefundLostItemFeeRules;
58 use Koha::Account::Lines;
59 use Koha::Account::Offsets;
60 use Carp;
61 use List::MoreUtils qw( uniq any );
62 use Scalar::Util qw( looks_like_number );
63 use Date::Calc qw(
64 Today
65 Today_and_Now
66 Add_Delta_YM
67 Add_Delta_DHMS
68 Date_to_Days
69 Day_of_Week
70 Add_Delta_Days
72 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
74 BEGIN {
75 require Exporter;
76 @ISA = qw(Exporter);
78 # FIXME subs that should probably be elsewhere
79 push @EXPORT, qw(
80 &barcodedecode
81 &LostItem
82 &ReturnLostItem
83 &GetPendingOnSiteCheckouts
86 # subs to deal with issuing a book
87 push @EXPORT, qw(
88 &CanBookBeIssued
89 &CanBookBeRenewed
90 &AddIssue
91 &AddRenewal
92 &GetRenewCount
93 &GetSoonestRenewDate
94 &GetLatestAutoRenewDate
95 &GetIssuingCharges
96 &GetBranchBorrowerCircRule
97 &GetBranchItemRule
98 &GetBiblioIssues
99 &GetOpenIssue
100 &CheckIfIssuedToPatron
101 &IsItemIssued
102 GetTopIssues
105 # subs to deal with returns
106 push @EXPORT, qw(
107 &AddReturn
108 &MarkIssueReturned
111 # subs to deal with transfers
112 push @EXPORT, qw(
113 &transferbook
114 &GetTransfers
115 &GetTransfersFromTo
116 &updateWrongTransfer
117 &DeleteTransfer
118 &IsBranchTransferAllowed
119 &CreateBranchTransferLimit
120 &DeleteBranchTransferLimits
121 &TransferSlip
124 # subs to deal with offline circulation
125 push @EXPORT, qw(
126 &GetOfflineOperations
127 &GetOfflineOperation
128 &AddOfflineOperation
129 &DeleteOfflineOperation
130 &ProcessOfflineOperation
134 =head1 NAME
136 C4::Circulation - Koha circulation module
138 =head1 SYNOPSIS
140 use C4::Circulation;
142 =head1 DESCRIPTION
144 The functions in this module deal with circulation, issues, and
145 returns, as well as general information about the library.
146 Also deals with inventory.
148 =head1 FUNCTIONS
150 =head2 barcodedecode
152 $str = &barcodedecode($barcode, [$filter]);
154 Generic filter function for barcode string.
155 Called on every circ if the System Pref itemBarcodeInputFilter is set.
156 Will do some manipulation of the barcode for systems that deliver a barcode
157 to circulation.pl that differs from the barcode stored for the item.
158 For proper functioning of this filter, calling the function on the
159 correct barcode string (items.barcode) should return an unaltered barcode.
161 The optional $filter argument is to allow for testing or explicit
162 behavior that ignores the System Pref. Valid values are the same as the
163 System Pref options.
165 =cut
167 # FIXME -- the &decode fcn below should be wrapped into this one.
168 # FIXME -- these plugins should be moved out of Circulation.pm
170 sub barcodedecode {
171 my ($barcode, $filter) = @_;
172 my $branch = C4::Context::mybranch();
173 $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
174 $filter or return $barcode; # ensure filter is defined, else return untouched barcode
175 if ($filter eq 'whitespace') {
176 $barcode =~ s/\s//g;
177 } elsif ($filter eq 'cuecat') {
178 chomp($barcode);
179 my @fields = split( /\./, $barcode );
180 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
181 ($#results == 2) and return $results[2];
182 } elsif ($filter eq 'T-prefix') {
183 if ($barcode =~ /^[Tt](\d)/) {
184 (defined($1) and $1 eq '0') and return $barcode;
185 $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1)
187 return sprintf("T%07d", $barcode);
188 # FIXME: $barcode could be "T1", causing warning: substr outside of string
189 # Why drop the nonzero digit after the T?
190 # Why pass non-digits (or empty string) to "T%07d"?
191 } elsif ($filter eq 'libsuite8') {
192 unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it.
193 if($barcode =~ m/^(\d)/i){ #Some barcodes even start with 0's & numbers and are assumed to have b as the item type in the libsuite8 software
194 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
195 }else{
196 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
199 } elsif ($filter eq 'EAN13') {
200 my $ean = CheckDigits('ean');
201 if ( $ean->is_valid($barcode) ) {
202 #$barcode = sprintf('%013d',$barcode); # this doesn't work on 32-bit systems
203 $barcode = '0' x ( 13 - length($barcode) ) . $barcode;
204 } else {
205 warn "# [$barcode] not valid EAN-13/UPC-A\n";
208 return $barcode; # return barcode, modified or not
211 =head2 decode
213 $str = &decode($chunk);
215 Decodes a segment of a string emitted by a CueCat barcode scanner and
216 returns it.
218 FIXME: Should be replaced with Barcode::Cuecat from CPAN
219 or Javascript based decoding on the client side.
221 =cut
223 sub decode {
224 my ($encoded) = @_;
225 my $seq =
226 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
227 my @s = map { index( $seq, $_ ); } split( //, $encoded );
228 my $l = ( $#s + 1 ) % 4;
229 if ($l) {
230 if ( $l == 1 ) {
231 # warn "Error: Cuecat decode parsing failed!";
232 return;
234 $l = 4 - $l;
235 $#s += $l;
237 my $r = '';
238 while ( $#s >= 0 ) {
239 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
240 $r .=
241 chr( ( $n >> 16 ) ^ 67 )
242 .chr( ( $n >> 8 & 255 ) ^ 67 )
243 .chr( ( $n & 255 ) ^ 67 );
244 @s = @s[ 4 .. $#s ];
246 $r = substr( $r, 0, length($r) - $l );
247 return $r;
250 =head2 transferbook
252 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
253 $barcode, $ignore_reserves);
255 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
257 C<$newbranch> is the code for the branch to which the item should be transferred.
259 C<$barcode> is the barcode of the item to be transferred.
261 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
262 Otherwise, if an item is reserved, the transfer fails.
264 Returns three values:
266 =over
268 =item $dotransfer
270 is true if the transfer was successful.
272 =item $messages
274 is a reference-to-hash which may have any of the following keys:
276 =over
278 =item C<BadBarcode>
280 There is no item in the catalog with the given barcode. The value is C<$barcode>.
282 =item C<DestinationEqualsHolding>
284 The item is already at the branch to which it is being transferred. The transfer is nonetheless considered to have failed. The value should be ignored.
286 =item C<WasReturned>
288 The item was on loan, and C<&transferbook> automatically returned it before transferring it. The value is the borrower number of the patron who had the item.
290 =item C<ResFound>
292 The item was reserved. The value is a reference-to-hash whose keys are fields from the reserves table of the Koha database, and C<biblioitemnumber>. It also has the key C<ResFound>, whose value is either C<Waiting> or C<Reserved>.
294 =item C<WasTransferred>
296 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
298 =back
300 =back
302 =cut
304 sub transferbook {
305 my ( $tbr, $barcode, $ignoreRs ) = @_;
306 my $messages;
307 my $dotransfer = 1;
308 my $item = Koha::Items->find( { barcode => $barcode } );
310 # bad barcode..
311 unless ( $item ) {
312 $messages->{'BadBarcode'} = $barcode;
313 $dotransfer = 0;
316 my $itemnumber = $item->itemnumber;
317 my $issue = GetOpenIssue($itemnumber);
318 # get branches of book...
319 my $hbr = $item->homebranch;
320 my $fbr = $item->holdingbranch;
322 # if using Branch Transfer Limits
323 if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
324 my $code = C4::Context->preference("BranchTransferLimitsType") eq 'ccode' ? $item->ccode : $item->biblio->biblioitem->itemtype; # BranchTransferLimitsType is 'ccode' or 'itemtype'
325 if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
326 if ( ! IsBranchTransferAllowed( $tbr, $fbr, $item->itype ) ) {
327 $messages->{'NotAllowed'} = $tbr . "::" . $item->itype;
328 $dotransfer = 0;
330 } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $code ) ) {
331 $messages->{'NotAllowed'} = $tbr . "::" . $code;
332 $dotransfer = 0;
336 # can't transfer book if is already there....
337 if ( $fbr eq $tbr ) {
338 $messages->{'DestinationEqualsHolding'} = 1;
339 $dotransfer = 0;
342 # check if it is still issued to someone, return it...
343 if ( $issue ) {
344 AddReturn( $barcode, $fbr );
345 $messages->{'WasReturned'} = $issue->borrowernumber;
348 # find reserves.....
349 # That'll save a database query.
350 my ( $resfound, $resrec, undef ) =
351 CheckReserves( $itemnumber );
352 if ( $resfound and not $ignoreRs ) {
353 $resrec->{'ResFound'} = $resfound;
355 # $messages->{'ResFound'} = $resrec;
356 $dotransfer = 1;
359 #actually do the transfer....
360 if ($dotransfer) {
361 ModItemTransfer( $itemnumber, $fbr, $tbr );
363 # don't need to update MARC anymore, we do it in batch now
364 $messages->{'WasTransfered'} = 1;
367 ModDateLastSeen( $itemnumber );
368 return ( $dotransfer, $messages );
372 sub TooMany {
373 my $borrower = shift;
374 my $biblionumber = shift;
375 my $item = shift;
376 my $params = shift;
377 my $onsite_checkout = $params->{onsite_checkout} || 0;
378 my $switch_onsite_checkout = $params->{switch_onsite_checkout} || 0;
379 my $cat_borrower = $borrower->{'categorycode'};
380 my $dbh = C4::Context->dbh;
381 my $branch;
382 # Get which branchcode we need
383 $branch = _GetCircControlBranch($item,$borrower);
384 my $type = (C4::Context->preference('item-level_itypes'))
385 ? $item->{'itype'} # item-level
386 : $item->{'itemtype'}; # biblio-level
388 # given branch, patron category, and item type, determine
389 # applicable issuing rule
390 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
391 { categorycode => $cat_borrower,
392 itemtype => $type,
393 branchcode => $branch
398 # if a rule is found and has a loan limit set, count
399 # how many loans the patron already has that meet that
400 # rule
401 if (defined($issuing_rule) and defined($issuing_rule->maxissueqty)) {
402 my @bind_params;
403 my $count_query = q|
404 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
405 FROM issues
406 JOIN items USING (itemnumber)
409 my $rule_itemtype = $issuing_rule->itemtype;
410 if ($rule_itemtype eq "*") {
411 # matching rule has the default item type, so count only
412 # those existing loans that don't fall under a more
413 # specific rule
414 if (C4::Context->preference('item-level_itypes')) {
415 $count_query .= " WHERE items.itype NOT IN (
416 SELECT itemtype FROM issuingrules
417 WHERE branchcode = ?
418 AND (categorycode = ? OR categorycode = ?)
419 AND itemtype <> '*'
420 ) ";
421 } else {
422 $count_query .= " JOIN biblioitems USING (biblionumber)
423 WHERE biblioitems.itemtype NOT IN (
424 SELECT itemtype FROM issuingrules
425 WHERE branchcode = ?
426 AND (categorycode = ? OR categorycode = ?)
427 AND itemtype <> '*'
428 ) ";
430 push @bind_params, $issuing_rule->branchcode;
431 push @bind_params, $issuing_rule->categorycode;
432 push @bind_params, $cat_borrower;
433 } else {
434 # rule has specific item type, so count loans of that
435 # specific item type
436 if (C4::Context->preference('item-level_itypes')) {
437 $count_query .= " WHERE items.itype = ? ";
438 } else {
439 $count_query .= " JOIN biblioitems USING (biblionumber)
440 WHERE biblioitems.itemtype= ? ";
442 push @bind_params, $type;
445 $count_query .= " AND borrowernumber = ? ";
446 push @bind_params, $borrower->{'borrowernumber'};
447 my $rule_branch = $issuing_rule->branchcode;
448 if ($rule_branch ne "*") {
449 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
450 $count_query .= " AND issues.branchcode = ? ";
451 push @bind_params, $branch;
452 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
453 ; # if branch is the patron's home branch, then count all loans by patron
454 } else {
455 $count_query .= " AND items.homebranch = ? ";
456 push @bind_params, $branch;
460 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $count_query, {}, @bind_params );
462 my $max_checkouts_allowed = $issuing_rule->maxissueqty;
463 my $max_onsite_checkouts_allowed = $issuing_rule->maxonsiteissueqty;
465 if ( $onsite_checkout and defined $max_onsite_checkouts_allowed ) {
466 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
467 return {
468 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
469 count => $onsite_checkout_count,
470 max_allowed => $max_onsite_checkouts_allowed,
474 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
475 my $delta = $switch_onsite_checkout ? 1 : 0;
476 if ( $checkout_count >= $max_checkouts_allowed + $delta ) {
477 return {
478 reason => 'TOO_MANY_CHECKOUTS',
479 count => $checkout_count,
480 max_allowed => $max_checkouts_allowed,
483 } elsif ( not $onsite_checkout ) {
484 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
485 return {
486 reason => 'TOO_MANY_CHECKOUTS',
487 count => $checkout_count - $onsite_checkout_count,
488 max_allowed => $max_checkouts_allowed,
494 # Now count total loans against the limit for the branch
495 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
496 if (defined($branch_borrower_circ_rule->{maxissueqty})) {
497 my @bind_params = ();
498 my $branch_count_query = q|
499 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
500 FROM issues
501 JOIN items USING (itemnumber)
502 WHERE borrowernumber = ?
504 push @bind_params, $borrower->{borrowernumber};
506 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
507 $branch_count_query .= " AND issues.branchcode = ? ";
508 push @bind_params, $branch;
509 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
510 ; # if branch is the patron's home branch, then count all loans by patron
511 } else {
512 $branch_count_query .= " AND items.homebranch = ? ";
513 push @bind_params, $branch;
515 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $branch_count_query, {}, @bind_params );
516 my $max_checkouts_allowed = $branch_borrower_circ_rule->{maxissueqty};
517 my $max_onsite_checkouts_allowed = $branch_borrower_circ_rule->{maxonsiteissueqty};
519 if ( $onsite_checkout and defined $max_onsite_checkouts_allowed ) {
520 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
521 return {
522 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
523 count => $onsite_checkout_count,
524 max_allowed => $max_onsite_checkouts_allowed,
528 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
529 my $delta = $switch_onsite_checkout ? 1 : 0;
530 if ( $checkout_count >= $max_checkouts_allowed + $delta ) {
531 return {
532 reason => 'TOO_MANY_CHECKOUTS',
533 count => $checkout_count,
534 max_allowed => $max_checkouts_allowed,
537 } elsif ( not $onsite_checkout ) {
538 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
539 return {
540 reason => 'TOO_MANY_CHECKOUTS',
541 count => $checkout_count - $onsite_checkout_count,
542 max_allowed => $max_checkouts_allowed,
548 if ( not defined( $issuing_rule ) and not defined($branch_borrower_circ_rule->{maxissueqty}) ) {
549 return { reason => 'NO_RULE_DEFINED', max_allowed => 0 };
552 # OK, the patron can issue !!!
553 return;
556 =head2 CanBookBeIssued
558 ( $issuingimpossible, $needsconfirmation, [ $alerts ] ) = CanBookBeIssued( $patron,
559 $barcode, $duedate, $inprocess, $ignore_reserves, $params );
561 Check if a book can be issued.
563 C<$issuingimpossible> and C<$needsconfirmation> are hashrefs.
565 IMPORTANT: The assumption by users of this routine is that causes blocking
566 the issue are keyed by uppercase labels and other returned
567 data is keyed in lower case!
569 =over 4
571 =item C<$patron> is a Koha::Patron
573 =item C<$barcode> is the bar code of the book being issued.
575 =item C<$duedates> is a DateTime object.
577 =item C<$inprocess> boolean switch
579 =item C<$ignore_reserves> boolean switch
581 =item C<$params> Hashref of additional parameters
583 Available keys:
584 override_high_holds - Ignore high holds
585 onsite_checkout - Checkout is an onsite checkout that will not leave the library
587 =back
589 Returns :
591 =over 4
593 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
594 Possible values are :
596 =back
598 =head3 INVALID_DATE
600 sticky due date is invalid
602 =head3 GNA
604 borrower gone with no address
606 =head3 CARD_LOST
608 borrower declared it's card lost
610 =head3 DEBARRED
612 borrower debarred
614 =head3 UNKNOWN_BARCODE
616 barcode unknown
618 =head3 NOT_FOR_LOAN
620 item is not for loan
622 =head3 WTHDRAWN
624 item withdrawn.
626 =head3 RESTRICTED
628 item is restricted (set by ??)
630 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
631 could be prevented, but ones that can be overriden by the operator.
633 Possible values are :
635 =head3 DEBT
637 borrower has debts.
639 =head3 RENEW_ISSUE
641 renewing, not issuing
643 =head3 ISSUED_TO_ANOTHER
645 issued to someone else.
647 =head3 RESERVED
649 reserved for someone else.
651 =head3 INVALID_DATE
653 sticky due date is invalid or due date in the past
655 =head3 TOO_MANY
657 if the borrower borrows to much things
659 =cut
661 sub CanBookBeIssued {
662 my ( $patron, $barcode, $duedate, $inprocess, $ignore_reserves, $params ) = @_;
663 my %needsconfirmation; # filled with problems that needs confirmations
664 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
665 my %alerts; # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
666 my %messages; # filled with information messages that should be displayed.
668 my $onsite_checkout = $params->{onsite_checkout} || 0;
669 my $override_high_holds = $params->{override_high_holds} || 0;
671 my $item = GetItem(undef, $barcode );
672 # MANDATORY CHECKS - unless item exists, nothing else matters
673 unless ( $item ) {
674 $issuingimpossible{UNKNOWN_BARCODE} = 1;
676 return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
678 my $issue = Koha::Checkouts->find( { itemnumber => $item->{itemnumber} } );
679 my $biblio = Koha::Biblios->find( $item->{biblionumber} );
680 my $biblioitem = $biblio->biblioitem;
681 my $effective_itemtype = $item->{itype}; # GetItem deals with that
682 my $dbh = C4::Context->dbh;
683 my $patron_unblessed = $patron->unblessed;
686 # DUE DATE is OK ? -- should already have checked.
688 if ($duedate && ref $duedate ne 'DateTime') {
689 $duedate = dt_from_string($duedate);
691 my $now = DateTime->now( time_zone => C4::Context->tz() );
692 unless ( $duedate ) {
693 my $issuedate = $now->clone();
695 my $branch = _GetCircControlBranch($item, $patron_unblessed);
696 $duedate = CalcDateDue( $issuedate, $effective_itemtype, $branch, $patron_unblessed );
698 # Offline circ calls AddIssue directly, doesn't run through here
699 # So issuingimpossible should be ok.
701 if ($duedate) {
702 my $today = $now->clone();
703 $today->truncate( to => 'minute');
704 if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
705 $needsconfirmation{INVALID_DATE} = output_pref($duedate);
707 } else {
708 $issuingimpossible{INVALID_DATE} = output_pref($duedate);
712 # BORROWER STATUS
714 if ( $patron->category->category_type eq 'X' && ( $item->{barcode} )) {
715 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
716 &UpdateStats({
717 branch => C4::Context->userenv->{'branch'},
718 type => 'localuse',
719 itemnumber => $item->{'itemnumber'},
720 itemtype => $effective_itemtype,
721 borrowernumber => $patron->borrowernumber,
722 ccode => $item->{'ccode'}}
724 ModDateLastSeen( $item->{'itemnumber'} );
725 return( { STATS => 1 }, {});
728 if ( $patron->gonenoaddress == 1 ) {
729 $issuingimpossible{GNA} = 1;
732 if ( $patron->lost == 1 ) {
733 $issuingimpossible{CARD_LOST} = 1;
735 if ( $patron->is_debarred ) {
736 $issuingimpossible{DEBARRED} = 1;
739 if ( $patron->is_expired ) {
740 $issuingimpossible{EXPIRED} = 1;
744 # BORROWER STATUS
747 # DEBTS
748 my $account = $patron->account;
749 my $balance = $account->balance;
750 my $non_issues_charges = $account->non_issues_charges;
751 my $other_charges = $balance - $non_issues_charges;
753 my $amountlimit = C4::Context->preference("noissuescharge");
754 my $allowfineoverride = C4::Context->preference("AllowFineOverride");
755 my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
757 # Check the debt of this patrons guarantees
758 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
759 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
760 if ( defined $no_issues_charge_guarantees ) {
761 my @guarantees = $patron->guarantees();
762 my $guarantees_non_issues_charges;
763 foreach my $g ( @guarantees ) {
764 $guarantees_non_issues_charges += $g->account->non_issues_charges;
767 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && !$allowfineoverride) {
768 $issuingimpossible{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
769 } elsif ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && $allowfineoverride) {
770 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
771 } elsif ( $allfinesneedoverride && $guarantees_non_issues_charges > 0 && $guarantees_non_issues_charges <= $no_issues_charge_guarantees && !$inprocess ) {
772 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
776 if ( C4::Context->preference("IssuingInProcess") ) {
777 if ( $non_issues_charges > $amountlimit && !$inprocess && !$allowfineoverride) {
778 $issuingimpossible{DEBT} = $non_issues_charges;
779 } elsif ( $non_issues_charges > $amountlimit && !$inprocess && $allowfineoverride) {
780 $needsconfirmation{DEBT} = $non_issues_charges;
781 } elsif ( $allfinesneedoverride && $non_issues_charges > 0 && $non_issues_charges <= $amountlimit && !$inprocess ) {
782 $needsconfirmation{DEBT} = $non_issues_charges;
785 else {
786 if ( $non_issues_charges > $amountlimit && $allowfineoverride ) {
787 $needsconfirmation{DEBT} = $non_issues_charges;
788 } elsif ( $non_issues_charges > $amountlimit && !$allowfineoverride) {
789 $issuingimpossible{DEBT} = $non_issues_charges;
790 } elsif ( $non_issues_charges > 0 && $allfinesneedoverride ) {
791 $needsconfirmation{DEBT} = $non_issues_charges;
795 if ($balance > 0 && $other_charges > 0) {
796 $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges );
799 $patron = Koha::Patrons->find( $patron->borrowernumber ); # FIXME Refetch just in case, to avoid regressions. But must not be needed
800 $patron_unblessed = $patron->unblessed;
802 if ( my $debarred_date = $patron->is_debarred ) {
803 # patron has accrued fine days or has a restriction. $count is a date
804 if ($debarred_date eq '9999-12-31') {
805 $issuingimpossible{USERBLOCKEDNOENDDATE} = $debarred_date;
807 else {
808 $issuingimpossible{USERBLOCKEDWITHENDDATE} = $debarred_date;
810 } elsif ( my $num_overdues = $patron->has_overdues ) {
811 ## patron has outstanding overdue loans
812 if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
813 $issuingimpossible{USERBLOCKEDOVERDUE} = $num_overdues;
815 elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
816 $needsconfirmation{USERBLOCKEDOVERDUE} = $num_overdues;
821 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
823 if ( $issue && $issue->borrowernumber eq $patron->borrowernumber ){
825 # Already issued to current borrower.
826 # If it is an on-site checkout if it can be switched to a normal checkout
827 # or ask whether the loan should be renewed
829 if ( $issue->onsite_checkout
830 and C4::Context->preference('SwitchOnSiteCheckouts') ) {
831 $messages{ONSITE_CHECKOUT_WILL_BE_SWITCHED} = 1;
832 } else {
833 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
834 $patron->borrowernumber,
835 $item->{'itemnumber'},
837 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
838 if ( $renewerror eq 'onsite_checkout' ) {
839 $issuingimpossible{NO_RENEWAL_FOR_ONSITE_CHECKOUTS} = 1;
841 else {
842 $issuingimpossible{NO_MORE_RENEWALS} = 1;
845 else {
846 $needsconfirmation{RENEW_ISSUE} = 1;
850 elsif ( $issue ) {
852 # issued to someone else
854 my $patron = Koha::Patrons->find( $issue->borrowernumber );
856 my ( $can_be_returned, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
858 unless ( $can_be_returned ) {
859 $issuingimpossible{RETURN_IMPOSSIBLE} = 1;
860 $issuingimpossible{branch_to_return} = $message;
861 } else {
862 $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
863 $needsconfirmation{issued_firstname} = $patron->firstname;
864 $needsconfirmation{issued_surname} = $patron->surname;
865 $needsconfirmation{issued_cardnumber} = $patron->cardnumber;
866 $needsconfirmation{issued_borrowernumber} = $patron->borrowernumber;
870 # JB34 CHECKS IF BORROWERS DON'T HAVE ISSUE TOO MANY BOOKS
872 my $switch_onsite_checkout = (
873 C4::Context->preference('SwitchOnSiteCheckouts')
874 and $issue
875 and $issue->onsite_checkout
876 and $issue->borrowernumber == $patron->borrowernumber ? 1 : 0 );
877 my $toomany = TooMany( $patron_unblessed, $item->{biblionumber}, $item, { onsite_checkout => $onsite_checkout, switch_onsite_checkout => $switch_onsite_checkout, } );
878 # if TooMany max_allowed returns 0 the user doesn't have permission to check out this book
879 if ( $toomany && not exists $needsconfirmation{RENEW_ISSUE} ) {
880 if ( $toomany->{max_allowed} == 0 ) {
881 $needsconfirmation{PATRON_CANT} = 1;
883 if ( C4::Context->preference("AllowTooManyOverride") ) {
884 $needsconfirmation{TOO_MANY} = $toomany->{reason};
885 $needsconfirmation{current_loan_count} = $toomany->{count};
886 $needsconfirmation{max_loans_allowed} = $toomany->{max_allowed};
887 } else {
888 $issuingimpossible{TOO_MANY} = $toomany->{reason};
889 $issuingimpossible{current_loan_count} = $toomany->{count};
890 $issuingimpossible{max_loans_allowed} = $toomany->{max_allowed};
895 # CHECKPREVCHECKOUT: CHECK IF ITEM HAS EVER BEEN LENT TO PATRON
897 $patron = Koha::Patrons->find( $patron->borrowernumber ); # FIXME Refetch just in case, to avoid regressions. But must not be needed
898 my $wants_check = $patron->wants_check_for_previous_checkout;
899 $needsconfirmation{PREVISSUE} = 1
900 if ($wants_check and $patron->do_check_for_previous_checkout($item));
903 # ITEM CHECKING
905 if ( $item->{'notforloan'} )
907 if(!C4::Context->preference("AllowNotForLoanOverride")){
908 $issuingimpossible{NOT_FOR_LOAN} = 1;
909 $issuingimpossible{item_notforloan} = $item->{'notforloan'};
910 }else{
911 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
912 $needsconfirmation{item_notforloan} = $item->{'notforloan'};
915 else {
916 # we have to check itemtypes.notforloan also
917 if (C4::Context->preference('item-level_itypes')){
918 # this should probably be a subroutine
919 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
920 $sth->execute($effective_itemtype);
921 my $notforloan=$sth->fetchrow_hashref();
922 if ($notforloan->{'notforloan'}) {
923 if (!C4::Context->preference("AllowNotForLoanOverride")) {
924 $issuingimpossible{NOT_FOR_LOAN} = 1;
925 $issuingimpossible{itemtype_notforloan} = $effective_itemtype;
926 } else {
927 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
928 $needsconfirmation{itemtype_notforloan} = $effective_itemtype;
932 else {
933 my $itemtype = Koha::ItemTypes->find($biblioitem->itemtype);
934 if ( $itemtype and $itemtype->notforloan == 1){
935 if (!C4::Context->preference("AllowNotForLoanOverride")) {
936 $issuingimpossible{NOT_FOR_LOAN} = 1;
937 $issuingimpossible{itemtype_notforloan} = $effective_itemtype;
938 } else {
939 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
940 $needsconfirmation{itemtype_notforloan} = $effective_itemtype;
945 if ( $item->{'withdrawn'} && $item->{'withdrawn'} > 0 )
947 $issuingimpossible{WTHDRAWN} = 1;
949 if ( $item->{'restricted'}
950 && $item->{'restricted'} == 1 )
952 $issuingimpossible{RESTRICTED} = 1;
954 if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
955 my $av = Koha::AuthorisedValues->search({ category => 'LOST', authorised_value => $item->{itemlost} });
956 my $code = $av->count ? $av->next->lib : '';
957 $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
958 $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
960 if ( C4::Context->preference("IndependentBranches") ) {
961 my $userenv = C4::Context->userenv;
962 unless ( C4::Context->IsSuperLibrarian() ) {
963 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ){
964 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
965 $issuingimpossible{'itemhomebranch'} = $item->{C4::Context->preference("HomeOrHoldingBranch")};
967 $needsconfirmation{BORRNOTSAMEBRANCH} = $patron->branchcode
968 if ( $patron->branchcode ne $userenv->{branch} );
972 # CHECK IF THERE IS RENTAL CHARGES. RENTAL MUST BE CONFIRMED BY THE BORROWER
974 my $rentalConfirmation = C4::Context->preference("RentalFeesCheckoutConfirmation");
976 if ( $rentalConfirmation ){
977 my ($rentalCharge) = GetIssuingCharges( $item->{'itemnumber'}, $patron->borrowernumber );
978 if ( $rentalCharge > 0 ){
979 $needsconfirmation{RENTALCHARGE} = $rentalCharge;
983 unless ( $ignore_reserves ) {
984 # See if the item is on reserve.
985 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
986 if ($restype) {
987 my $resbor = $res->{'borrowernumber'};
988 if ( $resbor ne $patron->borrowernumber ) {
989 my $patron = Koha::Patrons->find( $resbor );
990 if ( $restype eq "Waiting" )
992 # The item is on reserve and waiting, but has been
993 # reserved by some other patron.
994 $needsconfirmation{RESERVE_WAITING} = 1;
995 $needsconfirmation{'resfirstname'} = $patron->firstname;
996 $needsconfirmation{'ressurname'} = $patron->surname;
997 $needsconfirmation{'rescardnumber'} = $patron->cardnumber;
998 $needsconfirmation{'resborrowernumber'} = $patron->borrowernumber;
999 $needsconfirmation{'resbranchcode'} = $res->{branchcode};
1000 $needsconfirmation{'reswaitingdate'} = $res->{'waitingdate'};
1002 elsif ( $restype eq "Reserved" ) {
1003 # The item is on reserve for someone else.
1004 $needsconfirmation{RESERVED} = 1;
1005 $needsconfirmation{'resfirstname'} = $patron->firstname;
1006 $needsconfirmation{'ressurname'} = $patron->surname;
1007 $needsconfirmation{'rescardnumber'} = $patron->cardnumber;
1008 $needsconfirmation{'resborrowernumber'} = $patron->borrowernumber;
1009 $needsconfirmation{'resbranchcode'} = $patron->branchcode;
1010 $needsconfirmation{'resreservedate'} = $res->{reservedate};
1016 ## CHECK AGE RESTRICTION
1017 my $agerestriction = $biblioitem->agerestriction;
1018 my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $patron->unblessed );
1019 if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1020 if ( C4::Context->preference('AgeRestrictionOverride') ) {
1021 $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1023 else {
1024 $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1028 ## check for high holds decreasing loan period
1029 if ( C4::Context->preference('decreaseLoanHighHolds') ) {
1030 my $check = checkHighHolds( $item, $patron_unblessed );
1032 if ( $check->{exceeded} ) {
1033 if ($override_high_holds) {
1034 $alerts{HIGHHOLDS} = {
1035 num_holds => $check->{outstanding},
1036 duration => $check->{duration},
1037 returndate => output_pref( { dt => dt_from_string($check->{due_date}), dateformat => 'iso', timeformat => '24hr' }),
1040 else {
1041 $needsconfirmation{HIGHHOLDS} = {
1042 num_holds => $check->{outstanding},
1043 duration => $check->{duration},
1044 returndate => output_pref( { dt => dt_from_string($check->{due_date}), dateformat => 'iso', timeformat => '24hr' }),
1050 if (
1051 !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1052 # don't do the multiple loans per bib check if we've
1053 # already determined that we've got a loan on the same item
1054 !$issuingimpossible{NO_MORE_RENEWALS} &&
1055 !$needsconfirmation{RENEW_ISSUE}
1057 # Check if borrower has already issued an item from the same biblio
1058 # Only if it's not a subscription
1059 my $biblionumber = $item->{biblionumber};
1060 require C4::Serials;
1061 my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1062 unless ($is_a_subscription) {
1063 # FIXME Should be $patron->checkouts($args);
1064 my $checkouts = Koha::Checkouts->search(
1066 borrowernumber => $patron->borrowernumber,
1067 biblionumber => $biblionumber,
1070 join => 'item',
1073 # if we get here, we don't already have a loan on this item,
1074 # so if there are any loans on this bib, ask for confirmation
1075 if ( $checkouts->count ) {
1076 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1081 return ( \%issuingimpossible, \%needsconfirmation, \%alerts, \%messages, );
1084 =head2 CanBookBeReturned
1086 ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1088 Check whether the item can be returned to the provided branch
1090 =over 4
1092 =item C<$item> is a hash of item information as returned from GetItem
1094 =item C<$branch> is the branchcode where the return is taking place
1096 =back
1098 Returns:
1100 =over 4
1102 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1104 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1106 =back
1108 =cut
1110 sub CanBookBeReturned {
1111 my ($item, $branch) = @_;
1112 my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1114 # assume return is allowed to start
1115 my $allowed = 1;
1116 my $message;
1118 # identify all cases where return is forbidden
1119 if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1120 $allowed = 0;
1121 $message = $item->{'homebranch'};
1122 } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1123 $allowed = 0;
1124 $message = $item->{'holdingbranch'};
1125 } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1126 $allowed = 0;
1127 $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1130 return ($allowed, $message);
1133 =head2 CheckHighHolds
1135 used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1136 decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1137 has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1139 =cut
1141 sub checkHighHolds {
1142 my ( $item, $borrower ) = @_;
1143 my $branch = _GetCircControlBranch( $item, $borrower );
1144 my $item_object = Koha::Items->find( $item->{itemnumber} );
1146 my $return_data = {
1147 exceeded => 0,
1148 outstanding => 0,
1149 duration => 0,
1150 due_date => undef,
1153 my $holds = Koha::Holds->search( { biblionumber => $item->{'biblionumber'} } );
1155 if ( $holds->count() ) {
1156 $return_data->{outstanding} = $holds->count();
1158 my $decreaseLoanHighHoldsControl = C4::Context->preference('decreaseLoanHighHoldsControl');
1159 my $decreaseLoanHighHoldsValue = C4::Context->preference('decreaseLoanHighHoldsValue');
1160 my $decreaseLoanHighHoldsIgnoreStatuses = C4::Context->preference('decreaseLoanHighHoldsIgnoreStatuses');
1162 my @decreaseLoanHighHoldsIgnoreStatuses = split( /,/, $decreaseLoanHighHoldsIgnoreStatuses );
1164 if ( $decreaseLoanHighHoldsControl eq 'static' ) {
1166 # static means just more than a given number of holds on the record
1168 # If the number of holds is less than the threshold, we can stop here
1169 if ( $holds->count() < $decreaseLoanHighHoldsValue ) {
1170 return $return_data;
1173 elsif ( $decreaseLoanHighHoldsControl eq 'dynamic' ) {
1175 # dynamic means X more than the number of holdable items on the record
1177 # let's get the items
1178 my @items = $holds->next()->biblio()->items();
1180 # Remove any items with status defined to be ignored even if the would not make item unholdable
1181 foreach my $status (@decreaseLoanHighHoldsIgnoreStatuses) {
1182 @items = grep { !$_->$status } @items;
1185 # Remove any items that are not holdable for this patron
1186 @items = grep { CanItemBeReserved( $borrower->{borrowernumber}, $_->itemnumber )->{status} eq 'OK' } @items;
1188 my $items_count = scalar @items;
1190 my $threshold = $items_count + $decreaseLoanHighHoldsValue;
1192 # If the number of holds is less than the count of items we have
1193 # plus the number of holds allowed above that count, we can stop here
1194 if ( $holds->count() <= $threshold ) {
1195 return $return_data;
1199 my $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1201 my $calendar = Koha::Calendar->new( branchcode => $branch );
1203 my $itype = $item_object->effective_itemtype;
1204 my $orig_due = C4::Circulation::CalcDateDue( $issuedate, $itype, $branch, $borrower );
1206 my $decreaseLoanHighHoldsDuration = C4::Context->preference('decreaseLoanHighHoldsDuration');
1208 my $reduced_datedue = $calendar->addDate( $issuedate, $decreaseLoanHighHoldsDuration );
1209 $reduced_datedue->set_hour($orig_due->hour);
1210 $reduced_datedue->set_minute($orig_due->minute);
1211 $reduced_datedue->truncate( to => 'minute' );
1213 if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1214 $return_data->{exceeded} = 1;
1215 $return_data->{duration} = $decreaseLoanHighHoldsDuration;
1216 $return_data->{due_date} = $reduced_datedue;
1220 return $return_data;
1223 =head2 AddIssue
1225 &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1227 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1229 =over 4
1231 =item C<$borrower> is a hash with borrower informations (from Koha::Patron->unblessed).
1233 =item C<$barcode> is the barcode of the item being issued.
1235 =item C<$datedue> is a DateTime object for the max date of return, i.e. the date due (optional).
1236 Calculated if empty.
1238 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1240 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1241 Defaults to today. Unlike C<$datedue>, NOT a DateTime object, unfortunately.
1243 AddIssue does the following things :
1245 - step 01: check that there is a borrowernumber & a barcode provided
1246 - check for RENEWAL (book issued & being issued to the same patron)
1247 - renewal YES = Calculate Charge & renew
1248 - renewal NO =
1249 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1250 * RESERVE PLACED ?
1251 - fill reserve if reserve to this patron
1252 - cancel reserve or not, otherwise
1253 * TRANSFERT PENDING ?
1254 - complete the transfert
1255 * ISSUE THE BOOK
1257 =back
1259 =cut
1261 sub AddIssue {
1262 my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1264 my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1265 my $switch_onsite_checkout = $params && $params->{switch_onsite_checkout};
1266 my $auto_renew = $params && $params->{auto_renew};
1267 my $dbh = C4::Context->dbh;
1268 my $barcodecheck = CheckValidBarcode($barcode);
1270 my $issue;
1272 if ( $datedue && ref $datedue ne 'DateTime' ) {
1273 $datedue = dt_from_string($datedue);
1276 # $issuedate defaults to today.
1277 if ( !defined $issuedate ) {
1278 $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1280 else {
1281 if ( ref $issuedate ne 'DateTime' ) {
1282 $issuedate = dt_from_string($issuedate);
1287 # Stop here if the patron or barcode doesn't exist
1288 if ( $borrower && $barcode && $barcodecheck ) {
1289 # find which item we issue
1290 my $item = GetItem( '', $barcode )
1291 or return; # if we don't get an Item, abort.
1292 my $item_object = Koha::Items->find( { barcode => $barcode } );
1294 my $branch = _GetCircControlBranch( $item, $borrower );
1296 # get actual issuing if there is one
1297 my $actualissue = Koha::Checkouts->find( { itemnumber => $item->{itemnumber} } );
1299 # check if we just renew the issue.
1300 if ( $actualissue and $actualissue->borrowernumber eq $borrower->{'borrowernumber'}
1301 and not $switch_onsite_checkout ) {
1302 $datedue = AddRenewal(
1303 $borrower->{'borrowernumber'},
1304 $item->{'itemnumber'},
1305 $branch,
1306 $datedue,
1307 $issuedate, # here interpreted as the renewal date
1310 else {
1311 # it's NOT a renewal
1312 if ( $actualissue and not $switch_onsite_checkout ) {
1313 # This book is currently on loan, but not to the person
1314 # who wants to borrow it now. mark it returned before issuing to the new borrower
1315 my ( $allowed, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
1316 return unless $allowed;
1317 AddReturn( $item->{'barcode'}, C4::Context->userenv->{'branch'} );
1320 C4::Reserves::MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1322 # Starting process for transfer job (checking transfert and validate it if we have one)
1323 my ($datesent) = GetTransfers( $item->{'itemnumber'} );
1324 if ($datesent) {
1325 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1326 my $sth = $dbh->prepare(
1327 "UPDATE branchtransfers
1328 SET datearrived = now(),
1329 tobranch = ?,
1330 comments = 'Forced branchtransfer'
1331 WHERE itemnumber= ? AND datearrived IS NULL"
1333 $sth->execute( C4::Context->userenv->{'branch'},
1334 $item->{'itemnumber'} );
1337 # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1338 unless ($auto_renew) {
1339 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
1340 { categorycode => $borrower->{categorycode},
1341 itemtype => $item->{itype},
1342 branchcode => $branch
1346 $auto_renew = $issuing_rule->auto_renew if $issuing_rule;
1349 # Record in the database the fact that the book was issued.
1350 unless ($datedue) {
1351 my $itype = $item_object->effective_itemtype;
1352 $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1355 $datedue->truncate( to => 'minute' );
1357 $issue = Koha::Database->new()->schema()->resultset('Issue')->update_or_create(
1359 borrowernumber => $borrower->{'borrowernumber'},
1360 itemnumber => $item->{'itemnumber'},
1361 issuedate => $issuedate->strftime('%Y-%m-%d %H:%M:%S'),
1362 date_due => $datedue->strftime('%Y-%m-%d %H:%M:%S'),
1363 branchcode => C4::Context->userenv->{'branch'},
1364 onsite_checkout => $onsite_checkout,
1365 auto_renew => $auto_renew ? 1 : 0
1369 if ( C4::Context->preference('ReturnToShelvingCart') ) {
1370 # ReturnToShelvingCart is on, anything issued should be taken off the cart.
1371 CartToShelf( $item->{'itemnumber'} );
1373 $item->{'issues'}++;
1374 if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1375 UpdateTotalIssues( $item->{'biblionumber'}, 1 );
1378 ## If item was lost, it has now been found, reverse any list item charges if necessary.
1379 if ( $item->{'itemlost'} ) {
1380 if (
1381 Koha::RefundLostItemFeeRules->should_refund(
1383 current_branch => C4::Context->userenv->{branch},
1384 item_home_branch => $item->{homebranch},
1385 item_holding_branch => $item->{holdingbranch}
1390 _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef,
1391 $item->{'barcode'} );
1395 ModItem(
1397 issues => $item->{'issues'},
1398 holdingbranch => C4::Context->userenv->{'branch'},
1399 itemlost => 0,
1400 onloan => $datedue->ymd(),
1401 datelastborrowed => DateTime->now( time_zone => C4::Context->tz() )->ymd(),
1403 $item->{'biblionumber'},
1404 $item->{'itemnumber'},
1405 { log_action => 0 }
1407 ModDateLastSeen( $item->{'itemnumber'} );
1409 # If it costs to borrow this book, charge it to the patron's account.
1410 my ( $charge, $itemtype ) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
1411 if ( $charge > 0 ) {
1412 AddIssuingCharge( $issue, $charge );
1413 $item->{'charge'} = $charge;
1416 # Record the fact that this book was issued.
1417 &UpdateStats(
1419 branch => C4::Context->userenv->{'branch'},
1420 type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1421 amount => $charge,
1422 other => ( $sipmode ? "SIP-$sipmode" : '' ),
1423 itemnumber => $item->{'itemnumber'},
1424 itemtype => $item->{'itype'},
1425 location => $item->{location},
1426 borrowernumber => $borrower->{'borrowernumber'},
1427 ccode => $item->{'ccode'}
1431 # Send a checkout slip.
1432 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1433 my %conditions = (
1434 branchcode => $branch,
1435 categorycode => $borrower->{categorycode},
1436 item_type => $item->{itype},
1437 notification => 'CHECKOUT',
1439 if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
1440 SendCirculationAlert(
1442 type => 'CHECKOUT',
1443 item => $item,
1444 borrower => $borrower,
1445 branch => $branch,
1449 logaction(
1450 "CIRCULATION", "ISSUE",
1451 $borrower->{'borrowernumber'},
1452 $item->{'itemnumber'}
1453 ) if C4::Context->preference("IssueLog");
1456 return $issue;
1459 =head2 GetLoanLength
1461 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1463 Get loan length for an itemtype, a borrower type and a branch
1465 =cut
1467 sub GetLoanLength {
1468 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1469 my $dbh = C4::Context->dbh;
1470 my $sth = $dbh->prepare(qq{
1471 SELECT issuelength, lengthunit, renewalperiod
1472 FROM issuingrules
1473 WHERE categorycode=?
1474 AND itemtype=?
1475 AND branchcode=?
1476 AND issuelength IS NOT NULL
1479 # try to find issuelength & return the 1st available.
1480 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1481 $sth->execute( $borrowertype, $itemtype, $branchcode );
1482 my $loanlength = $sth->fetchrow_hashref;
1484 return $loanlength
1485 if defined($loanlength) && defined $loanlength->{issuelength};
1487 $sth->execute( $borrowertype, '*', $branchcode );
1488 $loanlength = $sth->fetchrow_hashref;
1489 return $loanlength
1490 if defined($loanlength) && defined $loanlength->{issuelength};
1492 $sth->execute( '*', $itemtype, $branchcode );
1493 $loanlength = $sth->fetchrow_hashref;
1494 return $loanlength
1495 if defined($loanlength) && defined $loanlength->{issuelength};
1497 $sth->execute( '*', '*', $branchcode );
1498 $loanlength = $sth->fetchrow_hashref;
1499 return $loanlength
1500 if defined($loanlength) && defined $loanlength->{issuelength};
1502 $sth->execute( $borrowertype, $itemtype, '*' );
1503 $loanlength = $sth->fetchrow_hashref;
1504 return $loanlength
1505 if defined($loanlength) && defined $loanlength->{issuelength};
1507 $sth->execute( $borrowertype, '*', '*' );
1508 $loanlength = $sth->fetchrow_hashref;
1509 return $loanlength
1510 if defined($loanlength) && defined $loanlength->{issuelength};
1512 $sth->execute( '*', $itemtype, '*' );
1513 $loanlength = $sth->fetchrow_hashref;
1514 return $loanlength
1515 if defined($loanlength) && defined $loanlength->{issuelength};
1517 $sth->execute( '*', '*', '*' );
1518 $loanlength = $sth->fetchrow_hashref;
1519 return $loanlength
1520 if defined($loanlength) && defined $loanlength->{issuelength};
1522 # if no rule is set => 0 day (hardcoded)
1523 return {
1524 issuelength => 0,
1525 renewalperiod => 0,
1526 lengthunit => 'days',
1532 =head2 GetHardDueDate
1534 my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1536 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1538 =cut
1540 sub GetHardDueDate {
1541 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1543 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
1544 { categorycode => $borrowertype,
1545 itemtype => $itemtype,
1546 branchcode => $branchcode
1551 if ( defined( $issuing_rule ) ) {
1552 if ( $issuing_rule->hardduedate ) {
1553 return (dt_from_string($issuing_rule->hardduedate, 'iso'),$issuing_rule->hardduedatecompare);
1554 } else {
1555 return (undef, undef);
1560 =head2 GetBranchBorrowerCircRule
1562 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1564 Retrieves circulation rule attributes that apply to the given
1565 branch and patron category, regardless of item type.
1566 The return value is a hashref containing the following key:
1568 maxissueqty - maximum number of loans that a
1569 patron of the given category can have at the given
1570 branch. If the value is undef, no limit.
1572 maxonsiteissueqty - maximum of on-site checkouts that a
1573 patron of the given category can have at the given
1574 branch. If the value is undef, no limit.
1576 This will first check for a specific branch and
1577 category match from branch_borrower_circ_rules.
1579 If no rule is found, it will then check default_branch_circ_rules
1580 (same branch, default category). If no rule is found,
1581 it will then check default_borrower_circ_rules (default
1582 branch, same category), then failing that, default_circ_rules
1583 (default branch, default category).
1585 If no rule has been found in the database, it will default to
1586 the buillt in rule:
1588 maxissueqty - undef
1589 maxonsiteissueqty - undef
1591 C<$branchcode> and C<$categorycode> should contain the
1592 literal branch code and patron category code, respectively - no
1593 wildcards.
1595 =cut
1597 sub GetBranchBorrowerCircRule {
1598 my ( $branchcode, $categorycode ) = @_;
1600 my $rules;
1601 my $dbh = C4::Context->dbh();
1602 $rules = $dbh->selectrow_hashref( q|
1603 SELECT maxissueqty, maxonsiteissueqty
1604 FROM branch_borrower_circ_rules
1605 WHERE branchcode = ?
1606 AND categorycode = ?
1607 |, {}, $branchcode, $categorycode ) ;
1608 return $rules if $rules;
1610 # try same branch, default borrower category
1611 $rules = $dbh->selectrow_hashref( q|
1612 SELECT maxissueqty, maxonsiteissueqty
1613 FROM default_branch_circ_rules
1614 WHERE branchcode = ?
1615 |, {}, $branchcode ) ;
1616 return $rules if $rules;
1618 # try default branch, same borrower category
1619 $rules = $dbh->selectrow_hashref( q|
1620 SELECT maxissueqty, maxonsiteissueqty
1621 FROM default_borrower_circ_rules
1622 WHERE categorycode = ?
1623 |, {}, $categorycode ) ;
1624 return $rules if $rules;
1626 # try default branch, default borrower category
1627 $rules = $dbh->selectrow_hashref( q|
1628 SELECT maxissueqty, maxonsiteissueqty
1629 FROM default_circ_rules
1630 |, {} );
1631 return $rules if $rules;
1633 # built-in default circulation rule
1634 return {
1635 maxissueqty => undef,
1636 maxonsiteissueqty => undef,
1640 =head2 GetBranchItemRule
1642 my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1644 Retrieves circulation rule attributes that apply to the given
1645 branch and item type, regardless of patron category.
1647 The return value is a hashref containing the following keys:
1649 holdallowed => Hold policy for this branch and itemtype. Possible values:
1650 0: No holds allowed.
1651 1: Holds allowed only by patrons that have the same homebranch as the item.
1652 2: Holds allowed from any patron.
1654 returnbranch => branch to which to return item. Possible values:
1655 noreturn: do not return, let item remain where checked in (floating collections)
1656 homebranch: return to item's home branch
1657 holdingbranch: return to issuer branch
1659 This searches branchitemrules in the following order:
1661 * Same branchcode and itemtype
1662 * Same branchcode, itemtype '*'
1663 * branchcode '*', same itemtype
1664 * branchcode and itemtype '*'
1666 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1668 =cut
1670 sub GetBranchItemRule {
1671 my ( $branchcode, $itemtype ) = @_;
1672 my $dbh = C4::Context->dbh();
1673 my $result = {};
1675 my @attempts = (
1676 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1677 FROM branch_item_rules
1678 WHERE branchcode = ?
1679 AND itemtype = ?', $branchcode, $itemtype],
1680 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1681 FROM default_branch_circ_rules
1682 WHERE branchcode = ?', $branchcode],
1683 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1684 FROM default_branch_item_rules
1685 WHERE itemtype = ?', $itemtype],
1686 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1687 FROM default_circ_rules'],
1690 foreach my $attempt (@attempts) {
1691 my ($query, @bind_params) = @{$attempt};
1692 my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1693 or next;
1695 # Since branch/category and branch/itemtype use the same per-branch
1696 # defaults tables, we have to check that the key we want is set, not
1697 # just that a row was returned
1698 $result->{'holdallowed'} = $search_result->{'holdallowed'} unless ( defined $result->{'holdallowed'} );
1699 $result->{'hold_fulfillment_policy'} = $search_result->{'hold_fulfillment_policy'} unless ( defined $result->{'hold_fulfillment_policy'} );
1700 $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1703 # built-in default circulation rule
1704 $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1705 $result->{'hold_fulfillment_policy'} = 'any' unless ( defined $result->{'hold_fulfillment_policy'} );
1706 $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1708 return $result;
1711 =head2 AddReturn
1713 ($doreturn, $messages, $iteminformation, $borrower) =
1714 &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
1716 Returns a book.
1718 =over 4
1720 =item C<$barcode> is the bar code of the book being returned.
1722 =item C<$branch> is the code of the branch where the book is being returned.
1724 =item C<$exemptfine> indicates that overdue charges for the item will be
1725 removed. Optional.
1727 =item C<$dropbox> indicates that the check-in date is assumed to be
1728 yesterday, or the last non-holiday as defined in C4::Calendar . If
1729 overdue charges are applied and C<$dropbox> is true, the last charge
1730 will be removed. This assumes that the fines accrual script has run
1731 for _today_. Optional.
1733 =item C<$return_date> allows the default return date to be overridden
1734 by the given return date. Optional.
1736 =back
1738 C<&AddReturn> returns a list of four items:
1740 C<$doreturn> is true iff the return succeeded.
1742 C<$messages> is a reference-to-hash giving feedback on the operation.
1743 The keys of the hash are:
1745 =over 4
1747 =item C<BadBarcode>
1749 No item with this barcode exists. The value is C<$barcode>.
1751 =item C<NotIssued>
1753 The book is not currently on loan. The value is C<$barcode>.
1755 =item C<withdrawn>
1757 This book has been withdrawn/cancelled. The value should be ignored.
1759 =item C<Wrongbranch>
1761 This book has was returned to the wrong branch. The value is a hashref
1762 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1763 contain the branchcode of the incorrect and correct return library, respectively.
1765 =item C<ResFound>
1767 The item was reserved. The value is a reference-to-hash whose keys are
1768 fields from the reserves table of the Koha database, and
1769 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1770 either C<Waiting>, C<Reserved>, or 0.
1772 =item C<WasReturned>
1774 Value 1 if return is successful.
1776 =item C<NeedsTransfer>
1778 If AutomaticItemReturn is disabled, return branch is given as value of NeedsTransfer.
1780 =back
1782 C<$iteminformation> is a reference-to-hash, giving information about the
1783 returned item from the issues table.
1785 C<$borrower> is a reference-to-hash, giving information about the
1786 patron who last borrowed the book.
1788 =cut
1790 sub AddReturn {
1791 my ( $barcode, $branch, $exemptfine, $dropbox, $return_date, $dropboxdate ) = @_;
1793 if ($branch and not Koha::Libraries->find($branch)) {
1794 warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
1795 undef $branch;
1797 $branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
1798 my $messages;
1799 my $patron;
1800 my $doreturn = 1;
1801 my $validTransfert = 0;
1802 my $stat_type = 'return';
1804 # get information on item
1805 my $item = GetItem( undef, $barcode );
1806 unless ($item) {
1807 return ( 0, { BadBarcode => $barcode } ); # no barcode means no item or borrower. bail out.
1810 my $itemnumber = $item->{ itemnumber };
1811 my $itemtype = $item->{itype}; # GetItem called effective_itemtype
1813 my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } );
1814 if ( $issue ) {
1815 $patron = Koha::Patrons->find( $issue->borrowernumber )
1816 or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existent borrowernumber '" . $issue->borrowernumber . "'\n"
1817 . Dumper($issue->unblessed) . "\n";
1818 } else {
1819 $messages->{'NotIssued'} = $barcode;
1820 ModItem({ onloan => undef }, $item->{biblionumber}, $item->{itemnumber}) if defined $item->{onloan};
1821 # even though item is not on loan, it may still be transferred; therefore, get current branch info
1822 $doreturn = 0;
1823 # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later.
1824 # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1825 if (C4::Context->preference("RecordLocalUseOnReturn")) {
1826 $messages->{'LocalUse'} = 1;
1827 $stat_type = 'localuse';
1831 if ( $item->{'location'} eq 'PROC' ) {
1832 if ( C4::Context->preference("InProcessingToShelvingCart") ) {
1833 $item->{'location'} = 'CART';
1835 else {
1836 $item->{location} = $item->{permanent_location};
1839 ModItem( $item, $item->{'biblionumber'}, $item->{'itemnumber'}, { log_action => 0 } );
1842 # full item data, but no borrowernumber or checkout info (no issue)
1843 my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1844 # get the proper branch to which to return the item
1845 my $returnbranch = $item->{$hbr} || $branch ;
1846 # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1848 my $borrowernumber = $patron ? $patron->borrowernumber : undef; # we don't know if we had a borrower or not
1849 my $patron_unblessed = $patron ? $patron->unblessed : {};
1851 my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
1852 if ($yaml) {
1853 $yaml = "$yaml\n\n"; # YAML is anal on ending \n. Surplus does not hurt
1854 my $rules;
1855 eval { $rules = YAML::Load($yaml); };
1856 if ($@) {
1857 warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
1859 else {
1860 foreach my $key ( keys %$rules ) {
1861 if ( $item->{notforloan} eq $key ) {
1862 $messages->{'NotForLoanStatusUpdated'} = { from => $item->{notforloan}, to => $rules->{$key} };
1863 ModItem( { notforloan => $rules->{$key} }, undef, $itemnumber, { log_action => 0 } );
1864 last;
1870 # check if the return is allowed at this branch
1871 my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
1872 unless ($returnallowed){
1873 $messages->{'Wrongbranch'} = {
1874 Wrongbranch => $branch,
1875 Rightbranch => $message
1877 $doreturn = 0;
1878 return ( $doreturn, $messages, $issue, $patron_unblessed);
1881 if ( $item->{'withdrawn'} ) { # book has been cancelled
1882 $messages->{'withdrawn'} = 1;
1883 $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
1886 if ( $item->{itemlost} and C4::Context->preference("BlockReturnOfLostItems") ) {
1887 $doreturn = 0;
1890 # case of a return of document (deal with issues and holdingbranch)
1891 my $today = DateTime->now( time_zone => C4::Context->tz() );
1893 if ($doreturn) {
1894 my $is_overdue;
1895 die "The item is not issed and cannot be returned" unless $issue; # Just in case...
1896 $patron or warn "AddReturn without current borrower";
1897 my $circControlBranch;
1898 if ($dropbox) {
1899 # define circControlBranch only if dropbox mode is set
1900 # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1901 # FIXME: check issuedate > returndate, factoring in holidays
1903 $circControlBranch = _GetCircControlBranch($item,$patron_unblessed);
1904 $is_overdue = $issue->is_overdue( $dropboxdate );
1905 } else {
1906 $is_overdue = $issue->is_overdue;
1909 if ($patron) {
1910 eval {
1911 MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
1912 $circControlBranch, $return_date, $patron->privacy );
1914 unless ( $@ ) {
1915 if ( ( C4::Context->preference('CalculateFinesOnReturn') && $is_overdue ) || $return_date ) {
1916 _CalculateAndUpdateFine( { issue => $issue, item => $item, borrower => $patron_unblessed, return_date => $return_date } );
1918 } else {
1919 carp "The checkin for the following issue failed, Please go to the about page, section 'data corrupted' to know how to fix this problem ($@)" . Dumper( $issue->unblessed );
1921 return ( 0, { WasReturned => 0, DataCorrupted => 1 }, $issue, $patron_unblessed );
1924 # FIXME is the "= 1" right? This could be the borrower hash.
1925 $messages->{'WasReturned'} = 1;
1929 ModItem( { onloan => undef }, $item->{biblionumber}, $item->{itemnumber}, { log_action => 0 } );
1932 # the holdingbranch is updated if the document is returned to another location.
1933 # this is always done regardless of whether the item was on loan or not
1934 my $item_holding_branch = $item->{ holdingbranch };
1935 if ($item->{'holdingbranch'} ne $branch) {
1936 UpdateHoldingbranch($branch, $item->{'itemnumber'});
1937 $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1940 my $leave_item_lost = C4::Context->preference("BlockReturnOfLostItems") ? 1 : 0;
1941 ModDateLastSeen( $item->{itemnumber}, $leave_item_lost );
1943 # check if we have a transfer for this document
1944 my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1946 # if we have a transfer to do, we update the line of transfers with the datearrived
1947 my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->{'itemnumber'} );
1948 if ($datesent) {
1949 if ( $tobranch eq $branch ) {
1950 my $sth = C4::Context->dbh->prepare(
1951 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1953 $sth->execute( $item->{'itemnumber'} );
1954 # if we have a reservation with valid transfer, we can set it's status to 'W'
1955 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1956 C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1957 } else {
1958 $messages->{'WrongTransfer'} = $tobranch;
1959 $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1961 $validTransfert = 1;
1962 } else {
1963 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1966 # fix up the accounts.....
1967 if ( $item->{'itemlost'} ) {
1968 $messages->{'WasLost'} = 1;
1969 unless ( C4::Context->preference("BlockReturnOfLostItems") ) {
1970 if (
1971 Koha::RefundLostItemFeeRules->should_refund(
1973 current_branch => C4::Context->userenv->{branch},
1974 item_home_branch => $item->{homebranch},
1975 item_holding_branch => $item_holding_branch
1980 _FixAccountForLostAndReturned( $item->{'itemnumber'},
1981 $borrowernumber, $barcode );
1982 $messages->{'LostItemFeeRefunded'} = 1;
1987 # fix up the overdues in accounts...
1988 if ($borrowernumber) {
1989 my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
1990 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
1992 if ( $issue and $issue->is_overdue ) {
1993 # fix fine days
1994 $today = dt_from_string($return_date) if $return_date;
1995 $today = $dropboxdate if $dropbox;
1996 my ($debardate,$reminder) = _debar_user_on_return( $patron_unblessed, $item, dt_from_string($issue->date_due), $today );
1997 if ($reminder){
1998 $messages->{'PrevDebarred'} = $debardate;
1999 } else {
2000 $messages->{'Debarred'} = $debardate if $debardate;
2002 # there's no overdue on the item but borrower had been previously debarred
2003 } elsif ( $issue->date_due and $patron->debarred ) {
2004 if ( $patron->debarred eq "9999-12-31") {
2005 $messages->{'ForeverDebarred'} = $patron->debarred;
2006 } else {
2007 my $borrower_debar_dt = dt_from_string( $patron->debarred );
2008 $borrower_debar_dt->truncate(to => 'day');
2009 my $today_dt = $today->clone()->truncate(to => 'day');
2010 if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2011 $messages->{'PrevDebarred'} = $patron->debarred;
2017 # find reserves.....
2018 # if we don't have a reserve with the status W, we launch the Checkreserves routine
2019 my ($resfound, $resrec);
2020 my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2021 ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'}, undef, $lookahead ) unless ( $item->{'withdrawn'} );
2022 if ($resfound) {
2023 $resrec->{'ResFound'} = $resfound;
2024 $messages->{'ResFound'} = $resrec;
2027 # Record the fact that this book was returned.
2028 UpdateStats({
2029 branch => $branch,
2030 type => $stat_type,
2031 itemnumber => $itemnumber,
2032 itemtype => $itemtype,
2033 borrowernumber => $borrowernumber,
2034 ccode => $item->{ ccode }
2037 # Send a check-in slip. # NOTE: borrower may be undef. Do not try to send messages then.
2038 if ( $patron ) {
2039 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2040 my %conditions = (
2041 branchcode => $branch,
2042 categorycode => $patron->categorycode,
2043 item_type => $item->{itype},
2044 notification => 'CHECKIN',
2046 if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2047 SendCirculationAlert({
2048 type => 'CHECKIN',
2049 item => $item,
2050 borrower => $patron->unblessed,
2051 branch => $branch,
2055 logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
2056 if C4::Context->preference("ReturnLog");
2059 # Remove any OVERDUES related debarment if the borrower has no overdues
2060 if ( $borrowernumber
2061 && $patron->debarred
2062 && C4::Context->preference('AutoRemoveOverduesRestrictions')
2063 && !Koha::Patrons->find( $borrowernumber )->has_overdues
2064 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2066 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2069 # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2070 if (!$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) and not $messages->{'WrongTransfer'}){
2071 if (C4::Context->preference("AutomaticItemReturn" ) or
2072 (C4::Context->preference("UseBranchTransferLimits") and
2073 ! IsBranchTransferAllowed($branch, $returnbranch, $item->{C4::Context->preference("BranchTransferLimitsType")} )
2074 )) {
2075 $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $returnbranch;
2076 $debug and warn "item: " . Dumper($item);
2077 ModItemTransfer($item->{'itemnumber'}, $branch, $returnbranch);
2078 $messages->{'WasTransfered'} = 1;
2079 } else {
2080 $messages->{'NeedsTransfer'} = $returnbranch;
2084 return ( $doreturn, $messages, $issue, ( $patron ? $patron->unblessed : {} ));
2087 =head2 MarkIssueReturned
2089 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
2091 Unconditionally marks an issue as being returned by
2092 moving the C<issues> row to C<old_issues> and
2093 setting C<returndate> to the current date, or
2094 the last non-holiday date of the branccode specified in
2095 C<dropbox_branch> . Assumes you've already checked that
2096 it's safe to do this, i.e. last non-holiday > issuedate.
2098 if C<$returndate> is specified (in iso format), it is used as the date
2099 of the return. It is ignored when a dropbox_branch is passed in.
2101 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2102 the old_issue is immediately anonymised
2104 Ideally, this function would be internal to C<C4::Circulation>,
2105 not exported, but it is currently needed by one
2106 routine in C<C4::Accounts>.
2108 =cut
2110 sub MarkIssueReturned {
2111 my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
2114 # Retrieve the issue
2115 my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return;
2116 my $issue_id = $issue->issue_id;
2118 my $anonymouspatron;
2119 if ( $privacy == 2 ) {
2120 # The default of 0 will not work due to foreign key constraints
2121 # The anonymisation will fail if AnonymousPatron is not a valid entry
2122 # We need to check if the anonymous patron exist, Koha will fail loudly if it does not
2123 # Note that a warning should appear on the about page (System information tab).
2124 $anonymouspatron = C4::Context->preference('AnonymousPatron');
2125 die "Fatal error: the patron ($borrowernumber) has requested their circulation history be anonymized on check-in, but the AnonymousPatron system preference is empty or not set correctly."
2126 unless Koha::Patrons->find( $anonymouspatron );
2128 my $database = Koha::Database->new();
2129 my $schema = $database->schema;
2130 my $dbh = C4::Context->dbh;
2132 my $query = 'UPDATE issues SET returndate=';
2133 my @bind;
2134 if ($dropbox_branch) {
2135 my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
2136 my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
2137 $query .= ' ? ';
2138 push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2139 } elsif ($returndate) {
2140 $query .= ' ? ';
2141 push @bind, $returndate;
2142 } else {
2143 $query .= ' now() ';
2145 $query .= ' WHERE issue_id = ?';
2146 push @bind, $issue_id;
2148 # FIXME Improve the return value and handle it from callers
2149 $schema->txn_do(sub {
2151 # Update the returndate
2152 $dbh->do( $query, undef, @bind );
2154 # We just updated the returndate, so we need to refetch $issue
2155 $issue->discard_changes;
2157 # Create the old_issues entry
2158 my $old_checkout = Koha::Old::Checkout->new($issue->unblessed)->store;
2160 # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2161 if ( $privacy == 2) {
2162 $dbh->do(q|UPDATE old_issues SET borrowernumber=? WHERE issue_id = ?|, undef, $anonymouspatron, $old_checkout->issue_id);
2165 # And finally delete the issue
2166 $issue->delete;
2168 ModItem( { 'onloan' => undef }, undef, $itemnumber, { log_action => 0 } );
2170 if ( C4::Context->preference('StoreLastBorrower') ) {
2171 my $item = Koha::Items->find( $itemnumber );
2172 my $patron = Koha::Patrons->find( $borrowernumber );
2173 $item->last_returned_by( $patron );
2177 return $issue_id;
2180 =head2 _debar_user_on_return
2182 _debar_user_on_return($borrower, $item, $datedue, today);
2184 C<$borrower> borrower hashref
2186 C<$item> item hashref
2188 C<$datedue> date due DateTime object
2190 C<$return_date> DateTime object representing the return time
2192 Internal function, called only by AddReturn that calculates and updates
2193 the user fine days, and debars them if necessary.
2195 Should only be called for overdue returns
2197 =cut
2199 sub _debar_user_on_return {
2200 my ( $borrower, $item, $dt_due, $return_date ) = @_;
2202 my $branchcode = _GetCircControlBranch( $item, $borrower );
2204 my $circcontrol = C4::Context->preference('CircControl');
2205 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2206 { categorycode => $borrower->{categorycode},
2207 itemtype => $item->{itype},
2208 branchcode => $branchcode
2211 my $finedays = $issuing_rule ? $issuing_rule->finedays : undef;
2212 my $unit = $issuing_rule ? $issuing_rule->lengthunit : undef;
2213 my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $return_date, $branchcode);
2215 if ($finedays) {
2217 # finedays is in days, so hourly loans must multiply by 24
2218 # thus 1 hour late equals 1 day suspension * finedays rate
2219 $finedays = $finedays * 24 if ( $unit eq 'hours' );
2221 # grace period is measured in the same units as the loan
2222 my $grace =
2223 DateTime::Duration->new( $unit => $issuing_rule->firstremind );
2225 my $deltadays = DateTime::Duration->new(
2226 days => $chargeable_units
2228 if ( $deltadays->subtract($grace)->is_positive() ) {
2229 my $suspension_days = $deltadays * $finedays;
2231 # If the max suspension days is < than the suspension days
2232 # the suspension days is limited to this maximum period.
2233 my $max_sd = $issuing_rule->maxsuspensiondays;
2234 if ( defined $max_sd ) {
2235 $max_sd = DateTime::Duration->new( days => $max_sd );
2236 $suspension_days = $max_sd
2237 if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2240 my ( $has_been_extended, $is_a_reminder );
2241 if ( C4::Context->preference('CumulativeRestrictionPeriods') and $borrower->{debarred} ) {
2242 my $debarment = @{ GetDebarments( { borrowernumber => $borrower->{borrowernumber}, type => 'SUSPENSION' } ) }[0];
2243 if ( $debarment ) {
2244 $return_date = dt_from_string( $debarment->{expiration}, 'sql' );
2245 $has_been_extended = 1;
2249 if ( $issuing_rule->suspension_chargeperiod > 1 ) {
2250 # No need to / 1 and do not consider / 0
2251 $suspension_days = DateTime::Duration->new(
2252 days => floor( $suspension_days->in_units('days') / $issuing_rule->suspension_chargeperiod )
2256 my $new_debar_dt;
2257 # Use the calendar or not to calculate the debarment date
2258 if ( C4::Context->preference('finesCalendar') eq 'noFinesWhenClosed' ) {
2259 my $calendar = Koha::Calendar->new(
2260 branchcode => $branchcode,
2261 days_mode => 'Calendar'
2263 $new_debar_dt = $calendar->addDate( $return_date, $suspension_days );
2265 else {
2266 $new_debar_dt = $return_date->clone()->add_duration($suspension_days);
2269 Koha::Patron::Debarments::AddUniqueDebarment({
2270 borrowernumber => $borrower->{borrowernumber},
2271 expiration => $new_debar_dt->ymd(),
2272 type => 'SUSPENSION',
2274 # if borrower was already debarred but does not get an extra debarment
2275 my $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
2276 my $new_debarment_str;
2277 if ( $borrower->{debarred} eq $patron->is_debarred ) {
2278 $is_a_reminder = 1;
2279 $new_debarment_str = $borrower->{debarred};
2280 } else {
2281 $new_debarment_str = $new_debar_dt->ymd();
2283 # FIXME Should return a DateTime object
2284 return $new_debarment_str, $is_a_reminder;
2287 return;
2290 =head2 _FixOverduesOnReturn
2292 &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2294 C<$brn> borrowernumber
2296 C<$itm> itemnumber
2298 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2299 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2301 Internal function, called only by AddReturn
2303 =cut
2305 sub _FixOverduesOnReturn {
2306 my ($borrowernumber, $item);
2307 unless ($borrowernumber = shift) {
2308 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2309 return;
2311 unless ($item = shift) {
2312 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2313 return;
2315 my ($exemptfine, $dropbox) = @_;
2316 my $dbh = C4::Context->dbh;
2318 # check for overdue fine
2319 my $accountline = Koha::Account::Lines->search(
2321 borrowernumber => $borrowernumber,
2322 itemnumber => $item,
2323 -or => [
2324 accounttype => 'FU',
2325 accounttype => 'O',
2328 )->next();
2329 return 0 unless $accountline; # no warning, there's just nothing to fix
2331 my $uquery;
2332 if ($exemptfine) {
2333 my $amountoutstanding = $accountline->amountoutstanding;
2335 $accountline->accounttype('FFOR');
2336 $accountline->amountoutstanding(0);
2338 Koha::Account::Offset->new(
2340 debit_id => $accountline->id,
2341 type => 'Forgiven',
2342 amount => $amountoutstanding * -1,
2346 if (C4::Context->preference("FinesLog")) {
2347 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2349 } elsif ($dropbox && $accountline->lastincrement) {
2350 my $outstanding = $accountline->amountoutstanding - $accountline->lastincrement;
2351 my $amt = $accountline->amount - $accountline->lastincrement;
2353 Koha::Account::Offset->new(
2355 debit_id => $accountline->id,
2356 type => 'Dropbox',
2357 amount => $accountline->lastincrement * -1,
2361 if ( C4::Context->preference("FinesLog") ) {
2362 &logaction( "FINES", 'MODIFY', $borrowernumber,
2363 "Dropbox adjustment $amt, item $item" );
2366 $accountline->accounttype('F');
2368 if ( $outstanding >= 0 && $amt >= 0 ) {
2369 $accountline->amount($amt);
2370 $accountline->amountoutstanding($outstanding);
2373 } else {
2374 $accountline->accounttype('F');
2377 return $accountline->store();
2380 =head2 _FixAccountForLostAndReturned
2382 &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2384 Calculates the charge for a book lost and returned.
2386 Internal function, not exported, called only by AddReturn.
2388 =cut
2390 sub _FixAccountForLostAndReturned {
2391 my $itemnumber = shift or return;
2392 my $borrowernumber = @_ ? shift : undef;
2393 my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
2395 my $credit;
2397 # check for charge made for lost book
2398 my $accountlines = Koha::Account::Lines->search(
2400 itemnumber => $itemnumber,
2401 accounttype => { -in => [ 'L', 'Rep', 'W' ] },
2404 order_by => { -desc => [ 'date', 'accountno' ] }
2408 return unless $accountlines->count > 0;
2409 my $accountline = $accountlines->next;
2411 # Use cases
2412 if ( $accountline->amount > $accountline->amountoutstanding ) {
2413 # some amount has been cancelled. collect the offsets that are not writeoffs
2414 # this works because the only way to subtract from a debt is
2415 # using the UI buttons 'Pay' and 'Write off'
2416 my $credits_offsets = Koha::Account::Offsets->search({
2417 debit_id => $accountline->id,
2418 credit_id => { '!=' => undef }, # it is not the debit itself
2419 type => { '!=' => 'Writeoff' },
2420 amount => { '<' => 0 } # credits are negative on the DB
2423 my $total_to_refund = ( $credits_offsets->count > 0 )
2424 ? $credits_offsets->total * -1 # credits are negative on the DB
2425 : 0;
2427 if ( $total_to_refund > 0 ) {
2428 my $account = Koha::Patrons->find( $accountline->borrowernumber )->account;
2429 $credit = $account->add_credit(
2431 amount => $total_to_refund,
2432 description => 'Item Returned ' . $item_id,
2433 type => 'lost_item_return'
2438 ModItem( { paidfor => '' }, undef, $itemnumber, { log_action => 0 } );
2440 # else {
2441 # $accountline->amount == $accountline->amountoutstanding
2444 $accountline->accounttype('LR');
2445 $accountline->amountoutstanding(0);
2446 $accountline->store();
2448 return ($credit) ? $credit->id : undef;
2451 =head2 _GetCircControlBranch
2453 my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2455 Internal function :
2457 Return the library code to be used to determine which circulation
2458 policy applies to a transaction. Looks up the CircControl and
2459 HomeOrHoldingBranch system preferences.
2461 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2463 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2465 =cut
2467 sub _GetCircControlBranch {
2468 my ($item, $borrower) = @_;
2469 my $circcontrol = C4::Context->preference('CircControl');
2470 my $branch;
2472 if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2473 $branch= C4::Context->userenv->{'branch'};
2474 } elsif ($circcontrol eq 'PatronLibrary') {
2475 $branch=$borrower->{branchcode};
2476 } else {
2477 my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2478 $branch = $item->{$branchfield};
2479 # default to item home branch if holdingbranch is used
2480 # and is not defined
2481 if (!defined($branch) && $branchfield eq 'holdingbranch') {
2482 $branch = $item->{homebranch};
2485 return $branch;
2488 =head2 GetOpenIssue
2490 $issue = GetOpenIssue( $itemnumber );
2492 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2494 C<$itemnumber> is the item's itemnumber
2496 Returns a hashref
2498 =cut
2500 sub GetOpenIssue {
2501 my ( $itemnumber ) = @_;
2502 return unless $itemnumber;
2503 my $dbh = C4::Context->dbh;
2504 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2505 $sth->execute( $itemnumber );
2506 return $sth->fetchrow_hashref();
2510 =head2 GetBiblioIssues
2512 $issues = GetBiblioIssues($biblionumber);
2514 this function get all issues from a biblionumber.
2516 Return:
2517 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash contains all column from
2518 tables issues and the firstname,surname & cardnumber from borrowers.
2520 =cut
2522 sub GetBiblioIssues {
2523 my $biblionumber = shift;
2524 return unless $biblionumber;
2525 my $dbh = C4::Context->dbh;
2526 my $query = "
2527 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2528 FROM issues
2529 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2530 LEFT JOIN items ON issues.itemnumber = items.itemnumber
2531 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2532 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2533 WHERE biblio.biblionumber = ?
2534 UNION ALL
2535 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2536 FROM old_issues
2537 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2538 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2539 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2540 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2541 WHERE biblio.biblionumber = ?
2542 ORDER BY timestamp
2544 my $sth = $dbh->prepare($query);
2545 $sth->execute($biblionumber, $biblionumber);
2547 my @issues;
2548 while ( my $data = $sth->fetchrow_hashref ) {
2549 push @issues, $data;
2551 return \@issues;
2554 =head2 GetUpcomingDueIssues
2556 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2558 =cut
2560 sub GetUpcomingDueIssues {
2561 my $params = shift;
2563 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2564 my $dbh = C4::Context->dbh;
2566 my $statement = <<END_SQL;
2567 SELECT *
2568 FROM (
2569 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2570 FROM issues
2571 LEFT JOIN items USING (itemnumber)
2572 LEFT OUTER JOIN branches USING (branchcode)
2573 WHERE returndate is NULL
2574 ) tmp
2575 WHERE days_until_due >= 0 AND days_until_due <= ?
2576 END_SQL
2578 my @bind_parameters = ( $params->{'days_in_advance'} );
2580 my $sth = $dbh->prepare( $statement );
2581 $sth->execute( @bind_parameters );
2582 my $upcoming_dues = $sth->fetchall_arrayref({});
2584 return $upcoming_dues;
2587 =head2 CanBookBeRenewed
2589 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2591 Find out whether a borrowed item may be renewed.
2593 C<$borrowernumber> is the borrower number of the patron who currently
2594 has the item on loan.
2596 C<$itemnumber> is the number of the item to renew.
2598 C<$override_limit>, if supplied with a true value, causes
2599 the limit on the number of times that the loan can be renewed
2600 (as controlled by the item type) to be ignored. Overriding also allows
2601 to renew sooner than "No renewal before" and to manually renew loans
2602 that are automatically renewed.
2604 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2605 item must currently be on loan to the specified borrower; renewals
2606 must be allowed for the item's type; and the borrower must not have
2607 already renewed the loan. $error will contain the reason the renewal can not proceed
2609 =cut
2611 sub CanBookBeRenewed {
2612 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2614 my $dbh = C4::Context->dbh;
2615 my $renews = 1;
2617 my $item = GetItem($itemnumber) or return ( 0, 'no_item' );
2618 my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return ( 0, 'no_checkout' );
2619 return ( 0, 'onsite_checkout' ) if $issue->onsite_checkout;
2620 return ( 0, 'item_denied_renewal') if _item_denied_renewal({ item => $item });
2623 $borrowernumber ||= $issue->borrowernumber;
2624 my $patron = Koha::Patrons->find( $borrowernumber )
2625 or return;
2627 my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2629 # This item can fill one or more unfilled reserve, can those unfilled reserves
2630 # all be filled by other available items?
2631 if ( $resfound
2632 && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2634 my $schema = Koha::Database->new()->schema();
2636 my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2637 if ($item_holds) {
2638 # There is an item level hold on this item, no other item can fill the hold
2639 $resfound = 1;
2641 else {
2643 # Get all other items that could possibly fill reserves
2644 my @itemnumbers = $schema->resultset('Item')->search(
2646 biblionumber => $resrec->{biblionumber},
2647 onloan => undef,
2648 notforloan => 0,
2649 -not => { itemnumber => $itemnumber }
2651 { columns => 'itemnumber' }
2652 )->get_column('itemnumber')->all();
2654 # Get all other reserves that could have been filled by this item
2655 my @borrowernumbers;
2656 while (1) {
2657 my ( $reserve_found, $reserve, undef ) =
2658 C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2660 if ($reserve_found) {
2661 push( @borrowernumbers, $reserve->{borrowernumber} );
2663 else {
2664 last;
2668 # If the count of the union of the lists of reservable items for each borrower
2669 # is equal or greater than the number of borrowers, we know that all reserves
2670 # can be filled with available items. We can get the union of the sets simply
2671 # by pushing all the elements onto an array and removing the duplicates.
2672 my @reservable;
2673 my %borrowers;
2674 ITEM: foreach my $i (@itemnumbers) {
2675 my $item = GetItem($i);
2676 next if IsItemOnHoldAndFound($i);
2677 for my $b (@borrowernumbers) {
2678 my $borr = $borrowers{$b} //= Koha::Patrons->find( $b )->unblessed;
2679 next unless IsAvailableForItemLevelRequest($item, $borr);
2680 next unless CanItemBeReserved($b,$i);
2682 push @reservable, $i;
2683 if (@reservable >= @borrowernumbers) {
2684 $resfound = 0;
2685 last ITEM;
2687 last;
2692 return ( 0, "on_reserve" ) if $resfound; # '' when no hold was found
2694 return ( 1, undef ) if $override_limit;
2696 my $branchcode = _GetCircControlBranch( $item, $patron->unblessed );
2697 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2698 { categorycode => $patron->categorycode,
2699 itemtype => $item->{itype},
2700 branchcode => $branchcode
2704 return ( 0, "too_many" )
2705 if not $issuing_rule or $issuing_rule->renewalsallowed <= $issue->renewals;
2707 my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2708 my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2709 $patron = Koha::Patrons->find($borrowernumber); # FIXME Is this really useful?
2710 my $restricted = $patron->is_debarred;
2711 my $hasoverdues = $patron->has_overdues;
2713 if ( $restricted and $restrictionblockrenewing ) {
2714 return ( 0, 'restriction');
2715 } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($issue->is_overdue and $overduesblockrenewing eq 'blockitem') ) {
2716 return ( 0, 'overdue');
2719 if ( $issue->auto_renew ) {
2721 if ( $patron->category->effective_BlockExpiredPatronOpacActions and $patron->is_expired ) {
2722 return ( 0, 'auto_account_expired' );
2725 if ( defined $issuing_rule->no_auto_renewal_after
2726 and $issuing_rule->no_auto_renewal_after ne "" ) {
2727 # Get issue_date and add no_auto_renewal_after
2728 # If this is greater than today, it's too late for renewal.
2729 my $maximum_renewal_date = dt_from_string($issue->issuedate, 'sql');
2730 $maximum_renewal_date->add(
2731 $issuing_rule->lengthunit => $issuing_rule->no_auto_renewal_after
2733 my $now = dt_from_string;
2734 if ( $now >= $maximum_renewal_date ) {
2735 return ( 0, "auto_too_late" );
2738 if ( defined $issuing_rule->no_auto_renewal_after_hard_limit
2739 and $issuing_rule->no_auto_renewal_after_hard_limit ne "" ) {
2740 # If no_auto_renewal_after_hard_limit is >= today, it's also too late for renewal
2741 if ( dt_from_string >= dt_from_string( $issuing_rule->no_auto_renewal_after_hard_limit ) ) {
2742 return ( 0, "auto_too_late" );
2746 if ( C4::Context->preference('OPACFineNoRenewalsBlockAutoRenew') ) {
2747 my $fine_no_renewals = C4::Context->preference("OPACFineNoRenewals");
2748 my $amountoutstanding = $patron->account->balance;
2749 if ( $amountoutstanding and $amountoutstanding > $fine_no_renewals ) {
2750 return ( 0, "auto_too_much_oweing" );
2755 if ( defined $issuing_rule->norenewalbefore
2756 and $issuing_rule->norenewalbefore ne "" )
2759 # Calculate soonest renewal by subtracting 'No renewal before' from due date
2760 my $soonestrenewal = dt_from_string( $issue->date_due, 'sql' )->subtract(
2761 $issuing_rule->lengthunit => $issuing_rule->norenewalbefore );
2763 # Depending on syspref reset the exact time, only check the date
2764 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2765 and $issuing_rule->lengthunit eq 'days' )
2767 $soonestrenewal->truncate( to => 'day' );
2770 if ( $soonestrenewal > DateTime->now( time_zone => C4::Context->tz() ) )
2772 return ( 0, "auto_too_soon" ) if $issue->auto_renew;
2773 return ( 0, "too_soon" );
2775 elsif ( $issue->auto_renew ) {
2776 return ( 0, "auto_renew" );
2780 # Fallback for automatic renewals:
2781 # If norenewalbefore is undef, don't renew before due date.
2782 if ( $issue->auto_renew ) {
2783 my $now = dt_from_string;
2784 return ( 0, "auto_renew" )
2785 if $now >= dt_from_string( $issue->date_due, 'sql' );
2786 return ( 0, "auto_too_soon" );
2789 return ( 1, undef );
2792 =head2 AddRenewal
2794 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2796 Renews a loan.
2798 C<$borrowernumber> is the borrower number of the patron who currently
2799 has the item.
2801 C<$itemnumber> is the number of the item to renew.
2803 C<$branch> is the library where the renewal took place (if any).
2804 The library that controls the circ policies for the renewal is retrieved from the issues record.
2806 C<$datedue> can be a DateTime object used to set the due date.
2808 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
2809 this parameter is not supplied, lastreneweddate is set to the current date.
2811 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2812 from the book's item type.
2814 =cut
2816 sub AddRenewal {
2817 my $borrowernumber = shift;
2818 my $itemnumber = shift or return;
2819 my $branch = shift;
2820 my $datedue = shift;
2821 my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2823 my $item = GetItem($itemnumber) or return;
2824 my $item_object = Koha::Items->find( $itemnumber ); # Should replace $item
2825 my $biblio = $item_object->biblio;
2827 my $dbh = C4::Context->dbh;
2829 # Find the issues record for this book
2830 my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } );
2832 return unless $issue;
2834 $borrowernumber ||= $issue->borrowernumber;
2836 if ( defined $datedue && ref $datedue ne 'DateTime' ) {
2837 carp 'Invalid date passed to AddRenewal.';
2838 return;
2841 my $patron = Koha::Patrons->find( $borrowernumber ) or return; # FIXME Should do more than just return
2842 my $patron_unblessed = $patron->unblessed;
2844 if ( C4::Context->preference('CalculateFinesOnReturn') && $issue->is_overdue ) {
2845 _CalculateAndUpdateFine( { issue => $issue, item => $item, borrower => $patron_unblessed } );
2847 _FixOverduesOnReturn( $borrowernumber, $itemnumber );
2849 # If the due date wasn't specified, calculate it by adding the
2850 # book's loan length to today's date or the current due date
2851 # based on the value of the RenewalPeriodBase syspref.
2852 unless ($datedue) {
2854 my $itemtype = $item_object->effective_itemtype;
2855 $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2856 dt_from_string( $issue->date_due, 'sql' ) :
2857 DateTime->now( time_zone => C4::Context->tz());
2858 $datedue = CalcDateDue($datedue, $itemtype, _GetCircControlBranch($item, $patron_unblessed), $patron_unblessed, 'is a renewal');
2861 # Update the issues record to have the new due date, and a new count
2862 # of how many times it has been renewed.
2863 my $renews = $issue->renewals + 1;
2864 my $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2865 WHERE borrowernumber=?
2866 AND itemnumber=?"
2869 $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2871 # Update the renewal count on the item, and tell zebra to reindex
2872 $renews = $item->{renewals} + 1;
2873 ModItem( { renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $item->{biblionumber}, $itemnumber, { log_action => 0 } );
2875 # Charge a new rental fee, if applicable?
2876 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2877 if ( $charge > 0 ) {
2878 my $accountno = C4::Accounts::getnextacctno( $borrowernumber );
2879 my $manager_id = 0;
2880 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2881 $sth = $dbh->prepare(
2882 "INSERT INTO accountlines
2883 (date, borrowernumber, accountno, amount, manager_id,
2884 description,accounttype, amountoutstanding, itemnumber)
2885 VALUES (now(),?,?,?,?,?,?,?,?)"
2887 $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2888 "Renewal of Rental Item " . $biblio->title . " $item->{'barcode'}",
2889 'Rent', $charge, $itemnumber );
2892 # Send a renewal slip according to checkout alert preferencei
2893 if ( C4::Context->preference('RenewalSendNotice') eq '1' ) {
2894 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2895 my %conditions = (
2896 branchcode => $branch,
2897 categorycode => $patron->categorycode,
2898 item_type => $item->{itype},
2899 notification => 'CHECKOUT',
2901 if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
2902 SendCirculationAlert(
2904 type => 'RENEWAL',
2905 item => $item,
2906 borrower => $patron->unblessed,
2907 branch => $branch,
2913 # Remove any OVERDUES related debarment if the borrower has no overdues
2914 if ( $patron
2915 && $patron->is_debarred
2916 && ! $patron->has_overdues
2917 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2919 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2922 unless ( C4::Context->interface eq 'opac' ) { #if from opac we are obeying OpacRenewalBranch as calculated in opac-renew.pl
2923 $branch = C4::Context->userenv ? C4::Context->userenv->{branch} : $branch;
2926 # Add the renewal to stats
2927 UpdateStats(
2929 branch => $branch,
2930 type => 'renew',
2931 amount => $charge,
2932 itemnumber => $itemnumber,
2933 itemtype => $item->{itype},
2934 location => $item->{location},
2935 borrowernumber => $borrowernumber,
2936 ccode => $item->{'ccode'}
2940 #Log the renewal
2941 logaction("CIRCULATION", "RENEWAL", $borrowernumber, $itemnumber) if C4::Context->preference("RenewalLog");
2942 return $datedue;
2945 sub GetRenewCount {
2946 # check renewal status
2947 my ( $bornum, $itemno ) = @_;
2948 my $dbh = C4::Context->dbh;
2949 my $renewcount = 0;
2950 my $renewsallowed = 0;
2951 my $renewsleft = 0;
2953 my $patron = Koha::Patrons->find( $bornum );
2954 my $item = GetItem($itemno);
2956 return (0, 0, 0) unless $patron or $item; # Wrong call, no renewal allowed
2958 # Look in the issues table for this item, lent to this borrower,
2959 # and not yet returned.
2961 # FIXME - I think this function could be redone to use only one SQL call.
2962 my $sth = $dbh->prepare(
2963 "select * from issues
2964 where (borrowernumber = ?)
2965 and (itemnumber = ?)"
2967 $sth->execute( $bornum, $itemno );
2968 my $data = $sth->fetchrow_hashref;
2969 $renewcount = $data->{'renewals'} if $data->{'renewals'};
2970 # $item and $borrower should be calculated
2971 my $branchcode = _GetCircControlBranch($item, $patron->unblessed);
2973 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2974 { categorycode => $patron->categorycode,
2975 itemtype => $item->{itype},
2976 branchcode => $branchcode
2980 $renewsallowed = $issuing_rule ? $issuing_rule->renewalsallowed : 0;
2981 $renewsleft = $renewsallowed - $renewcount;
2982 if($renewsleft < 0){ $renewsleft = 0; }
2983 return ( $renewcount, $renewsallowed, $renewsleft );
2986 =head2 GetSoonestRenewDate
2988 $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
2990 Find out the soonest possible renew date of a borrowed item.
2992 C<$borrowernumber> is the borrower number of the patron who currently
2993 has the item on loan.
2995 C<$itemnumber> is the number of the item to renew.
2997 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
2998 renew date, based on the value "No renewal before" of the applicable
2999 issuing rule. Returns the current date if the item can already be
3000 renewed, and returns undefined if the borrower, loan, or item
3001 cannot be found.
3003 =cut
3005 sub GetSoonestRenewDate {
3006 my ( $borrowernumber, $itemnumber ) = @_;
3008 my $dbh = C4::Context->dbh;
3010 my $item = GetItem($itemnumber) or return;
3011 my $itemissue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return;
3013 $borrowernumber ||= $itemissue->borrowernumber;
3014 my $patron = Koha::Patrons->find( $borrowernumber )
3015 or return;
3017 my $branchcode = _GetCircControlBranch( $item, $patron->unblessed );
3018 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
3019 { categorycode => $patron->categorycode,
3020 itemtype => $item->{itype},
3021 branchcode => $branchcode
3025 my $now = dt_from_string;
3026 return $now unless $issuing_rule;
3028 if ( defined $issuing_rule->norenewalbefore
3029 and $issuing_rule->norenewalbefore ne "" )
3031 my $soonestrenewal =
3032 dt_from_string( $itemissue->date_due )->subtract(
3033 $issuing_rule->lengthunit => $issuing_rule->norenewalbefore );
3035 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3036 and $issuing_rule->lengthunit eq 'days' )
3038 $soonestrenewal->truncate( to => 'day' );
3040 return $soonestrenewal if $now < $soonestrenewal;
3042 return $now;
3045 =head2 GetLatestAutoRenewDate
3047 $NoAutoRenewalAfterThisDate = &GetLatestAutoRenewDate($borrowernumber, $itemnumber);
3049 Find out the latest possible auto renew date of a borrowed item.
3051 C<$borrowernumber> is the borrower number of the patron who currently
3052 has the item on loan.
3054 C<$itemnumber> is the number of the item to renew.
3056 C<$GetLatestAutoRenewDate> returns the DateTime of the latest possible
3057 auto renew date, based on the value "No auto renewal after" and the "No auto
3058 renewal after (hard limit) of the applicable issuing rule.
3059 Returns undef if there is no date specify in the circ rules or if the patron, loan,
3060 or item cannot be found.
3062 =cut
3064 sub GetLatestAutoRenewDate {
3065 my ( $borrowernumber, $itemnumber ) = @_;
3067 my $dbh = C4::Context->dbh;
3069 my $item = GetItem($itemnumber) or return;
3070 my $itemissue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return;
3072 $borrowernumber ||= $itemissue->borrowernumber;
3073 my $patron = Koha::Patrons->find( $borrowernumber )
3074 or return;
3076 my $branchcode = _GetCircControlBranch( $item, $patron->unblessed );
3077 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
3078 { categorycode => $patron->categorycode,
3079 itemtype => $item->{itype},
3080 branchcode => $branchcode
3084 return unless $issuing_rule;
3085 return
3086 if ( not $issuing_rule->no_auto_renewal_after
3087 or $issuing_rule->no_auto_renewal_after eq '' )
3088 and ( not $issuing_rule->no_auto_renewal_after_hard_limit
3089 or $issuing_rule->no_auto_renewal_after_hard_limit eq '' );
3091 my $maximum_renewal_date;
3092 if ( $issuing_rule->no_auto_renewal_after ) {
3093 $maximum_renewal_date = dt_from_string($itemissue->issuedate);
3094 $maximum_renewal_date->add(
3095 $issuing_rule->lengthunit => $issuing_rule->no_auto_renewal_after
3099 if ( $issuing_rule->no_auto_renewal_after_hard_limit ) {
3100 my $dt = dt_from_string( $issuing_rule->no_auto_renewal_after_hard_limit );
3101 $maximum_renewal_date = $dt if not $maximum_renewal_date or $maximum_renewal_date > $dt;
3103 return $maximum_renewal_date;
3107 =head2 GetIssuingCharges
3109 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3111 Calculate how much it would cost for a given patron to borrow a given
3112 item, including any applicable discounts.
3114 C<$itemnumber> is the item number of item the patron wishes to borrow.
3116 C<$borrowernumber> is the patron's borrower number.
3118 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3119 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3120 if it's a video).
3122 =cut
3124 sub GetIssuingCharges {
3126 # calculate charges due
3127 my ( $itemnumber, $borrowernumber ) = @_;
3128 my $charge = 0;
3129 my $dbh = C4::Context->dbh;
3130 my $item_type;
3132 # Get the book's item type and rental charge (via its biblioitem).
3133 my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3134 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3135 $charge_query .= (C4::Context->preference('item-level_itypes'))
3136 ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3137 : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3139 $charge_query .= ' WHERE items.itemnumber =?';
3141 my $sth = $dbh->prepare($charge_query);
3142 $sth->execute($itemnumber);
3143 if ( my $item_data = $sth->fetchrow_hashref ) {
3144 $item_type = $item_data->{itemtype};
3145 $charge = $item_data->{rentalcharge};
3146 my $branch = C4::Context::mybranch();
3147 my $discount_query = q|SELECT rentaldiscount,
3148 issuingrules.itemtype, issuingrules.branchcode
3149 FROM borrowers
3150 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3151 WHERE borrowers.borrowernumber = ?
3152 AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3153 AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3154 my $discount_sth = $dbh->prepare($discount_query);
3155 $discount_sth->execute( $borrowernumber, $item_type, $branch );
3156 my $discount_rules = $discount_sth->fetchall_arrayref({});
3157 if (@{$discount_rules}) {
3158 # We may have multiple rules so get the most specific
3159 my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3160 $charge = ( $charge * ( 100 - $discount ) ) / 100;
3162 if ($charge) {
3163 $charge = sprintf '%.2f', $charge; # ensure no fractions of a penny returned
3167 return ( $charge, $item_type );
3170 # Select most appropriate discount rule from those returned
3171 sub _get_discount_from_rule {
3172 my ($rules_ref, $branch, $itemtype) = @_;
3173 my $discount;
3175 if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3176 $discount = $rules_ref->[0]->{rentaldiscount};
3177 return (defined $discount) ? $discount : 0;
3179 # could have up to 4 does one match $branch and $itemtype
3180 my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3181 if (@d) {
3182 $discount = $d[0]->{rentaldiscount};
3183 return (defined $discount) ? $discount : 0;
3185 # do we have item type + all branches
3186 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3187 if (@d) {
3188 $discount = $d[0]->{rentaldiscount};
3189 return (defined $discount) ? $discount : 0;
3191 # do we all item types + this branch
3192 @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3193 if (@d) {
3194 $discount = $d[0]->{rentaldiscount};
3195 return (defined $discount) ? $discount : 0;
3197 # so all and all (surely we wont get here)
3198 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3199 if (@d) {
3200 $discount = $d[0]->{rentaldiscount};
3201 return (defined $discount) ? $discount : 0;
3203 # none of the above
3204 return 0;
3207 =head2 AddIssuingCharge
3209 &AddIssuingCharge( $checkout, $charge )
3211 =cut
3213 sub AddIssuingCharge {
3214 my ( $checkout, $charge ) = @_;
3216 # FIXME What if checkout does not exist?
3218 my $nextaccntno = C4::Accounts::getnextacctno( $checkout->borrowernumber );
3220 my $manager_id = 0;
3221 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3223 my $accountline = Koha::Account::Line->new(
3225 borrowernumber => $checkout->borrowernumber,
3226 itemnumber => $checkout->itemnumber,
3227 issue_id => $checkout->issue_id,
3228 accountno => $nextaccntno,
3229 amount => $charge,
3230 amountoutstanding => $charge,
3231 manager_id => $manager_id,
3232 description => 'Rental',
3233 accounttype => 'Rent',
3234 date => \'NOW()',
3236 )->store();
3238 Koha::Account::Offset->new(
3240 debit_id => $accountline->id,
3241 type => 'Rental Fee',
3242 amount => $charge,
3244 )->store();
3247 =head2 GetTransfers
3249 GetTransfers($itemnumber);
3251 =cut
3253 sub GetTransfers {
3254 my ($itemnumber) = @_;
3256 my $dbh = C4::Context->dbh;
3258 my $query = '
3259 SELECT datesent,
3260 frombranch,
3261 tobranch,
3262 branchtransfer_id
3263 FROM branchtransfers
3264 WHERE itemnumber = ?
3265 AND datearrived IS NULL
3267 my $sth = $dbh->prepare($query);
3268 $sth->execute($itemnumber);
3269 my @row = $sth->fetchrow_array();
3270 return @row;
3273 =head2 GetTransfersFromTo
3275 @results = GetTransfersFromTo($frombranch,$tobranch);
3277 Returns the list of pending transfers between $from and $to branch
3279 =cut
3281 sub GetTransfersFromTo {
3282 my ( $frombranch, $tobranch ) = @_;
3283 return unless ( $frombranch && $tobranch );
3284 my $dbh = C4::Context->dbh;
3285 my $query = "
3286 SELECT branchtransfer_id,itemnumber,datesent,frombranch
3287 FROM branchtransfers
3288 WHERE frombranch=?
3289 AND tobranch=?
3290 AND datearrived IS NULL
3292 my $sth = $dbh->prepare($query);
3293 $sth->execute( $frombranch, $tobranch );
3294 my @gettransfers;
3296 while ( my $data = $sth->fetchrow_hashref ) {
3297 push @gettransfers, $data;
3299 return (@gettransfers);
3302 =head2 DeleteTransfer
3304 &DeleteTransfer($itemnumber);
3306 =cut
3308 sub DeleteTransfer {
3309 my ($itemnumber) = @_;
3310 return unless $itemnumber;
3311 my $dbh = C4::Context->dbh;
3312 my $sth = $dbh->prepare(
3313 "DELETE FROM branchtransfers
3314 WHERE itemnumber=?
3315 AND datearrived IS NULL "
3317 return $sth->execute($itemnumber);
3320 =head2 SendCirculationAlert
3322 Send out a C<check-in> or C<checkout> alert using the messaging system.
3324 B<Parameters>:
3326 =over 4
3328 =item type
3330 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3332 =item item
3334 Hashref of information about the item being checked in or out.
3336 =item borrower
3338 Hashref of information about the borrower of the item.
3340 =item branch
3342 The branchcode from where the checkout or check-in took place.
3344 =back
3346 B<Example>:
3348 SendCirculationAlert({
3349 type => 'CHECKOUT',
3350 item => $item,
3351 borrower => $borrower,
3352 branch => $branch,
3355 =cut
3357 sub SendCirculationAlert {
3358 my ($opts) = @_;
3359 my ($type, $item, $borrower, $branch) =
3360 ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3361 my %message_name = (
3362 CHECKIN => 'Item_Check_in',
3363 CHECKOUT => 'Item_Checkout',
3364 RENEWAL => 'Item_Checkout',
3366 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3367 borrowernumber => $borrower->{borrowernumber},
3368 message_name => $message_name{$type},
3370 my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3372 my $schema = Koha::Database->new->schema;
3373 my @transports = keys %{ $borrower_preferences->{transports} };
3375 # From the MySQL doc:
3376 # LOCK TABLES is not transaction-safe and implicitly commits any active transaction before attempting to lock the tables.
3377 # If the LOCK/UNLOCK statements are executed from tests, the current transaction will be committed.
3378 # To avoid that we need to guess if this code is execute from tests or not (yes it is a bit hacky)
3379 my $do_not_lock = ( exists $ENV{_} && $ENV{_} =~ m|prove| ) || $ENV{KOHA_NO_TABLE_LOCKS};
3381 for my $mtt (@transports) {
3382 my $letter = C4::Letters::GetPreparedLetter (
3383 module => 'circulation',
3384 letter_code => $type,
3385 branchcode => $branch,
3386 message_transport_type => $mtt,
3387 lang => $borrower->{lang},
3388 tables => {
3389 $issues_table => $item->{itemnumber},
3390 'items' => $item->{itemnumber},
3391 'biblio' => $item->{biblionumber},
3392 'biblioitems' => $item->{biblionumber},
3393 'borrowers' => $borrower,
3394 'branches' => $branch,
3396 ) or next;
3398 $schema->storage->txn_begin;
3399 C4::Context->dbh->do(q|LOCK TABLE message_queue READ|) unless $do_not_lock;
3400 C4::Context->dbh->do(q|LOCK TABLE message_queue WRITE|) unless $do_not_lock;
3401 my $message = C4::Message->find_last_message($borrower, $type, $mtt);
3402 unless ( $message ) {
3403 C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3404 C4::Message->enqueue($letter, $borrower, $mtt);
3405 } else {
3406 $message->append($letter);
3407 $message->update;
3409 C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3410 $schema->storage->txn_commit;
3413 return;
3416 =head2 updateWrongTransfer
3418 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3420 This function validate the line of brachtransfer but with the wrong destination (mistake from a librarian ...), and create a new line in branchtransfer from the actual library to the original library of reservation
3422 =cut
3424 sub updateWrongTransfer {
3425 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3426 my $dbh = C4::Context->dbh;
3427 # first step validate the actual line of transfert .
3428 my $sth =
3429 $dbh->prepare(
3430 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3432 $sth->execute($FromLibrary,$itemNumber);
3434 # second step create a new line of branchtransfer to the right location .
3435 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3437 #third step changing holdingbranch of item
3438 UpdateHoldingbranch($FromLibrary,$itemNumber);
3441 =head2 UpdateHoldingbranch
3443 $items = UpdateHoldingbranch($branch,$itmenumber);
3445 Simple methode for updating hodlingbranch in items BDD line
3447 =cut
3449 sub UpdateHoldingbranch {
3450 my ( $branch,$itemnumber ) = @_;
3451 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3454 =head2 CalcDateDue
3456 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3458 this function calculates the due date given the start date and configured circulation rules,
3459 checking against the holidays calendar as per the 'useDaysMode' syspref.
3460 C<$startdate> = DateTime object representing start date of loan period (assumed to be today)
3461 C<$itemtype> = itemtype code of item in question
3462 C<$branch> = location whose calendar to use
3463 C<$borrower> = Borrower object
3464 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3466 =cut
3468 sub CalcDateDue {
3469 my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3471 $isrenewal ||= 0;
3473 # loanlength now a href
3474 my $loanlength =
3475 GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3477 my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3478 ? qq{renewalperiod}
3479 : qq{issuelength};
3481 my $datedue;
3482 if ( $startdate ) {
3483 if (ref $startdate ne 'DateTime' ) {
3484 $datedue = dt_from_string($datedue);
3485 } else {
3486 $datedue = $startdate->clone;
3488 } else {
3489 $datedue =
3490 DateTime->now( time_zone => C4::Context->tz() )
3491 ->truncate( to => 'minute' );
3495 # calculate the datedue as normal
3496 if ( C4::Context->preference('useDaysMode') eq 'Days' )
3497 { # ignoring calendar
3498 if ( $loanlength->{lengthunit} eq 'hours' ) {
3499 $datedue->add( hours => $loanlength->{$length_key} );
3500 } else { # days
3501 $datedue->add( days => $loanlength->{$length_key} );
3502 $datedue->set_hour(23);
3503 $datedue->set_minute(59);
3505 } else {
3506 my $dur;
3507 if ($loanlength->{lengthunit} eq 'hours') {
3508 $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3510 else { # days
3511 $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3513 my $calendar = Koha::Calendar->new( branchcode => $branch );
3514 $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3515 if ($loanlength->{lengthunit} eq 'days') {
3516 $datedue->set_hour(23);
3517 $datedue->set_minute(59);
3521 # if Hard Due Dates are used, retrieve them and apply as necessary
3522 my ( $hardduedate, $hardduedatecompare ) =
3523 GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3524 if ($hardduedate) { # hardduedates are currently dates
3525 $hardduedate->truncate( to => 'minute' );
3526 $hardduedate->set_hour(23);
3527 $hardduedate->set_minute(59);
3528 my $cmp = DateTime->compare( $hardduedate, $datedue );
3530 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3531 # if the calculated date is before the 'after' Hard Due Date (floor), override
3532 # if the hard due date is set to 'exactly', overrride
3533 if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3534 $datedue = $hardduedate->clone;
3537 # in all other cases, keep the date due as it is
3541 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3542 if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3543 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3544 if( $expiry_dt ) { #skip empty expiry date..
3545 $expiry_dt->set( hour => 23, minute => 59);
3546 my $d1= $datedue->clone->set_time_zone('floating');
3547 if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3548 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3551 if ( C4::Context->preference('useDaysMode') ne 'Days' ) {
3552 my $calendar = Koha::Calendar->new( branchcode => $branch );
3553 if ( $calendar->is_holiday($datedue) ) {
3554 # Don't return on a closed day
3555 $datedue = $calendar->prev_open_day( $datedue );
3560 return $datedue;
3564 sub CheckValidBarcode{
3565 my ($barcode) = @_;
3566 my $dbh = C4::Context->dbh;
3567 my $query=qq|SELECT count(*)
3568 FROM items
3569 WHERE barcode=?
3571 my $sth = $dbh->prepare($query);
3572 $sth->execute($barcode);
3573 my $exist=$sth->fetchrow ;
3574 return $exist;
3577 =head2 IsBranchTransferAllowed
3579 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3581 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3583 Deprecated in favor of Koha::Item::Transfer::Limits->find/search and
3584 Koha::Item->can_be_transferred.
3586 =cut
3588 sub IsBranchTransferAllowed {
3589 my ( $toBranch, $fromBranch, $code ) = @_;
3591 if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3593 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3594 my $dbh = C4::Context->dbh;
3596 my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3597 $sth->execute( $toBranch, $fromBranch, $code );
3598 my $limit = $sth->fetchrow_hashref();
3600 ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3601 if ( $limit->{'limitId'} ) {
3602 return 0;
3603 } else {
3604 return 1;
3608 =head2 CreateBranchTransferLimit
3610 CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3612 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3614 Deprecated in favor of Koha::Item::Transfer::Limit->new.
3616 =cut
3618 sub CreateBranchTransferLimit {
3619 my ( $toBranch, $fromBranch, $code ) = @_;
3620 return unless defined($toBranch) && defined($fromBranch);
3621 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3623 my $dbh = C4::Context->dbh;
3625 my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3626 return $sth->execute( $code, $toBranch, $fromBranch );
3629 =head2 DeleteBranchTransferLimits
3631 my $result = DeleteBranchTransferLimits($frombranch);
3633 Deletes all the library transfer limits for one library. Returns the
3634 number of limits deleted, 0e0 if no limits were deleted, or undef if
3635 no arguments are supplied.
3637 Deprecated in favor of Koha::Item::Transfer::Limits->search({
3638 fromBranch => $fromBranch
3639 })->delete.
3641 =cut
3643 sub DeleteBranchTransferLimits {
3644 my $branch = shift;
3645 return unless defined $branch;
3646 my $dbh = C4::Context->dbh;
3647 my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3648 return $sth->execute($branch);
3651 sub ReturnLostItem{
3652 my ( $borrowernumber, $itemnum ) = @_;
3654 MarkIssueReturned( $borrowernumber, $itemnum );
3655 my $patron = Koha::Patrons->find( $borrowernumber );
3656 my $item = C4::Items::GetItem( $itemnum );
3657 my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3658 my @datearr = localtime(time);
3659 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3660 my $bor = $patron->firstname . ' ' . $patron->surname . ' ' . $patron->cardnumber;
3661 ModItem({ paidfor => $old_note."Paid for by $bor $date" }, undef, $itemnum);
3665 sub LostItem{
3666 my ($itemnumber, $mark_lost_from, $force_mark_returned) = @_;
3668 unless ( $mark_lost_from ) {
3669 # Temporary check to avoid regressions
3670 die q|LostItem called without $mark_lost_from, check the API.|;
3673 my $mark_returned;
3674 if ( $force_mark_returned ) {
3675 $mark_returned = 1;
3676 } else {
3677 my $pref = C4::Context->preference('MarkLostItemsAsReturned') // q{};
3678 $mark_returned = ( $pref =~ m|$mark_lost_from| );
3681 my $dbh = C4::Context->dbh();
3682 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3683 FROM issues
3684 JOIN items USING (itemnumber)
3685 JOIN biblio USING (biblionumber)
3686 WHERE issues.itemnumber=?");
3687 $sth->execute($itemnumber);
3688 my $issues=$sth->fetchrow_hashref();
3690 # If a borrower lost the item, add a replacement cost to the their record
3691 if ( my $borrowernumber = $issues->{borrowernumber} ){
3692 my $patron = Koha::Patrons->find( $borrowernumber );
3694 if (C4::Context->preference('WhenLostForgiveFine')){
3695 my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3696 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!"; # zero is OK, check defined
3698 if (C4::Context->preference('WhenLostChargeReplacementFee')){
3699 C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3700 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3701 #warn " $issues->{'borrowernumber'} / $itemnumber ";
3704 MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$patron->privacy) if $mark_returned;
3708 sub GetOfflineOperations {
3709 my $dbh = C4::Context->dbh;
3710 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3711 $sth->execute(C4::Context->userenv->{'branch'});
3712 my $results = $sth->fetchall_arrayref({});
3713 return $results;
3716 sub GetOfflineOperation {
3717 my $operationid = shift;
3718 return unless $operationid;
3719 my $dbh = C4::Context->dbh;
3720 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3721 $sth->execute( $operationid );
3722 return $sth->fetchrow_hashref;
3725 sub AddOfflineOperation {
3726 my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3727 my $dbh = C4::Context->dbh;
3728 my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3729 $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3730 return "Added.";
3733 sub DeleteOfflineOperation {
3734 my $dbh = C4::Context->dbh;
3735 my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3736 $sth->execute( shift );
3737 return "Deleted.";
3740 sub ProcessOfflineOperation {
3741 my $operation = shift;
3743 my $report;
3744 if ( $operation->{action} eq 'return' ) {
3745 $report = ProcessOfflineReturn( $operation );
3746 } elsif ( $operation->{action} eq 'issue' ) {
3747 $report = ProcessOfflineIssue( $operation );
3748 } elsif ( $operation->{action} eq 'payment' ) {
3749 $report = ProcessOfflinePayment( $operation );
3752 DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3754 return $report;
3757 sub ProcessOfflineReturn {
3758 my $operation = shift;
3760 my $item = Koha::Items->find({barcode => $operation->{barcode}});
3762 if ( $item ) {
3763 my $itemnumber = $item->itemnumber;
3764 my $issue = GetOpenIssue( $itemnumber );
3765 if ( $issue ) {
3766 MarkIssueReturned(
3767 $issue->{borrowernumber},
3768 $itemnumber,
3769 undef,
3770 $operation->{timestamp},
3772 ModItem(
3773 { renewals => 0, onloan => undef },
3774 $issue->{'biblionumber'},
3775 $itemnumber,
3776 { log_action => 0 }
3778 return "Success.";
3779 } else {
3780 return "Item not issued.";
3782 } else {
3783 return "Item not found.";
3787 sub ProcessOfflineIssue {
3788 my $operation = shift;
3790 my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} } );
3792 if ( $patron ) {
3793 my $item = Koha::Items->find({ barcode => $operation->{barcode} });
3794 unless ($item) {
3795 return "Barcode not found.";
3797 my $itemnumber = $item->itemnumber;
3798 my $issue = GetOpenIssue( $itemnumber );
3800 if ( $issue and ( $issue->{borrowernumber} ne $patron->borrowernumber ) ) { # Item already issued to another patron mark it returned
3801 MarkIssueReturned(
3802 $issue->{borrowernumber},
3803 $itemnumber,
3804 undef,
3805 $operation->{timestamp},
3808 AddIssue(
3809 $patron->unblessed,
3810 $operation->{'barcode'},
3811 undef,
3813 $operation->{timestamp},
3814 undef,
3816 return "Success.";
3817 } else {
3818 return "Borrower not found.";
3822 sub ProcessOfflinePayment {
3823 my $operation = shift;
3825 my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} });
3826 my $amount = $operation->{amount};
3828 Koha::Account->new( { patron_id => $patron->id } )->pay( { amount => $amount } );
3830 return "Success."
3834 =head2 TransferSlip
3836 TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3838 Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3840 =cut
3842 sub TransferSlip {
3843 my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3845 my $item = GetItem( $itemnumber, $barcode )
3846 or return;
3848 return C4::Letters::GetPreparedLetter (
3849 module => 'circulation',
3850 letter_code => 'TRANSFERSLIP',
3851 branchcode => $branch,
3852 tables => {
3853 'branches' => $to_branch,
3854 'biblio' => $item->{biblionumber},
3855 'items' => $item,
3860 =head2 CheckIfIssuedToPatron
3862 CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3864 Return 1 if any record item is issued to patron, otherwise return 0
3866 =cut
3868 sub CheckIfIssuedToPatron {
3869 my ($borrowernumber, $biblionumber) = @_;
3871 my $dbh = C4::Context->dbh;
3872 my $query = q|
3873 SELECT COUNT(*) FROM issues
3874 LEFT JOIN items ON items.itemnumber = issues.itemnumber
3875 WHERE items.biblionumber = ?
3876 AND issues.borrowernumber = ?
3878 my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
3879 return 1 if $is_issued;
3880 return;
3883 =head2 IsItemIssued
3885 IsItemIssued( $itemnumber )
3887 Return 1 if the item is on loan, otherwise return 0
3889 =cut
3891 sub IsItemIssued {
3892 my $itemnumber = shift;
3893 my $dbh = C4::Context->dbh;
3894 my $sth = $dbh->prepare(q{
3895 SELECT COUNT(*)
3896 FROM issues
3897 WHERE itemnumber = ?
3899 $sth->execute($itemnumber);
3900 return $sth->fetchrow;
3903 =head2 GetAgeRestriction
3905 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3906 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3908 if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as they are older or as old as the agerestriction }
3909 if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3911 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3912 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3913 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3914 Negative days mean the borrower has gone past the age restriction age.
3916 =cut
3918 sub GetAgeRestriction {
3919 my ($record_restrictions, $borrower) = @_;
3920 my $markers = C4::Context->preference('AgeRestrictionMarker');
3922 # Split $record_restrictions to something like FSK 16 or PEGI 6
3923 my @values = split ' ', uc($record_restrictions);
3924 return unless @values;
3926 # Search first occurrence of one of the markers
3927 my @markers = split /\|/, uc($markers);
3928 return unless @markers;
3930 my $index = 0;
3931 my $restriction_year = 0;
3932 for my $value (@values) {
3933 $index++;
3934 for my $marker (@markers) {
3935 $marker =~ s/^\s+//; #remove leading spaces
3936 $marker =~ s/\s+$//; #remove trailing spaces
3937 if ( $marker eq $value ) {
3938 if ( $index <= $#values ) {
3939 $restriction_year += $values[$index];
3941 last;
3943 elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
3945 # Perhaps it is something like "K16" (as in Finland)
3946 $restriction_year += $1;
3947 last;
3950 last if ( $restriction_year > 0 );
3953 #Check if the borrower is age restricted for this material and for how long.
3954 if ($restriction_year && $borrower) {
3955 if ( $borrower->{'dateofbirth'} ) {
3956 my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3957 $alloweddate[0] += $restriction_year;
3959 #Prevent runime eror on leap year (invalid date)
3960 if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3961 $alloweddate[2] = 28;
3964 #Get how many days the borrower has to reach the age restriction
3965 my @Today = split /-/, DateTime->today->ymd();
3966 my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
3967 #Negative days means the borrower went past the age restriction age
3968 return ($restriction_year, $daysToAgeRestriction);
3972 return ($restriction_year);
3976 =head2 GetPendingOnSiteCheckouts
3978 =cut
3980 sub GetPendingOnSiteCheckouts {
3981 my $dbh = C4::Context->dbh;
3982 return $dbh->selectall_arrayref(q|
3983 SELECT
3984 items.barcode,
3985 items.biblionumber,
3986 items.itemnumber,
3987 items.itemnotes,
3988 items.itemcallnumber,
3989 items.location,
3990 issues.date_due,
3991 issues.branchcode,
3992 issues.date_due < NOW() AS is_overdue,
3993 biblio.author,
3994 biblio.title,
3995 borrowers.firstname,
3996 borrowers.surname,
3997 borrowers.cardnumber,
3998 borrowers.borrowernumber
3999 FROM items
4000 LEFT JOIN issues ON items.itemnumber = issues.itemnumber
4001 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
4002 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
4003 WHERE issues.onsite_checkout = 1
4004 |, { Slice => {} } );
4007 sub GetTopIssues {
4008 my ($params) = @_;
4010 my ($count, $branch, $itemtype, $ccode, $newness)
4011 = @$params{qw(count branch itemtype ccode newness)};
4013 my $dbh = C4::Context->dbh;
4014 my $query = q{
4015 SELECT * FROM (
4016 SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4017 bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4018 i.ccode, SUM(i.issues) AS count
4019 FROM biblio b
4020 LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
4021 LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
4024 my (@where_strs, @where_args);
4026 if ($branch) {
4027 push @where_strs, 'i.homebranch = ?';
4028 push @where_args, $branch;
4030 if ($itemtype) {
4031 if (C4::Context->preference('item-level_itypes')){
4032 push @where_strs, 'i.itype = ?';
4033 push @where_args, $itemtype;
4034 } else {
4035 push @where_strs, 'bi.itemtype = ?';
4036 push @where_args, $itemtype;
4039 if ($ccode) {
4040 push @where_strs, 'i.ccode = ?';
4041 push @where_args, $ccode;
4043 if ($newness) {
4044 push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4045 push @where_args, $newness;
4048 if (@where_strs) {
4049 $query .= 'WHERE ' . join(' AND ', @where_strs);
4052 $query .= q{
4053 GROUP BY b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4054 bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4055 i.ccode
4056 ORDER BY count DESC
4059 $query .= q{ ) xxx WHERE count > 0 };
4060 $count = int($count);
4061 if ($count > 0) {
4062 $query .= "LIMIT $count";
4065 my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4067 return @$rows;
4070 sub _CalculateAndUpdateFine {
4071 my ($params) = @_;
4073 my $borrower = $params->{borrower};
4074 my $item = $params->{item};
4075 my $issue = $params->{issue};
4076 my $return_date = $params->{return_date};
4078 unless ($borrower) { carp "No borrower passed in!" && return; }
4079 unless ($item) { carp "No item passed in!" && return; }
4080 unless ($issue) { carp "No issue passed in!" && return; }
4082 my $datedue = dt_from_string( $issue->date_due );
4084 # we only need to calculate and change the fines if we want to do that on return
4085 # Should be on for hourly loans
4086 my $control = C4::Context->preference('CircControl');
4087 my $control_branchcode =
4088 ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
4089 : ( $control eq 'PatronLibrary' ) ? $borrower->{branchcode}
4090 : $issue->branchcode;
4092 my $date_returned = $return_date ? dt_from_string($return_date) : dt_from_string();
4094 my ( $amount, $type, $unitcounttotal ) =
4095 C4::Overdues::CalcFine( $item, $borrower->{categorycode}, $control_branchcode, $datedue, $date_returned );
4097 $type ||= q{};
4099 if ( C4::Context->preference('finesMode') eq 'production' ) {
4100 if ( $amount > 0 ) {
4101 C4::Overdues::UpdateFine({
4102 issue_id => $issue->issue_id,
4103 itemnumber => $issue->itemnumber,
4104 borrowernumber => $issue->borrowernumber,
4105 amount => $amount,
4106 type => $type,
4107 due => output_pref($datedue),
4110 elsif ($return_date) {
4112 # Backdated returns may have fines that shouldn't exist,
4113 # so in this case, we need to drop those fines to 0
4115 C4::Overdues::UpdateFine({
4116 issue_id => $issue->issue_id,
4117 itemnumber => $issue->itemnumber,
4118 borrowernumber => $issue->borrowernumber,
4119 amount => 0,
4120 type => $type,
4121 due => output_pref($datedue),
4127 sub _item_denied_renewal {
4128 my ($params) = @_;
4130 my $item = $params->{item};
4131 return unless $item;
4133 my $yaml = C4::Context->preference('ItemsDeniedRenewal');
4134 my @lines = split /\n/, $yaml;
4135 my $denyingrules;
4136 foreach my $line (@lines){
4137 my ($field,$array) = split /:/, $line;
4138 $array =~ s/[ [\]\r]//g;
4139 my @array = split /,/, $array;
4140 @array = map { $_ eq 'NULL' ? undef : $_ } @array;
4141 @array = map { $_ eq '""' || $_ eq "''" ? undef : $_ } @array;
4142 $denyingrules->{$field} = \@array;
4144 return unless $denyingrules;
4145 foreach my $field (keys %$denyingrules) {
4146 my $val = $item->{$field};
4147 if( !defined $val) {
4148 if ( any { !defined $_ } @{$denyingrules->{$field}} ){
4149 return 1;
4151 } elsif (any { $val eq $_ } @{$denyingrules->{$field}}) {
4152 # If the results matches the values in the syspref
4153 # We return true if match found
4154 return 1;
4157 return 0;
4163 __END__
4165 =head1 AUTHOR
4167 Koha Development Team <http://koha-community.org/>
4169 =cut