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>.
23 #use warnings; FIXME - Bug 2505
33 use C4::ItemCirculationAlertPreference;
36 use C4::Log; # logaction
37 use C4::Overdues qw(CalcFine UpdateFine get_chargeable_units);
38 use C4::RotatingCollections qw(GetCollectionItemBranches);
39 use Algorithm::CheckDigits;
43 use Koha::AuthorisedValues;
44 use Koha::Biblioitems;
48 use Koha::IssuingRules;
51 use Koha::Patron::Debarments;
55 use Koha::RefundLostItemFeeRule;
56 use Koha::RefundLostItemFeeRules;
57 use Koha::Account::Lines;
58 use Koha::Account::Offsets;
60 use List::MoreUtils qw( uniq );
61 use Scalar::Util qw( looks_like_number );
71 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
77 # FIXME subs that should probably be elsewhere
82 &GetPendingOnSiteCheckouts
85 # subs to deal with issuing a book
93 &GetLatestAutoRenewDate
95 &GetBranchBorrowerCircRule
99 &CheckIfIssuedToPatron
104 # subs to deal with returns
110 # subs to deal with transfers
117 &IsBranchTransferAllowed
118 &CreateBranchTransferLimit
119 &DeleteBranchTransferLimits
123 # subs to deal with offline circulation
125 &GetOfflineOperations
128 &DeleteOfflineOperation
129 &ProcessOfflineOperation
135 C4::Circulation - Koha circulation module
143 The functions in this module deal with circulation, issues, and
144 returns, as well as general information about the library.
145 Also deals with inventory.
151 $str = &barcodedecode($barcode, [$filter]);
153 Generic filter function for barcode string.
154 Called on every circ if the System Pref itemBarcodeInputFilter is set.
155 Will do some manipulation of the barcode for systems that deliver a barcode
156 to circulation.pl that differs from the barcode stored for the item.
157 For proper functioning of this filter, calling the function on the
158 correct barcode string (items.barcode) should return an unaltered barcode.
160 The optional $filter argument is to allow for testing or explicit
161 behavior that ignores the System Pref. Valid values are the same as the
166 # FIXME -- the &decode fcn below should be wrapped into this one.
167 # FIXME -- these plugins should be moved out of Circulation.pm
170 my ($barcode, $filter) = @_;
171 my $branch = C4::Context::mybranch();
172 $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
173 $filter or return $barcode; # ensure filter is defined, else return untouched barcode
174 if ($filter eq 'whitespace') {
176 } elsif ($filter eq 'cuecat') {
178 my @fields = split( /\./, $barcode );
179 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
180 ($#results == 2) and return $results[2];
181 } elsif ($filter eq 'T-prefix') {
182 if ($barcode =~ /^[Tt](\d)/) {
183 (defined($1) and $1 eq '0') and return $barcode;
184 $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1)
186 return sprintf("T%07d", $barcode);
187 # FIXME: $barcode could be "T1", causing warning: substr outside of string
188 # Why drop the nonzero digit after the T?
189 # Why pass non-digits (or empty string) to "T%07d"?
190 } elsif ($filter eq 'libsuite8') {
191 unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it.
192 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
193 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
195 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
198 } elsif ($filter eq 'EAN13') {
199 my $ean = CheckDigits('ean');
200 if ( $ean->is_valid($barcode) ) {
201 #$barcode = sprintf('%013d',$barcode); # this doesn't work on 32-bit systems
202 $barcode = '0' x ( 13 - length($barcode) ) . $barcode;
204 warn "# [$barcode] not valid EAN-13/UPC-A\n";
207 return $barcode; # return barcode, modified or not
212 $str = &decode($chunk);
214 Decodes a segment of a string emitted by a CueCat barcode scanner and
217 FIXME: Should be replaced with Barcode::Cuecat from CPAN
218 or Javascript based decoding on the client side.
225 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
226 my @s = map { index( $seq, $_ ); } split( //, $encoded );
227 my $l = ( $#s + 1 ) % 4;
230 # warn "Error: Cuecat decode parsing failed!";
238 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
240 chr( ( $n >> 16 ) ^ 67 )
241 .chr( ( $n >> 8 & 255 ) ^ 67 )
242 .chr( ( $n & 255 ) ^ 67 );
245 $r = substr( $r, 0, length($r) - $l );
251 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
252 $barcode, $ignore_reserves);
254 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
256 C<$newbranch> is the code for the branch to which the item should be transferred.
258 C<$barcode> is the barcode of the item to be transferred.
260 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
261 Otherwise, if an item is reserved, the transfer fails.
263 Returns three values:
269 is true if the transfer was successful.
273 is a reference-to-hash which may have any of the following keys:
279 There is no item in the catalog with the given barcode. The value is C<$barcode>.
281 =item C<DestinationEqualsHolding>
283 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.
287 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.
291 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>.
293 =item C<WasTransferred>
295 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
304 my ( $tbr, $barcode, $ignoreRs ) = @_;
307 my $item = Koha::Items->find( { barcode => $barcode } );
311 $messages->{'BadBarcode'} = $barcode;
315 my $itemnumber = $item->itemnumber;
316 my $issue = GetOpenIssue($itemnumber);
317 # get branches of book...
318 my $hbr = $item->homebranch;
319 my $fbr = $item->holdingbranch;
321 # if using Branch Transfer Limits
322 if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
323 my $code = C4::Context->preference("BranchTransferLimitsType") eq 'ccode' ? $item->ccode : $item->biblio->biblioitem->itemtype; # BranchTransferLimitsType is 'ccode' or 'itemtype'
324 if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
325 if ( ! IsBranchTransferAllowed( $tbr, $fbr, $item->itype ) ) {
326 $messages->{'NotAllowed'} = $tbr . "::" . $item->itype;
329 } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $code ) ) {
330 $messages->{'NotAllowed'} = $tbr . "::" . $code;
335 # can't transfer book if is already there....
336 if ( $fbr eq $tbr ) {
337 $messages->{'DestinationEqualsHolding'} = 1;
341 # check if it is still issued to someone, return it...
343 AddReturn( $barcode, $fbr );
344 $messages->{'WasReturned'} = $issue->borrowernumber;
348 # That'll save a database query.
349 my ( $resfound, $resrec, undef ) =
350 CheckReserves( $itemnumber );
351 if ( $resfound and not $ignoreRs ) {
352 $resrec->{'ResFound'} = $resfound;
354 # $messages->{'ResFound'} = $resrec;
358 #actually do the transfer....
360 ModItemTransfer( $itemnumber, $fbr, $tbr );
362 # don't need to update MARC anymore, we do it in batch now
363 $messages->{'WasTransfered'} = 1;
366 ModDateLastSeen( $itemnumber );
367 return ( $dotransfer, $messages );
372 my $borrower = shift;
373 my $biblionumber = shift;
376 my $onsite_checkout = $params->{onsite_checkout} || 0;
377 my $switch_onsite_checkout = $params->{switch_onsite_checkout} || 0;
378 my $cat_borrower = $borrower->{'categorycode'};
379 my $dbh = C4::Context->dbh;
381 # Get which branchcode we need
382 $branch = _GetCircControlBranch($item,$borrower);
383 my $type = (C4::Context->preference('item-level_itypes'))
384 ? $item->{'itype'} # item-level
385 : $item->{'itemtype'}; # biblio-level
387 # given branch, patron category, and item type, determine
388 # applicable issuing rule
389 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
390 { categorycode => $cat_borrower,
392 branchcode => $branch
397 # if a rule is found and has a loan limit set, count
398 # how many loans the patron already has that meet that
400 if (defined($issuing_rule) and defined($issuing_rule->maxissueqty)) {
403 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
405 JOIN items USING (itemnumber)
408 my $rule_itemtype = $issuing_rule->itemtype;
409 if ($rule_itemtype eq "*") {
410 # matching rule has the default item type, so count only
411 # those existing loans that don't fall under a more
413 if (C4::Context->preference('item-level_itypes')) {
414 $count_query .= " WHERE items.itype NOT IN (
415 SELECT itemtype FROM issuingrules
417 AND (categorycode = ? OR categorycode = ?)
421 $count_query .= " JOIN biblioitems USING (biblionumber)
422 WHERE biblioitems.itemtype NOT IN (
423 SELECT itemtype FROM issuingrules
425 AND (categorycode = ? OR categorycode = ?)
429 push @bind_params, $issuing_rule->branchcode;
430 push @bind_params, $issuing_rule->categorycode;
431 push @bind_params, $cat_borrower;
433 # rule has specific item type, so count loans of that
435 if (C4::Context->preference('item-level_itypes')) {
436 $count_query .= " WHERE items.itype = ? ";
438 $count_query .= " JOIN biblioitems USING (biblionumber)
439 WHERE biblioitems.itemtype= ? ";
441 push @bind_params, $type;
444 $count_query .= " AND borrowernumber = ? ";
445 push @bind_params, $borrower->{'borrowernumber'};
446 my $rule_branch = $issuing_rule->branchcode;
447 if ($rule_branch ne "*") {
448 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
449 $count_query .= " AND issues.branchcode = ? ";
450 push @bind_params, $branch;
451 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
452 ; # if branch is the patron's home branch, then count all loans by patron
454 $count_query .= " AND items.homebranch = ? ";
455 push @bind_params, $branch;
459 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $count_query, {}, @bind_params );
461 my $max_checkouts_allowed = $issuing_rule->maxissueqty;
462 my $max_onsite_checkouts_allowed = $issuing_rule->maxonsiteissueqty;
464 if ( $onsite_checkout and defined $max_onsite_checkouts_allowed ) {
465 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
467 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
468 count => $onsite_checkout_count,
469 max_allowed => $max_onsite_checkouts_allowed,
473 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
474 my $delta = $switch_onsite_checkout ? 1 : 0;
475 if ( $checkout_count >= $max_checkouts_allowed + $delta ) {
477 reason => 'TOO_MANY_CHECKOUTS',
478 count => $checkout_count,
479 max_allowed => $max_checkouts_allowed,
482 } elsif ( not $onsite_checkout ) {
483 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
485 reason => 'TOO_MANY_CHECKOUTS',
486 count => $checkout_count - $onsite_checkout_count,
487 max_allowed => $max_checkouts_allowed,
493 # Now count total loans against the limit for the branch
494 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
495 if (defined($branch_borrower_circ_rule->{maxissueqty})) {
496 my @bind_params = ();
497 my $branch_count_query = q|
498 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
500 JOIN items USING (itemnumber)
501 WHERE borrowernumber = ?
503 push @bind_params, $borrower->{borrowernumber};
505 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
506 $branch_count_query .= " AND issues.branchcode = ? ";
507 push @bind_params, $branch;
508 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
509 ; # if branch is the patron's home branch, then count all loans by patron
511 $branch_count_query .= " AND items.homebranch = ? ";
512 push @bind_params, $branch;
514 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $branch_count_query, {}, @bind_params );
515 my $max_checkouts_allowed = $branch_borrower_circ_rule->{maxissueqty};
516 my $max_onsite_checkouts_allowed = $branch_borrower_circ_rule->{maxonsiteissueqty};
518 if ( $onsite_checkout and defined $max_onsite_checkouts_allowed ) {
519 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
521 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
522 count => $onsite_checkout_count,
523 max_allowed => $max_onsite_checkouts_allowed,
527 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
528 my $delta = $switch_onsite_checkout ? 1 : 0;
529 if ( $checkout_count >= $max_checkouts_allowed + $delta ) {
531 reason => 'TOO_MANY_CHECKOUTS',
532 count => $checkout_count,
533 max_allowed => $max_checkouts_allowed,
536 } elsif ( not $onsite_checkout ) {
537 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
539 reason => 'TOO_MANY_CHECKOUTS',
540 count => $checkout_count - $onsite_checkout_count,
541 max_allowed => $max_checkouts_allowed,
547 if ( not defined( $issuing_rule ) and not defined($branch_borrower_circ_rule->{maxissueqty}) ) {
548 return { reason => 'NO_RULE_DEFINED', max_allowed => 0 };
551 # OK, the patron can issue !!!
555 =head2 CanBookBeIssued
557 ( $issuingimpossible, $needsconfirmation, [ $alerts ] ) = CanBookBeIssued( $patron,
558 $barcode, $duedate, $inprocess, $ignore_reserves, $params );
560 Check if a book can be issued.
562 C<$issuingimpossible> and C<$needsconfirmation> are hashrefs.
564 IMPORTANT: The assumption by users of this routine is that causes blocking
565 the issue are keyed by uppercase labels and other returned
566 data is keyed in lower case!
570 =item C<$patron> is a Koha::Patron
572 =item C<$barcode> is the bar code of the book being issued.
574 =item C<$duedates> is a DateTime object.
576 =item C<$inprocess> boolean switch
578 =item C<$ignore_reserves> boolean switch
580 =item C<$params> Hashref of additional parameters
583 override_high_holds - Ignore high holds
584 onsite_checkout - Checkout is an onsite checkout that will not leave the library
592 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
593 Possible values are :
599 sticky due date is invalid
603 borrower gone with no address
607 borrower declared it's card lost
613 =head3 UNKNOWN_BARCODE
627 item is restricted (set by ??)
629 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
630 could be prevented, but ones that can be overriden by the operator.
632 Possible values are :
640 renewing, not issuing
642 =head3 ISSUED_TO_ANOTHER
644 issued to someone else.
648 reserved for someone else.
652 sticky due date is invalid or due date in the past
656 if the borrower borrows to much things
660 sub CanBookBeIssued {
661 my ( $patron, $barcode, $duedate, $inprocess, $ignore_reserves, $params ) = @_;
662 my %needsconfirmation; # filled with problems that needs confirmations
663 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
664 my %alerts; # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
665 my %messages; # filled with information messages that should be displayed.
667 my $onsite_checkout = $params->{onsite_checkout} || 0;
668 my $override_high_holds = $params->{override_high_holds} || 0;
670 my $item = GetItem(undef, $barcode );
671 my $issue = Koha::Checkouts->find( { itemnumber => $item->{itemnumber} } );
672 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
673 $item->{'itemtype'}=$item->{'itype'};
674 my $dbh = C4::Context->dbh;
675 my $patron_unblessed = $patron->unblessed;
677 # MANDATORY CHECKS - unless item exists, nothing else matters
678 unless ( $item->{barcode} ) {
679 $issuingimpossible{UNKNOWN_BARCODE} = 1;
681 return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
684 # DUE DATE is OK ? -- should already have checked.
686 if ($duedate && ref $duedate ne 'DateTime') {
687 $duedate = dt_from_string($duedate);
689 my $now = DateTime->now( time_zone => C4::Context->tz() );
690 unless ( $duedate ) {
691 my $issuedate = $now->clone();
693 my $branch = _GetCircControlBranch($item, $patron_unblessed);
694 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
695 $duedate = CalcDateDue( $issuedate, $itype, $branch, $patron_unblessed );
697 # Offline circ calls AddIssue directly, doesn't run through here
698 # So issuingimpossible should be ok.
701 my $today = $now->clone();
702 $today->truncate( to => 'minute');
703 if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
704 $needsconfirmation{INVALID_DATE} = output_pref($duedate);
707 $issuingimpossible{INVALID_DATE} = output_pref($duedate);
713 if ( $patron->category->category_type eq 'X' && ( $item->{barcode} )) {
714 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
716 branch => C4::Context->userenv->{'branch'},
718 itemnumber => $item->{'itemnumber'},
719 itemtype => $item->{'itype'},
720 borrowernumber => $patron->borrowernumber,
721 ccode => $item->{'ccode'}}
723 ModDateLastSeen( $item->{'itemnumber'} );
724 return( { STATS => 1 }, {});
727 my $flags = C4::Members::patronflags( $patron_unblessed );
729 if ( $flags->{GNA} ) {
730 $issuingimpossible{GNA} = 1;
732 if ( $flags->{'LOST'} ) {
733 $issuingimpossible{CARD_LOST} = 1;
735 if ( $flags->{'DBARRED'} ) {
736 $issuingimpossible{DEBARRED} = 1;
739 if ( !defined $patron->dateexpiry || $patron->dateexpiry eq '0000-00-00') {
740 $issuingimpossible{EXPIRED} = 1;
742 my $expiry_dt = dt_from_string( $patron->dateexpiry, 'sql', 'floating' );
743 $expiry_dt->truncate( to => 'day');
744 my $today = $now->clone()->truncate(to => 'day');
745 $today->set_time_zone( 'floating' );
746 if ( DateTime->compare($today, $expiry_dt) == 1 ) {
747 $issuingimpossible{EXPIRED} = 1;
756 my ($balance, $non_issue_charges, $other_charges) =
757 C4::Members::GetMemberAccountBalance( $patron->borrowernumber );
759 my $amountlimit = C4::Context->preference("noissuescharge");
760 my $allowfineoverride = C4::Context->preference("AllowFineOverride");
761 my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
763 # Check the debt of this patrons guarantees
764 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
765 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
766 if ( defined $no_issues_charge_guarantees ) {
767 my @guarantees = $patron->guarantees();
768 my $guarantees_non_issues_charges;
769 foreach my $g ( @guarantees ) {
770 my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
771 $guarantees_non_issues_charges += $n;
774 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && !$allowfineoverride) {
775 $issuingimpossible{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
776 } elsif ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && $allowfineoverride) {
777 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
778 } elsif ( $allfinesneedoverride && $guarantees_non_issues_charges > 0 && $guarantees_non_issues_charges <= $no_issues_charge_guarantees && !$inprocess ) {
779 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
783 if ( C4::Context->preference("IssuingInProcess") ) {
784 if ( $non_issue_charges > $amountlimit && !$inprocess && !$allowfineoverride) {
785 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
786 } elsif ( $non_issue_charges > $amountlimit && !$inprocess && $allowfineoverride) {
787 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
788 } elsif ( $allfinesneedoverride && $non_issue_charges > 0 && $non_issue_charges <= $amountlimit && !$inprocess ) {
789 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
793 if ( $non_issue_charges > $amountlimit && $allowfineoverride ) {
794 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
795 } elsif ( $non_issue_charges > $amountlimit && !$allowfineoverride) {
796 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
797 } elsif ( $non_issue_charges > 0 && $allfinesneedoverride ) {
798 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
802 if ($balance > 0 && $other_charges > 0) {
803 $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges );
806 $patron = Koha::Patrons->find( $patron->borrowernumber ); # FIXME Refetch just in case, to avoid regressions. But must not be needed
807 $patron_unblessed = $patron->unblessed;
809 if ( my $debarred_date = $patron->is_debarred ) {
810 # patron has accrued fine days or has a restriction. $count is a date
811 if ($debarred_date eq '9999-12-31') {
812 $issuingimpossible{USERBLOCKEDNOENDDATE} = $debarred_date;
815 $issuingimpossible{USERBLOCKEDWITHENDDATE} = $debarred_date;
817 } elsif ( my $num_overdues = $patron->has_overdues ) {
818 ## patron has outstanding overdue loans
819 if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
820 $issuingimpossible{USERBLOCKEDOVERDUE} = $num_overdues;
822 elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
823 $needsconfirmation{USERBLOCKEDOVERDUE} = $num_overdues;
828 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
830 if ( $issue && $issue->borrowernumber eq $patron->borrowernumber ){
832 # Already issued to current borrower.
833 # If it is an on-site checkout if it can be switched to a normal checkout
834 # or ask whether the loan should be renewed
836 if ( $issue->onsite_checkout
837 and C4::Context->preference('SwitchOnSiteCheckouts') ) {
838 $messages{ONSITE_CHECKOUT_WILL_BE_SWITCHED} = 1;
840 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
841 $patron->borrowernumber,
842 $item->{'itemnumber'},
844 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
845 if ( $renewerror eq 'onsite_checkout' ) {
846 $issuingimpossible{NO_RENEWAL_FOR_ONSITE_CHECKOUTS} = 1;
849 $issuingimpossible{NO_MORE_RENEWALS} = 1;
853 $needsconfirmation{RENEW_ISSUE} = 1;
859 # issued to someone else
861 my $patron = Koha::Patrons->find( $issue->borrowernumber );
863 my ( $can_be_returned, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
865 unless ( $can_be_returned ) {
866 $issuingimpossible{RETURN_IMPOSSIBLE} = 1;
867 $issuingimpossible{branch_to_return} = $message;
869 $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
870 $needsconfirmation{issued_firstname} = $patron->firstname;
871 $needsconfirmation{issued_surname} = $patron->surname;
872 $needsconfirmation{issued_cardnumber} = $patron->cardnumber;
873 $needsconfirmation{issued_borrowernumber} = $patron->borrowernumber;
877 # JB34 CHECKS IF BORROWERS DON'T HAVE ISSUE TOO MANY BOOKS
879 my $switch_onsite_checkout = (
880 C4::Context->preference('SwitchOnSiteCheckouts')
882 and $issue->onsite_checkout
883 and $issue->borrowernumber == $patron->borrowernumber ? 1 : 0 );
884 my $toomany = TooMany( $patron_unblessed, $item->{biblionumber}, $item, { onsite_checkout => $onsite_checkout, switch_onsite_checkout => $switch_onsite_checkout, } );
885 # if TooMany max_allowed returns 0 the user doesn't have permission to check out this book
886 if ( $toomany && not exists $needsconfirmation{RENEW_ISSUE} ) {
887 if ( $toomany->{max_allowed} == 0 ) {
888 $needsconfirmation{PATRON_CANT} = 1;
890 if ( C4::Context->preference("AllowTooManyOverride") ) {
891 $needsconfirmation{TOO_MANY} = $toomany->{reason};
892 $needsconfirmation{current_loan_count} = $toomany->{count};
893 $needsconfirmation{max_loans_allowed} = $toomany->{max_allowed};
895 $issuingimpossible{TOO_MANY} = $toomany->{reason};
896 $issuingimpossible{current_loan_count} = $toomany->{count};
897 $issuingimpossible{max_loans_allowed} = $toomany->{max_allowed};
902 # CHECKPREVCHECKOUT: CHECK IF ITEM HAS EVER BEEN LENT TO PATRON
904 $patron = Koha::Patrons->find( $patron->borrowernumber ); # FIXME Refetch just in case, to avoid regressions. But must not be needed
905 my $wants_check = $patron->wants_check_for_previous_checkout;
906 $needsconfirmation{PREVISSUE} = 1
907 if ($wants_check and $patron->do_check_for_previous_checkout($item));
912 if ( $item->{'notforloan'} )
914 if(!C4::Context->preference("AllowNotForLoanOverride")){
915 $issuingimpossible{NOT_FOR_LOAN} = 1;
916 $issuingimpossible{item_notforloan} = $item->{'notforloan'};
918 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
919 $needsconfirmation{item_notforloan} = $item->{'notforloan'};
923 # we have to check itemtypes.notforloan also
924 if (C4::Context->preference('item-level_itypes')){
925 # this should probably be a subroutine
926 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
927 $sth->execute($item->{'itemtype'});
928 my $notforloan=$sth->fetchrow_hashref();
929 if ($notforloan->{'notforloan'}) {
930 if (!C4::Context->preference("AllowNotForLoanOverride")) {
931 $issuingimpossible{NOT_FOR_LOAN} = 1;
932 $issuingimpossible{itemtype_notforloan} = $item->{'itype'};
934 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
935 $needsconfirmation{itemtype_notforloan} = $item->{'itype'};
939 elsif ($biblioitem->{'notforloan'} == 1){
940 if (!C4::Context->preference("AllowNotForLoanOverride")) {
941 $issuingimpossible{NOT_FOR_LOAN} = 1;
942 $issuingimpossible{itemtype_notforloan} = $biblioitem->{'itemtype'};
944 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
945 $needsconfirmation{itemtype_notforloan} = $biblioitem->{'itemtype'};
949 if ( $item->{'withdrawn'} && $item->{'withdrawn'} > 0 )
951 $issuingimpossible{WTHDRAWN} = 1;
953 if ( $item->{'restricted'}
954 && $item->{'restricted'} == 1 )
956 $issuingimpossible{RESTRICTED} = 1;
958 if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
959 my $av = Koha::AuthorisedValues->search({ category => 'LOST', authorised_value => $item->{itemlost} });
960 my $code = $av->count ? $av->next->lib : '';
961 $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
962 $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
964 if ( C4::Context->preference("IndependentBranches") ) {
965 my $userenv = C4::Context->userenv;
966 unless ( C4::Context->IsSuperLibrarian() ) {
967 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ){
968 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
969 $issuingimpossible{'itemhomebranch'} = $item->{C4::Context->preference("HomeOrHoldingBranch")};
971 $needsconfirmation{BORRNOTSAMEBRANCH} = $patron->branchcode
972 if ( $patron->branchcode ne $userenv->{branch} );
976 # CHECK IF THERE IS RENTAL CHARGES. RENTAL MUST BE CONFIRMED BY THE BORROWER
978 my $rentalConfirmation = C4::Context->preference("RentalFeesCheckoutConfirmation");
980 if ( $rentalConfirmation ){
981 my ($rentalCharge) = GetIssuingCharges( $item->{'itemnumber'}, $patron->borrowernumber );
982 if ( $rentalCharge > 0 ){
983 $needsconfirmation{RENTALCHARGE} = $rentalCharge;
987 unless ( $ignore_reserves ) {
988 # See if the item is on reserve.
989 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
991 my $resbor = $res->{'borrowernumber'};
992 if ( $resbor ne $patron->borrowernumber ) {
993 my $patron = Koha::Patrons->find( $resbor );
994 if ( $restype eq "Waiting" )
996 # The item is on reserve and waiting, but has been
997 # reserved by some other patron.
998 $needsconfirmation{RESERVE_WAITING} = 1;
999 $needsconfirmation{'resfirstname'} = $patron->firstname;
1000 $needsconfirmation{'ressurname'} = $patron->surname;
1001 $needsconfirmation{'rescardnumber'} = $patron->cardnumber;
1002 $needsconfirmation{'resborrowernumber'} = $patron->borrowernumber;
1003 $needsconfirmation{'resbranchcode'} = $res->{branchcode};
1004 $needsconfirmation{'reswaitingdate'} = $res->{'waitingdate'};
1006 elsif ( $restype eq "Reserved" ) {
1007 # The item is on reserve for someone else.
1008 $needsconfirmation{RESERVED} = 1;
1009 $needsconfirmation{'resfirstname'} = $patron->firstname;
1010 $needsconfirmation{'ressurname'} = $patron->surname;
1011 $needsconfirmation{'rescardnumber'} = $patron->cardnumber;
1012 $needsconfirmation{'resborrowernumber'} = $patron->borrowernumber;
1013 $needsconfirmation{'resbranchcode'} = $patron->branchcode;
1014 $needsconfirmation{'resreservedate'} = $res->{reservedate};
1020 ## CHECK AGE RESTRICTION
1021 my $agerestriction = $biblioitem->{'agerestriction'};
1022 my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $patron->unblessed );
1023 if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1024 if ( C4::Context->preference('AgeRestrictionOverride') ) {
1025 $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1028 $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1032 ## check for high holds decreasing loan period
1033 if ( C4::Context->preference('decreaseLoanHighHolds') ) {
1034 my $check = checkHighHolds( $item, $patron_unblessed );
1036 if ( $check->{exceeded} ) {
1037 if ($override_high_holds) {
1038 $alerts{HIGHHOLDS} = {
1039 num_holds => $check->{outstanding},
1040 duration => $check->{duration},
1041 returndate => output_pref( $check->{due_date} ),
1045 $needsconfirmation{HIGHHOLDS} = {
1046 num_holds => $check->{outstanding},
1047 duration => $check->{duration},
1048 returndate => output_pref( $check->{due_date} ),
1055 !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1056 # don't do the multiple loans per bib check if we've
1057 # already determined that we've got a loan on the same item
1058 !$issuingimpossible{NO_MORE_RENEWALS} &&
1059 !$needsconfirmation{RENEW_ISSUE}
1061 # Check if borrower has already issued an item from the same biblio
1062 # Only if it's not a subscription
1063 my $biblionumber = $item->{biblionumber};
1064 require C4::Serials;
1065 my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1066 unless ($is_a_subscription) {
1067 # FIXME Should be $patron->checkouts($args);
1068 my $checkouts = Koha::Checkouts->search(
1070 borrowernumber => $patron->borrowernumber,
1071 biblionumber => $biblionumber,
1077 # if we get here, we don't already have a loan on this item,
1078 # so if there are any loans on this bib, ask for confirmation
1079 if ( $checkouts->count ) {
1080 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1085 return ( \%issuingimpossible, \%needsconfirmation, \%alerts, \%messages, );
1088 =head2 CanBookBeReturned
1090 ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1092 Check whether the item can be returned to the provided branch
1096 =item C<$item> is a hash of item information as returned from GetItem
1098 =item C<$branch> is the branchcode where the return is taking place
1106 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1108 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1114 sub CanBookBeReturned {
1115 my ($item, $branch) = @_;
1116 my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1118 # assume return is allowed to start
1122 # identify all cases where return is forbidden
1123 if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1125 $message = $item->{'homebranch'};
1126 } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1128 $message = $item->{'holdingbranch'};
1129 } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1131 $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1134 return ($allowed, $message);
1137 =head2 CheckHighHolds
1139 used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1140 decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1141 has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1145 sub checkHighHolds {
1146 my ( $item, $borrower ) = @_;
1147 my $branch = _GetCircControlBranch( $item, $borrower );
1148 my $item_object = Koha::Items->find( $item->{itemnumber} );
1157 my $holds = Koha::Holds->search( { biblionumber => $item->{'biblionumber'} } );
1159 if ( $holds->count() ) {
1160 $return_data->{outstanding} = $holds->count();
1162 my $decreaseLoanHighHoldsControl = C4::Context->preference('decreaseLoanHighHoldsControl');
1163 my $decreaseLoanHighHoldsValue = C4::Context->preference('decreaseLoanHighHoldsValue');
1164 my $decreaseLoanHighHoldsIgnoreStatuses = C4::Context->preference('decreaseLoanHighHoldsIgnoreStatuses');
1166 my @decreaseLoanHighHoldsIgnoreStatuses = split( /,/, $decreaseLoanHighHoldsIgnoreStatuses );
1168 if ( $decreaseLoanHighHoldsControl eq 'static' ) {
1170 # static means just more than a given number of holds on the record
1172 # If the number of holds is less than the threshold, we can stop here
1173 if ( $holds->count() < $decreaseLoanHighHoldsValue ) {
1174 return $return_data;
1177 elsif ( $decreaseLoanHighHoldsControl eq 'dynamic' ) {
1179 # dynamic means X more than the number of holdable items on the record
1181 # let's get the items
1182 my @items = $holds->next()->biblio()->items();
1184 # Remove any items with status defined to be ignored even if the would not make item unholdable
1185 foreach my $status (@decreaseLoanHighHoldsIgnoreStatuses) {
1186 @items = grep { !$_->$status } @items;
1189 # Remove any items that are not holdable for this patron
1190 @items = grep { CanItemBeReserved( $borrower->{borrowernumber}, $_->itemnumber ) eq 'OK' } @items;
1192 my $items_count = scalar @items;
1194 my $threshold = $items_count + $decreaseLoanHighHoldsValue;
1196 # If the number of holds is less than the count of items we have
1197 # plus the number of holds allowed above that count, we can stop here
1198 if ( $holds->count() <= $threshold ) {
1199 return $return_data;
1203 my $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1205 my $calendar = Koha::Calendar->new( branchcode => $branch );
1207 my $itype = $item_object->effective_itemtype;
1208 my $orig_due = C4::Circulation::CalcDateDue( $issuedate, $itype, $branch, $borrower );
1210 my $decreaseLoanHighHoldsDuration = C4::Context->preference('decreaseLoanHighHoldsDuration');
1212 my $reduced_datedue = $calendar->addDate( $issuedate, $decreaseLoanHighHoldsDuration );
1213 $reduced_datedue->set_hour($orig_due->hour);
1214 $reduced_datedue->set_minute($orig_due->minute);
1215 $reduced_datedue->truncate( to => 'minute' );
1217 if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1218 $return_data->{exceeded} = 1;
1219 $return_data->{duration} = $decreaseLoanHighHoldsDuration;
1220 $return_data->{due_date} = $reduced_datedue;
1224 return $return_data;
1229 &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1231 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1235 =item C<$borrower> is a hash with borrower informations (from Koha::Patron->unblessed).
1237 =item C<$barcode> is the barcode of the item being issued.
1239 =item C<$datedue> is a DateTime object for the max date of return, i.e. the date due (optional).
1240 Calculated if empty.
1242 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1244 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1245 Defaults to today. Unlike C<$datedue>, NOT a DateTime object, unfortunately.
1247 AddIssue does the following things :
1249 - step 01: check that there is a borrowernumber & a barcode provided
1250 - check for RENEWAL (book issued & being issued to the same patron)
1251 - renewal YES = Calculate Charge & renew
1253 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1255 - fill reserve if reserve to this patron
1256 - cancel reserve or not, otherwise
1257 * TRANSFERT PENDING ?
1258 - complete the transfert
1266 my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1268 my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1269 my $switch_onsite_checkout = $params && $params->{switch_onsite_checkout};
1270 my $auto_renew = $params && $params->{auto_renew};
1271 my $dbh = C4::Context->dbh;
1272 my $barcodecheck = CheckValidBarcode($barcode);
1276 if ( $datedue && ref $datedue ne 'DateTime' ) {
1277 $datedue = dt_from_string($datedue);
1280 # $issuedate defaults to today.
1281 if ( !defined $issuedate ) {
1282 $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1285 if ( ref $issuedate ne 'DateTime' ) {
1286 $issuedate = dt_from_string($issuedate);
1291 # Stop here if the patron or barcode doesn't exist
1292 if ( $borrower && $barcode && $barcodecheck ) {
1293 # find which item we issue
1294 my $item = GetItem( '', $barcode )
1295 or return; # if we don't get an Item, abort.
1296 my $item_object = Koha::Items->find( { barcode => $barcode } );
1298 my $branch = _GetCircControlBranch( $item, $borrower );
1300 # get actual issuing if there is one
1301 my $actualissue = Koha::Checkouts->find( { itemnumber => $item->{itemnumber} } );
1303 # check if we just renew the issue.
1304 if ( $actualissue and $actualissue->borrowernumber eq $borrower->{'borrowernumber'}
1305 and not $switch_onsite_checkout ) {
1306 $datedue = AddRenewal(
1307 $borrower->{'borrowernumber'},
1308 $item->{'itemnumber'},
1311 $issuedate, # here interpreted as the renewal date
1315 # it's NOT a renewal
1316 if ( $actualissue and not $switch_onsite_checkout ) {
1317 # This book is currently on loan, but not to the person
1318 # who wants to borrow it now. mark it returned before issuing to the new borrower
1319 my ( $allowed, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
1320 return unless $allowed;
1321 AddReturn( $item->{'barcode'}, C4::Context->userenv->{'branch'} );
1324 MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1326 # Starting process for transfer job (checking transfert and validate it if we have one)
1327 my ($datesent) = GetTransfers( $item->{'itemnumber'} );
1329 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1330 my $sth = $dbh->prepare(
1331 "UPDATE branchtransfers
1332 SET datearrived = now(),
1334 comments = 'Forced branchtransfer'
1335 WHERE itemnumber= ? AND datearrived IS NULL"
1337 $sth->execute( C4::Context->userenv->{'branch'},
1338 $item->{'itemnumber'} );
1341 # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1342 unless ($auto_renew) {
1343 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
1344 { categorycode => $borrower->{categorycode},
1345 itemtype => $item->{itype},
1346 branchcode => $branch
1350 $auto_renew = $issuing_rule->auto_renew if $issuing_rule;
1353 # Record in the database the fact that the book was issued.
1355 my $itype = $item_object->effective_itemtype;
1356 $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1359 $datedue->truncate( to => 'minute' );
1361 $issue = Koha::Database->new()->schema()->resultset('Issue')->update_or_create(
1363 borrowernumber => $borrower->{'borrowernumber'},
1364 itemnumber => $item->{'itemnumber'},
1365 issuedate => $issuedate->strftime('%Y-%m-%d %H:%M:%S'),
1366 date_due => $datedue->strftime('%Y-%m-%d %H:%M:%S'),
1367 branchcode => C4::Context->userenv->{'branch'},
1368 onsite_checkout => $onsite_checkout,
1369 auto_renew => $auto_renew ? 1 : 0
1373 if ( C4::Context->preference('ReturnToShelvingCart') ) {
1374 # ReturnToShelvingCart is on, anything issued should be taken off the cart.
1375 CartToShelf( $item->{'itemnumber'} );
1377 $item->{'issues'}++;
1378 if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1379 UpdateTotalIssues( $item->{'biblionumber'}, 1 );
1382 ## If item was lost, it has now been found, reverse any list item charges if necessary.
1383 if ( $item->{'itemlost'} ) {
1385 Koha::RefundLostItemFeeRules->should_refund(
1387 current_branch => C4::Context->userenv->{branch},
1388 item_home_branch => $item->{homebranch},
1389 item_holding_branch => $item->{holdingbranch}
1394 _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef,
1395 $item->{'barcode'} );
1401 issues => $item->{'issues'},
1402 holdingbranch => C4::Context->userenv->{'branch'},
1404 onloan => $datedue->ymd(),
1405 datelastborrowed => DateTime->now( time_zone => C4::Context->tz() )->ymd(),
1407 $item->{'biblionumber'},
1408 $item->{'itemnumber'}
1410 ModDateLastSeen( $item->{'itemnumber'} );
1412 # If it costs to borrow this book, charge it to the patron's account.
1413 my ( $charge, $itemtype ) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
1414 if ( $charge > 0 ) {
1415 AddIssuingCharge( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge );
1416 $item->{'charge'} = $charge;
1419 # Record the fact that this book was issued.
1422 branch => C4::Context->userenv->{'branch'},
1423 type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1425 other => ( $sipmode ? "SIP-$sipmode" : '' ),
1426 itemnumber => $item->{'itemnumber'},
1427 itemtype => $item->{'itype'},
1428 location => $item->{location},
1429 borrowernumber => $borrower->{'borrowernumber'},
1430 ccode => $item->{'ccode'}
1434 # Send a checkout slip.
1435 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1437 branchcode => $branch,
1438 categorycode => $borrower->{categorycode},
1439 item_type => $item->{itype},
1440 notification => 'CHECKOUT',
1442 if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
1443 SendCirculationAlert(
1447 borrower => $borrower,
1453 "CIRCULATION", "ISSUE",
1454 $borrower->{'borrowernumber'},
1455 $item->{'itemnumber'}
1456 ) if C4::Context->preference("IssueLog");
1462 =head2 GetLoanLength
1464 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1466 Get loan length for an itemtype, a borrower type and a branch
1471 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1472 my $dbh = C4::Context->dbh;
1473 my $sth = $dbh->prepare(qq{
1474 SELECT issuelength, lengthunit, renewalperiod
1476 WHERE categorycode=?
1479 AND issuelength IS NOT NULL
1482 # try to find issuelength & return the 1st available.
1483 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1484 $sth->execute( $borrowertype, $itemtype, $branchcode );
1485 my $loanlength = $sth->fetchrow_hashref;
1488 if defined($loanlength) && defined $loanlength->{issuelength};
1490 $sth->execute( $borrowertype, '*', $branchcode );
1491 $loanlength = $sth->fetchrow_hashref;
1493 if defined($loanlength) && defined $loanlength->{issuelength};
1495 $sth->execute( '*', $itemtype, $branchcode );
1496 $loanlength = $sth->fetchrow_hashref;
1498 if defined($loanlength) && defined $loanlength->{issuelength};
1500 $sth->execute( '*', '*', $branchcode );
1501 $loanlength = $sth->fetchrow_hashref;
1503 if defined($loanlength) && defined $loanlength->{issuelength};
1505 $sth->execute( $borrowertype, $itemtype, '*' );
1506 $loanlength = $sth->fetchrow_hashref;
1508 if defined($loanlength) && defined $loanlength->{issuelength};
1510 $sth->execute( $borrowertype, '*', '*' );
1511 $loanlength = $sth->fetchrow_hashref;
1513 if defined($loanlength) && defined $loanlength->{issuelength};
1515 $sth->execute( '*', $itemtype, '*' );
1516 $loanlength = $sth->fetchrow_hashref;
1518 if defined($loanlength) && defined $loanlength->{issuelength};
1520 $sth->execute( '*', '*', '*' );
1521 $loanlength = $sth->fetchrow_hashref;
1523 if defined($loanlength) && defined $loanlength->{issuelength};
1525 # if no rule is set => 0 day (hardcoded)
1529 lengthunit => 'days',
1535 =head2 GetHardDueDate
1537 my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1539 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1543 sub GetHardDueDate {
1544 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1546 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
1547 { categorycode => $borrowertype,
1548 itemtype => $itemtype,
1549 branchcode => $branchcode
1554 if ( defined( $issuing_rule ) ) {
1555 if ( $issuing_rule->hardduedate ) {
1556 return (dt_from_string($issuing_rule->hardduedate, 'iso'),$issuing_rule->hardduedatecompare);
1558 return (undef, undef);
1563 =head2 GetBranchBorrowerCircRule
1565 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1567 Retrieves circulation rule attributes that apply to the given
1568 branch and patron category, regardless of item type.
1569 The return value is a hashref containing the following key:
1571 maxissueqty - maximum number of loans that a
1572 patron of the given category can have at the given
1573 branch. If the value is undef, no limit.
1575 maxonsiteissueqty - maximum of on-site checkouts that a
1576 patron of the given category can have at the given
1577 branch. If the value is undef, no limit.
1579 This will first check for a specific branch and
1580 category match from branch_borrower_circ_rules.
1582 If no rule is found, it will then check default_branch_circ_rules
1583 (same branch, default category). If no rule is found,
1584 it will then check default_borrower_circ_rules (default
1585 branch, same category), then failing that, default_circ_rules
1586 (default branch, default category).
1588 If no rule has been found in the database, it will default to
1592 maxonsiteissueqty - undef
1594 C<$branchcode> and C<$categorycode> should contain the
1595 literal branch code and patron category code, respectively - no
1600 sub GetBranchBorrowerCircRule {
1601 my ( $branchcode, $categorycode ) = @_;
1604 my $dbh = C4::Context->dbh();
1605 $rules = $dbh->selectrow_hashref( q|
1606 SELECT maxissueqty, maxonsiteissueqty
1607 FROM branch_borrower_circ_rules
1608 WHERE branchcode = ?
1609 AND categorycode = ?
1610 |, {}, $branchcode, $categorycode ) ;
1611 return $rules if $rules;
1613 # try same branch, default borrower category
1614 $rules = $dbh->selectrow_hashref( q|
1615 SELECT maxissueqty, maxonsiteissueqty
1616 FROM default_branch_circ_rules
1617 WHERE branchcode = ?
1618 |, {}, $branchcode ) ;
1619 return $rules if $rules;
1621 # try default branch, same borrower category
1622 $rules = $dbh->selectrow_hashref( q|
1623 SELECT maxissueqty, maxonsiteissueqty
1624 FROM default_borrower_circ_rules
1625 WHERE categorycode = ?
1626 |, {}, $categorycode ) ;
1627 return $rules if $rules;
1629 # try default branch, default borrower category
1630 $rules = $dbh->selectrow_hashref( q|
1631 SELECT maxissueqty, maxonsiteissueqty
1632 FROM default_circ_rules
1634 return $rules if $rules;
1636 # built-in default circulation rule
1638 maxissueqty => undef,
1639 maxonsiteissueqty => undef,
1643 =head2 GetBranchItemRule
1645 my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1647 Retrieves circulation rule attributes that apply to the given
1648 branch and item type, regardless of patron category.
1650 The return value is a hashref containing the following keys:
1652 holdallowed => Hold policy for this branch and itemtype. Possible values:
1653 0: No holds allowed.
1654 1: Holds allowed only by patrons that have the same homebranch as the item.
1655 2: Holds allowed from any patron.
1657 returnbranch => branch to which to return item. Possible values:
1658 noreturn: do not return, let item remain where checked in (floating collections)
1659 homebranch: return to item's home branch
1660 holdingbranch: return to issuer branch
1662 This searches branchitemrules in the following order:
1664 * Same branchcode and itemtype
1665 * Same branchcode, itemtype '*'
1666 * branchcode '*', same itemtype
1667 * branchcode and itemtype '*'
1669 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1673 sub GetBranchItemRule {
1674 my ( $branchcode, $itemtype ) = @_;
1675 my $dbh = C4::Context->dbh();
1679 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1680 FROM branch_item_rules
1681 WHERE branchcode = ?
1682 AND itemtype = ?', $branchcode, $itemtype],
1683 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1684 FROM default_branch_circ_rules
1685 WHERE branchcode = ?', $branchcode],
1686 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1687 FROM default_branch_item_rules
1688 WHERE itemtype = ?', $itemtype],
1689 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1690 FROM default_circ_rules'],
1693 foreach my $attempt (@attempts) {
1694 my ($query, @bind_params) = @{$attempt};
1695 my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1698 # Since branch/category and branch/itemtype use the same per-branch
1699 # defaults tables, we have to check that the key we want is set, not
1700 # just that a row was returned
1701 $result->{'holdallowed'} = $search_result->{'holdallowed'} unless ( defined $result->{'holdallowed'} );
1702 $result->{'hold_fulfillment_policy'} = $search_result->{'hold_fulfillment_policy'} unless ( defined $result->{'hold_fulfillment_policy'} );
1703 $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1706 # built-in default circulation rule
1707 $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1708 $result->{'hold_fulfillment_policy'} = 'any' unless ( defined $result->{'hold_fulfillment_policy'} );
1709 $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1716 ($doreturn, $messages, $iteminformation, $borrower) =
1717 &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
1723 =item C<$barcode> is the bar code of the book being returned.
1725 =item C<$branch> is the code of the branch where the book is being returned.
1727 =item C<$exemptfine> indicates that overdue charges for the item will be
1730 =item C<$dropbox> indicates that the check-in date is assumed to be
1731 yesterday, or the last non-holiday as defined in C4::Calendar . If
1732 overdue charges are applied and C<$dropbox> is true, the last charge
1733 will be removed. This assumes that the fines accrual script has run
1734 for _today_. Optional.
1736 =item C<$return_date> allows the default return date to be overridden
1737 by the given return date. Optional.
1741 C<&AddReturn> returns a list of four items:
1743 C<$doreturn> is true iff the return succeeded.
1745 C<$messages> is a reference-to-hash giving feedback on the operation.
1746 The keys of the hash are:
1752 No item with this barcode exists. The value is C<$barcode>.
1756 The book is not currently on loan. The value is C<$barcode>.
1760 This book has been withdrawn/cancelled. The value should be ignored.
1762 =item C<Wrongbranch>
1764 This book has was returned to the wrong branch. The value is a hashref
1765 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1766 contain the branchcode of the incorrect and correct return library, respectively.
1770 The item was reserved. The value is a reference-to-hash whose keys are
1771 fields from the reserves table of the Koha database, and
1772 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1773 either C<Waiting>, C<Reserved>, or 0.
1775 =item C<WasReturned>
1777 Value 1 if return is successful.
1779 =item C<NeedsTransfer>
1781 If AutomaticItemReturn is disabled, return branch is given as value of NeedsTransfer.
1785 C<$iteminformation> is a reference-to-hash, giving information about the
1786 returned item from the issues table.
1788 C<$borrower> is a reference-to-hash, giving information about the
1789 patron who last borrowed the book.
1794 my ( $barcode, $branch, $exemptfine, $dropbox, $return_date, $dropboxdate ) = @_;
1796 if ($branch and not Koha::Libraries->find($branch)) {
1797 warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
1800 $branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
1804 my $validTransfert = 0;
1805 my $stat_type = 'return';
1807 # get information on item
1808 my $item = GetItem( undef, $barcode );
1810 return ( 0, { BadBarcode => $barcode } ); # no barcode means no item or borrower. bail out.
1813 my $itemnumber = $item->{ itemnumber };
1814 my $itemtype = $item->{itype}; # GetItem called effective_itemtype
1816 my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } );
1818 $patron = Koha::Patrons->find( $issue->borrowernumber )
1819 or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existent borrowernumber '" . $issue->borrowernumber . "'\n"
1820 . Dumper($issue->unblessed) . "\n";
1822 $messages->{'NotIssued'} = $barcode;
1823 # even though item is not on loan, it may still be transferred; therefore, get current branch info
1825 # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later.
1826 # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1827 if (C4::Context->preference("RecordLocalUseOnReturn")) {
1828 $messages->{'LocalUse'} = 1;
1829 $stat_type = 'localuse';
1833 if ( $item->{'location'} eq 'PROC' ) {
1834 if ( C4::Context->preference("InProcessingToShelvingCart") ) {
1835 $item->{'location'} = 'CART';
1838 $item->{location} = $item->{permanent_location};
1841 ModItem( $item, $item->{'biblionumber'}, $item->{'itemnumber'} );
1844 # full item data, but no borrowernumber or checkout info (no issue)
1845 my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1846 # get the proper branch to which to return the item
1847 my $returnbranch = $item->{$hbr} || $branch ;
1848 # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1850 my $borrowernumber = $patron ? $patron->borrowernumber : undef; # we don't know if we had a borrower or not
1851 my $patron_unblessed = $patron ? $patron->unblessed : {};
1853 my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
1855 $yaml = "$yaml\n\n"; # YAML is anal on ending \n. Surplus does not hurt
1857 eval { $rules = YAML::Load($yaml); };
1859 warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
1862 foreach my $key ( keys %$rules ) {
1863 if ( $item->{notforloan} eq $key ) {
1864 $messages->{'NotForLoanStatusUpdated'} = { from => $item->{notforloan}, to => $rules->{$key} };
1865 ModItem( { notforloan => $rules->{$key} }, undef, $itemnumber );
1872 # check if the return is allowed at this branch
1873 my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
1874 unless ($returnallowed){
1875 $messages->{'Wrongbranch'} = {
1876 Wrongbranch => $branch,
1877 Rightbranch => $message
1880 return ( $doreturn, $messages, $issue, $patron_unblessed);
1883 if ( $item->{'withdrawn'} ) { # book has been cancelled
1884 $messages->{'withdrawn'} = 1;
1885 $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
1888 if ( $item->{itemlost} and C4::Context->preference("BlockReturnOfLostItems") ) {
1892 # case of a return of document (deal with issues and holdingbranch)
1893 my $today = DateTime->now( time_zone => C4::Context->tz() );
1897 die "The item is not issed and cannot be returned" unless $issue; # Just in case...
1898 $patron or warn "AddReturn without current borrower";
1899 my $circControlBranch;
1901 # define circControlBranch only if dropbox mode is set
1902 # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1903 # FIXME: check issuedate > returndate, factoring in holidays
1905 $circControlBranch = _GetCircControlBranch($item,$patron_unblessed);
1906 $is_overdue = $issue->is_overdue( $dropboxdate );
1908 $is_overdue = $issue->is_overdue;
1913 MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
1914 $circControlBranch, $return_date, $patron->privacy );
1917 if ( ( C4::Context->preference('CalculateFinesOnReturn') && $is_overdue ) || $return_date ) {
1918 _CalculateAndUpdateFine( { issue => $issue, item => $item, borrower => $patron_unblessed, return_date => $return_date } );
1921 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 );
1923 return ( 0, { WasReturned => 0, DataCorrupted => 1 }, $issue, $patron_unblessed );
1926 # FIXME is the "= 1" right? This could be the borrower hash.
1927 $messages->{'WasReturned'} = 1;
1931 ModItem({ onloan => undef }, $item->{biblionumber}, $item->{'itemnumber'});
1934 # the holdingbranch is updated if the document is returned to another location.
1935 # this is always done regardless of whether the item was on loan or not
1936 my $item_holding_branch = $item->{ holdingbranch };
1937 if ($item->{'holdingbranch'} ne $branch) {
1938 UpdateHoldingbranch($branch, $item->{'itemnumber'});
1939 $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1941 ModDateLastSeen( $item->{'itemnumber'} );
1943 # check if we have a transfer for this document
1944 my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1946 # if we have a transfer to do, we update the line of transfers with the datearrived
1947 my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->{'itemnumber'} );
1949 if ( $tobranch eq $branch ) {
1950 my $sth = C4::Context->dbh->prepare(
1951 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1953 $sth->execute( $item->{'itemnumber'} );
1954 # if we have a reservation with valid transfer, we can set it's status to 'W'
1955 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1956 C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1958 $messages->{'WrongTransfer'} = $tobranch;
1959 $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1961 $validTransfert = 1;
1963 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1966 # fix up the accounts.....
1967 if ( $item->{'itemlost'} ) {
1968 $messages->{'WasLost'} = 1;
1969 unless ( C4::Context->preference("BlockReturnOfLostItems") ) {
1971 Koha::RefundLostItemFeeRules->should_refund(
1973 current_branch => C4::Context->userenv->{branch},
1974 item_home_branch => $item->{homebranch},
1975 item_holding_branch => $item_holding_branch
1980 _FixAccountForLostAndReturned( $item->{'itemnumber'},
1981 $borrowernumber, $barcode );
1982 $messages->{'LostItemFeeRefunded'} = 1;
1987 # fix up the overdues in accounts...
1988 if ($borrowernumber) {
1989 my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
1990 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
1992 if ( $issue and $issue->is_overdue ) {
1994 $today = $dropboxdate if $dropbox;
1995 my ($debardate,$reminder) = _debar_user_on_return( $patron_unblessed, $item, dt_from_string($issue->date_due), $today );
1997 $messages->{'PrevDebarred'} = $debardate;
1999 $messages->{'Debarred'} = $debardate if $debardate;
2001 # there's no overdue on the item but borrower had been previously debarred
2002 } elsif ( $issue->date_due and $patron->debarred ) {
2003 if ( $patron->debarred eq "9999-12-31") {
2004 $messages->{'ForeverDebarred'} = $patron->debarred;
2006 my $borrower_debar_dt = dt_from_string( $patron->debarred );
2007 $borrower_debar_dt->truncate(to => 'day');
2008 my $today_dt = $today->clone()->truncate(to => 'day');
2009 if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2010 $messages->{'PrevDebarred'} = $patron->debarred;
2016 # find reserves.....
2017 # if we don't have a reserve with the status W, we launch the Checkreserves routine
2018 my ($resfound, $resrec);
2019 my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2020 ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'}, undef, $lookahead ) unless ( $item->{'withdrawn'} );
2022 $resrec->{'ResFound'} = $resfound;
2023 $messages->{'ResFound'} = $resrec;
2026 # Record the fact that this book was returned.
2030 itemnumber => $itemnumber,
2031 itemtype => $itemtype,
2032 borrowernumber => $borrowernumber,
2033 ccode => $item->{ ccode }
2036 # Send a check-in slip. # NOTE: borrower may be undef. Do not try to send messages then.
2038 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2040 branchcode => $branch,
2041 categorycode => $patron->categorycode,
2042 item_type => $item->{itype},
2043 notification => 'CHECKIN',
2045 if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2046 SendCirculationAlert({
2049 borrower => $patron->unblessed,
2054 logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
2055 if C4::Context->preference("ReturnLog");
2058 # Remove any OVERDUES related debarment if the borrower has no overdues
2059 if ( $borrowernumber
2060 && $patron->debarred
2061 && C4::Context->preference('AutoRemoveOverduesRestrictions')
2062 && !Koha::Patrons->find( $borrowernumber )->has_overdues
2063 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2065 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2068 # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2069 if (!$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) and not $messages->{'WrongTransfer'}){
2070 if (C4::Context->preference("AutomaticItemReturn" ) or
2071 (C4::Context->preference("UseBranchTransferLimits") and
2072 ! IsBranchTransferAllowed($branch, $returnbranch, $item->{C4::Context->preference("BranchTransferLimitsType")} )
2074 $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $returnbranch;
2075 $debug and warn "item: " . Dumper($item);
2076 ModItemTransfer($item->{'itemnumber'}, $branch, $returnbranch);
2077 $messages->{'WasTransfered'} = 1;
2079 $messages->{'NeedsTransfer'} = $returnbranch;
2083 return ( $doreturn, $messages, $issue, ( $patron ? $patron->unblessed : {} ));
2086 =head2 MarkIssueReturned
2088 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
2090 Unconditionally marks an issue as being returned by
2091 moving the C<issues> row to C<old_issues> and
2092 setting C<returndate> to the current date, or
2093 the last non-holiday date of the branccode specified in
2094 C<dropbox_branch> . Assumes you've already checked that
2095 it's safe to do this, i.e. last non-holiday > issuedate.
2097 if C<$returndate> is specified (in iso format), it is used as the date
2098 of the return. It is ignored when a dropbox_branch is passed in.
2100 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2101 the old_issue is immediately anonymised
2103 Ideally, this function would be internal to C<C4::Circulation>,
2104 not exported, but it is currently needed by one
2105 routine in C<C4::Accounts>.
2109 sub MarkIssueReturned {
2110 my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
2113 # Retrieve the issue
2114 my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return;
2115 my $issue_id = $issue->issue_id;
2117 my $anonymouspatron;
2118 if ( $privacy == 2 ) {
2119 # The default of 0 will not work due to foreign key constraints
2120 # The anonymisation will fail if AnonymousPatron is not a valid entry
2121 # We need to check if the anonymous patron exist, Koha will fail loudly if it does not
2122 # Note that a warning should appear on the about page (System information tab).
2123 $anonymouspatron = C4::Context->preference('AnonymousPatron');
2124 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."
2125 unless Koha::Patrons->find( $anonymouspatron );
2127 my $database = Koha::Database->new();
2128 my $schema = $database->schema;
2129 my $dbh = C4::Context->dbh;
2131 my $query = 'UPDATE issues SET returndate=';
2133 if ($dropbox_branch) {
2134 my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
2135 my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
2137 push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2138 } elsif ($returndate) {
2140 push @bind, $returndate;
2142 $query .= ' now() ';
2144 $query .= ' WHERE issue_id = ?';
2145 push @bind, $issue_id;
2147 # FIXME Improve the return value and handle it from callers
2148 $schema->txn_do(sub {
2150 # Update the returndate
2151 $dbh->do( $query, undef, @bind );
2153 # We just updated the returndate, so we need to refetch $issue
2154 $issue->discard_changes;
2156 # Create the old_issues entry
2157 my $old_checkout = Koha::Old::Checkout->new($issue->unblessed)->store;
2159 # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2160 if ( $privacy == 2) {
2161 $dbh->do(q|UPDATE old_issues SET borrowernumber=? WHERE issue_id = ?|, undef, $anonymouspatron, $old_checkout->issue_id);
2164 # And finally delete the issue
2167 ModItem( { 'onloan' => undef }, undef, $itemnumber );
2169 if ( C4::Context->preference('StoreLastBorrower') ) {
2170 my $item = Koha::Items->find( $itemnumber );
2171 my $patron = Koha::Patrons->find( $borrowernumber );
2172 $item->last_returned_by( $patron );
2179 =head2 _debar_user_on_return
2181 _debar_user_on_return($borrower, $item, $datedue, today);
2183 C<$borrower> borrower hashref
2185 C<$item> item hashref
2187 C<$datedue> date due DateTime object
2189 C<$return_date> DateTime object representing the return time
2191 Internal function, called only by AddReturn that calculates and updates
2192 the user fine days, and debars them if necessary.
2194 Should only be called for overdue returns
2198 sub _debar_user_on_return {
2199 my ( $borrower, $item, $dt_due, $return_date ) = @_;
2201 my $branchcode = _GetCircControlBranch( $item, $borrower );
2203 my $circcontrol = C4::Context->preference('CircControl');
2204 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2205 { categorycode => $borrower->{categorycode},
2206 itemtype => $item->{itype},
2207 branchcode => $branchcode
2210 my $finedays = $issuing_rule ? $issuing_rule->finedays : undef;
2211 my $unit = $issuing_rule ? $issuing_rule->lengthunit : undef;
2212 my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $return_date, $branchcode);
2216 # finedays is in days, so hourly loans must multiply by 24
2217 # thus 1 hour late equals 1 day suspension * finedays rate
2218 $finedays = $finedays * 24 if ( $unit eq 'hours' );
2220 # grace period is measured in the same units as the loan
2222 DateTime::Duration->new( $unit => $issuing_rule->firstremind );
2224 my $deltadays = DateTime::Duration->new(
2225 days => $chargeable_units
2227 if ( $deltadays->subtract($grace)->is_positive() ) {
2228 my $suspension_days = $deltadays * $finedays;
2230 # If the max suspension days is < than the suspension days
2231 # the suspension days is limited to this maximum period.
2232 my $max_sd = $issuing_rule->maxsuspensiondays;
2233 if ( defined $max_sd ) {
2234 $max_sd = DateTime::Duration->new( days => $max_sd );
2235 $suspension_days = $max_sd
2236 if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2239 my ( $has_been_extended, $is_a_reminder );
2240 if ( C4::Context->preference('CumulativeRestrictionPeriods') and $borrower->{debarred} ) {
2241 my $debarment = @{ GetDebarments( { borrowernumber => $borrower->{borrowernumber}, type => 'SUSPENSION' } ) }[0];
2243 $return_date = dt_from_string( $debarment->{expiration}, 'sql' );
2244 $has_been_extended = 1;
2249 $return_date->clone()->add_duration( $suspension_days );
2251 Koha::Patron::Debarments::AddUniqueDebarment({
2252 borrowernumber => $borrower->{borrowernumber},
2253 expiration => $new_debar_dt->ymd(),
2254 type => 'SUSPENSION',
2256 # if borrower was already debarred but does not get an extra debarment
2257 my $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
2258 my $new_debarment_str;
2259 if ( $borrower->{debarred} eq $patron->is_debarred ) {
2261 $new_debarment_str = $borrower->{debarred};
2263 $new_debarment_str = $new_debar_dt->ymd();
2265 # FIXME Should return a DateTime object
2266 return $new_debarment_str, $is_a_reminder;
2272 =head2 _FixOverduesOnReturn
2274 &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2276 C<$brn> borrowernumber
2280 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2281 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2283 Internal function, called only by AddReturn
2287 sub _FixOverduesOnReturn {
2288 my ($borrowernumber, $item);
2289 unless ($borrowernumber = shift) {
2290 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2293 unless ($item = shift) {
2294 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2297 my ($exemptfine, $dropbox) = @_;
2298 my $dbh = C4::Context->dbh;
2300 # check for overdue fine
2301 my $accountline = Koha::Account::Lines->search(
2303 borrowernumber => $borrowernumber,
2304 itemnumber => $item,
2306 accounttype => 'FU',
2311 return 0 unless $accountline; # no warning, there's just nothing to fix
2315 my $amountoutstanding = $accountline->amountoutstanding;
2317 $accountline->accounttype('FFOR');
2318 $accountline->amountoutstanding(0);
2320 Koha::Account::Offset->new(
2322 debit_id => $accountline->id,
2324 amount => $amountoutstanding * -1,
2328 if (C4::Context->preference("FinesLog")) {
2329 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2331 } elsif ($dropbox && $accountline->lastincrement) {
2332 my $outstanding = $accountline->amountoutstanding - $accountline->lastincrement;
2333 my $amt = $accountline->amount - $accountline->lastincrement;
2335 Koha::Account::Offset->new(
2337 debit_id => $accountline->id,
2339 amount => $accountline->lastincrement * -1,
2343 if ( C4::Context->preference("FinesLog") ) {
2344 &logaction( "FINES", 'MODIFY', $borrowernumber,
2345 "Dropbox adjustment $amt, item $item" );
2348 $accountline->accounttype('F');
2350 if ( $outstanding >= 0 && $amt >= 0 ) {
2351 $accountline->amount($amt);
2352 $accountline->amountoutstanding($outstanding);
2356 $accountline->accounttype('F');
2359 return $accountline->store();
2362 =head2 _FixAccountForLostAndReturned
2364 &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2366 Calculates the charge for a book lost and returned.
2368 Internal function, not exported, called only by AddReturn.
2372 sub _FixAccountForLostAndReturned {
2373 my $itemnumber = shift or return;
2374 my $borrowernumber = @_ ? shift : undef;
2375 my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
2377 # check for charge made for lost book
2378 my $accountline = Koha::Account::Lines->search(
2380 itemnumber => $itemnumber,
2381 accounttype => { -in => [ 'L', 'Rep', 'W' ] },
2384 order_by => { -desc => [ 'date', 'accountno' ] }
2388 return unless $accountline;
2389 return if $accountline->accounttype eq 'W'; # Written off
2391 $accountline->accounttype('LR');
2392 $accountline->store();
2394 my $account = Koha::Account->new( { patron_id => $accountline->borrowernumber } );
2395 my $credit_id = $account->pay(
2397 amount => $accountline->amount,
2398 description => "Item Returned " . $item_id,
2399 account_type => 'CR',
2400 offset_type => 'Lost Item Return',
2401 accounlines => [$accountline],
2406 ModItem( { paidfor => '' }, undef, $itemnumber );
2411 =head2 _GetCircControlBranch
2413 my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2417 Return the library code to be used to determine which circulation
2418 policy applies to a transaction. Looks up the CircControl and
2419 HomeOrHoldingBranch system preferences.
2421 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2423 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2427 sub _GetCircControlBranch {
2428 my ($item, $borrower) = @_;
2429 my $circcontrol = C4::Context->preference('CircControl');
2432 if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2433 $branch= C4::Context->userenv->{'branch'};
2434 } elsif ($circcontrol eq 'PatronLibrary') {
2435 $branch=$borrower->{branchcode};
2437 my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2438 $branch = $item->{$branchfield};
2439 # default to item home branch if holdingbranch is used
2440 # and is not defined
2441 if (!defined($branch) && $branchfield eq 'holdingbranch') {
2442 $branch = $item->{homebranch};
2450 $issue = GetOpenIssue( $itemnumber );
2452 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2454 C<$itemnumber> is the item's itemnumber
2461 my ( $itemnumber ) = @_;
2462 return unless $itemnumber;
2463 my $dbh = C4::Context->dbh;
2464 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2465 $sth->execute( $itemnumber );
2466 return $sth->fetchrow_hashref();
2470 =head2 GetBiblioIssues
2472 $issues = GetBiblioIssues($biblionumber);
2474 this function get all issues from a biblionumber.
2477 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash contains all column from
2478 tables issues and the firstname,surname & cardnumber from borrowers.
2482 sub GetBiblioIssues {
2483 my $biblionumber = shift;
2484 return unless $biblionumber;
2485 my $dbh = C4::Context->dbh;
2487 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2489 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2490 LEFT JOIN items ON issues.itemnumber = items.itemnumber
2491 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2492 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2493 WHERE biblio.biblionumber = ?
2495 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2497 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2498 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2499 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2500 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2501 WHERE biblio.biblionumber = ?
2504 my $sth = $dbh->prepare($query);
2505 $sth->execute($biblionumber, $biblionumber);
2508 while ( my $data = $sth->fetchrow_hashref ) {
2509 push @issues, $data;
2514 =head2 GetUpcomingDueIssues
2516 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2520 sub GetUpcomingDueIssues {
2523 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2524 my $dbh = C4::Context->dbh;
2526 my $statement = <<END_SQL;
2529 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2531 LEFT JOIN items USING (itemnumber)
2532 LEFT OUTER JOIN branches USING (branchcode)
2533 WHERE returndate is NULL
2535 WHERE days_until_due >= 0 AND days_until_due <= ?
2538 my @bind_parameters = ( $params->{'days_in_advance'} );
2540 my $sth = $dbh->prepare( $statement );
2541 $sth->execute( @bind_parameters );
2542 my $upcoming_dues = $sth->fetchall_arrayref({});
2544 return $upcoming_dues;
2547 =head2 CanBookBeRenewed
2549 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2551 Find out whether a borrowed item may be renewed.
2553 C<$borrowernumber> is the borrower number of the patron who currently
2554 has the item on loan.
2556 C<$itemnumber> is the number of the item to renew.
2558 C<$override_limit>, if supplied with a true value, causes
2559 the limit on the number of times that the loan can be renewed
2560 (as controlled by the item type) to be ignored. Overriding also allows
2561 to renew sooner than "No renewal before" and to manually renew loans
2562 that are automatically renewed.
2564 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2565 item must currently be on loan to the specified borrower; renewals
2566 must be allowed for the item's type; and the borrower must not have
2567 already renewed the loan. $error will contain the reason the renewal can not proceed
2571 sub CanBookBeRenewed {
2572 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2574 my $dbh = C4::Context->dbh;
2577 my $item = GetItem($itemnumber) or return ( 0, 'no_item' );
2578 my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return ( 0, 'no_checkout' );
2579 return ( 0, 'onsite_checkout' ) if $issue->onsite_checkout;
2581 $borrowernumber ||= $issue->borrowernumber;
2582 my $patron = Koha::Patrons->find( $borrowernumber )
2585 my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2587 # This item can fill one or more unfilled reserve, can those unfilled reserves
2588 # all be filled by other available items?
2590 && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2592 my $schema = Koha::Database->new()->schema();
2594 my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2596 # There is an item level hold on this item, no other item can fill the hold
2601 # Get all other items that could possibly fill reserves
2602 my @itemnumbers = $schema->resultset('Item')->search(
2604 biblionumber => $resrec->{biblionumber},
2607 -not => { itemnumber => $itemnumber }
2609 { columns => 'itemnumber' }
2610 )->get_column('itemnumber')->all();
2612 # Get all other reserves that could have been filled by this item
2613 my @borrowernumbers;
2615 my ( $reserve_found, $reserve, undef ) =
2616 C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2618 if ($reserve_found) {
2619 push( @borrowernumbers, $reserve->{borrowernumber} );
2626 # If the count of the union of the lists of reservable items for each borrower
2627 # is equal or greater than the number of borrowers, we know that all reserves
2628 # can be filled with available items. We can get the union of the sets simply
2629 # by pushing all the elements onto an array and removing the duplicates.
2632 ITEM: foreach my $i (@itemnumbers) {
2633 my $item = GetItem($i);
2634 next if IsItemOnHoldAndFound($i);
2635 for my $b (@borrowernumbers) {
2636 my $borr = $borrowers{$b} //= Koha::Patrons->find( $b )->unblessed;
2637 next unless IsAvailableForItemLevelRequest($item, $borr);
2638 next unless CanItemBeReserved($b,$i);
2640 push @reservable, $i;
2641 if (@reservable >= @borrowernumbers) {
2650 return ( 0, "on_reserve" ) if $resfound; # '' when no hold was found
2652 return ( 1, undef ) if $override_limit;
2654 my $branchcode = _GetCircControlBranch( $item, $patron->unblessed );
2655 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2656 { categorycode => $patron->categorycode,
2657 itemtype => $item->{itype},
2658 branchcode => $branchcode
2662 return ( 0, "too_many" )
2663 if not $issuing_rule or $issuing_rule->renewalsallowed <= $issue->renewals;
2665 my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2666 my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2667 $patron = Koha::Patrons->find($borrowernumber); # FIXME Is this really useful?
2668 my $restricted = $patron->is_debarred;
2669 my $hasoverdues = $patron->has_overdues;
2671 if ( $restricted and $restrictionblockrenewing ) {
2672 return ( 0, 'restriction');
2673 } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($issue->is_overdue and $overduesblockrenewing eq 'blockitem') ) {
2674 return ( 0, 'overdue');
2677 if ( $issue->auto_renew ) {
2679 if ( $patron->category->effective_BlockExpiredPatronOpacActions and $patron->is_expired ) {
2680 return ( 0, 'auto_account_expired' );
2683 if ( defined $issuing_rule->no_auto_renewal_after
2684 and $issuing_rule->no_auto_renewal_after ne "" ) {
2685 # Get issue_date and add no_auto_renewal_after
2686 # If this is greater than today, it's too late for renewal.
2687 my $maximum_renewal_date = dt_from_string($issue->issuedate, 'sql');
2688 $maximum_renewal_date->add(
2689 $issuing_rule->lengthunit => $issuing_rule->no_auto_renewal_after
2691 my $now = dt_from_string;
2692 if ( $now >= $maximum_renewal_date ) {
2693 return ( 0, "auto_too_late" );
2696 if ( defined $issuing_rule->no_auto_renewal_after_hard_limit
2697 and $issuing_rule->no_auto_renewal_after_hard_limit ne "" ) {
2698 # If no_auto_renewal_after_hard_limit is >= today, it's also too late for renewal
2699 if ( dt_from_string >= dt_from_string( $issuing_rule->no_auto_renewal_after_hard_limit ) ) {
2700 return ( 0, "auto_too_late" );
2704 if ( C4::Context->preference('OPACFineNoRenewalsBlockAutoRenew') ) {
2705 my $fine_no_renewals = C4::Context->preference("OPACFineNoRenewals");
2706 my ( $amountoutstanding ) = C4::Members::GetMemberAccountRecords($patron->borrowernumber);
2707 if ( $amountoutstanding and $amountoutstanding > $fine_no_renewals ) {
2708 return ( 0, "auto_too_much_oweing" );
2713 if ( defined $issuing_rule->norenewalbefore
2714 and $issuing_rule->norenewalbefore ne "" )
2717 # Calculate soonest renewal by subtracting 'No renewal before' from due date
2718 my $soonestrenewal = dt_from_string( $issue->date_due, 'sql' )->subtract(
2719 $issuing_rule->lengthunit => $issuing_rule->norenewalbefore );
2721 # Depending on syspref reset the exact time, only check the date
2722 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2723 and $issuing_rule->lengthunit eq 'days' )
2725 $soonestrenewal->truncate( to => 'day' );
2728 if ( $soonestrenewal > DateTime->now( time_zone => C4::Context->tz() ) )
2730 return ( 0, "auto_too_soon" ) if $issue->auto_renew;
2731 return ( 0, "too_soon" );
2733 elsif ( $issue->auto_renew ) {
2734 return ( 0, "auto_renew" );
2738 # Fallback for automatic renewals:
2739 # If norenewalbefore is undef, don't renew before due date.
2740 if ( $issue->auto_renew ) {
2741 my $now = dt_from_string;
2742 return ( 0, "auto_renew" )
2743 if $now >= dt_from_string( $issue->date_due, 'sql' );
2744 return ( 0, "auto_too_soon" );
2747 return ( 1, undef );
2752 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2756 C<$borrowernumber> is the borrower number of the patron who currently
2759 C<$itemnumber> is the number of the item to renew.
2761 C<$branch> is the library where the renewal took place (if any).
2762 The library that controls the circ policies for the renewal is retrieved from the issues record.
2764 C<$datedue> can be a DateTime object used to set the due date.
2766 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
2767 this parameter is not supplied, lastreneweddate is set to the current date.
2769 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2770 from the book's item type.
2775 my $borrowernumber = shift;
2776 my $itemnumber = shift or return;
2778 my $datedue = shift;
2779 my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2781 my $item = GetItem($itemnumber) or return;
2782 my $item_object = Koha::Items->find( $itemnumber ); # Should replace $item
2783 my $biblio = $item_object->biblio;
2785 my $dbh = C4::Context->dbh;
2787 # Find the issues record for this book
2788 my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } );
2790 return unless $issue;
2792 $borrowernumber ||= $issue->borrowernumber;
2794 if ( defined $datedue && ref $datedue ne 'DateTime' ) {
2795 carp 'Invalid date passed to AddRenewal.';
2799 my $patron = Koha::Patrons->find( $borrowernumber ) or return; # FIXME Should do more than just return
2800 my $patron_unblessed = $patron->unblessed;
2802 if ( C4::Context->preference('CalculateFinesOnReturn') && $issue->is_overdue ) {
2803 _CalculateAndUpdateFine( { issue => $issue, item => $item, borrower => $patron_unblessed } );
2805 _FixOverduesOnReturn( $borrowernumber, $itemnumber );
2807 # If the due date wasn't specified, calculate it by adding the
2808 # book's loan length to today's date or the current due date
2809 # based on the value of the RenewalPeriodBase syspref.
2812 my $itemtype = $item_object->effective_itemtype;
2813 $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2814 dt_from_string( $issue->date_due, 'sql' ) :
2815 DateTime->now( time_zone => C4::Context->tz());
2816 $datedue = CalcDateDue($datedue, $itemtype, _GetCircControlBranch($item, $patron_unblessed), $patron_unblessed, 'is a renewal');
2819 # Update the issues record to have the new due date, and a new count
2820 # of how many times it has been renewed.
2821 my $renews = $issue->renewals + 1;
2822 my $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2823 WHERE borrowernumber=?
2827 $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2829 # Update the renewal count on the item, and tell zebra to reindex
2830 $renews = $item->{renewals} + 1;
2831 ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $item->{biblionumber}, $itemnumber);
2833 # Charge a new rental fee, if applicable?
2834 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2835 if ( $charge > 0 ) {
2836 my $accountno = getnextacctno( $borrowernumber );
2838 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2839 $sth = $dbh->prepare(
2840 "INSERT INTO accountlines
2841 (date, borrowernumber, accountno, amount, manager_id,
2842 description,accounttype, amountoutstanding, itemnumber)
2843 VALUES (now(),?,?,?,?,?,?,?,?)"
2845 $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2846 "Renewal of Rental Item " . $biblio->title . " $item->{'barcode'}",
2847 'Rent', $charge, $itemnumber );
2850 # Send a renewal slip according to checkout alert preferencei
2851 if ( C4::Context->preference('RenewalSendNotice') eq '1' ) {
2852 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2854 branchcode => $branch,
2855 categorycode => $patron->categorycode,
2856 item_type => $item->{itype},
2857 notification => 'CHECKOUT',
2859 if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
2860 SendCirculationAlert(
2864 borrower => $patron->unblessed,
2871 # Remove any OVERDUES related debarment if the borrower has no overdues
2873 && $patron->is_debarred
2874 && ! $patron->has_overdues
2875 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2877 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2880 unless ( C4::Context->interface eq 'opac' ) { #if from opac we are obeying OpacRenewalBranch as calculated in opac-renew.pl
2881 $branch = C4::Context->userenv ? C4::Context->userenv->{branch} : $branch;
2884 # Add the renewal to stats
2890 itemnumber => $itemnumber,
2891 itemtype => $item->{itype},
2892 location => $item->{location},
2893 borrowernumber => $borrowernumber,
2894 ccode => $item->{'ccode'}
2899 logaction("CIRCULATION", "RENEWAL", $borrowernumber, $itemnumber) if C4::Context->preference("RenewalLog");
2904 # check renewal status
2905 my ( $bornum, $itemno ) = @_;
2906 my $dbh = C4::Context->dbh;
2908 my $renewsallowed = 0;
2911 my $patron = Koha::Patrons->find( $bornum );
2912 my $item = GetItem($itemno);
2914 return (0, 0, 0) unless $patron or $item; # Wrong call, no renewal allowed
2916 # Look in the issues table for this item, lent to this borrower,
2917 # and not yet returned.
2919 # FIXME - I think this function could be redone to use only one SQL call.
2920 my $sth = $dbh->prepare(
2921 "select * from issues
2922 where (borrowernumber = ?)
2923 and (itemnumber = ?)"
2925 $sth->execute( $bornum, $itemno );
2926 my $data = $sth->fetchrow_hashref;
2927 $renewcount = $data->{'renewals'} if $data->{'renewals'};
2928 # $item and $borrower should be calculated
2929 my $branchcode = _GetCircControlBranch($item, $patron->unblessed);
2931 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2932 { categorycode => $patron->categorycode,
2933 itemtype => $item->{itype},
2934 branchcode => $branchcode
2938 $renewsallowed = $issuing_rule ? $issuing_rule->renewalsallowed : 0;
2939 $renewsleft = $renewsallowed - $renewcount;
2940 if($renewsleft < 0){ $renewsleft = 0; }
2941 return ( $renewcount, $renewsallowed, $renewsleft );
2944 =head2 GetSoonestRenewDate
2946 $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
2948 Find out the soonest possible renew date of a borrowed item.
2950 C<$borrowernumber> is the borrower number of the patron who currently
2951 has the item on loan.
2953 C<$itemnumber> is the number of the item to renew.
2955 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
2956 renew date, based on the value "No renewal before" of the applicable
2957 issuing rule. Returns the current date if the item can already be
2958 renewed, and returns undefined if the borrower, loan, or item
2963 sub GetSoonestRenewDate {
2964 my ( $borrowernumber, $itemnumber ) = @_;
2966 my $dbh = C4::Context->dbh;
2968 my $item = GetItem($itemnumber) or return;
2969 my $itemissue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return;
2971 $borrowernumber ||= $itemissue->borrowernumber;
2972 my $patron = Koha::Patrons->find( $borrowernumber )
2975 my $branchcode = _GetCircControlBranch( $item, $patron->unblessed );
2976 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2977 { categorycode => $patron->categorycode,
2978 itemtype => $item->{itype},
2979 branchcode => $branchcode
2983 my $now = dt_from_string;
2984 return $now unless $issuing_rule;
2986 if ( defined $issuing_rule->norenewalbefore
2987 and $issuing_rule->norenewalbefore ne "" )
2989 my $soonestrenewal =
2990 dt_from_string( $itemissue->date_due )->subtract(
2991 $issuing_rule->lengthunit => $issuing_rule->norenewalbefore );
2993 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2994 and $issuing_rule->lengthunit eq 'days' )
2996 $soonestrenewal->truncate( to => 'day' );
2998 return $soonestrenewal if $now < $soonestrenewal;
3003 =head2 GetLatestAutoRenewDate
3005 $NoAutoRenewalAfterThisDate = &GetLatestAutoRenewDate($borrowernumber, $itemnumber);
3007 Find out the latest possible auto renew date of a borrowed item.
3009 C<$borrowernumber> is the borrower number of the patron who currently
3010 has the item on loan.
3012 C<$itemnumber> is the number of the item to renew.
3014 C<$GetLatestAutoRenewDate> returns the DateTime of the latest possible
3015 auto renew date, based on the value "No auto renewal after" and the "No auto
3016 renewal after (hard limit) of the applicable issuing rule.
3017 Returns undef if there is no date specify in the circ rules or if the patron, loan,
3018 or item cannot be found.
3022 sub GetLatestAutoRenewDate {
3023 my ( $borrowernumber, $itemnumber ) = @_;
3025 my $dbh = C4::Context->dbh;
3027 my $item = GetItem($itemnumber) or return;
3028 my $itemissue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return;
3030 $borrowernumber ||= $itemissue->borrowernumber;
3031 my $patron = Koha::Patrons->find( $borrowernumber )
3034 my $branchcode = _GetCircControlBranch( $item, $patron->unblessed );
3035 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
3036 { categorycode => $patron->categorycode,
3037 itemtype => $item->{itype},
3038 branchcode => $branchcode
3042 return unless $issuing_rule;
3044 if ( not $issuing_rule->no_auto_renewal_after
3045 or $issuing_rule->no_auto_renewal_after eq '' )
3046 and ( not $issuing_rule->no_auto_renewal_after_hard_limit
3047 or $issuing_rule->no_auto_renewal_after_hard_limit eq '' );
3049 my $maximum_renewal_date;
3050 if ( $issuing_rule->no_auto_renewal_after ) {
3051 $maximum_renewal_date = dt_from_string($itemissue->issuedate);
3052 $maximum_renewal_date->add(
3053 $issuing_rule->lengthunit => $issuing_rule->no_auto_renewal_after
3057 if ( $issuing_rule->no_auto_renewal_after_hard_limit ) {
3058 my $dt = dt_from_string( $issuing_rule->no_auto_renewal_after_hard_limit );
3059 $maximum_renewal_date = $dt if not $maximum_renewal_date or $maximum_renewal_date > $dt;
3061 return $maximum_renewal_date;
3065 =head2 GetIssuingCharges
3067 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3069 Calculate how much it would cost for a given patron to borrow a given
3070 item, including any applicable discounts.
3072 C<$itemnumber> is the item number of item the patron wishes to borrow.
3074 C<$borrowernumber> is the patron's borrower number.
3076 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3077 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3082 sub GetIssuingCharges {
3084 # calculate charges due
3085 my ( $itemnumber, $borrowernumber ) = @_;
3087 my $dbh = C4::Context->dbh;
3090 # Get the book's item type and rental charge (via its biblioitem).
3091 my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3092 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3093 $charge_query .= (C4::Context->preference('item-level_itypes'))
3094 ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3095 : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3097 $charge_query .= ' WHERE items.itemnumber =?';
3099 my $sth = $dbh->prepare($charge_query);
3100 $sth->execute($itemnumber);
3101 if ( my $item_data = $sth->fetchrow_hashref ) {
3102 $item_type = $item_data->{itemtype};
3103 $charge = $item_data->{rentalcharge};
3104 my $branch = C4::Context::mybranch();
3105 my $discount_query = q|SELECT rentaldiscount,
3106 issuingrules.itemtype, issuingrules.branchcode
3108 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3109 WHERE borrowers.borrowernumber = ?
3110 AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3111 AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3112 my $discount_sth = $dbh->prepare($discount_query);
3113 $discount_sth->execute( $borrowernumber, $item_type, $branch );
3114 my $discount_rules = $discount_sth->fetchall_arrayref({});
3115 if (@{$discount_rules}) {
3116 # We may have multiple rules so get the most specific
3117 my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3118 $charge = ( $charge * ( 100 - $discount ) ) / 100;
3121 $charge = sprintf '%.2f', $charge; # ensure no fractions of a penny returned
3125 return ( $charge, $item_type );
3128 # Select most appropriate discount rule from those returned
3129 sub _get_discount_from_rule {
3130 my ($rules_ref, $branch, $itemtype) = @_;
3133 if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3134 $discount = $rules_ref->[0]->{rentaldiscount};
3135 return (defined $discount) ? $discount : 0;
3137 # could have up to 4 does one match $branch and $itemtype
3138 my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3140 $discount = $d[0]->{rentaldiscount};
3141 return (defined $discount) ? $discount : 0;
3143 # do we have item type + all branches
3144 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3146 $discount = $d[0]->{rentaldiscount};
3147 return (defined $discount) ? $discount : 0;
3149 # do we all item types + this branch
3150 @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3152 $discount = $d[0]->{rentaldiscount};
3153 return (defined $discount) ? $discount : 0;
3155 # so all and all (surely we wont get here)
3156 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3158 $discount = $d[0]->{rentaldiscount};
3159 return (defined $discount) ? $discount : 0;
3165 =head2 AddIssuingCharge
3167 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3171 sub AddIssuingCharge {
3172 my ( $itemnumber, $borrowernumber, $charge ) = @_;
3174 my $nextaccntno = getnextacctno($borrowernumber);
3177 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3179 my $accountline = Koha::Account::Line->new(
3181 borrowernumber => $borrowernumber,
3182 itemnumber => $itemnumber,
3183 accountno => $nextaccntno,
3185 amountoutstanding => $charge,
3186 manager_id => $manager_id,
3187 description => 'Rental',
3188 accounttype => 'Rent',
3193 Koha::Account::Offset->new(
3195 debit_id => $accountline->id,
3196 type => 'Rental Fee',
3204 GetTransfers($itemnumber);
3209 my ($itemnumber) = @_;
3211 my $dbh = C4::Context->dbh;
3218 FROM branchtransfers
3219 WHERE itemnumber = ?
3220 AND datearrived IS NULL
3222 my $sth = $dbh->prepare($query);
3223 $sth->execute($itemnumber);
3224 my @row = $sth->fetchrow_array();
3228 =head2 GetTransfersFromTo
3230 @results = GetTransfersFromTo($frombranch,$tobranch);
3232 Returns the list of pending transfers between $from and $to branch
3236 sub GetTransfersFromTo {
3237 my ( $frombranch, $tobranch ) = @_;
3238 return unless ( $frombranch && $tobranch );
3239 my $dbh = C4::Context->dbh;
3241 SELECT branchtransfer_id,itemnumber,datesent,frombranch
3242 FROM branchtransfers
3245 AND datearrived IS NULL
3247 my $sth = $dbh->prepare($query);
3248 $sth->execute( $frombranch, $tobranch );
3251 while ( my $data = $sth->fetchrow_hashref ) {
3252 push @gettransfers, $data;
3254 return (@gettransfers);
3257 =head2 DeleteTransfer
3259 &DeleteTransfer($itemnumber);
3263 sub DeleteTransfer {
3264 my ($itemnumber) = @_;
3265 return unless $itemnumber;
3266 my $dbh = C4::Context->dbh;
3267 my $sth = $dbh->prepare(
3268 "DELETE FROM branchtransfers
3270 AND datearrived IS NULL "
3272 return $sth->execute($itemnumber);
3275 =head2 SendCirculationAlert
3277 Send out a C<check-in> or C<checkout> alert using the messaging system.
3285 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3289 Hashref of information about the item being checked in or out.
3293 Hashref of information about the borrower of the item.
3297 The branchcode from where the checkout or check-in took place.
3303 SendCirculationAlert({
3306 borrower => $borrower,
3312 sub SendCirculationAlert {
3314 my ($type, $item, $borrower, $branch) =
3315 ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3316 my %message_name = (
3317 CHECKIN => 'Item_Check_in',
3318 CHECKOUT => 'Item_Checkout',
3319 RENEWAL => 'Item_Checkout',
3321 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3322 borrowernumber => $borrower->{borrowernumber},
3323 message_name => $message_name{$type},
3325 my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3327 my $schema = Koha::Database->new->schema;
3328 my @transports = keys %{ $borrower_preferences->{transports} };
3330 # From the MySQL doc:
3331 # LOCK TABLES is not transaction-safe and implicitly commits any active transaction before attempting to lock the tables.
3332 # If the LOCK/UNLOCK statements are executed from tests, the current transaction will be committed.
3333 # To avoid that we need to guess if this code is execute from tests or not (yes it is a bit hacky)
3334 my $do_not_lock = ( exists $ENV{_} && $ENV{_} =~ m|prove| ) || $ENV{KOHA_NO_TABLE_LOCKS};
3336 for my $mtt (@transports) {
3337 my $letter = C4::Letters::GetPreparedLetter (
3338 module => 'circulation',
3339 letter_code => $type,
3340 branchcode => $branch,
3341 message_transport_type => $mtt,
3342 lang => $borrower->{lang},
3344 $issues_table => $item->{itemnumber},
3345 'items' => $item->{itemnumber},
3346 'biblio' => $item->{biblionumber},
3347 'biblioitems' => $item->{biblionumber},
3348 'borrowers' => $borrower,
3349 'branches' => $branch,
3353 $schema->storage->txn_begin;
3354 C4::Context->dbh->do(q|LOCK TABLE message_queue READ|) unless $do_not_lock;
3355 C4::Context->dbh->do(q|LOCK TABLE message_queue WRITE|) unless $do_not_lock;
3356 my $message = C4::Message->find_last_message($borrower, $type, $mtt);
3357 unless ( $message ) {
3358 C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3359 C4::Message->enqueue($letter, $borrower, $mtt);
3361 $message->append($letter);
3364 C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3365 $schema->storage->txn_commit;
3371 =head2 updateWrongTransfer
3373 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3375 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
3379 sub updateWrongTransfer {
3380 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3381 my $dbh = C4::Context->dbh;
3382 # first step validate the actual line of transfert .
3385 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3387 $sth->execute($FromLibrary,$itemNumber);
3389 # second step create a new line of branchtransfer to the right location .
3390 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3392 #third step changing holdingbranch of item
3393 UpdateHoldingbranch($FromLibrary,$itemNumber);
3396 =head2 UpdateHoldingbranch
3398 $items = UpdateHoldingbranch($branch,$itmenumber);
3400 Simple methode for updating hodlingbranch in items BDD line
3404 sub UpdateHoldingbranch {
3405 my ( $branch,$itemnumber ) = @_;
3406 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3411 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3413 this function calculates the due date given the start date and configured circulation rules,
3414 checking against the holidays calendar as per the 'useDaysMode' syspref.
3415 C<$startdate> = DateTime object representing start date of loan period (assumed to be today)
3416 C<$itemtype> = itemtype code of item in question
3417 C<$branch> = location whose calendar to use
3418 C<$borrower> = Borrower object
3419 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3424 my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3428 # loanlength now a href
3430 GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3432 my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3438 if (ref $startdate ne 'DateTime' ) {
3439 $datedue = dt_from_string($datedue);
3441 $datedue = $startdate->clone;
3445 DateTime->now( time_zone => C4::Context->tz() )
3446 ->truncate( to => 'minute' );
3450 # calculate the datedue as normal
3451 if ( C4::Context->preference('useDaysMode') eq 'Days' )
3452 { # ignoring calendar
3453 if ( $loanlength->{lengthunit} eq 'hours' ) {
3454 $datedue->add( hours => $loanlength->{$length_key} );
3456 $datedue->add( days => $loanlength->{$length_key} );
3457 $datedue->set_hour(23);
3458 $datedue->set_minute(59);
3462 if ($loanlength->{lengthunit} eq 'hours') {
3463 $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3466 $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3468 my $calendar = Koha::Calendar->new( branchcode => $branch );
3469 $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3470 if ($loanlength->{lengthunit} eq 'days') {
3471 $datedue->set_hour(23);
3472 $datedue->set_minute(59);
3476 # if Hard Due Dates are used, retrieve them and apply as necessary
3477 my ( $hardduedate, $hardduedatecompare ) =
3478 GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3479 if ($hardduedate) { # hardduedates are currently dates
3480 $hardduedate->truncate( to => 'minute' );
3481 $hardduedate->set_hour(23);
3482 $hardduedate->set_minute(59);
3483 my $cmp = DateTime->compare( $hardduedate, $datedue );
3485 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3486 # if the calculated date is before the 'after' Hard Due Date (floor), override
3487 # if the hard due date is set to 'exactly', overrride
3488 if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3489 $datedue = $hardduedate->clone;
3492 # in all other cases, keep the date due as it is
3496 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3497 if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3498 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3499 if( $expiry_dt ) { #skip empty expiry date..
3500 $expiry_dt->set( hour => 23, minute => 59);
3501 my $d1= $datedue->clone->set_time_zone('floating');
3502 if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3503 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3506 if ( C4::Context->preference('useDaysMode') ne 'Days' ) {
3507 my $calendar = Koha::Calendar->new( branchcode => $branch );
3508 if ( $calendar->is_holiday($datedue) ) {
3509 # Don't return on a closed day
3510 $datedue = $calendar->prev_open_day( $datedue );
3519 sub CheckValidBarcode{
3521 my $dbh = C4::Context->dbh;
3522 my $query=qq|SELECT count(*)
3526 my $sth = $dbh->prepare($query);
3527 $sth->execute($barcode);
3528 my $exist=$sth->fetchrow ;
3532 =head2 IsBranchTransferAllowed
3534 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3536 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3540 sub IsBranchTransferAllowed {
3541 my ( $toBranch, $fromBranch, $code ) = @_;
3543 if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3545 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3546 my $dbh = C4::Context->dbh;
3548 my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3549 $sth->execute( $toBranch, $fromBranch, $code );
3550 my $limit = $sth->fetchrow_hashref();
3552 ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3553 if ( $limit->{'limitId'} ) {
3560 =head2 CreateBranchTransferLimit
3562 CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3564 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3568 sub CreateBranchTransferLimit {
3569 my ( $toBranch, $fromBranch, $code ) = @_;
3570 return unless defined($toBranch) && defined($fromBranch);
3571 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3573 my $dbh = C4::Context->dbh;
3575 my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3576 return $sth->execute( $code, $toBranch, $fromBranch );
3579 =head2 DeleteBranchTransferLimits
3581 my $result = DeleteBranchTransferLimits($frombranch);
3583 Deletes all the library transfer limits for one library. Returns the
3584 number of limits deleted, 0e0 if no limits were deleted, or undef if
3585 no arguments are supplied.
3589 sub DeleteBranchTransferLimits {
3591 return unless defined $branch;
3592 my $dbh = C4::Context->dbh;
3593 my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3594 return $sth->execute($branch);
3598 my ( $borrowernumber, $itemnum ) = @_;
3600 MarkIssueReturned( $borrowernumber, $itemnum );
3601 my $patron = Koha::Patrons->find( $borrowernumber );
3602 my $item = C4::Items::GetItem( $itemnum );
3603 my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3604 my @datearr = localtime(time);
3605 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3606 my $bor = $patron->firstname . ' ' . $patron->surname . ' ' . $patron->cardnumber;
3607 ModItem({ paidfor => $old_note."Paid for by $bor $date" }, undef, $itemnum);
3612 my ($itemnumber, $mark_returned) = @_;
3614 $mark_returned //= C4::Context->preference('MarkLostItemsAsReturned');
3616 my $dbh = C4::Context->dbh();
3617 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3619 JOIN items USING (itemnumber)
3620 JOIN biblio USING (biblionumber)
3621 WHERE issues.itemnumber=?");
3622 $sth->execute($itemnumber);
3623 my $issues=$sth->fetchrow_hashref();
3625 # If a borrower lost the item, add a replacement cost to the their record
3626 if ( my $borrowernumber = $issues->{borrowernumber} ){
3627 my $patron = Koha::Patrons->find( $borrowernumber );
3629 if (C4::Context->preference('WhenLostForgiveFine')){
3630 my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3631 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!"; # zero is OK, check defined
3633 if (C4::Context->preference('WhenLostChargeReplacementFee')){
3634 C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3635 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3636 #warn " $issues->{'borrowernumber'} / $itemnumber ";
3639 MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$patron->privacy) if $mark_returned;
3643 sub GetOfflineOperations {
3644 my $dbh = C4::Context->dbh;
3645 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3646 $sth->execute(C4::Context->userenv->{'branch'});
3647 my $results = $sth->fetchall_arrayref({});
3651 sub GetOfflineOperation {
3652 my $operationid = shift;
3653 return unless $operationid;
3654 my $dbh = C4::Context->dbh;
3655 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3656 $sth->execute( $operationid );
3657 return $sth->fetchrow_hashref;
3660 sub AddOfflineOperation {
3661 my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3662 my $dbh = C4::Context->dbh;
3663 my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3664 $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3668 sub DeleteOfflineOperation {
3669 my $dbh = C4::Context->dbh;
3670 my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3671 $sth->execute( shift );
3675 sub ProcessOfflineOperation {
3676 my $operation = shift;
3679 if ( $operation->{action} eq 'return' ) {
3680 $report = ProcessOfflineReturn( $operation );
3681 } elsif ( $operation->{action} eq 'issue' ) {
3682 $report = ProcessOfflineIssue( $operation );
3683 } elsif ( $operation->{action} eq 'payment' ) {
3684 $report = ProcessOfflinePayment( $operation );
3687 DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3692 sub ProcessOfflineReturn {
3693 my $operation = shift;
3695 my $item = Koha::Items->find({barcode => $operation->{barcode}});
3698 my $itemnumber = $item->itemnumber;
3699 my $issue = GetOpenIssue( $itemnumber );
3702 $issue->{borrowernumber},
3705 $operation->{timestamp},
3708 { renewals => 0, onloan => undef },
3709 $issue->{'biblionumber'},
3714 return "Item not issued.";
3717 return "Item not found.";
3721 sub ProcessOfflineIssue {
3722 my $operation = shift;
3724 my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} } );
3727 my $item = Koha::Items->find({ barcode => $operation->{barcode} });
3729 return "Barcode not found.";
3731 my $itemnumber = $item->itemnumber;
3732 my $issue = GetOpenIssue( $itemnumber );
3734 if ( $issue and ( $issue->{borrowernumber} ne $patron->borrowernumber ) ) { # Item already issued to another patron mark it returned
3736 $issue->{borrowernumber},
3739 $operation->{timestamp},
3744 $operation->{'barcode'},
3747 $operation->{timestamp},
3752 return "Borrower not found.";
3756 sub ProcessOfflinePayment {
3757 my $operation = shift;
3759 my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} });
3760 my $amount = $operation->{amount};
3762 Koha::Account->new( { patron_id => $patron->id } )->pay( { amount => $amount } );
3770 TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3772 Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3777 my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3779 my $item = GetItem( $itemnumber, $barcode )
3782 return C4::Letters::GetPreparedLetter (
3783 module => 'circulation',
3784 letter_code => 'TRANSFERSLIP',
3785 branchcode => $branch,
3787 'branches' => $to_branch,
3788 'biblio' => $item->{biblionumber},
3794 =head2 CheckIfIssuedToPatron
3796 CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3798 Return 1 if any record item is issued to patron, otherwise return 0
3802 sub CheckIfIssuedToPatron {
3803 my ($borrowernumber, $biblionumber) = @_;
3805 my $dbh = C4::Context->dbh;
3807 SELECT COUNT(*) FROM issues
3808 LEFT JOIN items ON items.itemnumber = issues.itemnumber
3809 WHERE items.biblionumber = ?
3810 AND issues.borrowernumber = ?
3812 my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
3813 return 1 if $is_issued;
3819 IsItemIssued( $itemnumber )
3821 Return 1 if the item is on loan, otherwise return 0
3826 my $itemnumber = shift;
3827 my $dbh = C4::Context->dbh;
3828 my $sth = $dbh->prepare(q{
3831 WHERE itemnumber = ?
3833 $sth->execute($itemnumber);
3834 return $sth->fetchrow;
3837 =head2 GetAgeRestriction
3839 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3840 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3842 if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as they are older or as old as the agerestriction }
3843 if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3845 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3846 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3847 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3848 Negative days mean the borrower has gone past the age restriction age.
3852 sub GetAgeRestriction {
3853 my ($record_restrictions, $borrower) = @_;
3854 my $markers = C4::Context->preference('AgeRestrictionMarker');
3856 # Split $record_restrictions to something like FSK 16 or PEGI 6
3857 my @values = split ' ', uc($record_restrictions);
3858 return unless @values;
3860 # Search first occurrence of one of the markers
3861 my @markers = split /\|/, uc($markers);
3862 return unless @markers;
3865 my $restriction_year = 0;
3866 for my $value (@values) {
3868 for my $marker (@markers) {
3869 $marker =~ s/^\s+//; #remove leading spaces
3870 $marker =~ s/\s+$//; #remove trailing spaces
3871 if ( $marker eq $value ) {
3872 if ( $index <= $#values ) {
3873 $restriction_year += $values[$index];
3877 elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
3879 # Perhaps it is something like "K16" (as in Finland)
3880 $restriction_year += $1;
3884 last if ( $restriction_year > 0 );
3887 #Check if the borrower is age restricted for this material and for how long.
3888 if ($restriction_year && $borrower) {
3889 if ( $borrower->{'dateofbirth'} ) {
3890 my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3891 $alloweddate[0] += $restriction_year;
3893 #Prevent runime eror on leap year (invalid date)
3894 if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3895 $alloweddate[2] = 28;
3898 #Get how many days the borrower has to reach the age restriction
3899 my @Today = split /-/, DateTime->today->ymd();
3900 my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
3901 #Negative days means the borrower went past the age restriction age
3902 return ($restriction_year, $daysToAgeRestriction);
3906 return ($restriction_year);
3910 =head2 GetPendingOnSiteCheckouts
3914 sub GetPendingOnSiteCheckouts {
3915 my $dbh = C4::Context->dbh;
3916 return $dbh->selectall_arrayref(q|
3922 items.itemcallnumber,
3926 issues.date_due < NOW() AS is_overdue,
3929 borrowers.firstname,
3931 borrowers.cardnumber,
3932 borrowers.borrowernumber
3934 LEFT JOIN issues ON items.itemnumber = issues.itemnumber
3935 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
3936 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
3937 WHERE issues.onsite_checkout = 1
3938 |, { Slice => {} } );
3944 my ($count, $branch, $itemtype, $ccode, $newness)
3945 = @$params{qw(count branch itemtype ccode newness)};
3947 my $dbh = C4::Context->dbh;
3949 SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
3950 bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
3951 i.ccode, SUM(i.issues) AS count
3953 LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
3954 LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
3957 my (@where_strs, @where_args);
3960 push @where_strs, 'i.homebranch = ?';
3961 push @where_args, $branch;
3964 if (C4::Context->preference('item-level_itypes')){
3965 push @where_strs, 'i.itype = ?';
3966 push @where_args, $itemtype;
3968 push @where_strs, 'bi.itemtype = ?';
3969 push @where_args, $itemtype;
3973 push @where_strs, 'i.ccode = ?';
3974 push @where_args, $ccode;
3977 push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
3978 push @where_args, $newness;
3982 $query .= 'WHERE ' . join(' AND ', @where_strs);
3986 GROUP BY b.biblionumber
3991 $count = int($count);
3993 $query .= "LIMIT $count";
3996 my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4001 sub _CalculateAndUpdateFine {
4004 my $borrower = $params->{borrower};
4005 my $item = $params->{item};
4006 my $issue = $params->{issue};
4007 my $return_date = $params->{return_date};
4009 unless ($borrower) { carp "No borrower passed in!" && return; }
4010 unless ($item) { carp "No item passed in!" && return; }
4011 unless ($issue) { carp "No issue passed in!" && return; }
4013 my $datedue = dt_from_string( $issue->date_due );
4015 # we only need to calculate and change the fines if we want to do that on return
4016 # Should be on for hourly loans
4017 my $control = C4::Context->preference('CircControl');
4018 my $control_branchcode =
4019 ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
4020 : ( $control eq 'PatronLibrary' ) ? $borrower->{branchcode}
4021 : $issue->branchcode;
4023 my $date_returned = $return_date ? dt_from_string($return_date) : dt_from_string();
4025 my ( $amount, $type, $unitcounttotal ) =
4026 C4::Overdues::CalcFine( $item, $borrower->{categorycode}, $control_branchcode, $datedue, $date_returned );
4030 if ( C4::Context->preference('finesMode') eq 'production' ) {
4031 if ( $amount > 0 ) {
4032 C4::Overdues::UpdateFine({
4033 issue_id => $issue->issue_id,
4034 itemnumber => $issue->itemnumber,
4035 borrowernumber => $issue->borrowernumber,
4038 due => output_pref($datedue),
4041 elsif ($return_date) {
4043 # Backdated returns may have fines that shouldn't exist,
4044 # so in this case, we need to drop those fines to 0
4046 C4::Overdues::UpdateFine({
4047 issue_id => $issue->issue_id,
4048 itemnumber => $issue->itemnumber,
4049 borrowernumber => $issue->borrowernumber,
4052 due => output_pref($datedue),
4064 Koha Development Team <http://koha-community.org/>