Bug 26017: (follow-up) Serverside permission check on registers page
[koha.git] / C4 / Circulation.pm
bloba9cf02ca3da46bf5c83d5034b62be53b953c51f8
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>.
21 use Modern::Perl;
22 use DateTime;
23 use POSIX qw( floor );
24 use Koha::DateUtils;
25 use C4::Context;
26 use C4::Stats;
27 use C4::Reserves;
28 use C4::Biblio;
29 use C4::Items;
30 use C4::Members;
31 use C4::Accounts;
32 use C4::ItemCirculationAlertPreference;
33 use C4::Message;
34 use C4::Debug;
35 use C4::Log; # logaction
36 use C4::Overdues qw(CalcFine UpdateFine get_chargeable_units);
37 use C4::RotatingCollections qw(GetCollectionItemBranches);
38 use Algorithm::CheckDigits;
40 use Data::Dumper;
41 use Koha::Account;
42 use Koha::AuthorisedValues;
43 use Koha::Biblioitems;
44 use Koha::DateUtils;
45 use Koha::Calendar;
46 use Koha::Checkouts;
47 use Koha::Illrequests;
48 use Koha::Items;
49 use Koha::Patrons;
50 use Koha::Patron::Debarments;
51 use Koha::Database;
52 use Koha::Libraries;
53 use Koha::Account::Lines;
54 use Koha::Holds;
55 use Koha::RefundLostItemFeeRules;
56 use Koha::Account::Lines;
57 use Koha::Account::Offsets;
58 use Koha::Config::SysPrefs;
59 use Koha::Charges::Fees;
60 use Koha::Util::SystemPreferences;
61 use Koha::Checkouts::ReturnClaims;
62 use Carp;
63 use List::MoreUtils qw( uniq any );
64 use Scalar::Util qw( looks_like_number );
65 use Try::Tiny;
66 use Date::Calc qw(
67 Today
68 Today_and_Now
69 Add_Delta_YM
70 Add_Delta_DHMS
71 Date_to_Days
72 Day_of_Week
73 Add_Delta_Days
75 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
77 BEGIN {
78 require Exporter;
79 @ISA = qw(Exporter);
81 # FIXME subs that should probably be elsewhere
82 push @EXPORT, qw(
83 &barcodedecode
84 &LostItem
85 &ReturnLostItem
86 &GetPendingOnSiteCheckouts
89 # subs to deal with issuing a book
90 push @EXPORT, qw(
91 &CanBookBeIssued
92 &CanBookBeRenewed
93 &AddIssue
94 &AddRenewal
95 &GetRenewCount
96 &GetSoonestRenewDate
97 &GetLatestAutoRenewDate
98 &GetIssuingCharges
99 &GetBranchBorrowerCircRule
100 &GetBranchItemRule
101 &GetBiblioIssues
102 &GetOpenIssue
103 &CheckIfIssuedToPatron
104 &IsItemIssued
105 GetTopIssues
108 # subs to deal with returns
109 push @EXPORT, qw(
110 &AddReturn
111 &MarkIssueReturned
114 # subs to deal with transfers
115 push @EXPORT, qw(
116 &transferbook
117 &GetTransfers
118 &GetTransfersFromTo
119 &updateWrongTransfer
120 &DeleteTransfer
121 &IsBranchTransferAllowed
122 &CreateBranchTransferLimit
123 &DeleteBranchTransferLimits
124 &TransferSlip
127 # subs to deal with offline circulation
128 push @EXPORT, qw(
129 &GetOfflineOperations
130 &GetOfflineOperation
131 &AddOfflineOperation
132 &DeleteOfflineOperation
133 &ProcessOfflineOperation
137 =head1 NAME
139 C4::Circulation - Koha circulation module
141 =head1 SYNOPSIS
143 use C4::Circulation;
145 =head1 DESCRIPTION
147 The functions in this module deal with circulation, issues, and
148 returns, as well as general information about the library.
149 Also deals with inventory.
151 =head1 FUNCTIONS
153 =head2 barcodedecode
155 $str = &barcodedecode($barcode, [$filter]);
157 Generic filter function for barcode string.
158 Called on every circ if the System Pref itemBarcodeInputFilter is set.
159 Will do some manipulation of the barcode for systems that deliver a barcode
160 to circulation.pl that differs from the barcode stored for the item.
161 For proper functioning of this filter, calling the function on the
162 correct barcode string (items.barcode) should return an unaltered barcode.
164 The optional $filter argument is to allow for testing or explicit
165 behavior that ignores the System Pref. Valid values are the same as the
166 System Pref options.
168 =cut
170 # FIXME -- the &decode fcn below should be wrapped into this one.
171 # FIXME -- these plugins should be moved out of Circulation.pm
173 sub barcodedecode {
174 my ($barcode, $filter) = @_;
175 my $branch = C4::Context::mybranch();
176 $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
177 $filter or return $barcode; # ensure filter is defined, else return untouched barcode
178 if ($filter eq 'whitespace') {
179 $barcode =~ s/\s//g;
180 } elsif ($filter eq 'cuecat') {
181 chomp($barcode);
182 my @fields = split( /\./, $barcode );
183 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
184 ($#results == 2) and return $results[2];
185 } elsif ($filter eq 'T-prefix') {
186 if ($barcode =~ /^[Tt](\d)/) {
187 (defined($1) and $1 eq '0') and return $barcode;
188 $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1)
190 return sprintf("T%07d", $barcode);
191 # FIXME: $barcode could be "T1", causing warning: substr outside of string
192 # Why drop the nonzero digit after the T?
193 # Why pass non-digits (or empty string) to "T%07d"?
194 } elsif ($filter eq 'libsuite8') {
195 unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it.
196 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
197 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
198 }else{
199 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
202 } elsif ($filter eq 'EAN13') {
203 my $ean = CheckDigits('ean');
204 if ( $ean->is_valid($barcode) ) {
205 #$barcode = sprintf('%013d',$barcode); # this doesn't work on 32-bit systems
206 $barcode = '0' x ( 13 - length($barcode) ) . $barcode;
207 } else {
208 warn "# [$barcode] not valid EAN-13/UPC-A\n";
211 return $barcode; # return barcode, modified or not
214 =head2 decode
216 $str = &decode($chunk);
218 Decodes a segment of a string emitted by a CueCat barcode scanner and
219 returns it.
221 FIXME: Should be replaced with Barcode::Cuecat from CPAN
222 or Javascript based decoding on the client side.
224 =cut
226 sub decode {
227 my ($encoded) = @_;
228 my $seq =
229 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
230 my @s = map { index( $seq, $_ ); } split( //, $encoded );
231 my $l = ( $#s + 1 ) % 4;
232 if ($l) {
233 if ( $l == 1 ) {
234 # warn "Error: Cuecat decode parsing failed!";
235 return;
237 $l = 4 - $l;
238 $#s += $l;
240 my $r = '';
241 while ( $#s >= 0 ) {
242 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
243 $r .=
244 chr( ( $n >> 16 ) ^ 67 )
245 .chr( ( $n >> 8 & 255 ) ^ 67 )
246 .chr( ( $n & 255 ) ^ 67 );
247 @s = @s[ 4 .. $#s ];
249 $r = substr( $r, 0, length($r) - $l );
250 return $r;
253 =head2 transferbook
255 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
256 $barcode, $ignore_reserves, $trigger);
258 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
260 C<$newbranch> is the code for the branch to which the item should be transferred.
262 C<$barcode> is the barcode of the item to be transferred.
264 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
265 Otherwise, if an item is reserved, the transfer fails.
267 C<$trigger> is the enum value for what triggered the transfer.
269 Returns three values:
271 =over
273 =item $dotransfer
275 is true if the transfer was successful.
277 =item $messages
279 is a reference-to-hash which may have any of the following keys:
281 =over
283 =item C<BadBarcode>
285 There is no item in the catalog with the given barcode. The value is C<$barcode>.
287 =item C<DestinationEqualsHolding>
289 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.
291 =item C<WasReturned>
293 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.
295 =item C<ResFound>
297 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>.
299 =item C<WasTransferred>
301 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
303 =back
305 =back
307 =cut
309 sub transferbook {
310 my ( $tbr, $barcode, $ignoreRs, $trigger ) = @_;
311 my $messages;
312 my $dotransfer = 1;
313 my $item = Koha::Items->find( { barcode => $barcode } );
315 # bad barcode..
316 unless ( $item ) {
317 $messages->{'BadBarcode'} = $barcode;
318 $dotransfer = 0;
319 return ( $dotransfer, $messages );
322 my $itemnumber = $item->itemnumber;
323 # get branches of book...
324 my $hbr = $item->homebranch;
325 my $fbr = $item->holdingbranch;
327 # if using Branch Transfer Limits
328 if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
329 my $code = C4::Context->preference("BranchTransferLimitsType") eq 'ccode' ? $item->ccode : $item->biblio->biblioitem->itemtype; # BranchTransferLimitsType is 'ccode' or 'itemtype'
330 if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
331 if ( ! IsBranchTransferAllowed( $tbr, $fbr, $item->itype ) ) {
332 $messages->{'NotAllowed'} = $tbr . "::" . $item->itype;
333 $dotransfer = 0;
335 } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $code ) ) {
336 $messages->{'NotAllowed'} = $tbr . "::" . $code;
337 $dotransfer = 0;
341 # can't transfer book if is already there....
342 if ( $fbr eq $tbr ) {
343 $messages->{'DestinationEqualsHolding'} = 1;
344 $dotransfer = 0;
347 # check if it is still issued to someone, return it...
348 my $issue = Koha::Checkouts->find({ itemnumber => $itemnumber });
349 if ( $issue ) {
350 AddReturn( $barcode, $fbr );
351 $messages->{'WasReturned'} = $issue->borrowernumber;
354 # find reserves.....
355 # That'll save a database query.
356 my ( $resfound, $resrec, undef ) =
357 CheckReserves( $itemnumber );
358 if ( $resfound and not $ignoreRs ) {
359 $resrec->{'ResFound'} = $resfound;
360 $messages->{'ResFound'} = $resrec;
361 $dotransfer = 1;
364 #actually do the transfer....
365 if ($dotransfer) {
366 ModItemTransfer( $itemnumber, $fbr, $tbr, $trigger );
368 # don't need to update MARC anymore, we do it in batch now
369 $messages->{'WasTransfered'} = 1;
372 ModDateLastSeen( $itemnumber );
373 return ( $dotransfer, $messages );
377 sub TooMany {
378 my $borrower = shift;
379 my $item_object = shift;
380 my $params = shift;
381 my $onsite_checkout = $params->{onsite_checkout} || 0;
382 my $switch_onsite_checkout = $params->{switch_onsite_checkout} || 0;
383 my $cat_borrower = $borrower->{'categorycode'};
384 my $dbh = C4::Context->dbh;
385 my $branch;
386 # Get which branchcode we need
387 $branch = _GetCircControlBranch($item_object->unblessed,$borrower);
388 my $type = $item_object->effective_itemtype;
390 # given branch, patron category, and item type, determine
391 # applicable issuing rule
392 my $maxissueqty_rule = Koha::CirculationRules->get_effective_rule(
394 categorycode => $cat_borrower,
395 itemtype => $type,
396 branchcode => $branch,
397 rule_name => 'maxissueqty',
400 my $maxonsiteissueqty_rule = Koha::CirculationRules->get_effective_rule(
402 categorycode => $cat_borrower,
403 itemtype => $type,
404 branchcode => $branch,
405 rule_name => 'maxonsiteissueqty',
410 # if a rule is found and has a loan limit set, count
411 # how many loans the patron already has that meet that
412 # rule
413 if (defined($maxissueqty_rule) and $maxissueqty_rule->rule_value ne '') {
414 my @bind_params;
415 my $count_query = q|
416 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
417 FROM issues
418 JOIN items USING (itemnumber)
421 my $rule_itemtype = $maxissueqty_rule->itemtype;
422 unless ($rule_itemtype) {
423 # matching rule has the default item type, so count only
424 # those existing loans that don't fall under a more
425 # specific rule
426 if (C4::Context->preference('item-level_itypes')) {
427 $count_query .= " WHERE items.itype NOT IN (
428 SELECT itemtype FROM circulation_rules
429 WHERE branchcode = ?
430 AND (categorycode = ? OR categorycode = ?)
431 AND itemtype IS NOT NULL
432 AND rule_name = 'maxissueqty'
433 ) ";
434 } else {
435 $count_query .= " JOIN biblioitems USING (biblionumber)
436 WHERE biblioitems.itemtype NOT IN (
437 SELECT itemtype FROM circulation_rules
438 WHERE branchcode = ?
439 AND (categorycode = ? OR categorycode = ?)
440 AND itemtype IS NOT NULL
441 AND rule_name = 'maxissueqty'
442 ) ";
444 push @bind_params, $maxissueqty_rule->branchcode;
445 push @bind_params, $maxissueqty_rule->categorycode;
446 push @bind_params, $cat_borrower;
447 } else {
448 # rule has specific item type, so count loans of that
449 # specific item type
450 if (C4::Context->preference('item-level_itypes')) {
451 $count_query .= " WHERE items.itype = ? ";
452 } else {
453 $count_query .= " JOIN biblioitems USING (biblionumber)
454 WHERE biblioitems.itemtype= ? ";
456 push @bind_params, $type;
459 $count_query .= " AND borrowernumber = ? ";
460 push @bind_params, $borrower->{'borrowernumber'};
461 my $rule_branch = $maxissueqty_rule->branchcode;
462 if ($rule_branch) {
463 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
464 $count_query .= " AND issues.branchcode = ? ";
465 push @bind_params, $rule_branch;
466 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
467 ; # if branch is the patron's home branch, then count all loans by patron
468 } else {
469 $count_query .= " AND items.homebranch = ? ";
470 push @bind_params, $rule_branch;
474 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $count_query, {}, @bind_params );
476 my $max_checkouts_allowed = $maxissueqty_rule ? $maxissueqty_rule->rule_value : undef;
477 my $max_onsite_checkouts_allowed = $maxonsiteissueqty_rule ? $maxonsiteissueqty_rule->rule_value : undef;
479 if ( $onsite_checkout and $max_onsite_checkouts_allowed ne '' ) {
480 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
481 return {
482 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
483 count => $onsite_checkout_count,
484 max_allowed => $max_onsite_checkouts_allowed,
488 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
489 my $delta = $switch_onsite_checkout ? 1 : 0;
490 if ( $checkout_count >= $max_checkouts_allowed + $delta ) {
491 return {
492 reason => 'TOO_MANY_CHECKOUTS',
493 count => $checkout_count,
494 max_allowed => $max_checkouts_allowed,
497 } elsif ( not $onsite_checkout ) {
498 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
499 return {
500 reason => 'TOO_MANY_CHECKOUTS',
501 count => $checkout_count - $onsite_checkout_count,
502 max_allowed => $max_checkouts_allowed,
508 # Now count total loans against the limit for the branch
509 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
510 if (defined($branch_borrower_circ_rule->{patron_maxissueqty}) and $branch_borrower_circ_rule->{patron_maxissueqty} ne '') {
511 my @bind_params = ();
512 my $branch_count_query = q|
513 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
514 FROM issues
515 JOIN items USING (itemnumber)
516 WHERE borrowernumber = ?
518 push @bind_params, $borrower->{borrowernumber};
520 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
521 $branch_count_query .= " AND issues.branchcode = ? ";
522 push @bind_params, $branch;
523 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
524 ; # if branch is the patron's home branch, then count all loans by patron
525 } else {
526 $branch_count_query .= " AND items.homebranch = ? ";
527 push @bind_params, $branch;
529 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $branch_count_query, {}, @bind_params );
530 my $max_checkouts_allowed = $branch_borrower_circ_rule->{patron_maxissueqty};
531 my $max_onsite_checkouts_allowed = $branch_borrower_circ_rule->{patron_maxonsiteissueqty};
533 if ( $onsite_checkout and $max_onsite_checkouts_allowed ne '' ) {
534 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
535 return {
536 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
537 count => $onsite_checkout_count,
538 max_allowed => $max_onsite_checkouts_allowed,
542 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
543 my $delta = $switch_onsite_checkout ? 1 : 0;
544 if ( $checkout_count >= $max_checkouts_allowed + $delta ) {
545 return {
546 reason => 'TOO_MANY_CHECKOUTS',
547 count => $checkout_count,
548 max_allowed => $max_checkouts_allowed,
551 } elsif ( not $onsite_checkout ) {
552 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
553 return {
554 reason => 'TOO_MANY_CHECKOUTS',
555 count => $checkout_count - $onsite_checkout_count,
556 max_allowed => $max_checkouts_allowed,
562 if ( not defined( $maxissueqty_rule ) and not defined($branch_borrower_circ_rule->{patron_maxissueqty}) ) {
563 return { reason => 'NO_RULE_DEFINED', max_allowed => 0 };
566 # OK, the patron can issue !!!
567 return;
570 =head2 CanBookBeIssued
572 ( $issuingimpossible, $needsconfirmation, [ $alerts ] ) = CanBookBeIssued( $patron,
573 $barcode, $duedate, $inprocess, $ignore_reserves, $params );
575 Check if a book can be issued.
577 C<$issuingimpossible> and C<$needsconfirmation> are hashrefs.
579 IMPORTANT: The assumption by users of this routine is that causes blocking
580 the issue are keyed by uppercase labels and other returned
581 data is keyed in lower case!
583 =over 4
585 =item C<$patron> is a Koha::Patron
587 =item C<$barcode> is the bar code of the book being issued.
589 =item C<$duedates> is a DateTime object.
591 =item C<$inprocess> boolean switch
593 =item C<$ignore_reserves> boolean switch
595 =item C<$params> Hashref of additional parameters
597 Available keys:
598 override_high_holds - Ignore high holds
599 onsite_checkout - Checkout is an onsite checkout that will not leave the library
601 =back
603 Returns :
605 =over 4
607 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
608 Possible values are :
610 =back
612 =head3 INVALID_DATE
614 sticky due date is invalid
616 =head3 GNA
618 borrower gone with no address
620 =head3 CARD_LOST
622 borrower declared it's card lost
624 =head3 DEBARRED
626 borrower debarred
628 =head3 UNKNOWN_BARCODE
630 barcode unknown
632 =head3 NOT_FOR_LOAN
634 item is not for loan
636 =head3 WTHDRAWN
638 item withdrawn.
640 =head3 RESTRICTED
642 item is restricted (set by ??)
644 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
645 could be prevented, but ones that can be overriden by the operator.
647 Possible values are :
649 =head3 DEBT
651 borrower has debts.
653 =head3 RENEW_ISSUE
655 renewing, not issuing
657 =head3 ISSUED_TO_ANOTHER
659 issued to someone else.
661 =head3 RESERVED
663 reserved for someone else.
665 =head3 INVALID_DATE
667 sticky due date is invalid or due date in the past
669 =head3 TOO_MANY
671 if the borrower borrows to much things
673 =cut
675 sub CanBookBeIssued {
676 my ( $patron, $barcode, $duedate, $inprocess, $ignore_reserves, $params ) = @_;
677 my %needsconfirmation; # filled with problems that needs confirmations
678 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
679 my %alerts; # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
680 my %messages; # filled with information messages that should be displayed.
682 my $onsite_checkout = $params->{onsite_checkout} || 0;
683 my $override_high_holds = $params->{override_high_holds} || 0;
685 my $item_object = Koha::Items->find({barcode => $barcode });
687 # MANDATORY CHECKS - unless item exists, nothing else matters
688 unless ( $item_object ) {
689 $issuingimpossible{UNKNOWN_BARCODE} = 1;
691 return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
693 my $item_unblessed = $item_object->unblessed; # Transition...
694 my $issue = $item_object->checkout;
695 my $biblio = $item_object->biblio;
697 my $biblioitem = $biblio->biblioitem;
698 my $effective_itemtype = $item_object->effective_itemtype;
699 my $dbh = C4::Context->dbh;
700 my $patron_unblessed = $patron->unblessed;
702 my $circ_library = Koha::Libraries->find( _GetCircControlBranch($item_unblessed, $patron_unblessed) );
704 # DUE DATE is OK ? -- should already have checked.
706 if ($duedate && ref $duedate ne 'DateTime') {
707 $duedate = dt_from_string($duedate);
709 my $now = dt_from_string();
710 unless ( $duedate ) {
711 my $issuedate = $now->clone();
713 $duedate = CalcDateDue( $issuedate, $effective_itemtype, $circ_library->branchcode, $patron_unblessed );
715 # Offline circ calls AddIssue directly, doesn't run through here
716 # So issuingimpossible should be ok.
719 my $fees = Koha::Charges::Fees->new(
721 patron => $patron,
722 library => $circ_library,
723 item => $item_object,
724 to_date => $duedate,
728 if ($duedate) {
729 my $today = $now->clone();
730 $today->truncate( to => 'minute');
731 if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
732 $needsconfirmation{INVALID_DATE} = output_pref($duedate);
734 } else {
735 $issuingimpossible{INVALID_DATE} = output_pref($duedate);
739 # BORROWER STATUS
741 if ( $patron->category->category_type eq 'X' && ( $item_object->barcode )) {
742 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
743 &UpdateStats({
744 branch => C4::Context->userenv->{'branch'},
745 type => 'localuse',
746 itemnumber => $item_object->itemnumber,
747 itemtype => $effective_itemtype,
748 borrowernumber => $patron->borrowernumber,
749 ccode => $item_object->ccode}
751 ModDateLastSeen( $item_object->itemnumber ); # FIXME Move to Koha::Item
752 return( { STATS => 1 }, {});
755 if ( $patron->gonenoaddress && $patron->gonenoaddress == 1 ) {
756 $issuingimpossible{GNA} = 1;
759 if ( $patron->lost && $patron->lost == 1 ) {
760 $issuingimpossible{CARD_LOST} = 1;
762 if ( $patron->is_debarred ) {
763 $issuingimpossible{DEBARRED} = 1;
766 if ( $patron->is_expired ) {
767 $issuingimpossible{EXPIRED} = 1;
771 # BORROWER STATUS
774 # DEBTS
775 my $account = $patron->account;
776 my $balance = $account->balance;
777 my $non_issues_charges = $account->non_issues_charges;
778 my $other_charges = $balance - $non_issues_charges;
780 my $amountlimit = C4::Context->preference("noissuescharge");
781 my $allowfineoverride = C4::Context->preference("AllowFineOverride");
782 my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
784 # Check the debt of this patrons guarantees
785 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
786 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
787 if ( defined $no_issues_charge_guarantees ) {
788 my @guarantees = map { $_->guarantee } $patron->guarantee_relationships();
789 my $guarantees_non_issues_charges;
790 foreach my $g ( @guarantees ) {
791 $guarantees_non_issues_charges += $g->account->non_issues_charges;
794 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && !$allowfineoverride) {
795 $issuingimpossible{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
796 } elsif ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && $allowfineoverride) {
797 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
798 } elsif ( $allfinesneedoverride && $guarantees_non_issues_charges > 0 && $guarantees_non_issues_charges <= $no_issues_charge_guarantees && !$inprocess ) {
799 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
803 if ( C4::Context->preference("IssuingInProcess") ) {
804 if ( $non_issues_charges > $amountlimit && !$inprocess && !$allowfineoverride) {
805 $issuingimpossible{DEBT} = $non_issues_charges;
806 } elsif ( $non_issues_charges > $amountlimit && !$inprocess && $allowfineoverride) {
807 $needsconfirmation{DEBT} = $non_issues_charges;
808 } elsif ( $allfinesneedoverride && $non_issues_charges > 0 && $non_issues_charges <= $amountlimit && !$inprocess ) {
809 $needsconfirmation{DEBT} = $non_issues_charges;
812 else {
813 if ( $non_issues_charges > $amountlimit && $allowfineoverride ) {
814 $needsconfirmation{DEBT} = $non_issues_charges;
815 } elsif ( $non_issues_charges > $amountlimit && !$allowfineoverride) {
816 $issuingimpossible{DEBT} = $non_issues_charges;
817 } elsif ( $non_issues_charges > 0 && $allfinesneedoverride ) {
818 $needsconfirmation{DEBT} = $non_issues_charges;
822 if ($balance > 0 && $other_charges > 0) {
823 $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges );
826 $patron = Koha::Patrons->find( $patron->borrowernumber ); # FIXME Refetch just in case, to avoid regressions. But must not be needed
827 $patron_unblessed = $patron->unblessed;
829 if ( my $debarred_date = $patron->is_debarred ) {
830 # patron has accrued fine days or has a restriction. $count is a date
831 if ($debarred_date eq '9999-12-31') {
832 $issuingimpossible{USERBLOCKEDNOENDDATE} = $debarred_date;
834 else {
835 $issuingimpossible{USERBLOCKEDWITHENDDATE} = $debarred_date;
837 } elsif ( my $num_overdues = $patron->has_overdues ) {
838 ## patron has outstanding overdue loans
839 if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
840 $issuingimpossible{USERBLOCKEDOVERDUE} = $num_overdues;
842 elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
843 $needsconfirmation{USERBLOCKEDOVERDUE} = $num_overdues;
848 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
850 if ( $issue && $issue->borrowernumber eq $patron->borrowernumber ){
852 # Already issued to current borrower.
853 # If it is an on-site checkout if it can be switched to a normal checkout
854 # or ask whether the loan should be renewed
856 if ( $issue->onsite_checkout
857 and C4::Context->preference('SwitchOnSiteCheckouts') ) {
858 $messages{ONSITE_CHECKOUT_WILL_BE_SWITCHED} = 1;
859 } else {
860 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
861 $patron->borrowernumber,
862 $item_object->itemnumber,
864 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
865 if ( $renewerror eq 'onsite_checkout' ) {
866 $issuingimpossible{NO_RENEWAL_FOR_ONSITE_CHECKOUTS} = 1;
868 else {
869 $issuingimpossible{NO_MORE_RENEWALS} = 1;
872 else {
873 $needsconfirmation{RENEW_ISSUE} = 1;
877 elsif ( $issue ) {
879 # issued to someone else
881 my $patron = Koha::Patrons->find( $issue->borrowernumber );
883 my ( $can_be_returned, $message ) = CanBookBeReturned( $item_unblessed, C4::Context->userenv->{branch} );
885 unless ( $can_be_returned ) {
886 $issuingimpossible{RETURN_IMPOSSIBLE} = 1;
887 $issuingimpossible{branch_to_return} = $message;
888 } else {
889 if ( C4::Context->preference('AutoReturnCheckedOutItems') ) {
890 $alerts{RETURNED_FROM_ANOTHER} = { patron => $patron };
891 } else {
892 $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
893 $needsconfirmation{issued_firstname} = $patron->firstname;
894 $needsconfirmation{issued_surname} = $patron->surname;
895 $needsconfirmation{issued_cardnumber} = $patron->cardnumber;
896 $needsconfirmation{issued_borrowernumber} = $patron->borrowernumber;
901 # JB34 CHECKS IF BORROWERS DON'T HAVE ISSUE TOO MANY BOOKS
903 my $switch_onsite_checkout = (
904 C4::Context->preference('SwitchOnSiteCheckouts')
905 and $issue
906 and $issue->onsite_checkout
907 and $issue->borrowernumber == $patron->borrowernumber ? 1 : 0 );
908 my $toomany = TooMany( $patron_unblessed, $item_object, { onsite_checkout => $onsite_checkout, switch_onsite_checkout => $switch_onsite_checkout, } );
909 # if TooMany max_allowed returns 0 the user doesn't have permission to check out this book
910 if ( $toomany && not exists $needsconfirmation{RENEW_ISSUE} ) {
911 if ( $toomany->{max_allowed} == 0 ) {
912 $needsconfirmation{PATRON_CANT} = 1;
914 if ( C4::Context->preference("AllowTooManyOverride") ) {
915 $needsconfirmation{TOO_MANY} = $toomany->{reason};
916 $needsconfirmation{current_loan_count} = $toomany->{count};
917 $needsconfirmation{max_loans_allowed} = $toomany->{max_allowed};
918 } else {
919 $issuingimpossible{TOO_MANY} = $toomany->{reason};
920 $issuingimpossible{current_loan_count} = $toomany->{count};
921 $issuingimpossible{max_loans_allowed} = $toomany->{max_allowed};
926 # CHECKPREVCHECKOUT: CHECK IF ITEM HAS EVER BEEN LENT TO PATRON
928 $patron = Koha::Patrons->find( $patron->borrowernumber ); # FIXME Refetch just in case, to avoid regressions. But must not be needed
929 my $wants_check = $patron->wants_check_for_previous_checkout;
930 $needsconfirmation{PREVISSUE} = 1
931 if ($wants_check and $patron->do_check_for_previous_checkout($item_unblessed));
934 # ITEM CHECKING
936 if ( $item_object->notforloan )
938 if(!C4::Context->preference("AllowNotForLoanOverride")){
939 $issuingimpossible{NOT_FOR_LOAN} = 1;
940 $issuingimpossible{item_notforloan} = $item_object->notforloan;
941 }else{
942 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
943 $needsconfirmation{item_notforloan} = $item_object->notforloan;
946 else {
947 # we have to check itemtypes.notforloan also
948 if (C4::Context->preference('item-level_itypes')){
949 # this should probably be a subroutine
950 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
951 $sth->execute($effective_itemtype);
952 my $notforloan=$sth->fetchrow_hashref();
953 if ($notforloan->{'notforloan'}) {
954 if (!C4::Context->preference("AllowNotForLoanOverride")) {
955 $issuingimpossible{NOT_FOR_LOAN} = 1;
956 $issuingimpossible{itemtype_notforloan} = $effective_itemtype;
957 } else {
958 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
959 $needsconfirmation{itemtype_notforloan} = $effective_itemtype;
963 else {
964 my $itemtype = Koha::ItemTypes->find($biblioitem->itemtype);
965 if ( $itemtype && defined $itemtype->notforloan && $itemtype->notforloan == 1){
966 if (!C4::Context->preference("AllowNotForLoanOverride")) {
967 $issuingimpossible{NOT_FOR_LOAN} = 1;
968 $issuingimpossible{itemtype_notforloan} = $effective_itemtype;
969 } else {
970 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
971 $needsconfirmation{itemtype_notforloan} = $effective_itemtype;
976 if ( $item_object->withdrawn && $item_object->withdrawn > 0 )
978 $issuingimpossible{WTHDRAWN} = 1;
980 if ( $item_object->restricted
981 && $item_object->restricted == 1 )
983 $issuingimpossible{RESTRICTED} = 1;
985 if ( $item_object->itemlost && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
986 my $av = Koha::AuthorisedValues->search({ category => 'LOST', authorised_value => $item_object->itemlost });
987 my $code = $av->count ? $av->next->lib : '';
988 $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
989 $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
991 if ( C4::Context->preference("IndependentBranches") ) {
992 my $userenv = C4::Context->userenv;
993 unless ( C4::Context->IsSuperLibrarian() ) {
994 my $HomeOrHoldingBranch = C4::Context->preference("HomeOrHoldingBranch");
995 if ( $item_object->$HomeOrHoldingBranch ne $userenv->{branch} ){
996 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
997 $issuingimpossible{'itemhomebranch'} = $item_object->$HomeOrHoldingBranch;
999 $needsconfirmation{BORRNOTSAMEBRANCH} = $patron->branchcode
1000 if ( $patron->branchcode ne $userenv->{branch} );
1005 # CHECK IF THERE IS RENTAL CHARGES. RENTAL MUST BE CONFIRMED BY THE BORROWER
1007 my $rentalConfirmation = C4::Context->preference("RentalFeesCheckoutConfirmation");
1008 if ($rentalConfirmation) {
1009 my ($rentalCharge) = GetIssuingCharges( $item_object->itemnumber, $patron->borrowernumber );
1011 my $itemtype_object = Koha::ItemTypes->find( $item_object->effective_itemtype );
1012 if ($itemtype_object) {
1013 my $accumulate_charge = $fees->accumulate_rentalcharge();
1014 if ( $accumulate_charge > 0 ) {
1015 $rentalCharge += $accumulate_charge;
1019 if ( $rentalCharge > 0 ) {
1020 $needsconfirmation{RENTALCHARGE} = $rentalCharge;
1024 unless ( $ignore_reserves ) {
1025 # See if the item is on reserve.
1026 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item_object->itemnumber );
1027 if ($restype) {
1028 my $resbor = $res->{'borrowernumber'};
1029 if ( $resbor ne $patron->borrowernumber ) {
1030 my $patron = Koha::Patrons->find( $resbor );
1031 if ( $restype eq "Waiting" )
1033 # The item is on reserve and waiting, but has been
1034 # reserved by some other patron.
1035 $needsconfirmation{RESERVE_WAITING} = 1;
1036 $needsconfirmation{'resfirstname'} = $patron->firstname;
1037 $needsconfirmation{'ressurname'} = $patron->surname;
1038 $needsconfirmation{'rescardnumber'} = $patron->cardnumber;
1039 $needsconfirmation{'resborrowernumber'} = $patron->borrowernumber;
1040 $needsconfirmation{'resbranchcode'} = $res->{branchcode};
1041 $needsconfirmation{'reswaitingdate'} = $res->{'waitingdate'};
1042 $needsconfirmation{'reserve_id'} = $res->{reserve_id};
1044 elsif ( $restype eq "Reserved" ) {
1045 # The item is on reserve for someone else.
1046 $needsconfirmation{RESERVED} = 1;
1047 $needsconfirmation{'resfirstname'} = $patron->firstname;
1048 $needsconfirmation{'ressurname'} = $patron->surname;
1049 $needsconfirmation{'rescardnumber'} = $patron->cardnumber;
1050 $needsconfirmation{'resborrowernumber'} = $patron->borrowernumber;
1051 $needsconfirmation{'resbranchcode'} = $patron->branchcode;
1052 $needsconfirmation{'resreservedate'} = $res->{reservedate};
1053 $needsconfirmation{'reserve_id'} = $res->{reserve_id};
1059 ## CHECK AGE RESTRICTION
1060 my $agerestriction = $biblioitem->agerestriction;
1061 my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $patron->unblessed );
1062 if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1063 if ( C4::Context->preference('AgeRestrictionOverride') ) {
1064 $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1066 else {
1067 $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1071 ## check for high holds decreasing loan period
1072 if ( C4::Context->preference('decreaseLoanHighHolds') ) {
1073 my $check = checkHighHolds( $item_unblessed, $patron_unblessed );
1075 if ( $check->{exceeded} ) {
1076 if ($override_high_holds) {
1077 $alerts{HIGHHOLDS} = {
1078 num_holds => $check->{outstanding},
1079 duration => $check->{duration},
1080 returndate => output_pref( { dt => dt_from_string($check->{due_date}), dateformat => 'iso', timeformat => '24hr' }),
1083 else {
1084 $needsconfirmation{HIGHHOLDS} = {
1085 num_holds => $check->{outstanding},
1086 duration => $check->{duration},
1087 returndate => output_pref( { dt => dt_from_string($check->{due_date}), dateformat => 'iso', timeformat => '24hr' }),
1093 if (
1094 !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1095 # don't do the multiple loans per bib check if we've
1096 # already determined that we've got a loan on the same item
1097 !$issuingimpossible{NO_MORE_RENEWALS} &&
1098 !$needsconfirmation{RENEW_ISSUE}
1100 # Check if borrower has already issued an item from the same biblio
1101 # Only if it's not a subscription
1102 my $biblionumber = $item_object->biblionumber;
1103 require C4::Serials;
1104 my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1105 unless ($is_a_subscription) {
1106 # FIXME Should be $patron->checkouts($args);
1107 my $checkouts = Koha::Checkouts->search(
1109 borrowernumber => $patron->borrowernumber,
1110 biblionumber => $biblionumber,
1113 join => 'item',
1116 # if we get here, we don't already have a loan on this item,
1117 # so if there are any loans on this bib, ask for confirmation
1118 if ( $checkouts->count ) {
1119 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1124 return ( \%issuingimpossible, \%needsconfirmation, \%alerts, \%messages, );
1127 =head2 CanBookBeReturned
1129 ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1131 Check whether the item can be returned to the provided branch
1133 =over 4
1135 =item C<$item> is a hash of item information as returned Koha::Items->find->unblessed (Temporary, should be a Koha::Item instead)
1137 =item C<$branch> is the branchcode where the return is taking place
1139 =back
1141 Returns:
1143 =over 4
1145 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1147 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1149 =back
1151 =cut
1153 sub CanBookBeReturned {
1154 my ($item, $branch) = @_;
1155 my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1157 # assume return is allowed to start
1158 my $allowed = 1;
1159 my $message;
1161 # identify all cases where return is forbidden
1162 if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1163 $allowed = 0;
1164 $message = $item->{'homebranch'};
1165 } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1166 $allowed = 0;
1167 $message = $item->{'holdingbranch'};
1168 } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1169 $allowed = 0;
1170 $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1173 return ($allowed, $message);
1176 =head2 CheckHighHolds
1178 used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1179 decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1180 has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1182 =cut
1184 sub checkHighHolds {
1185 my ( $item, $borrower ) = @_;
1186 my $branchcode = _GetCircControlBranch( $item, $borrower );
1187 my $item_object = Koha::Items->find( $item->{itemnumber} );
1189 my $return_data = {
1190 exceeded => 0,
1191 outstanding => 0,
1192 duration => 0,
1193 due_date => undef,
1196 my $holds = Koha::Holds->search( { biblionumber => $item->{'biblionumber'} } );
1198 if ( $holds->count() ) {
1199 $return_data->{outstanding} = $holds->count();
1201 my $decreaseLoanHighHoldsControl = C4::Context->preference('decreaseLoanHighHoldsControl');
1202 my $decreaseLoanHighHoldsValue = C4::Context->preference('decreaseLoanHighHoldsValue');
1203 my $decreaseLoanHighHoldsIgnoreStatuses = C4::Context->preference('decreaseLoanHighHoldsIgnoreStatuses');
1205 my @decreaseLoanHighHoldsIgnoreStatuses = split( /,/, $decreaseLoanHighHoldsIgnoreStatuses );
1207 if ( $decreaseLoanHighHoldsControl eq 'static' ) {
1209 # static means just more than a given number of holds on the record
1211 # If the number of holds is less than the threshold, we can stop here
1212 if ( $holds->count() < $decreaseLoanHighHoldsValue ) {
1213 return $return_data;
1216 elsif ( $decreaseLoanHighHoldsControl eq 'dynamic' ) {
1218 # dynamic means X more than the number of holdable items on the record
1220 # let's get the items
1221 my @items = $holds->next()->biblio()->items()->as_list;
1223 # Remove any items with status defined to be ignored even if the would not make item unholdable
1224 foreach my $status (@decreaseLoanHighHoldsIgnoreStatuses) {
1225 @items = grep { !$_->$status } @items;
1228 # Remove any items that are not holdable for this patron
1229 @items = grep { CanItemBeReserved( $borrower->{borrowernumber}, $_->itemnumber, undef, { ignore_found_holds => 1 } )->{status} eq 'OK' } @items;
1231 my $items_count = scalar @items;
1233 my $threshold = $items_count + $decreaseLoanHighHoldsValue;
1235 # If the number of holds is less than the count of items we have
1236 # plus the number of holds allowed above that count, we can stop here
1237 if ( $holds->count() <= $threshold ) {
1238 return $return_data;
1242 my $issuedate = dt_from_string();
1244 my $itype = $item_object->effective_itemtype;
1245 my $daysmode = Koha::CirculationRules->get_effective_daysmode(
1247 categorycode => $borrower->{categorycode},
1248 itemtype => $itype,
1249 branchcode => $branchcode,
1252 my $calendar = Koha::Calendar->new( branchcode => $branchcode, days_mode => $daysmode );
1254 my $orig_due = C4::Circulation::CalcDateDue( $issuedate, $itype, $branchcode, $borrower );
1256 my $decreaseLoanHighHoldsDuration = C4::Context->preference('decreaseLoanHighHoldsDuration');
1258 my $reduced_datedue = $calendar->addDate( $issuedate, $decreaseLoanHighHoldsDuration );
1259 $reduced_datedue->set_hour($orig_due->hour);
1260 $reduced_datedue->set_minute($orig_due->minute);
1261 $reduced_datedue->truncate( to => 'minute' );
1263 if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1264 $return_data->{exceeded} = 1;
1265 $return_data->{duration} = $decreaseLoanHighHoldsDuration;
1266 $return_data->{due_date} = $reduced_datedue;
1270 return $return_data;
1273 =head2 AddIssue
1275 &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1277 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1279 =over 4
1281 =item C<$borrower> is a hash with borrower informations (from Koha::Patron->unblessed).
1283 =item C<$barcode> is the barcode of the item being issued.
1285 =item C<$datedue> is a DateTime object for the max date of return, i.e. the date due (optional).
1286 Calculated if empty.
1288 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1290 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1291 Defaults to today. Unlike C<$datedue>, NOT a DateTime object, unfortunately.
1293 AddIssue does the following things :
1295 - step 01: check that there is a borrowernumber & a barcode provided
1296 - check for RENEWAL (book issued & being issued to the same patron)
1297 - renewal YES = Calculate Charge & renew
1298 - renewal NO =
1299 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1300 * RESERVE PLACED ?
1301 - fill reserve if reserve to this patron
1302 - cancel reserve or not, otherwise
1303 * TRANSFERT PENDING ?
1304 - complete the transfert
1305 * ISSUE THE BOOK
1307 =back
1309 =cut
1311 sub AddIssue {
1312 my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1314 my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1315 my $switch_onsite_checkout = $params && $params->{switch_onsite_checkout};
1316 my $auto_renew = $params && $params->{auto_renew};
1317 my $dbh = C4::Context->dbh;
1318 my $barcodecheck = CheckValidBarcode($barcode);
1320 my $issue;
1322 if ( $datedue && ref $datedue ne 'DateTime' ) {
1323 $datedue = dt_from_string($datedue);
1326 # $issuedate defaults to today.
1327 if ( !defined $issuedate ) {
1328 $issuedate = dt_from_string();
1330 else {
1331 if ( ref $issuedate ne 'DateTime' ) {
1332 $issuedate = dt_from_string($issuedate);
1337 # Stop here if the patron or barcode doesn't exist
1338 if ( $borrower && $barcode && $barcodecheck ) {
1339 # find which item we issue
1340 my $item_object = Koha::Items->find({ barcode => $barcode })
1341 or return; # if we don't get an Item, abort.
1342 my $item_unblessed = $item_object->unblessed;
1344 my $branchcode = _GetCircControlBranch( $item_unblessed, $borrower );
1346 # get actual issuing if there is one
1347 my $actualissue = $item_object->checkout;
1349 # check if we just renew the issue.
1350 if ( $actualissue and $actualissue->borrowernumber eq $borrower->{'borrowernumber'}
1351 and not $switch_onsite_checkout ) {
1352 $datedue = AddRenewal(
1353 $borrower->{'borrowernumber'},
1354 $item_object->itemnumber,
1355 $branchcode,
1356 $datedue,
1357 $issuedate, # here interpreted as the renewal date
1360 else {
1361 unless ($datedue) {
1362 my $itype = $item_object->effective_itemtype;
1363 $datedue = CalcDateDue( $issuedate, $itype, $branchcode, $borrower );
1366 $datedue->truncate( to => 'minute' );
1368 my $patron = Koha::Patrons->find( $borrower );
1369 my $library = Koha::Libraries->find( $branchcode );
1370 my $fees = Koha::Charges::Fees->new(
1372 patron => $patron,
1373 library => $library,
1374 item => $item_object,
1375 to_date => $datedue,
1379 # it's NOT a renewal
1380 if ( $actualissue and not $switch_onsite_checkout ) {
1381 # This book is currently on loan, but not to the person
1382 # who wants to borrow it now. mark it returned before issuing to the new borrower
1383 my ( $allowed, $message ) = CanBookBeReturned( $item_unblessed, C4::Context->userenv->{branch} );
1384 return unless $allowed;
1385 AddReturn( $item_object->barcode, C4::Context->userenv->{'branch'} );
1388 C4::Reserves::MoveReserve( $item_object->itemnumber, $borrower->{'borrowernumber'}, $cancelreserve );
1390 # Starting process for transfer job (checking transfert and validate it if we have one)
1391 my ($datesent) = GetTransfers( $item_object->itemnumber );
1392 if ($datesent) {
1393 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1394 my $sth = $dbh->prepare(
1395 "UPDATE branchtransfers
1396 SET datearrived = now(),
1397 tobranch = ?,
1398 comments = 'Forced branchtransfer'
1399 WHERE itemnumber= ? AND datearrived IS NULL"
1401 $sth->execute( C4::Context->userenv->{'branch'},
1402 $item_object->itemnumber );
1405 # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1406 unless ($auto_renew) {
1407 my $rule = Koha::CirculationRules->get_effective_rule(
1409 categorycode => $borrower->{categorycode},
1410 itemtype => $item_object->effective_itemtype,
1411 branchcode => $branchcode,
1412 rule_name => 'auto_renew'
1416 $auto_renew = $rule->rule_value if $rule;
1419 # Record in the database the fact that the book was issued.
1420 unless ($datedue) {
1421 my $itype = $item_object->effective_itemtype;
1422 $datedue = CalcDateDue( $issuedate, $itype, $branchcode, $borrower );
1425 $datedue->truncate( to => 'minute' );
1427 my $issue_attributes = {
1428 borrowernumber => $borrower->{'borrowernumber'},
1429 issuedate => $issuedate->strftime('%Y-%m-%d %H:%M:%S'),
1430 date_due => $datedue->strftime('%Y-%m-%d %H:%M:%S'),
1431 branchcode => C4::Context->userenv->{'branch'},
1432 onsite_checkout => $onsite_checkout,
1433 auto_renew => $auto_renew ? 1 : 0,
1436 $issue = Koha::Checkouts->find( { itemnumber => $item_object->itemnumber } );
1437 if ($issue) {
1438 $issue->set($issue_attributes)->store;
1440 else {
1441 $issue = Koha::Checkout->new(
1443 itemnumber => $item_object->itemnumber,
1444 %$issue_attributes,
1446 )->store;
1448 if ( $item_object->location && $item_object->location eq 'CART'
1449 && ( !$item_object->permanent_location || $item_object->permanent_location ne 'CART' ) ) {
1450 ## Item was moved to cart via UpdateItemLocationOnCheckin, anything issued should be taken off the cart.
1451 CartToShelf( $item_object->itemnumber );
1454 if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1455 UpdateTotalIssues( $item_object->biblionumber, 1 );
1458 ## If item was lost, it has now been found, reverse any list item charges if necessary.
1459 if ( $item_object->itemlost ) {
1460 my $refund = 1;
1461 my $no_refund_after_days = C4::Context->preference('NoRefundOnLostReturnedItemsAge');
1462 if ($no_refund_after_days) {
1463 my $today = dt_from_string();
1464 my $lost_age_in_days =
1465 dt_from_string( $item_object->itemlost_on )
1466 ->delta_days($today)
1467 ->in_units('days');
1469 $refund = 0 unless ( $lost_age_in_days < $no_refund_after_days );
1472 if (
1473 $refund
1474 && Koha::RefundLostItemFeeRules->should_refund(
1476 current_branch => C4::Context->userenv->{branch},
1477 item_home_branch => $item_object->homebranch,
1478 item_holding_branch => $item_object->holdingbranch,
1483 _FixAccountForLostAndFound( $item_object->itemnumber, undef,
1484 $item_object->barcode );
1488 $item_object->issues( ( $item_object->issues || 0 ) + 1);
1489 $item_object->holdingbranch(C4::Context->userenv->{'branch'});
1490 $item_object->itemlost(0);
1491 $item_object->onloan($datedue->ymd());
1492 $item_object->datelastborrowed( dt_from_string()->ymd() );
1493 $item_object->store({log_action => 0});
1494 ModDateLastSeen( $item_object->itemnumber );
1496 # If it costs to borrow this book, charge it to the patron's account.
1497 my ( $charge, $itemtype ) = GetIssuingCharges( $item_object->itemnumber, $borrower->{'borrowernumber'} );
1498 if ( $charge && $charge > 0 ) {
1499 AddIssuingCharge( $issue, $charge, 'RENT' );
1502 my $itemtype_object = Koha::ItemTypes->find( $item_object->effective_itemtype );
1503 if ( $itemtype_object ) {
1504 my $accumulate_charge = $fees->accumulate_rentalcharge();
1505 if ( $accumulate_charge > 0 ) {
1506 AddIssuingCharge( $issue, $accumulate_charge, 'RENT_DAILY' );
1507 $charge += $accumulate_charge;
1508 $item_unblessed->{charge} = $charge;
1512 # Record the fact that this book was issued.
1513 &UpdateStats(
1515 branch => C4::Context->userenv->{'branch'},
1516 type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1517 amount => $charge,
1518 other => ( $sipmode ? "SIP-$sipmode" : '' ),
1519 itemnumber => $item_object->itemnumber,
1520 itemtype => $item_object->effective_itemtype,
1521 location => $item_object->location,
1522 borrowernumber => $borrower->{'borrowernumber'},
1523 ccode => $item_object->ccode,
1527 # Send a checkout slip.
1528 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1529 my %conditions = (
1530 branchcode => $branchcode,
1531 categorycode => $borrower->{categorycode},
1532 item_type => $item_object->effective_itemtype,
1533 notification => 'CHECKOUT',
1535 if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
1536 SendCirculationAlert(
1538 type => 'CHECKOUT',
1539 item => $item_object->unblessed,
1540 borrower => $borrower,
1541 branch => $branchcode,
1545 logaction(
1546 "CIRCULATION", "ISSUE",
1547 $borrower->{'borrowernumber'},
1548 $item_object->itemnumber,
1549 ) if C4::Context->preference("IssueLog");
1551 Koha::Plugins->call('after_circ_action', {
1552 action => 'checkout',
1553 payload => {
1554 type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1555 checkout => $issue->get_from_storage
1560 return $issue;
1563 =head2 GetLoanLength
1565 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1567 Get loan length for an itemtype, a borrower type and a branch
1569 =cut
1571 sub GetLoanLength {
1572 my ( $categorycode, $itemtype, $branchcode ) = @_;
1574 # Set search precedences
1575 my @params = (
1577 categorycode => $categorycode,
1578 itemtype => $itemtype,
1579 branchcode => $branchcode,
1582 categorycode => $categorycode,
1583 itemtype => undef,
1584 branchcode => $branchcode,
1587 categorycode => undef,
1588 itemtype => $itemtype,
1589 branchcode => $branchcode,
1592 categorycode => undef,
1593 itemtype => undef,
1594 branchcode => $branchcode,
1597 categorycode => $categorycode,
1598 itemtype => $itemtype,
1599 branchcode => undef,
1602 categorycode => $categorycode,
1603 itemtype => undef,
1604 branchcode => undef,
1607 categorycode => undef,
1608 itemtype => $itemtype,
1609 branchcode => undef,
1612 categorycode => undef,
1613 itemtype => undef,
1614 branchcode => undef,
1618 # Initialize default values
1619 my $rules = {
1620 issuelength => 0,
1621 renewalperiod => 0,
1622 lengthunit => 'days',
1625 # Search for rules!
1626 foreach my $rule_name (qw( issuelength renewalperiod lengthunit )) {
1627 foreach my $params (@params) {
1628 my $rule = Koha::CirculationRules->search(
1630 rule_name => $rule_name,
1631 %$params,
1633 )->next();
1635 if ($rule) {
1636 $rules->{$rule_name} = $rule->rule_value;
1637 last;
1642 return $rules;
1646 =head2 GetHardDueDate
1648 my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1650 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1652 =cut
1654 sub GetHardDueDate {
1655 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1657 my $rules = Koha::CirculationRules->get_effective_rules(
1659 categorycode => $borrowertype,
1660 itemtype => $itemtype,
1661 branchcode => $branchcode,
1662 rules => [ 'hardduedate', 'hardduedatecompare' ],
1666 if ( defined( $rules->{hardduedate} ) ) {
1667 if ( $rules->{hardduedate} ) {
1668 return ( dt_from_string( $rules->{hardduedate}, 'iso' ), $rules->{hardduedatecompare} );
1670 else {
1671 return ( undef, undef );
1676 =head2 GetBranchBorrowerCircRule
1678 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1680 Retrieves circulation rule attributes that apply to the given
1681 branch and patron category, regardless of item type.
1682 The return value is a hashref containing the following key:
1684 patron_maxissueqty - maximum number of loans that a
1685 patron of the given category can have at the given
1686 branch. If the value is undef, no limit.
1688 patron_maxonsiteissueqty - maximum of on-site checkouts that a
1689 patron of the given category can have at the given
1690 branch. If the value is undef, no limit.
1692 This will check for different branch/category combinations in the following order:
1693 branch and category
1694 branch only
1695 category only
1696 default branch and category
1698 If no rule has been found in the database, it will default to
1699 the buillt in rule:
1701 patron_maxissueqty - undef
1702 patron_maxonsiteissueqty - undef
1704 C<$branchcode> and C<$categorycode> should contain the
1705 literal branch code and patron category code, respectively - no
1706 wildcards.
1708 =cut
1710 sub GetBranchBorrowerCircRule {
1711 my ( $branchcode, $categorycode ) = @_;
1713 # Initialize default values
1714 my $rules = {
1715 patron_maxissueqty => undef,
1716 patron_maxonsiteissueqty => undef,
1719 # Search for rules!
1720 foreach my $rule_name (qw( patron_maxissueqty patron_maxonsiteissueqty )) {
1721 my $rule = Koha::CirculationRules->get_effective_rule(
1723 categorycode => $categorycode,
1724 itemtype => undef,
1725 branchcode => $branchcode,
1726 rule_name => $rule_name,
1730 $rules->{$rule_name} = $rule->rule_value if defined $rule;
1733 return $rules;
1736 =head2 GetBranchItemRule
1738 my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1740 Retrieves circulation rule attributes that apply to the given
1741 branch and item type, regardless of patron category.
1743 The return value is a hashref containing the following keys:
1745 holdallowed => Hold policy for this branch and itemtype. Possible values:
1746 0: No holds allowed.
1747 1: Holds allowed only by patrons that have the same homebranch as the item.
1748 2: Holds allowed from any patron.
1750 returnbranch => branch to which to return item. Possible values:
1751 noreturn: do not return, let item remain where checked in (floating collections)
1752 homebranch: return to item's home branch
1753 holdingbranch: return to issuer branch
1755 This searches branchitemrules in the following order:
1757 * Same branchcode and itemtype
1758 * Same branchcode, itemtype '*'
1759 * branchcode '*', same itemtype
1760 * branchcode and itemtype '*'
1762 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1764 =cut
1766 sub GetBranchItemRule {
1767 my ( $branchcode, $itemtype ) = @_;
1769 # Search for rules!
1770 my $holdallowed_rule = Koha::CirculationRules->get_effective_rule(
1772 branchcode => $branchcode,
1773 itemtype => $itemtype,
1774 rule_name => 'holdallowed',
1777 my $hold_fulfillment_policy_rule = Koha::CirculationRules->get_effective_rule(
1779 branchcode => $branchcode,
1780 itemtype => $itemtype,
1781 rule_name => 'hold_fulfillment_policy',
1784 my $returnbranch_rule = Koha::CirculationRules->get_effective_rule(
1786 branchcode => $branchcode,
1787 itemtype => $itemtype,
1788 rule_name => 'returnbranch',
1792 # built-in default circulation rule
1793 my $rules;
1794 $rules->{holdallowed} = defined $holdallowed_rule
1795 ? $holdallowed_rule->rule_value
1796 : 2;
1797 $rules->{hold_fulfillment_policy} = defined $hold_fulfillment_policy_rule
1798 ? $hold_fulfillment_policy_rule->rule_value
1799 : 'any';
1800 $rules->{returnbranch} = defined $returnbranch_rule
1801 ? $returnbranch_rule->rule_value
1802 : 'homebranch';
1804 return $rules;
1807 =head2 AddReturn
1809 ($doreturn, $messages, $iteminformation, $borrower) =
1810 &AddReturn( $barcode, $branch [,$exemptfine] [,$returndate] );
1812 Returns a book.
1814 =over 4
1816 =item C<$barcode> is the bar code of the book being returned.
1818 =item C<$branch> is the code of the branch where the book is being returned.
1820 =item C<$exemptfine> indicates that overdue charges for the item will be
1821 removed. Optional.
1823 =item C<$return_date> allows the default return date to be overridden
1824 by the given return date. Optional.
1826 =back
1828 C<&AddReturn> returns a list of four items:
1830 C<$doreturn> is true iff the return succeeded.
1832 C<$messages> is a reference-to-hash giving feedback on the operation.
1833 The keys of the hash are:
1835 =over 4
1837 =item C<BadBarcode>
1839 No item with this barcode exists. The value is C<$barcode>.
1841 =item C<NotIssued>
1843 The book is not currently on loan. The value is C<$barcode>.
1845 =item C<withdrawn>
1847 This book has been withdrawn/cancelled. The value should be ignored.
1849 =item C<Wrongbranch>
1851 This book has was returned to the wrong branch. The value is a hashref
1852 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1853 contain the branchcode of the incorrect and correct return library, respectively.
1855 =item C<ResFound>
1857 The item was reserved. The value is a reference-to-hash whose keys are
1858 fields from the reserves table of the Koha database, and
1859 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1860 either C<Waiting>, C<Reserved>, or 0.
1862 =item C<WasReturned>
1864 Value 1 if return is successful.
1866 =item C<NeedsTransfer>
1868 If AutomaticItemReturn is disabled, return branch is given as value of NeedsTransfer.
1870 =back
1872 C<$iteminformation> is a reference-to-hash, giving information about the
1873 returned item from the issues table.
1875 C<$borrower> is a reference-to-hash, giving information about the
1876 patron who last borrowed the book.
1878 =cut
1880 sub AddReturn {
1881 my ( $barcode, $branch, $exemptfine, $return_date ) = @_;
1883 if ($branch and not Koha::Libraries->find($branch)) {
1884 warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
1885 undef $branch;
1887 $branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
1888 my $return_date_specified = !!$return_date;
1889 $return_date //= dt_from_string();
1890 my $messages;
1891 my $patron;
1892 my $doreturn = 1;
1893 my $validTransfert = 0;
1894 my $stat_type = 'return';
1896 # get information on item
1897 my $item = Koha::Items->find({ barcode => $barcode });
1898 unless ($item) {
1899 return ( 0, { BadBarcode => $barcode } ); # no barcode means no item or borrower. bail out.
1902 my $itemnumber = $item->itemnumber;
1903 my $itemtype = $item->effective_itemtype;
1905 my $issue = $item->checkout;
1906 if ( $issue ) {
1907 $patron = $issue->patron
1908 or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existent borrowernumber '" . $issue->borrowernumber . "'\n"
1909 . Dumper($issue->unblessed) . "\n";
1910 } else {
1911 $messages->{'NotIssued'} = $barcode;
1912 $item->onloan(undef)->store if defined $item->onloan;
1914 # even though item is not on loan, it may still be transferred; therefore, get current branch info
1915 $doreturn = 0;
1916 # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later.
1917 # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1918 if (C4::Context->preference("RecordLocalUseOnReturn")) {
1919 $messages->{'LocalUse'} = 1;
1920 $stat_type = 'localuse';
1924 # full item data, but no borrowernumber or checkout info (no issue)
1925 my $hbr = GetBranchItemRule($item->homebranch, $itemtype)->{'returnbranch'} || "homebranch";
1926 # get the proper branch to which to return the item
1927 my $returnbranch = $hbr ne 'noreturn' ? $item->$hbr : $branch;
1928 # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1929 my $transfer_trigger = $hbr eq 'homebranch' ? 'ReturnToHome' : $hbr eq 'holdingbranch' ? 'ReturnToHolding' : undef;
1931 my $borrowernumber = $patron ? $patron->borrowernumber : undef; # we don't know if we had a borrower or not
1932 my $patron_unblessed = $patron ? $patron->unblessed : {};
1934 my $update_loc_rules = get_yaml_pref_hash('UpdateItemLocationOnCheckin');
1935 map { $update_loc_rules->{$_} = $update_loc_rules->{$_}[0] } keys %$update_loc_rules; #We can only move to one location so we flatten the arrays
1936 if ($update_loc_rules) {
1937 if (defined $update_loc_rules->{_ALL_}) {
1938 if ($update_loc_rules->{_ALL_} eq '_PERM_') { $update_loc_rules->{_ALL_} = $item->permanent_location; }
1939 if ($update_loc_rules->{_ALL_} eq '_BLANK_') { $update_loc_rules->{_ALL_} = ''; }
1940 if ( $item->location ne $update_loc_rules->{_ALL_}) {
1941 $messages->{'ItemLocationUpdated'} = { from => $item->location, to => $update_loc_rules->{_ALL_} };
1942 $item->location($update_loc_rules->{_ALL_})->store;
1945 else {
1946 foreach my $key ( keys %$update_loc_rules ) {
1947 if ( $update_loc_rules->{$key} eq '_PERM_' ) { $update_loc_rules->{$key} = $item->permanent_location; }
1948 if ( $update_loc_rules->{$key} eq '_BLANK_') { $update_loc_rules->{$key} = '' ;}
1949 if ( ($item->location eq $key && $item->location ne $update_loc_rules->{$key}) || ($key eq '_BLANK_' && $item->location eq '' && $update_loc_rules->{$key} ne '') ) {
1950 $messages->{'ItemLocationUpdated'} = { from => $item->location, to => $update_loc_rules->{$key} };
1951 $item->location($update_loc_rules->{$key})->store;
1952 last;
1958 my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
1959 if ($yaml) {
1960 $yaml = "$yaml\n\n"; # YAML is anal on ending \n. Surplus does not hurt
1961 my $rules;
1962 eval { $rules = YAML::Load($yaml); };
1963 if ($@) {
1964 warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
1966 else {
1967 foreach my $key ( keys %$rules ) {
1968 if ( $item->notforloan eq $key ) {
1969 $messages->{'NotForLoanStatusUpdated'} = { from => $item->notforloan, to => $rules->{$key} };
1970 $item->notforloan($rules->{$key})->store({ log_action => 0 });
1971 last;
1977 # check if the return is allowed at this branch
1978 my ($returnallowed, $message) = CanBookBeReturned($item->unblessed, $branch);
1979 unless ($returnallowed){
1980 $messages->{'Wrongbranch'} = {
1981 Wrongbranch => $branch,
1982 Rightbranch => $message
1984 $doreturn = 0;
1985 return ( $doreturn, $messages, $issue, $patron_unblessed);
1988 if ( $item->withdrawn ) { # book has been cancelled
1989 $messages->{'withdrawn'} = 1;
1990 $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
1993 if ( $item->itemlost and C4::Context->preference("BlockReturnOfLostItems") ) {
1994 $doreturn = 0;
1997 # case of a return of document (deal with issues and holdingbranch)
1998 if ($doreturn) {
1999 die "The item is not issed and cannot be returned" unless $issue; # Just in case...
2000 $patron or warn "AddReturn without current borrower";
2002 if ($patron) {
2003 eval {
2004 MarkIssueReturned( $borrowernumber, $item->itemnumber, $return_date, $patron->privacy );
2006 unless ( $@ ) {
2007 if (
2009 C4::Context->preference('CalculateFinesOnReturn')
2010 || ( $return_date_specified && C4::Context->preference('CalculateFinesOnBackdate') )
2012 && !$item->itemlost
2015 _CalculateAndUpdateFine( { issue => $issue, item => $item->unblessed, borrower => $patron_unblessed, return_date => $return_date } );
2017 } else {
2018 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 );
2020 return ( 0, { WasReturned => 0, DataCorrupted => 1 }, $issue, $patron_unblessed );
2023 # FIXME is the "= 1" right? This could be the borrower hash.
2024 $messages->{'WasReturned'} = 1;
2028 $item->onloan(undef)->store({ log_action => 0 });
2031 # the holdingbranch is updated if the document is returned to another location.
2032 # this is always done regardless of whether the item was on loan or not
2033 my $item_holding_branch = $item->holdingbranch;
2034 if ($item->holdingbranch ne $branch) {
2035 $item->holdingbranch($branch)->store;
2038 my $leave_item_lost = C4::Context->preference("BlockReturnOfLostItems") ? 1 : 0;
2039 ModDateLastSeen( $item->itemnumber, $leave_item_lost );
2041 # check if we have a transfer for this document
2042 my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->itemnumber );
2044 # if we have a transfer to do, we update the line of transfers with the datearrived
2045 my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->itemnumber );
2046 if ($datesent) {
2047 if ( $tobranch eq $branch ) {
2048 my $sth = C4::Context->dbh->prepare(
2049 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
2051 $sth->execute( $item->itemnumber );
2052 } else {
2053 $messages->{'WrongTransfer'} = $tobranch;
2054 $messages->{'WrongTransferItem'} = $item->itemnumber;
2056 $validTransfert = 1;
2059 # fix up the accounts.....
2060 if ( $item->itemlost ) {
2061 $messages->{'WasLost'} = 1;
2062 unless ( C4::Context->preference("BlockReturnOfLostItems") ) {
2063 my $refund = 1;
2064 my $no_refund_after_days = C4::Context->preference('NoRefundOnLostReturnedItemsAge');
2065 if ($no_refund_after_days) {
2066 my $today = dt_from_string();
2067 my $lost_age_in_days =
2068 dt_from_string( $item->itemlost_on )
2069 ->delta_days($today)
2070 ->in_units('days');
2072 $refund = 0 unless ( $lost_age_in_days < $no_refund_after_days );
2075 if (
2076 $refund &&
2077 Koha::RefundLostItemFeeRules->should_refund(
2079 current_branch => C4::Context->userenv->{branch},
2080 item_home_branch => $item->homebranch,
2081 item_holding_branch => $item_holding_branch
2086 _FixAccountForLostAndFound( $item->itemnumber,
2087 $borrowernumber, $barcode );
2088 $messages->{'LostItemFeeRefunded'} = 1;
2093 # fix up the overdues in accounts...
2094 if ($borrowernumber) {
2095 my $fix = _FixOverduesOnReturn( $borrowernumber, $item->itemnumber, $exemptfine, 'RETURNED' );
2096 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, ".$item->itemnumber."...) failed!"; # zero is OK, check defined
2098 if ( $issue and $issue->is_overdue($return_date) ) {
2099 # fix fine days
2100 my ($debardate,$reminder) = _debar_user_on_return( $patron_unblessed, $item->unblessed, dt_from_string($issue->date_due), $return_date );
2101 if ($reminder){
2102 $messages->{'PrevDebarred'} = $debardate;
2103 } else {
2104 $messages->{'Debarred'} = $debardate if $debardate;
2106 # there's no overdue on the item but borrower had been previously debarred
2107 } elsif ( $issue->date_due and $patron->debarred ) {
2108 if ( $patron->debarred eq "9999-12-31") {
2109 $messages->{'ForeverDebarred'} = $patron->debarred;
2110 } else {
2111 my $borrower_debar_dt = dt_from_string( $patron->debarred );
2112 $borrower_debar_dt->truncate(to => 'day');
2113 my $today_dt = $return_date->clone()->truncate(to => 'day');
2114 if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2115 $messages->{'PrevDebarred'} = $patron->debarred;
2121 # find reserves.....
2122 # launch the Checkreserves routine to find any holds
2123 my ($resfound, $resrec);
2124 my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2125 ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->itemnumber, undef, $lookahead ) unless ( $item->withdrawn );
2126 # if a hold is found and is waiting at another branch, change the priority back to 1 and trigger the hold (this will trigger a transfer and update the hold status properly)
2127 if ( $resfound and $resfound eq "Waiting" and $branch ne $resrec->{branchcode} ) {
2128 my $hold = C4::Reserves::RevertWaitingStatus( { itemnumber => $item->itemnumber } );
2129 $resfound = 'Reserved';
2130 $resrec = $hold->unblessed;
2132 if ($resfound) {
2133 $resrec->{'ResFound'} = $resfound;
2134 $messages->{'ResFound'} = $resrec;
2137 # Record the fact that this book was returned.
2138 UpdateStats({
2139 branch => $branch,
2140 type => $stat_type,
2141 itemnumber => $itemnumber,
2142 itemtype => $itemtype,
2143 location => $item->location,
2144 borrowernumber => $borrowernumber,
2145 ccode => $item->ccode,
2148 # Send a check-in slip. # NOTE: borrower may be undef. Do not try to send messages then.
2149 if ( $patron ) {
2150 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2151 my %conditions = (
2152 branchcode => $branch,
2153 categorycode => $patron->categorycode,
2154 item_type => $itemtype,
2155 notification => 'CHECKIN',
2157 if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2158 SendCirculationAlert({
2159 type => 'CHECKIN',
2160 item => $item->unblessed,
2161 borrower => $patron->unblessed,
2162 branch => $branch,
2166 logaction("CIRCULATION", "RETURN", $borrowernumber, $item->itemnumber)
2167 if C4::Context->preference("ReturnLog");
2170 # Check if this item belongs to a biblio record that is attached to an
2171 # ILL request, if it is we need to update the ILL request's status
2172 if (C4::Context->preference('CirculateILL')) {
2173 my $request = Koha::Illrequests->find(
2174 { biblio_id => $item->biblio->biblionumber }
2176 $request->status('RET') if $request;
2179 # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2180 if (!$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) and not $messages->{'WrongTransfer'}){
2181 my $BranchTransferLimitsType = C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ? 'effective_itemtype' : 'ccode';
2182 if (C4::Context->preference("AutomaticItemReturn" ) or
2183 (C4::Context->preference("UseBranchTransferLimits") and
2184 ! IsBranchTransferAllowed($branch, $returnbranch, $item->$BranchTransferLimitsType )
2185 )) {
2186 $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s, %s)", $item->itemnumber,$branch, $returnbranch, $transfer_trigger;
2187 $debug and warn "item: " . Dumper($item->unblessed);
2188 ModItemTransfer($item->itemnumber, $branch, $returnbranch, $transfer_trigger);
2189 $messages->{'WasTransfered'} = 1;
2190 } else {
2191 $messages->{'NeedsTransfer'} = $returnbranch;
2192 $messages->{'TransferTrigger'} = $transfer_trigger;
2196 if ( C4::Context->preference('ClaimReturnedLostValue') ) {
2197 my $claims = Koha::Checkouts::ReturnClaims->search(
2199 itemnumber => $item->id,
2200 resolution => undef,
2204 if ( $claims->count ) {
2205 $messages->{ReturnClaims} = $claims;
2209 if ( $doreturn and $issue ) {
2210 my $checkin = Koha::Old::Checkouts->find($issue->id);
2212 Koha::Plugins->call('after_circ_action', {
2213 action => 'checkin',
2214 payload => {
2215 checkout=> $checkin
2220 return ( $doreturn, $messages, $issue, ( $patron ? $patron->unblessed : {} ));
2223 =head2 MarkIssueReturned
2225 MarkIssueReturned($borrowernumber, $itemnumber, $returndate, $privacy);
2227 Unconditionally marks an issue as being returned by
2228 moving the C<issues> row to C<old_issues> and
2229 setting C<returndate> to the current date.
2231 if C<$returndate> is specified (in iso format), it is used as the date
2232 of the return.
2234 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2235 the old_issue is immediately anonymised
2237 Ideally, this function would be internal to C<C4::Circulation>,
2238 not exported, but it is currently used in misc/cronjobs/longoverdue.pl
2239 and offline_circ/process_koc.pl.
2241 =cut
2243 sub MarkIssueReturned {
2244 my ( $borrowernumber, $itemnumber, $returndate, $privacy ) = @_;
2246 # Retrieve the issue
2247 my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return;
2249 return unless $issue->borrowernumber == $borrowernumber; # If the item is checked out to another patron we do not return it
2251 my $issue_id = $issue->issue_id;
2253 my $anonymouspatron;
2254 if ( $privacy && $privacy == 2 ) {
2255 # The default of 0 will not work due to foreign key constraints
2256 # The anonymisation will fail if AnonymousPatron is not a valid entry
2257 # We need to check if the anonymous patron exist, Koha will fail loudly if it does not
2258 # Note that a warning should appear on the about page (System information tab).
2259 $anonymouspatron = C4::Context->preference('AnonymousPatron');
2260 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."
2261 unless Koha::Patrons->find( $anonymouspatron );
2264 my $schema = Koha::Database->schema;
2266 # FIXME Improve the return value and handle it from callers
2267 $schema->txn_do(sub {
2269 my $patron = Koha::Patrons->find( $borrowernumber );
2271 # Update the returndate value
2272 if ( $returndate ) {
2273 $issue->returndate( $returndate )->store->discard_changes; # update and refetch
2275 else {
2276 $issue->returndate( \'NOW()' )->store->discard_changes; # update and refetch
2279 # Create the old_issues entry
2280 my $old_checkout = Koha::Old::Checkout->new($issue->unblessed)->store;
2282 # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2283 if ( $privacy && $privacy == 2) {
2284 $old_checkout->borrowernumber($anonymouspatron)->store;
2287 # And finally delete the issue
2288 $issue->delete;
2290 $issue->item->onloan(undef)->store({ log_action => 0 });
2292 if ( C4::Context->preference('StoreLastBorrower') ) {
2293 my $item = Koha::Items->find( $itemnumber );
2294 $item->last_returned_by( $patron );
2297 # Remove any OVERDUES related debarment if the borrower has no overdues
2298 if ( C4::Context->preference('AutoRemoveOverduesRestrictions')
2299 && $patron->debarred
2300 && !$patron->has_overdues
2301 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2303 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2308 return $issue_id;
2311 =head2 _debar_user_on_return
2313 _debar_user_on_return($borrower, $item, $datedue, $returndate);
2315 C<$borrower> borrower hashref
2317 C<$item> item hashref
2319 C<$datedue> date due DateTime object
2321 C<$returndate> DateTime object representing the return time
2323 Internal function, called only by AddReturn that calculates and updates
2324 the user fine days, and debars them if necessary.
2326 Should only be called for overdue returns
2328 Calculation of the debarment date has been moved to a separate subroutine _calculate_new_debar_dt
2329 to ease testing.
2331 =cut
2333 sub _calculate_new_debar_dt {
2334 my ( $borrower, $item, $dt_due, $return_date ) = @_;
2336 my $branchcode = _GetCircControlBranch( $item, $borrower );
2337 my $circcontrol = C4::Context->preference('CircControl');
2338 my $issuing_rule = Koha::CirculationRules->get_effective_rules(
2339 { categorycode => $borrower->{categorycode},
2340 itemtype => $item->{itype},
2341 branchcode => $branchcode,
2342 rules => [
2343 'finedays',
2344 'lengthunit',
2345 'firstremind',
2346 'maxsuspensiondays',
2347 'suspension_chargeperiod',
2351 my $finedays = $issuing_rule ? $issuing_rule->{finedays} : undef;
2352 my $unit = $issuing_rule ? $issuing_rule->{lengthunit} : undef;
2353 my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $return_date, $branchcode);
2355 return unless $finedays;
2357 # finedays is in days, so hourly loans must multiply by 24
2358 # thus 1 hour late equals 1 day suspension * finedays rate
2359 $finedays = $finedays * 24 if ( $unit eq 'hours' );
2361 # grace period is measured in the same units as the loan
2362 my $grace =
2363 DateTime::Duration->new( $unit => $issuing_rule->{firstremind} );
2365 my $deltadays = DateTime::Duration->new(
2366 days => $chargeable_units
2369 if ( $deltadays->subtract($grace)->is_positive() ) {
2370 my $suspension_days = $deltadays * $finedays;
2372 if ( defined $issuing_rule->{suspension_chargeperiod} && $issuing_rule->{suspension_chargeperiod} > 1 ) {
2373 # No need to / 1 and do not consider / 0
2374 $suspension_days = DateTime::Duration->new(
2375 days => floor( $suspension_days->in_units('days') / $issuing_rule->{suspension_chargeperiod} )
2379 # If the max suspension days is < than the suspension days
2380 # the suspension days is limited to this maximum period.
2381 my $max_sd = $issuing_rule->{maxsuspensiondays};
2382 if ( defined $max_sd && $max_sd ne '' ) {
2383 $max_sd = DateTime::Duration->new( days => $max_sd );
2384 $suspension_days = $max_sd
2385 if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2388 my ( $has_been_extended );
2389 if ( C4::Context->preference('CumulativeRestrictionPeriods') and $borrower->{debarred} ) {
2390 my $debarment = @{ GetDebarments( { borrowernumber => $borrower->{borrowernumber}, type => 'SUSPENSION' } ) }[0];
2391 if ( $debarment ) {
2392 $return_date = dt_from_string( $debarment->{expiration}, 'sql' );
2393 $has_been_extended = 1;
2397 my $new_debar_dt;
2398 # Use the calendar or not to calculate the debarment date
2399 if ( C4::Context->preference('SuspensionsCalendar') eq 'noSuspensionsWhenClosed' ) {
2400 my $calendar = Koha::Calendar->new(
2401 branchcode => $branchcode,
2402 days_mode => 'Calendar'
2404 $new_debar_dt = $calendar->addDate( $return_date, $suspension_days );
2406 else {
2407 $new_debar_dt = $return_date->clone()->add_duration($suspension_days);
2409 return $new_debar_dt;
2411 return;
2414 sub _debar_user_on_return {
2415 my ( $borrower, $item, $dt_due, $return_date ) = @_;
2417 $return_date //= dt_from_string();
2419 my $new_debar_dt = _calculate_new_debar_dt ($borrower, $item, $dt_due, $return_date);
2421 return unless $new_debar_dt;
2423 Koha::Patron::Debarments::AddUniqueDebarment({
2424 borrowernumber => $borrower->{borrowernumber},
2425 expiration => $new_debar_dt->ymd(),
2426 type => 'SUSPENSION',
2428 # if borrower was already debarred but does not get an extra debarment
2429 my $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
2430 my ($new_debarment_str, $is_a_reminder);
2431 if ( $borrower->{debarred} && $borrower->{debarred} eq $patron->is_debarred ) {
2432 $is_a_reminder = 1;
2433 $new_debarment_str = $borrower->{debarred};
2434 } else {
2435 $new_debarment_str = $new_debar_dt->ymd();
2437 # FIXME Should return a DateTime object
2438 return $new_debarment_str, $is_a_reminder;
2441 =head2 _FixOverduesOnReturn
2443 &_FixOverduesOnReturn($borrowernumber, $itemnumber, $exemptfine, $status);
2445 C<$borrowernumber> borrowernumber
2447 C<$itemnumber> itemnumber
2449 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2451 C<$status> ENUM -- reason for fix [ RETURNED, RENEWED, LOST, FORGIVEN ]
2453 Internal function
2455 =cut
2457 sub _FixOverduesOnReturn {
2458 my ( $borrowernumber, $item, $exemptfine, $status ) = @_;
2459 unless( $borrowernumber ) {
2460 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2461 return;
2463 unless( $item ) {
2464 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2465 return;
2467 unless( $status ) {
2468 warn "_FixOverduesOnReturn() not supplied valid status";
2469 return;
2472 my $schema = Koha::Database->schema;
2474 my $result = $schema->txn_do(
2475 sub {
2476 # check for overdue fine
2477 my $accountlines = Koha::Account::Lines->search(
2479 borrowernumber => $borrowernumber,
2480 itemnumber => $item,
2481 debit_type_code => 'OVERDUE',
2482 status => 'UNRETURNED'
2485 return 0 unless $accountlines->count; # no warning, there's just nothing to fix
2487 my $accountline = $accountlines->next;
2488 my $payments = $accountline->credits;
2490 my $amountoutstanding = $accountline->amountoutstanding;
2491 if ( $accountline->amount == 0 && $payments->count == 0 ) {
2492 $accountline->delete;
2493 } elsif ($exemptfine && ($amountoutstanding != 0)) {
2494 my $account = Koha::Account->new({patron_id => $borrowernumber});
2495 my $credit = $account->add_credit(
2497 amount => $amountoutstanding,
2498 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
2499 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
2500 interface => C4::Context->interface,
2501 type => 'FORGIVEN',
2502 item_id => $item
2506 $credit->apply({ debits => [ $accountline ], offset_type => 'Forgiven' });
2508 if (C4::Context->preference("FinesLog")) {
2509 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2512 $accountline->status('FORGIVEN');
2513 $accountline->store();
2514 } else {
2515 $accountline->status($status);
2516 $accountline->store();
2522 return $result;
2525 =head2 _FixAccountForLostAndFound
2527 &_FixAccountForLostAndFound($itemnumber, [$borrowernumber, $barcode]);
2529 Finds the most recent lost item charge for this item and refunds the borrower
2530 appropriatly, taking into account any payments or writeoffs already applied
2531 against the charge.
2533 Internal function, not exported, called only by AddReturn.
2535 =cut
2537 sub _FixAccountForLostAndFound {
2538 my $itemnumber = shift or return;
2539 my $borrowernumber = @_ ? shift : undef;
2540 my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
2542 my $credit;
2544 # check for charge made for lost book
2545 my $accountlines = Koha::Account::Lines->search(
2547 itemnumber => $itemnumber,
2548 debit_type_code => 'LOST',
2549 status => [ undef, { '<>' => 'FOUND' } ]
2552 order_by => { -desc => [ 'date', 'accountlines_id' ] }
2556 return unless $accountlines->count > 0;
2557 my $accountline = $accountlines->next;
2558 my $total_to_refund = 0;
2560 return unless $accountline->borrowernumber;
2561 my $patron = Koha::Patrons->find( $accountline->borrowernumber );
2562 return unless $patron; # Patron has been deleted, nobody to credit the return to
2564 my $account = $patron->account;
2566 # Use cases
2567 if ( $accountline->amount > $accountline->amountoutstanding ) {
2568 # some amount has been cancelled. collect the offsets that are not writeoffs
2569 # this works because the only way to subtract from this kind of a debt is
2570 # using the UI buttons 'Pay' and 'Write off'
2571 my $credits_offsets = Koha::Account::Offsets->search({
2572 debit_id => $accountline->id,
2573 credit_id => { '!=' => undef }, # it is not the debit itself
2574 type => { '!=' => 'Writeoff' },
2575 amount => { '<' => 0 } # credits are negative on the DB
2578 $total_to_refund = ( $credits_offsets->count > 0 )
2579 ? $credits_offsets->total * -1 # credits are negative on the DB
2580 : 0;
2583 my $credit_total = $accountline->amountoutstanding + $total_to_refund;
2585 if ( $credit_total > 0 ) {
2586 my $branchcode = C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
2587 $credit = $account->add_credit(
2589 amount => $credit_total,
2590 description => 'Item found ' . $item_id,
2591 type => 'LOST_FOUND',
2592 interface => C4::Context->interface,
2593 library_id => $branchcode,
2594 item_id => $itemnumber
2598 $credit->apply( { debits => [ $accountline ] } );
2601 # Update the account status
2602 $accountline->discard_changes->status('FOUND');
2603 $accountline->store;
2605 $accountline->item->paidfor('')->store({ log_action => 0 });
2607 if ( defined $account and C4::Context->preference('AccountAutoReconcile') ) {
2608 $account->reconcile_balance;
2611 return ($credit) ? $credit->id : undef;
2614 =head2 _GetCircControlBranch
2616 my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2618 Internal function :
2620 Return the library code to be used to determine which circulation
2621 policy applies to a transaction. Looks up the CircControl and
2622 HomeOrHoldingBranch system preferences.
2624 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2626 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2628 =cut
2630 sub _GetCircControlBranch {
2631 my ($item, $borrower) = @_;
2632 my $circcontrol = C4::Context->preference('CircControl');
2633 my $branch;
2635 if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2636 $branch= C4::Context->userenv->{'branch'};
2637 } elsif ($circcontrol eq 'PatronLibrary') {
2638 $branch=$borrower->{branchcode};
2639 } else {
2640 my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2641 $branch = $item->{$branchfield};
2642 # default to item home branch if holdingbranch is used
2643 # and is not defined
2644 if (!defined($branch) && $branchfield eq 'holdingbranch') {
2645 $branch = $item->{homebranch};
2648 return $branch;
2651 =head2 GetOpenIssue
2653 $issue = GetOpenIssue( $itemnumber );
2655 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2657 C<$itemnumber> is the item's itemnumber
2659 Returns a hashref
2661 =cut
2663 sub GetOpenIssue {
2664 my ( $itemnumber ) = @_;
2665 return unless $itemnumber;
2666 my $dbh = C4::Context->dbh;
2667 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2668 $sth->execute( $itemnumber );
2669 return $sth->fetchrow_hashref();
2673 =head2 GetBiblioIssues
2675 $issues = GetBiblioIssues($biblionumber);
2677 this function get all issues from a biblionumber.
2679 Return:
2680 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash contains all column from
2681 tables issues and the firstname,surname & cardnumber from borrowers.
2683 =cut
2685 sub GetBiblioIssues {
2686 my $biblionumber = shift;
2687 return unless $biblionumber;
2688 my $dbh = C4::Context->dbh;
2689 my $query = "
2690 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2691 FROM issues
2692 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2693 LEFT JOIN items ON issues.itemnumber = items.itemnumber
2694 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2695 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2696 WHERE biblio.biblionumber = ?
2697 UNION ALL
2698 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2699 FROM old_issues
2700 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2701 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2702 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2703 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2704 WHERE biblio.biblionumber = ?
2705 ORDER BY timestamp
2707 my $sth = $dbh->prepare($query);
2708 $sth->execute($biblionumber, $biblionumber);
2710 my @issues;
2711 while ( my $data = $sth->fetchrow_hashref ) {
2712 push @issues, $data;
2714 return \@issues;
2717 =head2 GetUpcomingDueIssues
2719 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2721 =cut
2723 sub GetUpcomingDueIssues {
2724 my $params = shift;
2726 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2727 my $dbh = C4::Context->dbh;
2729 my $statement = <<END_SQL;
2730 SELECT *
2731 FROM (
2732 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2733 FROM issues
2734 LEFT JOIN items USING (itemnumber)
2735 LEFT OUTER JOIN branches USING (branchcode)
2736 WHERE returndate is NULL
2737 ) tmp
2738 WHERE days_until_due >= 0 AND days_until_due <= ?
2739 END_SQL
2741 my @bind_parameters = ( $params->{'days_in_advance'} );
2743 my $sth = $dbh->prepare( $statement );
2744 $sth->execute( @bind_parameters );
2745 my $upcoming_dues = $sth->fetchall_arrayref({});
2747 return $upcoming_dues;
2750 =head2 CanBookBeRenewed
2752 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2754 Find out whether a borrowed item may be renewed.
2756 C<$borrowernumber> is the borrower number of the patron who currently
2757 has the item on loan.
2759 C<$itemnumber> is the number of the item to renew.
2761 C<$override_limit>, if supplied with a true value, causes
2762 the limit on the number of times that the loan can be renewed
2763 (as controlled by the item type) to be ignored. Overriding also allows
2764 to renew sooner than "No renewal before" and to manually renew loans
2765 that are automatically renewed.
2767 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2768 item must currently be on loan to the specified borrower; renewals
2769 must be allowed for the item's type; and the borrower must not have
2770 already renewed the loan. $error will contain the reason the renewal can not proceed
2772 =cut
2774 sub CanBookBeRenewed {
2775 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2777 my $dbh = C4::Context->dbh;
2778 my $renews = 1;
2779 my $auto_renew = 0;
2781 my $item = Koha::Items->find($itemnumber) or return ( 0, 'no_item' );
2782 my $issue = $item->checkout or return ( 0, 'no_checkout' );
2783 return ( 0, 'onsite_checkout' ) if $issue->onsite_checkout;
2784 return ( 0, 'item_denied_renewal') if _item_denied_renewal({ item => $item });
2786 my $patron = $issue->patron or return;
2788 # override_limit will override anything else except on_reserve
2789 unless ( $override_limit ){
2790 my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
2791 my $issuing_rule = Koha::CirculationRules->get_effective_rules(
2793 categorycode => $patron->categorycode,
2794 itemtype => $item->effective_itemtype,
2795 branchcode => $branchcode,
2796 rules => [
2797 'renewalsallowed',
2798 'no_auto_renewal_after',
2799 'no_auto_renewal_after_hard_limit',
2800 'lengthunit',
2801 'norenewalbefore',
2806 return ( 0, "too_many" )
2807 if not $issuing_rule->{renewalsallowed} or $issuing_rule->{renewalsallowed} <= $issue->renewals;
2809 my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2810 my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2811 $patron = Koha::Patrons->find($borrowernumber); # FIXME Is this really useful?
2812 my $restricted = $patron->is_debarred;
2813 my $hasoverdues = $patron->has_overdues;
2815 if ( $restricted and $restrictionblockrenewing ) {
2816 return ( 0, 'restriction');
2817 } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($issue->is_overdue and $overduesblockrenewing eq 'blockitem') ) {
2818 return ( 0, 'overdue');
2821 if ( $issue->auto_renew && $patron->autorenew_checkouts ) {
2823 if ( $patron->category->effective_BlockExpiredPatronOpacActions and $patron->is_expired ) {
2824 return ( 0, 'auto_account_expired' );
2827 if ( defined $issuing_rule->{no_auto_renewal_after}
2828 and $issuing_rule->{no_auto_renewal_after} ne "" ) {
2829 # Get issue_date and add no_auto_renewal_after
2830 # If this is greater than today, it's too late for renewal.
2831 my $maximum_renewal_date = dt_from_string($issue->issuedate, 'sql');
2832 $maximum_renewal_date->add(
2833 $issuing_rule->{lengthunit} => $issuing_rule->{no_auto_renewal_after}
2835 my $now = dt_from_string;
2836 if ( $now >= $maximum_renewal_date ) {
2837 return ( 0, "auto_too_late" );
2840 if ( defined $issuing_rule->{no_auto_renewal_after_hard_limit}
2841 and $issuing_rule->{no_auto_renewal_after_hard_limit} ne "" ) {
2842 # If no_auto_renewal_after_hard_limit is >= today, it's also too late for renewal
2843 if ( dt_from_string >= dt_from_string( $issuing_rule->{no_auto_renewal_after_hard_limit} ) ) {
2844 return ( 0, "auto_too_late" );
2848 if ( C4::Context->preference('OPACFineNoRenewalsBlockAutoRenew') ) {
2849 my $fine_no_renewals = C4::Context->preference("OPACFineNoRenewals");
2850 my $amountoutstanding =
2851 C4::Context->preference("OPACFineNoRenewalsIncludeCredit")
2852 ? $patron->account->balance
2853 : $patron->account->outstanding_debits->total_outstanding;
2854 if ( $amountoutstanding and $amountoutstanding > $fine_no_renewals ) {
2855 return ( 0, "auto_too_much_oweing" );
2860 if ( defined $issuing_rule->{norenewalbefore}
2861 and $issuing_rule->{norenewalbefore} ne "" )
2864 # Calculate soonest renewal by subtracting 'No renewal before' from due date
2865 my $soonestrenewal = dt_from_string( $issue->date_due, 'sql' )->subtract(
2866 $issuing_rule->{lengthunit} => $issuing_rule->{norenewalbefore} );
2868 # Depending on syspref reset the exact time, only check the date
2869 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2870 and $issuing_rule->{lengthunit} eq 'days' )
2872 $soonestrenewal->truncate( to => 'day' );
2875 if ( $soonestrenewal > dt_from_string() )
2877 return ( 0, "auto_too_soon" ) if $issue->auto_renew && $patron->autorenew_checkouts;
2878 return ( 0, "too_soon" );
2880 elsif ( $issue->auto_renew && $patron->autorenew_checkouts ) {
2881 $auto_renew = 1;
2885 # Fallback for automatic renewals:
2886 # If norenewalbefore is undef, don't renew before due date.
2887 if ( $issue->auto_renew && !$auto_renew && $patron->autorenew_checkouts ) {
2888 my $now = dt_from_string;
2889 if ( $now >= dt_from_string( $issue->date_due, 'sql' ) ){
2890 $auto_renew = 1;
2891 } else {
2892 return ( 0, "auto_too_soon" );
2897 my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2899 # This item can fill one or more unfilled reserve, can those unfilled reserves
2900 # all be filled by other available items?
2901 if ( $resfound
2902 && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2904 my $schema = Koha::Database->new()->schema();
2906 my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2907 if ($item_holds) {
2908 # There is an item level hold on this item, no other item can fill the hold
2909 $resfound = 1;
2911 else {
2913 # Get all other items that could possibly fill reserves
2914 my @itemnumbers = $schema->resultset('Item')->search(
2916 biblionumber => $resrec->{biblionumber},
2917 onloan => undef,
2918 notforloan => 0,
2919 -not => { itemnumber => $itemnumber }
2921 { columns => 'itemnumber' }
2922 )->get_column('itemnumber')->all();
2924 # Get all other reserves that could have been filled by this item
2925 my @borrowernumbers;
2926 while (1) {
2927 my ( $reserve_found, $reserve, undef ) =
2928 C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2930 if ($reserve_found) {
2931 push( @borrowernumbers, $reserve->{borrowernumber} );
2933 else {
2934 last;
2938 # If the count of the union of the lists of reservable items for each borrower
2939 # is equal or greater than the number of borrowers, we know that all reserves
2940 # can be filled with available items. We can get the union of the sets simply
2941 # by pushing all the elements onto an array and removing the duplicates.
2942 my @reservable;
2943 my %patrons;
2944 ITEM: foreach my $itemnumber (@itemnumbers) {
2945 my $item = Koha::Items->find( $itemnumber );
2946 next if IsItemOnHoldAndFound( $itemnumber );
2947 for my $borrowernumber (@borrowernumbers) {
2948 my $patron = $patrons{$borrowernumber} //= Koha::Patrons->find( $borrowernumber );
2949 next unless IsAvailableForItemLevelRequest($item, $patron);
2950 next unless CanItemBeReserved($borrowernumber,$itemnumber);
2952 push @reservable, $itemnumber;
2953 if (@reservable >= @borrowernumbers) {
2954 $resfound = 0;
2955 last ITEM;
2957 last;
2962 return ( 0, "on_reserve" ) if $resfound; # '' when no hold was found
2963 return ( 0, "auto_renew" ) if $auto_renew && !$override_limit; # 0 if auto-renewal should not succeed
2965 return ( 1, undef );
2968 =head2 AddRenewal
2970 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2972 Renews a loan.
2974 C<$borrowernumber> is the borrower number of the patron who currently
2975 has the item.
2977 C<$itemnumber> is the number of the item to renew.
2979 C<$branch> is the library where the renewal took place (if any).
2980 The library that controls the circ policies for the renewal is retrieved from the issues record.
2982 C<$datedue> can be a DateTime object used to set the due date.
2984 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
2985 this parameter is not supplied, lastreneweddate is set to the current date.
2987 C<$skipfinecalc> is an optional boolean. There may be circumstances where, even if the
2988 CalculateFinesOnReturn syspref is enabled, we don't want to calculate fines upon renew,
2989 for example, when we're renewing as a result of a fine being paid (see RenewAccruingItemWhenPaid
2990 syspref)
2992 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2993 from the book's item type.
2995 =cut
2997 sub AddRenewal {
2998 my $borrowernumber = shift;
2999 my $itemnumber = shift or return;
3000 my $branch = shift;
3001 my $datedue = shift;
3002 my $lastreneweddate = shift || dt_from_string();
3003 my $skipfinecalc = shift;
3005 my $item_object = Koha::Items->find($itemnumber) or return;
3006 my $biblio = $item_object->biblio;
3007 my $issue = $item_object->checkout;
3008 my $item_unblessed = $item_object->unblessed;
3010 my $dbh = C4::Context->dbh;
3012 return unless $issue;
3014 $borrowernumber ||= $issue->borrowernumber;
3016 if ( defined $datedue && ref $datedue ne 'DateTime' ) {
3017 carp 'Invalid date passed to AddRenewal.';
3018 return;
3021 my $patron = Koha::Patrons->find( $borrowernumber ) or return; # FIXME Should do more than just return
3022 my $patron_unblessed = $patron->unblessed;
3024 my $circ_library = Koha::Libraries->find( _GetCircControlBranch($item_unblessed, $patron_unblessed) );
3026 my $schema = Koha::Database->schema;
3027 $schema->txn_do(sub{
3029 if ( !$skipfinecalc && C4::Context->preference('CalculateFinesOnReturn') ) {
3030 _CalculateAndUpdateFine( { issue => $issue, item => $item_unblessed, borrower => $patron_unblessed } );
3032 _FixOverduesOnReturn( $borrowernumber, $itemnumber, undef, 'RENEWED' );
3034 # If the due date wasn't specified, calculate it by adding the
3035 # book's loan length to today's date or the current due date
3036 # based on the value of the RenewalPeriodBase syspref.
3037 my $itemtype = $item_object->effective_itemtype;
3038 unless ($datedue) {
3040 $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
3041 dt_from_string( $issue->date_due, 'sql' ) :
3042 dt_from_string();
3043 $datedue = CalcDateDue($datedue, $itemtype, $circ_library->branchcode, $patron_unblessed, 'is a renewal');
3046 my $fees = Koha::Charges::Fees->new(
3048 patron => $patron,
3049 library => $circ_library,
3050 item => $item_object,
3051 from_date => dt_from_string( $issue->date_due, 'sql' ),
3052 to_date => dt_from_string($datedue),
3056 # Update the issues record to have the new due date, and a new count
3057 # of how many times it has been renewed.
3058 my $renews = ( $issue->renewals || 0 ) + 1;
3059 my $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
3060 WHERE borrowernumber=?
3061 AND itemnumber=?"
3064 $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
3066 # Update the renewal count on the item, and tell zebra to reindex
3067 $renews = ( $item_object->renewals || 0 ) + 1;
3068 $item_object->renewals($renews);
3069 $item_object->onloan($datedue);
3070 $item_object->store({ log_action => 0 });
3072 # Charge a new rental fee, if applicable
3073 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
3074 if ( $charge > 0 ) {
3075 AddIssuingCharge($issue, $charge, 'RENT_RENEW');
3078 # Charge a new accumulate rental fee, if applicable
3079 my $itemtype_object = Koha::ItemTypes->find( $itemtype );
3080 if ( $itemtype_object ) {
3081 my $accumulate_charge = $fees->accumulate_rentalcharge();
3082 if ( $accumulate_charge > 0 ) {
3083 AddIssuingCharge( $issue, $accumulate_charge, 'RENT_DAILY_RENEW' )
3085 $charge += $accumulate_charge;
3088 # Send a renewal slip according to checkout alert preferencei
3089 if ( C4::Context->preference('RenewalSendNotice') eq '1' ) {
3090 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
3091 my %conditions = (
3092 branchcode => $branch,
3093 categorycode => $patron->categorycode,
3094 item_type => $itemtype,
3095 notification => 'CHECKOUT',
3097 if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
3098 SendCirculationAlert(
3100 type => 'RENEWAL',
3101 item => $item_unblessed,
3102 borrower => $patron->unblessed,
3103 branch => $branch,
3109 # Remove any OVERDUES related debarment if the borrower has no overdues
3110 if ( $patron
3111 && $patron->is_debarred
3112 && ! $patron->has_overdues
3113 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
3115 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
3118 # Add the renewal to stats
3119 UpdateStats(
3121 branch => $item_object->renewal_branchcode({branch => $branch}),
3122 type => 'renew',
3123 amount => $charge,
3124 itemnumber => $itemnumber,
3125 itemtype => $itemtype,
3126 location => $item_object->location,
3127 borrowernumber => $borrowernumber,
3128 ccode => $item_object->ccode,
3132 #Log the renewal
3133 logaction("CIRCULATION", "RENEWAL", $borrowernumber, $itemnumber) if C4::Context->preference("RenewalLog");
3135 Koha::Plugins->call('after_circ_action', {
3136 action => 'renewal',
3137 payload => {
3138 checkout => $issue->get_from_storage
3143 return $datedue;
3146 sub GetRenewCount {
3147 # check renewal status
3148 my ( $bornum, $itemno ) = @_;
3149 my $dbh = C4::Context->dbh;
3150 my $renewcount = 0;
3151 my $renewsallowed = 0;
3152 my $renewsleft = 0;
3154 my $patron = Koha::Patrons->find( $bornum );
3155 my $item = Koha::Items->find($itemno);
3157 return (0, 0, 0) unless $patron or $item; # Wrong call, no renewal allowed
3159 # Look in the issues table for this item, lent to this borrower,
3160 # and not yet returned.
3162 # FIXME - I think this function could be redone to use only one SQL call.
3163 my $sth = $dbh->prepare(
3164 "select * from issues
3165 where (borrowernumber = ?)
3166 and (itemnumber = ?)"
3168 $sth->execute( $bornum, $itemno );
3169 my $data = $sth->fetchrow_hashref;
3170 $renewcount = $data->{'renewals'} if $data->{'renewals'};
3171 # $item and $borrower should be calculated
3172 my $branchcode = _GetCircControlBranch($item->unblessed, $patron->unblessed);
3174 my $rule = Koha::CirculationRules->get_effective_rule(
3176 categorycode => $patron->categorycode,
3177 itemtype => $item->effective_itemtype,
3178 branchcode => $branchcode,
3179 rule_name => 'renewalsallowed',
3183 $renewsallowed = $rule ? $rule->rule_value : 0;
3184 $renewsleft = $renewsallowed - $renewcount;
3185 if($renewsleft < 0){ $renewsleft = 0; }
3186 return ( $renewcount, $renewsallowed, $renewsleft );
3189 =head2 GetSoonestRenewDate
3191 $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
3193 Find out the soonest possible renew date of a borrowed item.
3195 C<$borrowernumber> is the borrower number of the patron who currently
3196 has the item on loan.
3198 C<$itemnumber> is the number of the item to renew.
3200 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3201 renew date, based on the value "No renewal before" of the applicable
3202 issuing rule. Returns the current date if the item can already be
3203 renewed, and returns undefined if the borrower, loan, or item
3204 cannot be found.
3206 =cut
3208 sub GetSoonestRenewDate {
3209 my ( $borrowernumber, $itemnumber ) = @_;
3211 my $dbh = C4::Context->dbh;
3213 my $item = Koha::Items->find($itemnumber) or return;
3214 my $itemissue = $item->checkout or return;
3216 $borrowernumber ||= $itemissue->borrowernumber;
3217 my $patron = Koha::Patrons->find( $borrowernumber )
3218 or return;
3220 my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
3221 my $issuing_rule = Koha::CirculationRules->get_effective_rules(
3222 { categorycode => $patron->categorycode,
3223 itemtype => $item->effective_itemtype,
3224 branchcode => $branchcode,
3225 rules => [
3226 'norenewalbefore',
3227 'lengthunit',
3232 my $now = dt_from_string;
3233 return $now unless $issuing_rule;
3235 if ( defined $issuing_rule->{norenewalbefore}
3236 and $issuing_rule->{norenewalbefore} ne "" )
3238 my $soonestrenewal =
3239 dt_from_string( $itemissue->date_due )->subtract(
3240 $issuing_rule->{lengthunit} => $issuing_rule->{norenewalbefore} );
3242 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3243 and $issuing_rule->{lengthunit} eq 'days' )
3245 $soonestrenewal->truncate( to => 'day' );
3247 return $soonestrenewal if $now < $soonestrenewal;
3249 return $now;
3252 =head2 GetLatestAutoRenewDate
3254 $NoAutoRenewalAfterThisDate = &GetLatestAutoRenewDate($borrowernumber, $itemnumber);
3256 Find out the latest possible auto renew date of a borrowed item.
3258 C<$borrowernumber> is the borrower number of the patron who currently
3259 has the item on loan.
3261 C<$itemnumber> is the number of the item to renew.
3263 C<$GetLatestAutoRenewDate> returns the DateTime of the latest possible
3264 auto renew date, based on the value "No auto renewal after" and the "No auto
3265 renewal after (hard limit) of the applicable issuing rule.
3266 Returns undef if there is no date specify in the circ rules or if the patron, loan,
3267 or item cannot be found.
3269 =cut
3271 sub GetLatestAutoRenewDate {
3272 my ( $borrowernumber, $itemnumber ) = @_;
3274 my $dbh = C4::Context->dbh;
3276 my $item = Koha::Items->find($itemnumber) or return;
3277 my $itemissue = $item->checkout or return;
3279 $borrowernumber ||= $itemissue->borrowernumber;
3280 my $patron = Koha::Patrons->find( $borrowernumber )
3281 or return;
3283 my $branchcode = _GetCircControlBranch( $item->unblessed, $patron->unblessed );
3284 my $circulation_rules = Koha::CirculationRules->get_effective_rules(
3286 categorycode => $patron->categorycode,
3287 itemtype => $item->effective_itemtype,
3288 branchcode => $branchcode,
3289 rules => [
3290 'no_auto_renewal_after',
3291 'no_auto_renewal_after_hard_limit',
3292 'lengthunit',
3297 return unless $circulation_rules;
3298 return
3299 if ( not $circulation_rules->{no_auto_renewal_after}
3300 or $circulation_rules->{no_auto_renewal_after} eq '' )
3301 and ( not $circulation_rules->{no_auto_renewal_after_hard_limit}
3302 or $circulation_rules->{no_auto_renewal_after_hard_limit} eq '' );
3304 my $maximum_renewal_date;
3305 if ( $circulation_rules->{no_auto_renewal_after} ) {
3306 $maximum_renewal_date = dt_from_string($itemissue->issuedate);
3307 $maximum_renewal_date->add(
3308 $circulation_rules->{lengthunit} => $circulation_rules->{no_auto_renewal_after}
3312 if ( $circulation_rules->{no_auto_renewal_after_hard_limit} ) {
3313 my $dt = dt_from_string( $circulation_rules->{no_auto_renewal_after_hard_limit} );
3314 $maximum_renewal_date = $dt if not $maximum_renewal_date or $maximum_renewal_date > $dt;
3316 return $maximum_renewal_date;
3320 =head2 GetIssuingCharges
3322 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3324 Calculate how much it would cost for a given patron to borrow a given
3325 item, including any applicable discounts.
3327 C<$itemnumber> is the item number of item the patron wishes to borrow.
3329 C<$borrowernumber> is the patron's borrower number.
3331 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3332 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3333 if it's a video).
3335 =cut
3337 sub GetIssuingCharges {
3339 # calculate charges due
3340 my ( $itemnumber, $borrowernumber ) = @_;
3341 my $charge = 0;
3342 my $dbh = C4::Context->dbh;
3343 my $item_type;
3345 # Get the book's item type and rental charge (via its biblioitem).
3346 my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3347 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3348 $charge_query .= (C4::Context->preference('item-level_itypes'))
3349 ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3350 : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3352 $charge_query .= ' WHERE items.itemnumber =?';
3354 my $sth = $dbh->prepare($charge_query);
3355 $sth->execute($itemnumber);
3356 if ( my $item_data = $sth->fetchrow_hashref ) {
3357 $item_type = $item_data->{itemtype};
3358 $charge = $item_data->{rentalcharge};
3359 my $branch = C4::Context::mybranch();
3360 my $patron = Koha::Patrons->find( $borrowernumber );
3361 my $discount = _get_discount_from_rule($patron->categorycode, $branch, $item_type);
3362 if ($discount) {
3363 # We may have multiple rules so get the most specific
3364 $charge = ( $charge * ( 100 - $discount ) ) / 100;
3366 if ($charge) {
3367 $charge = sprintf '%.2f', $charge; # ensure no fractions of a penny returned
3371 return ( $charge, $item_type );
3374 # Select most appropriate discount rule from those returned
3375 sub _get_discount_from_rule {
3376 my ($categorycode, $branchcode, $itemtype) = @_;
3378 # Set search precedences
3379 my @params = (
3381 branchcode => $branchcode,
3382 itemtype => $itemtype,
3383 categorycode => $categorycode,
3386 branchcode => undef,
3387 categorycode => $categorycode,
3388 itemtype => $itemtype,
3391 branchcode => $branchcode,
3392 categorycode => $categorycode,
3393 itemtype => undef,
3396 branchcode => undef,
3397 categorycode => $categorycode,
3398 itemtype => undef,
3402 foreach my $params (@params) {
3403 my $rule = Koha::CirculationRules->search(
3405 rule_name => 'rentaldiscount',
3406 %$params,
3408 )->next();
3410 return $rule->rule_value if $rule;
3413 # none of the above
3414 return 0;
3417 =head2 AddIssuingCharge
3419 &AddIssuingCharge( $checkout, $charge, $type )
3421 =cut
3423 sub AddIssuingCharge {
3424 my ( $checkout, $charge, $type ) = @_;
3426 # FIXME What if checkout does not exist?
3428 my $account = Koha::Account->new({ patron_id => $checkout->borrowernumber });
3429 my $accountline = $account->add_debit(
3431 amount => $charge,
3432 note => undef,
3433 user_id => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
3434 library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
3435 interface => C4::Context->interface,
3436 type => $type,
3437 item_id => $checkout->itemnumber,
3438 issue_id => $checkout->issue_id,
3443 =head2 GetTransfers
3445 GetTransfers($itemnumber);
3447 =cut
3449 sub GetTransfers {
3450 my ($itemnumber) = @_;
3452 my $dbh = C4::Context->dbh;
3454 my $query = '
3455 SELECT datesent,
3456 frombranch,
3457 tobranch,
3458 branchtransfer_id
3459 FROM branchtransfers
3460 WHERE itemnumber = ?
3461 AND datearrived IS NULL
3463 my $sth = $dbh->prepare($query);
3464 $sth->execute($itemnumber);
3465 my @row = $sth->fetchrow_array();
3466 return @row;
3469 =head2 GetTransfersFromTo
3471 @results = GetTransfersFromTo($frombranch,$tobranch);
3473 Returns the list of pending transfers between $from and $to branch
3475 =cut
3477 sub GetTransfersFromTo {
3478 my ( $frombranch, $tobranch ) = @_;
3479 return unless ( $frombranch && $tobranch );
3480 my $dbh = C4::Context->dbh;
3481 my $query = "
3482 SELECT branchtransfer_id,itemnumber,datesent,frombranch
3483 FROM branchtransfers
3484 WHERE frombranch=?
3485 AND tobranch=?
3486 AND datearrived IS NULL
3488 my $sth = $dbh->prepare($query);
3489 $sth->execute( $frombranch, $tobranch );
3490 my @gettransfers;
3492 while ( my $data = $sth->fetchrow_hashref ) {
3493 push @gettransfers, $data;
3495 return (@gettransfers);
3498 =head2 DeleteTransfer
3500 &DeleteTransfer($itemnumber);
3502 =cut
3504 sub DeleteTransfer {
3505 my ($itemnumber) = @_;
3506 return unless $itemnumber;
3507 my $dbh = C4::Context->dbh;
3508 my $sth = $dbh->prepare(
3509 "DELETE FROM branchtransfers
3510 WHERE itemnumber=?
3511 AND datearrived IS NULL "
3513 return $sth->execute($itemnumber);
3516 =head2 SendCirculationAlert
3518 Send out a C<check-in> or C<checkout> alert using the messaging system.
3520 B<Parameters>:
3522 =over 4
3524 =item type
3526 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3528 =item item
3530 Hashref of information about the item being checked in or out.
3532 =item borrower
3534 Hashref of information about the borrower of the item.
3536 =item branch
3538 The branchcode from where the checkout or check-in took place.
3540 =back
3542 B<Example>:
3544 SendCirculationAlert({
3545 type => 'CHECKOUT',
3546 item => $item,
3547 borrower => $borrower,
3548 branch => $branch,
3551 =cut
3553 sub SendCirculationAlert {
3554 my ($opts) = @_;
3555 my ($type, $item, $borrower, $branch) =
3556 ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3557 my %message_name = (
3558 CHECKIN => 'Item_Check_in',
3559 CHECKOUT => 'Item_Checkout',
3560 RENEWAL => 'Item_Checkout',
3562 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3563 borrowernumber => $borrower->{borrowernumber},
3564 message_name => $message_name{$type},
3566 my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3568 my $schema = Koha::Database->new->schema;
3569 my @transports = keys %{ $borrower_preferences->{transports} };
3571 # From the MySQL doc:
3572 # LOCK TABLES is not transaction-safe and implicitly commits any active transaction before attempting to lock the tables.
3573 # If the LOCK/UNLOCK statements are executed from tests, the current transaction will be committed.
3574 # To avoid that we need to guess if this code is execute from tests or not (yes it is a bit hacky)
3575 my $do_not_lock = ( exists $ENV{_} && $ENV{_} =~ m|prove| ) || $ENV{KOHA_TESTING};
3577 for my $mtt (@transports) {
3578 my $letter = C4::Letters::GetPreparedLetter (
3579 module => 'circulation',
3580 letter_code => $type,
3581 branchcode => $branch,
3582 message_transport_type => $mtt,
3583 lang => $borrower->{lang},
3584 tables => {
3585 $issues_table => $item->{itemnumber},
3586 'items' => $item->{itemnumber},
3587 'biblio' => $item->{biblionumber},
3588 'biblioitems' => $item->{biblionumber},
3589 'borrowers' => $borrower,
3590 'branches' => $branch,
3592 ) or next;
3594 $schema->storage->txn_begin;
3595 C4::Context->dbh->do(q|LOCK TABLE message_queue READ|) unless $do_not_lock;
3596 C4::Context->dbh->do(q|LOCK TABLE message_queue WRITE|) unless $do_not_lock;
3597 my $message = C4::Message->find_last_message($borrower, $type, $mtt);
3598 unless ( $message ) {
3599 C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3600 C4::Message->enqueue($letter, $borrower, $mtt);
3601 } else {
3602 $message->append($letter);
3603 $message->update;
3605 C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3606 $schema->storage->txn_commit;
3609 return;
3612 =head2 updateWrongTransfer
3614 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3616 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
3618 =cut
3620 sub updateWrongTransfer {
3621 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3622 my $dbh = C4::Context->dbh;
3623 # first step validate the actual line of transfert .
3624 my $sth =
3625 $dbh->prepare(
3626 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3628 $sth->execute($FromLibrary,$itemNumber);
3630 # second step create a new line of branchtransfer to the right location .
3631 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3633 #third step changing holdingbranch of item
3634 my $item = Koha::Items->find($itemNumber)->holdingbranch($FromLibrary)->store;
3637 =head2 CalcDateDue
3639 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3641 this function calculates the due date given the start date and configured circulation rules,
3642 checking against the holidays calendar as per the daysmode circulation rule.
3643 C<$startdate> = DateTime object representing start date of loan period (assumed to be today)
3644 C<$itemtype> = itemtype code of item in question
3645 C<$branch> = location whose calendar to use
3646 C<$borrower> = Borrower object
3647 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3649 =cut
3651 sub CalcDateDue {
3652 my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3654 $isrenewal ||= 0;
3656 # loanlength now a href
3657 my $loanlength =
3658 GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3660 my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3661 ? qq{renewalperiod}
3662 : qq{issuelength};
3664 my $datedue;
3665 if ( $startdate ) {
3666 if (ref $startdate ne 'DateTime' ) {
3667 $datedue = dt_from_string($datedue);
3668 } else {
3669 $datedue = $startdate->clone;
3671 } else {
3672 $datedue = dt_from_string()->truncate( to => 'minute' );
3676 my $daysmode = Koha::CirculationRules->get_effective_daysmode(
3678 categorycode => $borrower->{categorycode},
3679 itemtype => $itemtype,
3680 branchcode => $branch,
3684 # calculate the datedue as normal
3685 if ( $daysmode eq 'Days' )
3686 { # ignoring calendar
3687 if ( $loanlength->{lengthunit} eq 'hours' ) {
3688 $datedue->add( hours => $loanlength->{$length_key} );
3689 } else { # days
3690 $datedue->add( days => $loanlength->{$length_key} );
3691 $datedue->set_hour(23);
3692 $datedue->set_minute(59);
3694 } else {
3695 my $dur;
3696 if ($loanlength->{lengthunit} eq 'hours') {
3697 $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3699 else { # days
3700 $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3702 my $calendar = Koha::Calendar->new( branchcode => $branch, days_mode => $daysmode );
3703 $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3704 if ($loanlength->{lengthunit} eq 'days') {
3705 $datedue->set_hour(23);
3706 $datedue->set_minute(59);
3710 # if Hard Due Dates are used, retrieve them and apply as necessary
3711 my ( $hardduedate, $hardduedatecompare ) =
3712 GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3713 if ($hardduedate) { # hardduedates are currently dates
3714 $hardduedate->truncate( to => 'minute' );
3715 $hardduedate->set_hour(23);
3716 $hardduedate->set_minute(59);
3717 my $cmp = DateTime->compare( $hardduedate, $datedue );
3719 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3720 # if the calculated date is before the 'after' Hard Due Date (floor), override
3721 # if the hard due date is set to 'exactly', overrride
3722 if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3723 $datedue = $hardduedate->clone;
3726 # in all other cases, keep the date due as it is
3730 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3731 if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3732 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3733 if( $expiry_dt ) { #skip empty expiry date..
3734 $expiry_dt->set( hour => 23, minute => 59);
3735 my $d1= $datedue->clone->set_time_zone('floating');
3736 if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3737 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3740 if ( $daysmode ne 'Days' ) {
3741 my $calendar = Koha::Calendar->new( branchcode => $branch, days_mode => $daysmode );
3742 if ( $calendar->is_holiday($datedue) ) {
3743 # Don't return on a closed day
3744 $datedue = $calendar->prev_open_days( $datedue, 1 );
3749 return $datedue;
3753 sub CheckValidBarcode{
3754 my ($barcode) = @_;
3755 my $dbh = C4::Context->dbh;
3756 my $query=qq|SELECT count(*)
3757 FROM items
3758 WHERE barcode=?
3760 my $sth = $dbh->prepare($query);
3761 $sth->execute($barcode);
3762 my $exist=$sth->fetchrow ;
3763 return $exist;
3766 =head2 IsBranchTransferAllowed
3768 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3770 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3772 Deprecated in favor of Koha::Item::Transfer::Limits->find/search and
3773 Koha::Item->can_be_transferred.
3775 =cut
3777 sub IsBranchTransferAllowed {
3778 my ( $toBranch, $fromBranch, $code ) = @_;
3780 if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3782 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3783 my $dbh = C4::Context->dbh;
3785 my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3786 $sth->execute( $toBranch, $fromBranch, $code );
3787 my $limit = $sth->fetchrow_hashref();
3789 ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3790 if ( $limit->{'limitId'} ) {
3791 return 0;
3792 } else {
3793 return 1;
3797 =head2 CreateBranchTransferLimit
3799 CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3801 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3803 Deprecated in favor of Koha::Item::Transfer::Limit->new.
3805 =cut
3807 sub CreateBranchTransferLimit {
3808 my ( $toBranch, $fromBranch, $code ) = @_;
3809 return unless defined($toBranch) && defined($fromBranch);
3810 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3812 my $dbh = C4::Context->dbh;
3814 my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3815 return $sth->execute( $code, $toBranch, $fromBranch );
3818 =head2 DeleteBranchTransferLimits
3820 my $result = DeleteBranchTransferLimits($frombranch);
3822 Deletes all the library transfer limits for one library. Returns the
3823 number of limits deleted, 0e0 if no limits were deleted, or undef if
3824 no arguments are supplied.
3826 Deprecated in favor of Koha::Item::Transfer::Limits->search({
3827 fromBranch => $fromBranch
3828 })->delete.
3830 =cut
3832 sub DeleteBranchTransferLimits {
3833 my $branch = shift;
3834 return unless defined $branch;
3835 my $dbh = C4::Context->dbh;
3836 my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3837 return $sth->execute($branch);
3840 sub ReturnLostItem{
3841 my ( $borrowernumber, $itemnum ) = @_;
3842 MarkIssueReturned( $borrowernumber, $itemnum );
3846 sub LostItem{
3847 my ($itemnumber, $mark_lost_from, $force_mark_returned) = @_;
3849 unless ( $mark_lost_from ) {
3850 # Temporary check to avoid regressions
3851 die q|LostItem called without $mark_lost_from, check the API.|;
3854 my $mark_returned;
3855 if ( $force_mark_returned ) {
3856 $mark_returned = 1;
3857 } else {
3858 my $pref = C4::Context->preference('MarkLostItemsAsReturned') // q{};
3859 $mark_returned = ( $pref =~ m|$mark_lost_from| );
3862 my $dbh = C4::Context->dbh();
3863 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3864 FROM issues
3865 JOIN items USING (itemnumber)
3866 JOIN biblio USING (biblionumber)
3867 WHERE issues.itemnumber=?");
3868 $sth->execute($itemnumber);
3869 my $issues=$sth->fetchrow_hashref();
3871 # If a borrower lost the item, add a replacement cost to the their record
3872 if ( my $borrowernumber = $issues->{borrowernumber} ){
3873 my $patron = Koha::Patrons->find( $borrowernumber );
3875 my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, C4::Context->preference('WhenLostForgiveFine'), 'LOST');
3876 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!"; # zero is OK, check defined
3878 if (C4::Context->preference('WhenLostChargeReplacementFee')){
3879 C4::Accounts::chargelostitem(
3880 $borrowernumber,
3881 $itemnumber,
3882 $issues->{'replacementprice'},
3883 sprintf( "%s %s %s",
3884 $issues->{'title'} || q{},
3885 $issues->{'barcode'} || q{},
3886 $issues->{'itemcallnumber'} || q{},
3889 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3890 #warn " $issues->{'borrowernumber'} / $itemnumber ";
3893 MarkIssueReturned($borrowernumber,$itemnumber,undef,$patron->privacy) if $mark_returned;
3896 #When item is marked lost automatically cancel its outstanding transfers and set items holdingbranch to the transfer source branch (frombranch)
3897 if (my ( $datesent,$frombranch,$tobranch ) = GetTransfers($itemnumber)) {
3898 Koha::Items->find($itemnumber)->holdingbranch($frombranch)->store;
3900 my $transferdeleted = DeleteTransfer($itemnumber);
3903 sub GetOfflineOperations {
3904 my $dbh = C4::Context->dbh;
3905 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3906 $sth->execute(C4::Context->userenv->{'branch'});
3907 my $results = $sth->fetchall_arrayref({});
3908 return $results;
3911 sub GetOfflineOperation {
3912 my $operationid = shift;
3913 return unless $operationid;
3914 my $dbh = C4::Context->dbh;
3915 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3916 $sth->execute( $operationid );
3917 return $sth->fetchrow_hashref;
3920 sub AddOfflineOperation {
3921 my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3922 my $dbh = C4::Context->dbh;
3923 my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3924 $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3925 return "Added.";
3928 sub DeleteOfflineOperation {
3929 my $dbh = C4::Context->dbh;
3930 my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3931 $sth->execute( shift );
3932 return "Deleted.";
3935 sub ProcessOfflineOperation {
3936 my $operation = shift;
3938 my $report;
3939 if ( $operation->{action} eq 'return' ) {
3940 $report = ProcessOfflineReturn( $operation );
3941 } elsif ( $operation->{action} eq 'issue' ) {
3942 $report = ProcessOfflineIssue( $operation );
3943 } elsif ( $operation->{action} eq 'payment' ) {
3944 $report = ProcessOfflinePayment( $operation );
3947 DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3949 return $report;
3952 sub ProcessOfflineReturn {
3953 my $operation = shift;
3955 my $item = Koha::Items->find({barcode => $operation->{barcode}});
3957 if ( $item ) {
3958 my $itemnumber = $item->itemnumber;
3959 my $issue = GetOpenIssue( $itemnumber );
3960 if ( $issue ) {
3961 my $leave_item_lost = C4::Context->preference("BlockReturnOfLostItems") ? 1 : 0;
3962 ModDateLastSeen( $itemnumber, $leave_item_lost );
3963 MarkIssueReturned(
3964 $issue->{borrowernumber},
3965 $itemnumber,
3966 $operation->{timestamp},
3968 $item->renewals(0);
3969 $item->onloan(undef);
3970 $item->store({ log_action => 0 });
3971 return "Success.";
3972 } else {
3973 return "Item not issued.";
3975 } else {
3976 return "Item not found.";
3980 sub ProcessOfflineIssue {
3981 my $operation = shift;
3983 my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} } );
3985 if ( $patron ) {
3986 my $item = Koha::Items->find({ barcode => $operation->{barcode} });
3987 unless ($item) {
3988 return "Barcode not found.";
3990 my $itemnumber = $item->itemnumber;
3991 my $issue = GetOpenIssue( $itemnumber );
3993 if ( $issue and ( $issue->{borrowernumber} ne $patron->borrowernumber ) ) { # Item already issued to another patron mark it returned
3994 MarkIssueReturned(
3995 $issue->{borrowernumber},
3996 $itemnumber,
3997 $operation->{timestamp},
4000 AddIssue(
4001 $patron->unblessed,
4002 $operation->{'barcode'},
4003 undef,
4005 $operation->{timestamp},
4006 undef,
4008 return "Success.";
4009 } else {
4010 return "Borrower not found.";
4014 sub ProcessOfflinePayment {
4015 my $operation = shift;
4017 my $patron = Koha::Patrons->find({ cardnumber => $operation->{cardnumber} });
4019 $patron->account->pay(
4021 amount => $operation->{amount},
4022 library_id => $operation->{branchcode},
4023 interface => 'koc'
4027 return "Success.";
4030 =head2 TransferSlip
4032 TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
4034 Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
4036 =cut
4038 sub TransferSlip {
4039 my ($branch, $itemnumber, $barcode, $to_branch) = @_;
4041 my $item =
4042 $itemnumber
4043 ? Koha::Items->find($itemnumber)
4044 : Koha::Items->find( { barcode => $barcode } );
4046 $item or return;
4048 return C4::Letters::GetPreparedLetter (
4049 module => 'circulation',
4050 letter_code => 'TRANSFERSLIP',
4051 branchcode => $branch,
4052 tables => {
4053 'branches' => $to_branch,
4054 'biblio' => $item->biblionumber,
4055 'items' => $item->unblessed,
4060 =head2 CheckIfIssuedToPatron
4062 CheckIfIssuedToPatron($borrowernumber, $biblionumber)
4064 Return 1 if any record item is issued to patron, otherwise return 0
4066 =cut
4068 sub CheckIfIssuedToPatron {
4069 my ($borrowernumber, $biblionumber) = @_;
4071 my $dbh = C4::Context->dbh;
4072 my $query = q|
4073 SELECT COUNT(*) FROM issues
4074 LEFT JOIN items ON items.itemnumber = issues.itemnumber
4075 WHERE items.biblionumber = ?
4076 AND issues.borrowernumber = ?
4078 my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
4079 return 1 if $is_issued;
4080 return;
4083 =head2 IsItemIssued
4085 IsItemIssued( $itemnumber )
4087 Return 1 if the item is on loan, otherwise return 0
4089 =cut
4091 sub IsItemIssued {
4092 my $itemnumber = shift;
4093 my $dbh = C4::Context->dbh;
4094 my $sth = $dbh->prepare(q{
4095 SELECT COUNT(*)
4096 FROM issues
4097 WHERE itemnumber = ?
4099 $sth->execute($itemnumber);
4100 return $sth->fetchrow;
4103 =head2 GetAgeRestriction
4105 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
4106 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
4108 if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as they are older or as old as the agerestriction }
4109 if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
4111 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
4112 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
4113 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
4114 Negative days mean the borrower has gone past the age restriction age.
4116 =cut
4118 sub GetAgeRestriction {
4119 my ($record_restrictions, $borrower) = @_;
4120 my $markers = C4::Context->preference('AgeRestrictionMarker');
4122 return unless $record_restrictions;
4123 # Split $record_restrictions to something like FSK 16 or PEGI 6
4124 my @values = split ' ', uc($record_restrictions);
4125 return unless @values;
4127 # Search first occurrence of one of the markers
4128 my @markers = split /\|/, uc($markers);
4129 return unless @markers;
4131 my $index = 0;
4132 my $restriction_year = 0;
4133 for my $value (@values) {
4134 $index++;
4135 for my $marker (@markers) {
4136 $marker =~ s/^\s+//; #remove leading spaces
4137 $marker =~ s/\s+$//; #remove trailing spaces
4138 if ( $marker eq $value ) {
4139 if ( $index <= $#values ) {
4140 $restriction_year += $values[$index];
4142 last;
4144 elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
4146 # Perhaps it is something like "K16" (as in Finland)
4147 $restriction_year += $1;
4148 last;
4151 last if ( $restriction_year > 0 );
4154 #Check if the borrower is age restricted for this material and for how long.
4155 if ($restriction_year && $borrower) {
4156 if ( $borrower->{'dateofbirth'} ) {
4157 my @alloweddate = split /-/, $borrower->{'dateofbirth'};
4158 $alloweddate[0] += $restriction_year;
4160 #Prevent runime eror on leap year (invalid date)
4161 if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
4162 $alloweddate[2] = 28;
4165 #Get how many days the borrower has to reach the age restriction
4166 my @Today = split /-/, dt_from_string()->ymd();
4167 my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
4168 #Negative days means the borrower went past the age restriction age
4169 return ($restriction_year, $daysToAgeRestriction);
4173 return ($restriction_year);
4177 =head2 GetPendingOnSiteCheckouts
4179 =cut
4181 sub GetPendingOnSiteCheckouts {
4182 my $dbh = C4::Context->dbh;
4183 return $dbh->selectall_arrayref(q|
4184 SELECT
4185 items.barcode,
4186 items.biblionumber,
4187 items.itemnumber,
4188 items.itemnotes,
4189 items.itemcallnumber,
4190 items.location,
4191 issues.date_due,
4192 issues.branchcode,
4193 issues.date_due < NOW() AS is_overdue,
4194 biblio.author,
4195 biblio.title,
4196 borrowers.firstname,
4197 borrowers.surname,
4198 borrowers.cardnumber,
4199 borrowers.borrowernumber
4200 FROM items
4201 LEFT JOIN issues ON items.itemnumber = issues.itemnumber
4202 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
4203 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
4204 WHERE issues.onsite_checkout = 1
4205 |, { Slice => {} } );
4208 sub GetTopIssues {
4209 my ($params) = @_;
4211 my ($count, $branch, $itemtype, $ccode, $newness)
4212 = @$params{qw(count branch itemtype ccode newness)};
4214 my $dbh = C4::Context->dbh;
4215 my $query = q{
4216 SELECT * FROM (
4217 SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4218 bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4219 i.ccode, SUM(i.issues) AS count
4220 FROM biblio b
4221 LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
4222 LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
4225 my (@where_strs, @where_args);
4227 if ($branch) {
4228 push @where_strs, 'i.homebranch = ?';
4229 push @where_args, $branch;
4231 if ($itemtype) {
4232 if (C4::Context->preference('item-level_itypes')){
4233 push @where_strs, 'i.itype = ?';
4234 push @where_args, $itemtype;
4235 } else {
4236 push @where_strs, 'bi.itemtype = ?';
4237 push @where_args, $itemtype;
4240 if ($ccode) {
4241 push @where_strs, 'i.ccode = ?';
4242 push @where_args, $ccode;
4244 if ($newness) {
4245 push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4246 push @where_args, $newness;
4249 if (@where_strs) {
4250 $query .= 'WHERE ' . join(' AND ', @where_strs);
4253 $query .= q{
4254 GROUP BY b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4255 bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4256 i.ccode
4257 ORDER BY count DESC
4260 $query .= q{ ) xxx WHERE count > 0 };
4261 $count = int($count);
4262 if ($count > 0) {
4263 $query .= "LIMIT $count";
4266 my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4268 return @$rows;
4271 =head2 Internal methods
4273 =cut
4275 sub _CalculateAndUpdateFine {
4276 my ($params) = @_;
4278 my $borrower = $params->{borrower};
4279 my $item = $params->{item};
4280 my $issue = $params->{issue};
4281 my $return_date = $params->{return_date};
4283 unless ($borrower) { carp "No borrower passed in!" && return; }
4284 unless ($item) { carp "No item passed in!" && return; }
4285 unless ($issue) { carp "No issue passed in!" && return; }
4287 my $datedue = dt_from_string( $issue->date_due );
4289 # we only need to calculate and change the fines if we want to do that on return
4290 # Should be on for hourly loans
4291 my $control = C4::Context->preference('CircControl');
4292 my $control_branchcode =
4293 ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
4294 : ( $control eq 'PatronLibrary' ) ? $borrower->{branchcode}
4295 : $issue->branchcode;
4297 my $date_returned = $return_date ? $return_date : dt_from_string();
4299 my ( $amount, $unitcounttotal, $unitcount ) =
4300 C4::Overdues::CalcFine( $item, $borrower->{categorycode}, $control_branchcode, $datedue, $date_returned );
4302 if ( C4::Context->preference('finesMode') eq 'production' ) {
4303 if ( $amount > 0 ) {
4304 C4::Overdues::UpdateFine({
4305 issue_id => $issue->issue_id,
4306 itemnumber => $issue->itemnumber,
4307 borrowernumber => $issue->borrowernumber,
4308 amount => $amount,
4309 due => output_pref($datedue),
4312 elsif ($return_date) {
4314 # Backdated returns may have fines that shouldn't exist,
4315 # so in this case, we need to drop those fines to 0
4317 C4::Overdues::UpdateFine({
4318 issue_id => $issue->issue_id,
4319 itemnumber => $issue->itemnumber,
4320 borrowernumber => $issue->borrowernumber,
4321 amount => 0,
4322 due => output_pref($datedue),
4328 sub _item_denied_renewal {
4329 my ($params) = @_;
4331 my $item = $params->{item};
4332 return unless $item;
4334 my $denyingrules = Koha::Config::SysPrefs->find('ItemsDeniedRenewal')->get_yaml_pref_hash();
4335 return unless $denyingrules;
4336 foreach my $field (keys %$denyingrules) {
4337 my $val = $item->$field;
4338 if( !defined $val) {
4339 if ( any { !defined $_ } @{$denyingrules->{$field}} ){
4340 return 1;
4342 } elsif (any { defined($_) && $val eq $_ } @{$denyingrules->{$field}}) {
4343 # If the results matches the values in the syspref
4344 # We return true if match found
4345 return 1;
4348 return 0;
4353 __END__
4355 =head1 AUTHOR
4357 Koha Development Team <http://koha-community.org/>
4359 =cut