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>.
283 The item's home branch is permanent. This doesn't prevent the item from being transferred, though. The value is the code of the item's home branch.
285 =item C<DestinationEqualsHolding>
287 The item is already at the branch to which it is being transferred. The transfer is nonetheless considered to have failed. The value should be ignored.
291 The item was on loan, and C<&transferbook> automatically returned it before transferring it. The value is the borrower number of the patron who had the item.
295 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>.
297 =item C<WasTransferred>
299 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
308 my ( $tbr, $barcode, $ignoreRs ) = @_;
311 my $item = Koha::Items->find( { barcode => $barcode } );
315 $messages->{'BadBarcode'} = $barcode;
319 my $itemnumber = $item->itemnumber;
320 my $issue = GetOpenIssue($itemnumber);
321 # get branches of book...
322 my $hbr = $item->homebranch;
323 my $fbr = $item->holdingbranch;
325 # if using Branch Transfer Limits
326 if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
327 my $code = C4::Context->preference("BranchTransferLimitsType") eq 'ccode' ? $item->ccode : $item->biblio->biblioitem->itemtype; # BranchTransferLimitsType is 'ccode' or 'itemtype'
328 if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
329 if ( ! IsBranchTransferAllowed( $tbr, $fbr, $item->itype ) ) {
330 $messages->{'NotAllowed'} = $tbr . "::" . $item->itype;
333 } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $code ) ) {
334 $messages->{'NotAllowed'} = $tbr . "::" . $code;
340 # FIXME Is this still used by someone?
341 # See other FIXME in AddReturn
342 my $library = Koha::Libraries->find($hbr);
343 if ( $library and $library->get_categories->search({'me.categorycode' => 'PE'})->count ) {
344 $messages->{'IsPermanent'} = $hbr;
348 # can't transfer book if is already there....
349 if ( $fbr eq $tbr ) {
350 $messages->{'DestinationEqualsHolding'} = 1;
354 # check if it is still issued to someone, return it...
356 AddReturn( $barcode, $fbr );
357 $messages->{'WasReturned'} = $issue->borrowernumber;
361 # That'll save a database query.
362 my ( $resfound, $resrec, undef ) =
363 CheckReserves( $itemnumber );
364 if ( $resfound and not $ignoreRs ) {
365 $resrec->{'ResFound'} = $resfound;
367 # $messages->{'ResFound'} = $resrec;
371 #actually do the transfer....
373 ModItemTransfer( $itemnumber, $fbr, $tbr );
375 # don't need to update MARC anymore, we do it in batch now
376 $messages->{'WasTransfered'} = 1;
379 ModDateLastSeen( $itemnumber );
380 return ( $dotransfer, $messages );
385 my $borrower = shift;
386 my $biblionumber = shift;
389 my $onsite_checkout = $params->{onsite_checkout} || 0;
390 my $switch_onsite_checkout = $params->{switch_onsite_checkout} || 0;
391 my $cat_borrower = $borrower->{'categorycode'};
392 my $dbh = C4::Context->dbh;
394 # Get which branchcode we need
395 $branch = _GetCircControlBranch($item,$borrower);
396 my $type = (C4::Context->preference('item-level_itypes'))
397 ? $item->{'itype'} # item-level
398 : $item->{'itemtype'}; # biblio-level
400 # given branch, patron category, and item type, determine
401 # applicable issuing rule
402 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
403 { categorycode => $cat_borrower,
405 branchcode => $branch
410 # if a rule is found and has a loan limit set, count
411 # how many loans the patron already has that meet that
413 if (defined($issuing_rule) and defined($issuing_rule->maxissueqty)) {
416 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
418 JOIN items USING (itemnumber)
421 my $rule_itemtype = $issuing_rule->itemtype;
422 if ($rule_itemtype eq "*") {
423 # matching rule has the default item type, so count only
424 # those existing loans that don't fall under a more
426 if (C4::Context->preference('item-level_itypes')) {
427 $count_query .= " WHERE items.itype NOT IN (
428 SELECT itemtype FROM issuingrules
430 AND (categorycode = ? OR categorycode = ?)
434 $count_query .= " JOIN biblioitems USING (biblionumber)
435 WHERE biblioitems.itemtype NOT IN (
436 SELECT itemtype FROM issuingrules
438 AND (categorycode = ? OR categorycode = ?)
442 push @bind_params, $issuing_rule->branchcode;
443 push @bind_params, $issuing_rule->categorycode;
444 push @bind_params, $cat_borrower;
446 # rule has specific item type, so count loans of that
448 if (C4::Context->preference('item-level_itypes')) {
449 $count_query .= " WHERE items.itype = ? ";
451 $count_query .= " JOIN biblioitems USING (biblionumber)
452 WHERE biblioitems.itemtype= ? ";
454 push @bind_params, $type;
457 $count_query .= " AND borrowernumber = ? ";
458 push @bind_params, $borrower->{'borrowernumber'};
459 my $rule_branch = $issuing_rule->branchcode;
460 if ($rule_branch ne "*") {
461 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
462 $count_query .= " AND issues.branchcode = ? ";
463 push @bind_params, $branch;
464 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
465 ; # if branch is the patron's home branch, then count all loans by patron
467 $count_query .= " AND items.homebranch = ? ";
468 push @bind_params, $branch;
472 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $count_query, {}, @bind_params );
474 my $max_checkouts_allowed = $issuing_rule->maxissueqty;
475 my $max_onsite_checkouts_allowed = $issuing_rule->maxonsiteissueqty;
477 if ( $onsite_checkout ) {
478 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
480 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
481 count => $onsite_checkout_count,
482 max_allowed => $max_onsite_checkouts_allowed,
486 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
487 my $delta = $switch_onsite_checkout ? 1 : 0;
488 if ( $checkout_count >= $max_checkouts_allowed + $delta ) {
490 reason => 'TOO_MANY_CHECKOUTS',
491 count => $checkout_count,
492 max_allowed => $max_checkouts_allowed,
495 } elsif ( not $onsite_checkout ) {
496 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
498 reason => 'TOO_MANY_CHECKOUTS',
499 count => $checkout_count - $onsite_checkout_count,
500 max_allowed => $max_checkouts_allowed,
506 # Now count total loans against the limit for the branch
507 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
508 if (defined($branch_borrower_circ_rule->{maxissueqty})) {
509 my @bind_params = ();
510 my $branch_count_query = q|
511 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
513 JOIN items USING (itemnumber)
514 WHERE borrowernumber = ?
516 push @bind_params, $borrower->{borrowernumber};
518 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
519 $branch_count_query .= " AND issues.branchcode = ? ";
520 push @bind_params, $branch;
521 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
522 ; # if branch is the patron's home branch, then count all loans by patron
524 $branch_count_query .= " AND items.homebranch = ? ";
525 push @bind_params, $branch;
527 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $branch_count_query, {}, @bind_params );
528 my $max_checkouts_allowed = $branch_borrower_circ_rule->{maxissueqty};
529 my $max_onsite_checkouts_allowed = $branch_borrower_circ_rule->{maxonsiteissueqty};
531 if ( $onsite_checkout ) {
532 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
534 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
535 count => $onsite_checkout_count,
536 max_allowed => $max_onsite_checkouts_allowed,
540 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
541 my $delta = $switch_onsite_checkout ? 1 : 0;
542 if ( $checkout_count >= $max_checkouts_allowed + $delta ) {
544 reason => 'TOO_MANY_CHECKOUTS',
545 count => $checkout_count,
546 max_allowed => $max_checkouts_allowed,
549 } elsif ( not $onsite_checkout ) {
550 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
552 reason => 'TOO_MANY_CHECKOUTS',
553 count => $checkout_count - $onsite_checkout_count,
554 max_allowed => $max_checkouts_allowed,
560 if ( not defined( $issuing_rule ) and not defined($branch_borrower_circ_rule->{maxissueqty}) ) {
561 return { reason => 'NO_RULE_DEFINED', max_allowed => 0 };
564 # OK, the patron can issue !!!
568 =head2 CanBookBeIssued
570 ( $issuingimpossible, $needsconfirmation, [ $alerts ] ) = CanBookBeIssued( $borrower,
571 $barcode, $duedate, $inprocess, $ignore_reserves, $params );
573 Check if a book can be issued.
575 C<$issuingimpossible> and C<$needsconfirmation> are hashrefs.
577 IMPORTANT: The assumption by users of this routine is that causes blocking
578 the issue are keyed by uppercase labels and other returned
579 data is keyed in lower case!
583 =item C<$borrower> hash with borrower informations (from Koha::Patron->unblessed)
585 =item C<$barcode> is the bar code of the book being issued.
587 =item C<$duedates> is a DateTime object.
589 =item C<$inprocess> boolean switch
591 =item C<$ignore_reserves> boolean switch
593 =item C<$params> Hashref of additional parameters
596 override_high_holds - Ignore high holds
597 onsite_checkout - Checkout is an onsite checkout that will not leave the library
605 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
606 Possible values are :
612 sticky due date is invalid
616 borrower gone with no address
620 borrower declared it's card lost
626 =head3 UNKNOWN_BARCODE
640 item is restricted (set by ??)
642 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
643 could be prevented, but ones that can be overriden by the operator.
645 Possible values are :
653 renewing, not issuing
655 =head3 ISSUED_TO_ANOTHER
657 issued to someone else.
661 reserved for someone else.
665 sticky due date is invalid or due date in the past
669 if the borrower borrows to much things
673 sub CanBookBeIssued {
674 my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves, $params ) = @_;
675 my %needsconfirmation; # filled with problems that needs confirmations
676 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
677 my %alerts; # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
678 my %messages; # filled with information messages that should be displayed.
680 my $onsite_checkout = $params->{onsite_checkout} || 0;
681 my $override_high_holds = $params->{override_high_holds} || 0;
683 my $item = GetItem(undef, $barcode );
684 my $issue = Koha::Checkouts->find( { itemnumber => $item->{itemnumber} } );
685 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
686 $item->{'itemtype'}=$item->{'itype'};
687 my $dbh = C4::Context->dbh;
689 # MANDATORY CHECKS - unless item exists, nothing else matters
690 unless ( $item->{barcode} ) {
691 $issuingimpossible{UNKNOWN_BARCODE} = 1;
693 return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
696 # DUE DATE is OK ? -- should already have checked.
698 if ($duedate && ref $duedate ne 'DateTime') {
699 $duedate = dt_from_string($duedate);
701 my $now = DateTime->now( time_zone => C4::Context->tz() );
702 unless ( $duedate ) {
703 my $issuedate = $now->clone();
705 my $branch = _GetCircControlBranch($item,$borrower);
706 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
707 $duedate = CalcDateDue( $issuedate, $itype, $branch, $borrower );
709 # Offline circ calls AddIssue directly, doesn't run through here
710 # So issuingimpossible should be ok.
713 my $today = $now->clone();
714 $today->truncate( to => 'minute');
715 if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
716 $needsconfirmation{INVALID_DATE} = output_pref($duedate);
719 $issuingimpossible{INVALID_DATE} = output_pref($duedate);
725 my $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
726 if ( $patron->category->category_type eq 'X' && ( $item->{barcode} )) {
727 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
729 branch => C4::Context->userenv->{'branch'},
731 itemnumber => $item->{'itemnumber'},
732 itemtype => $item->{'itype'},
733 borrowernumber => $borrower->{'borrowernumber'},
734 ccode => $item->{'ccode'}}
736 ModDateLastSeen( $item->{'itemnumber'} );
737 return( { STATS => 1 }, {});
740 my $flags = C4::Members::patronflags( $borrower );
742 if ( $flags->{GNA} ) {
743 $issuingimpossible{GNA} = 1;
745 if ( $flags->{'LOST'} ) {
746 $issuingimpossible{CARD_LOST} = 1;
748 if ( $flags->{'DBARRED'} ) {
749 $issuingimpossible{DEBARRED} = 1;
752 if ( !defined $borrower->{dateexpiry} || $borrower->{'dateexpiry'} eq '0000-00-00') {
753 $issuingimpossible{EXPIRED} = 1;
755 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'sql', 'floating' );
756 $expiry_dt->truncate( to => 'day');
757 my $today = $now->clone()->truncate(to => 'day');
758 $today->set_time_zone( 'floating' );
759 if ( DateTime->compare($today, $expiry_dt) == 1 ) {
760 $issuingimpossible{EXPIRED} = 1;
769 my ($balance, $non_issue_charges, $other_charges) =
770 C4::Members::GetMemberAccountBalance( $borrower->{'borrowernumber'} );
772 my $amountlimit = C4::Context->preference("noissuescharge");
773 my $allowfineoverride = C4::Context->preference("AllowFineOverride");
774 my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
776 # Check the debt of this patrons guarantees
777 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
778 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
779 if ( defined $no_issues_charge_guarantees ) {
780 my $p = Koha::Patrons->find( $borrower->{borrowernumber} );
781 my @guarantees = $p->guarantees();
782 my $guarantees_non_issues_charges;
783 foreach my $g ( @guarantees ) {
784 my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
785 $guarantees_non_issues_charges += $n;
788 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && !$allowfineoverride) {
789 $issuingimpossible{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
790 } elsif ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && $allowfineoverride) {
791 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
792 } elsif ( $allfinesneedoverride && $guarantees_non_issues_charges > 0 && $guarantees_non_issues_charges <= $no_issues_charge_guarantees && !$inprocess ) {
793 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
797 if ( C4::Context->preference("IssuingInProcess") ) {
798 if ( $non_issue_charges > $amountlimit && !$inprocess && !$allowfineoverride) {
799 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
800 } elsif ( $non_issue_charges > $amountlimit && !$inprocess && $allowfineoverride) {
801 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
802 } elsif ( $allfinesneedoverride && $non_issue_charges > 0 && $non_issue_charges <= $amountlimit && !$inprocess ) {
803 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
807 if ( $non_issue_charges > $amountlimit && $allowfineoverride ) {
808 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
809 } elsif ( $non_issue_charges > $amountlimit && !$allowfineoverride) {
810 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
811 } elsif ( $non_issue_charges > 0 && $allfinesneedoverride ) {
812 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
816 if ($balance > 0 && $other_charges > 0) {
817 $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges );
820 $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
821 if ( my $debarred_date = $patron->is_debarred ) {
822 # patron has accrued fine days or has a restriction. $count is a date
823 if ($debarred_date eq '9999-12-31') {
824 $issuingimpossible{USERBLOCKEDNOENDDATE} = $debarred_date;
827 $issuingimpossible{USERBLOCKEDWITHENDDATE} = $debarred_date;
829 } elsif ( my $num_overdues = $patron->has_overdues ) {
830 ## patron has outstanding overdue loans
831 if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
832 $issuingimpossible{USERBLOCKEDOVERDUE} = $num_overdues;
834 elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
835 $needsconfirmation{USERBLOCKEDOVERDUE} = $num_overdues;
840 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
842 if ( $issue && $issue->borrowernumber eq $borrower->{'borrowernumber'} ){
844 # Already issued to current borrower.
845 # If it is an on-site checkout if it can be switched to a normal checkout
846 # or ask whether the loan should be renewed
848 if ( $issue->onsite_checkout
849 and C4::Context->preference('SwitchOnSiteCheckouts') ) {
850 $messages{ONSITE_CHECKOUT_WILL_BE_SWITCHED} = 1;
852 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
853 $borrower->{'borrowernumber'},
854 $item->{'itemnumber'},
856 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
857 if ( $renewerror eq 'onsite_checkout' ) {
858 $issuingimpossible{NO_RENEWAL_FOR_ONSITE_CHECKOUTS} = 1;
861 $issuingimpossible{NO_MORE_RENEWALS} = 1;
865 $needsconfirmation{RENEW_ISSUE} = 1;
871 # issued to someone else
873 my $patron = Koha::Patrons->find( $issue->borrowernumber );
875 my ( $can_be_returned, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
877 unless ( $can_be_returned ) {
878 $issuingimpossible{RETURN_IMPOSSIBLE} = 1;
879 $issuingimpossible{branch_to_return} = $message;
881 $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
882 $needsconfirmation{issued_firstname} = $patron->firstname;
883 $needsconfirmation{issued_surname} = $patron->surname;
884 $needsconfirmation{issued_cardnumber} = $patron->cardnumber;
885 $needsconfirmation{issued_borrowernumber} = $patron->borrowernumber;
889 # JB34 CHECKS IF BORROWERS DON'T HAVE ISSUE TOO MANY BOOKS
891 my $switch_onsite_checkout = (
892 C4::Context->preference('SwitchOnSiteCheckouts')
894 and $issue->onsite_checkout
895 and $issue->borrowernumber == $borrower->{'borrowernumber'} ? 1 : 0 );
896 my $toomany = TooMany( $borrower, $item->{biblionumber}, $item, { onsite_checkout => $onsite_checkout, switch_onsite_checkout => $switch_onsite_checkout, } );
897 # if TooMany max_allowed returns 0 the user doesn't have permission to check out this book
898 if ( $toomany && not exists $needsconfirmation{RENEW_ISSUE} ) {
899 if ( $toomany->{max_allowed} == 0 ) {
900 $needsconfirmation{PATRON_CANT} = 1;
902 if ( C4::Context->preference("AllowTooManyOverride") ) {
903 $needsconfirmation{TOO_MANY} = $toomany->{reason};
904 $needsconfirmation{current_loan_count} = $toomany->{count};
905 $needsconfirmation{max_loans_allowed} = $toomany->{max_allowed};
907 $issuingimpossible{TOO_MANY} = $toomany->{reason};
908 $issuingimpossible{current_loan_count} = $toomany->{count};
909 $issuingimpossible{max_loans_allowed} = $toomany->{max_allowed};
914 # CHECKPREVCHECKOUT: CHECK IF ITEM HAS EVER BEEN LENT TO PATRON
916 $patron = Koha::Patrons->find($borrower->{borrowernumber});
917 my $wants_check = $patron->wants_check_for_previous_checkout;
918 $needsconfirmation{PREVISSUE} = 1
919 if ($wants_check and $patron->do_check_for_previous_checkout($item));
924 if ( $item->{'notforloan'} )
926 if(!C4::Context->preference("AllowNotForLoanOverride")){
927 $issuingimpossible{NOT_FOR_LOAN} = 1;
928 $issuingimpossible{item_notforloan} = $item->{'notforloan'};
930 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
931 $needsconfirmation{item_notforloan} = $item->{'notforloan'};
935 # we have to check itemtypes.notforloan also
936 if (C4::Context->preference('item-level_itypes')){
937 # this should probably be a subroutine
938 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
939 $sth->execute($item->{'itemtype'});
940 my $notforloan=$sth->fetchrow_hashref();
941 if ($notforloan->{'notforloan'}) {
942 if (!C4::Context->preference("AllowNotForLoanOverride")) {
943 $issuingimpossible{NOT_FOR_LOAN} = 1;
944 $issuingimpossible{itemtype_notforloan} = $item->{'itype'};
946 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
947 $needsconfirmation{itemtype_notforloan} = $item->{'itype'};
951 elsif ($biblioitem->{'notforloan'} == 1){
952 if (!C4::Context->preference("AllowNotForLoanOverride")) {
953 $issuingimpossible{NOT_FOR_LOAN} = 1;
954 $issuingimpossible{itemtype_notforloan} = $biblioitem->{'itemtype'};
956 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
957 $needsconfirmation{itemtype_notforloan} = $biblioitem->{'itemtype'};
961 if ( $item->{'withdrawn'} && $item->{'withdrawn'} > 0 )
963 $issuingimpossible{WTHDRAWN} = 1;
965 if ( $item->{'restricted'}
966 && $item->{'restricted'} == 1 )
968 $issuingimpossible{RESTRICTED} = 1;
970 if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
971 my $av = Koha::AuthorisedValues->search({ category => 'LOST', authorised_value => $item->{itemlost} });
972 my $code = $av->count ? $av->next->lib : '';
973 $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
974 $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
976 if ( C4::Context->preference("IndependentBranches") ) {
977 my $userenv = C4::Context->userenv;
978 unless ( C4::Context->IsSuperLibrarian() ) {
979 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ){
980 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
981 $issuingimpossible{'itemhomebranch'} = $item->{C4::Context->preference("HomeOrHoldingBranch")};
983 $needsconfirmation{BORRNOTSAMEBRANCH} = $borrower->{'branchcode'}
984 if ( $borrower->{'branchcode'} ne $userenv->{branch} );
988 # CHECK IF THERE IS RENTAL CHARGES. RENTAL MUST BE CONFIRMED BY THE BORROWER
990 my $rentalConfirmation = C4::Context->preference("RentalFeesCheckoutConfirmation");
992 if ( $rentalConfirmation ){
993 my ($rentalCharge) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
994 if ( $rentalCharge > 0 ){
995 $needsconfirmation{RENTALCHARGE} = $rentalCharge;
999 unless ( $ignore_reserves ) {
1000 # See if the item is on reserve.
1001 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
1003 my $resbor = $res->{'borrowernumber'};
1004 if ( $resbor ne $borrower->{'borrowernumber'} ) {
1005 my $patron = Koha::Patrons->find( $resbor );
1006 if ( $restype eq "Waiting" )
1008 # The item is on reserve and waiting, but has been
1009 # reserved by some other patron.
1010 $needsconfirmation{RESERVE_WAITING} = 1;
1011 $needsconfirmation{'resfirstname'} = $patron->firstname;
1012 $needsconfirmation{'ressurname'} = $patron->surname;
1013 $needsconfirmation{'rescardnumber'} = $patron->cardnumber;
1014 $needsconfirmation{'resborrowernumber'} = $patron->borrowernumber;
1015 $needsconfirmation{'resbranchcode'} = $res->{branchcode};
1016 $needsconfirmation{'reswaitingdate'} = $res->{'waitingdate'};
1018 elsif ( $restype eq "Reserved" ) {
1019 # The item is on reserve for someone else.
1020 $needsconfirmation{RESERVED} = 1;
1021 $needsconfirmation{'resfirstname'} = $patron->firstname;
1022 $needsconfirmation{'ressurname'} = $patron->surname;
1023 $needsconfirmation{'rescardnumber'} = $patron->cardnumber;
1024 $needsconfirmation{'resborrowernumber'} = $patron->borrowernumber;
1025 $needsconfirmation{'resbranchcode'} = $patron->branchcode;
1026 $needsconfirmation{'resreservedate'} = $res->{reservedate};
1032 ## CHECK AGE RESTRICTION
1033 my $agerestriction = $biblioitem->{'agerestriction'};
1034 my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $borrower );
1035 if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1036 if ( C4::Context->preference('AgeRestrictionOverride') ) {
1037 $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1040 $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1044 ## check for high holds decreasing loan period
1045 if ( C4::Context->preference('decreaseLoanHighHolds') ) {
1046 my $check = checkHighHolds( $item, $borrower );
1048 if ( $check->{exceeded} ) {
1049 if ($override_high_holds) {
1050 $alerts{HIGHHOLDS} = {
1051 num_holds => $check->{outstanding},
1052 duration => $check->{duration},
1053 returndate => output_pref( $check->{due_date} ),
1057 $needsconfirmation{HIGHHOLDS} = {
1058 num_holds => $check->{outstanding},
1059 duration => $check->{duration},
1060 returndate => output_pref( $check->{due_date} ),
1067 !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1068 # don't do the multiple loans per bib check if we've
1069 # already determined that we've got a loan on the same item
1070 !$issuingimpossible{NO_MORE_RENEWALS} &&
1071 !$needsconfirmation{RENEW_ISSUE}
1073 # Check if borrower has already issued an item from the same biblio
1074 # Only if it's not a subscription
1075 my $biblionumber = $item->{biblionumber};
1076 require C4::Serials;
1077 my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1078 unless ($is_a_subscription) {
1079 my $checkouts = Koha::Checkouts->search(
1081 borrowernumber => $borrower->{borrowernumber},
1082 biblionumber => $biblionumber,
1088 # if we get here, we don't already have a loan on this item,
1089 # so if there are any loans on this bib, ask for confirmation
1090 if ( $checkouts->count ) {
1091 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1096 return ( \%issuingimpossible, \%needsconfirmation, \%alerts, \%messages, );
1099 =head2 CanBookBeReturned
1101 ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1103 Check whether the item can be returned to the provided branch
1107 =item C<$item> is a hash of item information as returned from GetItem
1109 =item C<$branch> is the branchcode where the return is taking place
1117 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1119 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1125 sub CanBookBeReturned {
1126 my ($item, $branch) = @_;
1127 my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1129 # assume return is allowed to start
1133 # identify all cases where return is forbidden
1134 if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1136 $message = $item->{'homebranch'};
1137 } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1139 $message = $item->{'holdingbranch'};
1140 } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1142 $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1145 return ($allowed, $message);
1148 =head2 CheckHighHolds
1150 used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1151 decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1152 has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1156 sub checkHighHolds {
1157 my ( $item, $borrower ) = @_;
1158 my $branch = _GetCircControlBranch( $item, $borrower );
1159 my $item_object = Koha::Items->find( $item->{itemnumber} );
1168 my $holds = Koha::Holds->search( { biblionumber => $item->{'biblionumber'} } );
1170 if ( $holds->count() ) {
1171 $return_data->{outstanding} = $holds->count();
1173 my $decreaseLoanHighHoldsControl = C4::Context->preference('decreaseLoanHighHoldsControl');
1174 my $decreaseLoanHighHoldsValue = C4::Context->preference('decreaseLoanHighHoldsValue');
1175 my $decreaseLoanHighHoldsIgnoreStatuses = C4::Context->preference('decreaseLoanHighHoldsIgnoreStatuses');
1177 my @decreaseLoanHighHoldsIgnoreStatuses = split( /,/, $decreaseLoanHighHoldsIgnoreStatuses );
1179 if ( $decreaseLoanHighHoldsControl eq 'static' ) {
1181 # static means just more than a given number of holds on the record
1183 # If the number of holds is less than the threshold, we can stop here
1184 if ( $holds->count() < $decreaseLoanHighHoldsValue ) {
1185 return $return_data;
1188 elsif ( $decreaseLoanHighHoldsControl eq 'dynamic' ) {
1190 # dynamic means X more than the number of holdable items on the record
1192 # let's get the items
1193 my @items = $holds->next()->biblio()->items();
1195 # Remove any items with status defined to be ignored even if the would not make item unholdable
1196 foreach my $status (@decreaseLoanHighHoldsIgnoreStatuses) {
1197 @items = grep { !$_->$status } @items;
1200 # Remove any items that are not holdable for this patron
1201 @items = grep { CanItemBeReserved( $borrower->{borrowernumber}, $_->itemnumber ) eq 'OK' } @items;
1203 my $items_count = scalar @items;
1205 my $threshold = $items_count + $decreaseLoanHighHoldsValue;
1207 # If the number of holds is less than the count of items we have
1208 # plus the number of holds allowed above that count, we can stop here
1209 if ( $holds->count() <= $threshold ) {
1210 return $return_data;
1214 my $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1216 my $calendar = Koha::Calendar->new( branchcode => $branch );
1218 my $itype = $item_object->effective_itemtype;
1219 my $orig_due = C4::Circulation::CalcDateDue( $issuedate, $itype, $branch, $borrower );
1221 my $decreaseLoanHighHoldsDuration = C4::Context->preference('decreaseLoanHighHoldsDuration');
1223 my $reduced_datedue = $calendar->addDate( $issuedate, $decreaseLoanHighHoldsDuration );
1224 $reduced_datedue->set_hour($orig_due->hour);
1225 $reduced_datedue->set_minute($orig_due->minute);
1226 $reduced_datedue->truncate( to => 'minute' );
1228 if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1229 $return_data->{exceeded} = 1;
1230 $return_data->{duration} = $decreaseLoanHighHoldsDuration;
1231 $return_data->{due_date} = $reduced_datedue;
1235 return $return_data;
1240 &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1242 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1246 =item C<$borrower> is a hash with borrower informations (from Koha::Patron->unblessed).
1248 =item C<$barcode> is the barcode of the item being issued.
1250 =item C<$datedue> is a DateTime object for the max date of return, i.e. the date due (optional).
1251 Calculated if empty.
1253 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1255 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1256 Defaults to today. Unlike C<$datedue>, NOT a DateTime object, unfortunately.
1258 AddIssue does the following things :
1260 - step 01: check that there is a borrowernumber & a barcode provided
1261 - check for RENEWAL (book issued & being issued to the same patron)
1262 - renewal YES = Calculate Charge & renew
1264 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1266 - fill reserve if reserve to this patron
1267 - cancel reserve or not, otherwise
1268 * TRANSFERT PENDING ?
1269 - complete the transfert
1277 my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1279 my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1280 my $switch_onsite_checkout = $params && $params->{switch_onsite_checkout};
1281 my $auto_renew = $params && $params->{auto_renew};
1282 my $dbh = C4::Context->dbh;
1283 my $barcodecheck = CheckValidBarcode($barcode);
1287 if ( $datedue && ref $datedue ne 'DateTime' ) {
1288 $datedue = dt_from_string($datedue);
1291 # $issuedate defaults to today.
1292 if ( !defined $issuedate ) {
1293 $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1296 if ( ref $issuedate ne 'DateTime' ) {
1297 $issuedate = dt_from_string($issuedate);
1302 # Stop here if the patron or barcode doesn't exist
1303 if ( $borrower && $barcode && $barcodecheck ) {
1304 # find which item we issue
1305 my $item = GetItem( '', $barcode )
1306 or return; # if we don't get an Item, abort.
1307 my $item_object = Koha::Items->find( { barcode => $barcode } );
1309 my $branch = _GetCircControlBranch( $item, $borrower );
1311 # get actual issuing if there is one
1312 my $actualissue = Koha::Checkouts->find( { itemnumber => $item->{itemnumber} } );
1314 # check if we just renew the issue.
1315 if ( $actualissue and $actualissue->borrowernumber eq $borrower->{'borrowernumber'}
1316 and not $switch_onsite_checkout ) {
1317 $datedue = AddRenewal(
1318 $borrower->{'borrowernumber'},
1319 $item->{'itemnumber'},
1322 $issuedate, # here interpreted as the renewal date
1326 # it's NOT a renewal
1327 if ( $actualissue and not $switch_onsite_checkout ) {
1328 # This book is currently on loan, but not to the person
1329 # who wants to borrow it now. mark it returned before issuing to the new borrower
1330 my ( $allowed, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
1331 return unless $allowed;
1332 AddReturn( $item->{'barcode'}, C4::Context->userenv->{'branch'} );
1335 MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1337 # Starting process for transfer job (checking transfert and validate it if we have one)
1338 my ($datesent) = GetTransfers( $item->{'itemnumber'} );
1340 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1341 my $sth = $dbh->prepare(
1342 "UPDATE branchtransfers
1343 SET datearrived = now(),
1345 comments = 'Forced branchtransfer'
1346 WHERE itemnumber= ? AND datearrived IS NULL"
1348 $sth->execute( C4::Context->userenv->{'branch'},
1349 $item->{'itemnumber'} );
1352 # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1353 unless ($auto_renew) {
1354 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
1355 { categorycode => $borrower->{categorycode},
1356 itemtype => $item->{itype},
1357 branchcode => $branch
1361 $auto_renew = $issuing_rule->auto_renew if $issuing_rule;
1364 # Record in the database the fact that the book was issued.
1366 my $itype = $item_object->effective_itemtype;
1367 $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1370 $datedue->truncate( to => 'minute' );
1372 $issue = Koha::Database->new()->schema()->resultset('Issue')->update_or_create(
1374 borrowernumber => $borrower->{'borrowernumber'},
1375 itemnumber => $item->{'itemnumber'},
1376 issuedate => $issuedate->strftime('%Y-%m-%d %H:%M:%S'),
1377 date_due => $datedue->strftime('%Y-%m-%d %H:%M:%S'),
1378 branchcode => C4::Context->userenv->{'branch'},
1379 onsite_checkout => $onsite_checkout,
1380 auto_renew => $auto_renew ? 1 : 0
1384 if ( C4::Context->preference('ReturnToShelvingCart') ) {
1385 # ReturnToShelvingCart is on, anything issued should be taken off the cart.
1386 CartToShelf( $item->{'itemnumber'} );
1388 $item->{'issues'}++;
1389 if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1390 UpdateTotalIssues( $item->{'biblionumber'}, 1 );
1393 ## If item was lost, it has now been found, reverse any list item charges if necessary.
1394 if ( $item->{'itemlost'} ) {
1396 Koha::RefundLostItemFeeRules->should_refund(
1398 current_branch => C4::Context->userenv->{branch},
1399 item_home_branch => $item->{homebranch},
1400 item_holding_branch => $item->{holdingbranch}
1405 _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef,
1406 $item->{'barcode'} );
1412 issues => $item->{'issues'},
1413 holdingbranch => C4::Context->userenv->{'branch'},
1415 onloan => $datedue->ymd(),
1416 datelastborrowed => DateTime->now( time_zone => C4::Context->tz() )->ymd(),
1418 $item->{'biblionumber'},
1419 $item->{'itemnumber'}
1421 ModDateLastSeen( $item->{'itemnumber'} );
1423 # If it costs to borrow this book, charge it to the patron's account.
1424 my ( $charge, $itemtype ) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
1425 if ( $charge > 0 ) {
1426 AddIssuingCharge( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge );
1427 $item->{'charge'} = $charge;
1430 # Record the fact that this book was issued.
1433 branch => C4::Context->userenv->{'branch'},
1434 type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1436 other => ( $sipmode ? "SIP-$sipmode" : '' ),
1437 itemnumber => $item->{'itemnumber'},
1438 itemtype => $item->{'itype'},
1439 borrowernumber => $borrower->{'borrowernumber'},
1440 ccode => $item->{'ccode'}
1444 # Send a checkout slip.
1445 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1447 branchcode => $branch,
1448 categorycode => $borrower->{categorycode},
1449 item_type => $item->{itype},
1450 notification => 'CHECKOUT',
1452 if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
1453 SendCirculationAlert(
1457 borrower => $borrower,
1463 "CIRCULATION", "ISSUE",
1464 $borrower->{'borrowernumber'},
1465 $item->{'itemnumber'}
1466 ) if C4::Context->preference("IssueLog");
1472 =head2 GetLoanLength
1474 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1476 Get loan length for an itemtype, a borrower type and a branch
1481 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1482 my $dbh = C4::Context->dbh;
1483 my $sth = $dbh->prepare(qq{
1484 SELECT issuelength, lengthunit, renewalperiod
1486 WHERE categorycode=?
1489 AND issuelength IS NOT NULL
1492 # try to find issuelength & return the 1st available.
1493 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1494 $sth->execute( $borrowertype, $itemtype, $branchcode );
1495 my $loanlength = $sth->fetchrow_hashref;
1498 if defined($loanlength) && defined $loanlength->{issuelength};
1500 $sth->execute( $borrowertype, '*', $branchcode );
1501 $loanlength = $sth->fetchrow_hashref;
1503 if defined($loanlength) && defined $loanlength->{issuelength};
1505 $sth->execute( '*', $itemtype, $branchcode );
1506 $loanlength = $sth->fetchrow_hashref;
1508 if defined($loanlength) && defined $loanlength->{issuelength};
1510 $sth->execute( '*', '*', $branchcode );
1511 $loanlength = $sth->fetchrow_hashref;
1513 if defined($loanlength) && defined $loanlength->{issuelength};
1515 $sth->execute( $borrowertype, $itemtype, '*' );
1516 $loanlength = $sth->fetchrow_hashref;
1518 if defined($loanlength) && defined $loanlength->{issuelength};
1520 $sth->execute( $borrowertype, '*', '*' );
1521 $loanlength = $sth->fetchrow_hashref;
1523 if defined($loanlength) && defined $loanlength->{issuelength};
1525 $sth->execute( '*', $itemtype, '*' );
1526 $loanlength = $sth->fetchrow_hashref;
1528 if defined($loanlength) && defined $loanlength->{issuelength};
1530 $sth->execute( '*', '*', '*' );
1531 $loanlength = $sth->fetchrow_hashref;
1533 if defined($loanlength) && defined $loanlength->{issuelength};
1535 # if no rule is set => 0 day (hardcoded)
1539 lengthunit => 'days',
1545 =head2 GetHardDueDate
1547 my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1549 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1553 sub GetHardDueDate {
1554 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1556 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
1557 { categorycode => $borrowertype,
1558 itemtype => $itemtype,
1559 branchcode => $branchcode
1564 if ( defined( $issuing_rule ) ) {
1565 if ( $issuing_rule->hardduedate ) {
1566 return (dt_from_string($issuing_rule->hardduedate, 'iso'),$issuing_rule->hardduedatecompare);
1568 return (undef, undef);
1573 =head2 GetBranchBorrowerCircRule
1575 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1577 Retrieves circulation rule attributes that apply to the given
1578 branch and patron category, regardless of item type.
1579 The return value is a hashref containing the following key:
1581 maxissueqty - maximum number of loans that a
1582 patron of the given category can have at the given
1583 branch. If the value is undef, no limit.
1585 maxonsiteissueqty - maximum of on-site checkouts that a
1586 patron of the given category can have at the given
1587 branch. If the value is undef, no limit.
1589 This will first check for a specific branch and
1590 category match from branch_borrower_circ_rules.
1592 If no rule is found, it will then check default_branch_circ_rules
1593 (same branch, default category). If no rule is found,
1594 it will then check default_borrower_circ_rules (default
1595 branch, same category), then failing that, default_circ_rules
1596 (default branch, default category).
1598 If no rule has been found in the database, it will default to
1602 maxonsiteissueqty - undef
1604 C<$branchcode> and C<$categorycode> should contain the
1605 literal branch code and patron category code, respectively - no
1610 sub GetBranchBorrowerCircRule {
1611 my ( $branchcode, $categorycode ) = @_;
1614 my $dbh = C4::Context->dbh();
1615 $rules = $dbh->selectrow_hashref( q|
1616 SELECT maxissueqty, maxonsiteissueqty
1617 FROM branch_borrower_circ_rules
1618 WHERE branchcode = ?
1619 AND categorycode = ?
1620 |, {}, $branchcode, $categorycode ) ;
1621 return $rules if $rules;
1623 # try same branch, default borrower category
1624 $rules = $dbh->selectrow_hashref( q|
1625 SELECT maxissueqty, maxonsiteissueqty
1626 FROM default_branch_circ_rules
1627 WHERE branchcode = ?
1628 |, {}, $branchcode ) ;
1629 return $rules if $rules;
1631 # try default branch, same borrower category
1632 $rules = $dbh->selectrow_hashref( q|
1633 SELECT maxissueqty, maxonsiteissueqty
1634 FROM default_borrower_circ_rules
1635 WHERE categorycode = ?
1636 |, {}, $categorycode ) ;
1637 return $rules if $rules;
1639 # try default branch, default borrower category
1640 $rules = $dbh->selectrow_hashref( q|
1641 SELECT maxissueqty, maxonsiteissueqty
1642 FROM default_circ_rules
1644 return $rules if $rules;
1646 # built-in default circulation rule
1648 maxissueqty => undef,
1649 maxonsiteissueqty => undef,
1653 =head2 GetBranchItemRule
1655 my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1657 Retrieves circulation rule attributes that apply to the given
1658 branch and item type, regardless of patron category.
1660 The return value is a hashref containing the following keys:
1662 holdallowed => Hold policy for this branch and itemtype. Possible values:
1663 0: No holds allowed.
1664 1: Holds allowed only by patrons that have the same homebranch as the item.
1665 2: Holds allowed from any patron.
1667 returnbranch => branch to which to return item. Possible values:
1668 noreturn: do not return, let item remain where checked in (floating collections)
1669 homebranch: return to item's home branch
1670 holdingbranch: return to issuer branch
1672 This searches branchitemrules in the following order:
1674 * Same branchcode and itemtype
1675 * Same branchcode, itemtype '*'
1676 * branchcode '*', same itemtype
1677 * branchcode and itemtype '*'
1679 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1683 sub GetBranchItemRule {
1684 my ( $branchcode, $itemtype ) = @_;
1685 my $dbh = C4::Context->dbh();
1689 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1690 FROM branch_item_rules
1691 WHERE branchcode = ?
1692 AND itemtype = ?', $branchcode, $itemtype],
1693 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1694 FROM default_branch_circ_rules
1695 WHERE branchcode = ?', $branchcode],
1696 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1697 FROM default_branch_item_rules
1698 WHERE itemtype = ?', $itemtype],
1699 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1700 FROM default_circ_rules'],
1703 foreach my $attempt (@attempts) {
1704 my ($query, @bind_params) = @{$attempt};
1705 my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1708 # Since branch/category and branch/itemtype use the same per-branch
1709 # defaults tables, we have to check that the key we want is set, not
1710 # just that a row was returned
1711 $result->{'holdallowed'} = $search_result->{'holdallowed'} unless ( defined $result->{'holdallowed'} );
1712 $result->{'hold_fulfillment_policy'} = $search_result->{'hold_fulfillment_policy'} unless ( defined $result->{'hold_fulfillment_policy'} );
1713 $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1716 # built-in default circulation rule
1717 $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1718 $result->{'hold_fulfillment_policy'} = 'any' unless ( defined $result->{'hold_fulfillment_policy'} );
1719 $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1726 ($doreturn, $messages, $iteminformation, $borrower) =
1727 &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
1733 =item C<$barcode> is the bar code of the book being returned.
1735 =item C<$branch> is the code of the branch where the book is being returned.
1737 =item C<$exemptfine> indicates that overdue charges for the item will be
1740 =item C<$dropbox> indicates that the check-in date is assumed to be
1741 yesterday, or the last non-holiday as defined in C4::Calendar . If
1742 overdue charges are applied and C<$dropbox> is true, the last charge
1743 will be removed. This assumes that the fines accrual script has run
1744 for _today_. Optional.
1746 =item C<$return_date> allows the default return date to be overridden
1747 by the given return date. Optional.
1751 C<&AddReturn> returns a list of four items:
1753 C<$doreturn> is true iff the return succeeded.
1755 C<$messages> is a reference-to-hash giving feedback on the operation.
1756 The keys of the hash are:
1762 No item with this barcode exists. The value is C<$barcode>.
1766 The book is not currently on loan. The value is C<$barcode>.
1768 =item C<IsPermanent>
1770 The book's home branch is a permanent collection. If you have borrowed
1771 this book, you are not allowed to return it. The value is the code for
1772 the book's home branch.
1776 This book has been withdrawn/cancelled. The value should be ignored.
1778 =item C<Wrongbranch>
1780 This book has was returned to the wrong branch. The value is a hashref
1781 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1782 contain the branchcode of the incorrect and correct return library, respectively.
1786 The item was reserved. The value is a reference-to-hash whose keys are
1787 fields from the reserves table of the Koha database, and
1788 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1789 either C<Waiting>, C<Reserved>, or 0.
1791 =item C<WasReturned>
1793 Value 1 if return is successful.
1795 =item C<NeedsTransfer>
1797 If AutomaticItemReturn is disabled, return branch is given as value of NeedsTransfer.
1801 C<$iteminformation> is a reference-to-hash, giving information about the
1802 returned item from the issues table.
1804 C<$borrower> is a reference-to-hash, giving information about the
1805 patron who last borrowed the book.
1810 my ( $barcode, $branch, $exemptfine, $dropbox, $return_date, $dropboxdate ) = @_;
1812 if ($branch and not Koha::Libraries->find($branch)) {
1813 warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
1816 $branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
1820 my $validTransfert = 0;
1821 my $stat_type = 'return';
1823 # get information on item
1824 my $item = GetItem( undef, $barcode );
1826 return ( 0, { BadBarcode => $barcode } ); # no barcode means no item or borrower. bail out.
1829 my $itemnumber = $item->{ itemnumber };
1830 my $itemtype = $item->{itype}; # GetItem called effective_itemtype
1832 my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } );
1834 $patron = Koha::Patrons->find( $issue->borrowernumber )
1835 or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existent borrowernumber '" . $issue->borrowernumber . "'\n"
1836 . Dumper($issue->unblessed) . "\n";
1838 $messages->{'NotIssued'} = $barcode;
1839 # even though item is not on loan, it may still be transferred; therefore, get current branch info
1841 # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later.
1842 # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1843 if (C4::Context->preference("RecordLocalUseOnReturn")) {
1844 $messages->{'LocalUse'} = 1;
1845 $stat_type = 'localuse';
1849 if ( $item->{'location'} eq 'PROC' ) {
1850 if ( C4::Context->preference("InProcessingToShelvingCart") ) {
1851 $item->{'location'} = 'CART';
1854 $item->{location} = $item->{permanent_location};
1857 ModItem( $item, $item->{'biblionumber'}, $item->{'itemnumber'} );
1860 # full item data, but no borrowernumber or checkout info (no issue)
1861 my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1862 # get the proper branch to which to return the item
1863 my $returnbranch = $item->{$hbr} || $branch ;
1864 # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1866 my $borrowernumber = $patron ? $patron->borrowernumber : undef; # we don't know if we had a borrower or not
1867 my $patron_unblessed = $patron ? $patron->unblessed : {};
1869 my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
1871 $yaml = "$yaml\n\n"; # YAML is anal on ending \n. Surplus does not hurt
1873 eval { $rules = YAML::Load($yaml); };
1875 warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
1878 foreach my $key ( keys %$rules ) {
1879 if ( $item->{notforloan} eq $key ) {
1880 $messages->{'NotForLoanStatusUpdated'} = { from => $item->{notforloan}, to => $rules->{$key} };
1881 ModItem( { notforloan => $rules->{$key} }, undef, $itemnumber );
1889 # check if the book is in a permanent collection....
1890 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1891 if ( $returnbranch ) {
1892 my $library = Koha::Libraries->find($returnbranch);
1893 if ( $library and $library->get_categories->search({'me.categorycode' => 'PE'})->count ) {
1894 $messages->{'IsPermanent'} = $returnbranch;
1898 # check if the return is allowed at this branch
1899 my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
1900 unless ($returnallowed){
1901 $messages->{'Wrongbranch'} = {
1902 Wrongbranch => $branch,
1903 Rightbranch => $message
1906 return ( $doreturn, $messages, $issue, $patron_unblessed);
1909 if ( $item->{'withdrawn'} ) { # book has been cancelled
1910 $messages->{'withdrawn'} = 1;
1911 $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
1914 # case of a return of document (deal with issues and holdingbranch)
1915 my $today = DateTime->now( time_zone => C4::Context->tz() );
1919 die "The item is not issed and cannot be returned" unless $issue; # Just in case...
1920 $patron or warn "AddReturn without current borrower";
1921 my $circControlBranch;
1923 # define circControlBranch only if dropbox mode is set
1924 # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1925 # FIXME: check issuedate > returndate, factoring in holidays
1927 $circControlBranch = _GetCircControlBranch($item,$patron_unblessed);
1928 $is_overdue = $issue->is_overdue( $dropboxdate );
1930 $is_overdue = $issue->is_overdue;
1935 MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
1936 $circControlBranch, $return_date, $patron->privacy );
1939 if ( ( C4::Context->preference('CalculateFinesOnReturn') && $is_overdue ) || $return_date ) {
1940 _CalculateAndUpdateFine( { issue => $issue, item => $item, borrower => $patron_unblessed, return_date => $return_date } );
1943 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 );
1945 return ( 0, { WasReturned => 0, DataCorrupted => 1 }, $issue, $patron_unblessed );
1948 # FIXME is the "= 1" right? This could be the borrower hash.
1949 $messages->{'WasReturned'} = 1;
1953 ModItem({ onloan => undef }, $item->{biblionumber}, $item->{'itemnumber'});
1956 # the holdingbranch is updated if the document is returned to another location.
1957 # this is always done regardless of whether the item was on loan or not
1958 my $item_holding_branch = $item->{ holdingbranch };
1959 if ($item->{'holdingbranch'} ne $branch) {
1960 UpdateHoldingbranch($branch, $item->{'itemnumber'});
1961 $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1963 ModDateLastSeen( $item->{'itemnumber'} );
1965 # check if we have a transfer for this document
1966 my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1968 # if we have a transfer to do, we update the line of transfers with the datearrived
1969 my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->{'itemnumber'} );
1971 if ( $tobranch eq $branch ) {
1972 my $sth = C4::Context->dbh->prepare(
1973 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1975 $sth->execute( $item->{'itemnumber'} );
1976 # if we have a reservation with valid transfer, we can set it's status to 'W'
1977 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1978 C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1980 $messages->{'WrongTransfer'} = $tobranch;
1981 $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1983 $validTransfert = 1;
1985 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1988 # fix up the accounts.....
1989 if ( $item->{'itemlost'} ) {
1990 $messages->{'WasLost'} = 1;
1992 if ( $item->{'itemlost'} ) {
1994 Koha::RefundLostItemFeeRules->should_refund(
1996 current_branch => C4::Context->userenv->{branch},
1997 item_home_branch => $item->{homebranch},
1998 item_holding_branch => $item_holding_branch
2003 _FixAccountForLostAndReturned( $item->{'itemnumber'}, $borrowernumber, $barcode );
2004 $messages->{'LostItemFeeRefunded'} = 1;
2009 # fix up the overdues in accounts...
2010 if ($borrowernumber) {
2011 my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
2012 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
2014 if ( $issue and $issue->is_overdue ) {
2016 $today = $dropboxdate if $dropbox;
2017 my ($debardate,$reminder) = _debar_user_on_return( $patron_unblessed, $item, dt_from_string($issue->date_due), $today );
2019 $messages->{'PrevDebarred'} = $debardate;
2021 $messages->{'Debarred'} = $debardate if $debardate;
2023 # there's no overdue on the item but borrower had been previously debarred
2024 } elsif ( $issue->date_due and $patron->debarred ) {
2025 if ( $patron->debarred eq "9999-12-31") {
2026 $messages->{'ForeverDebarred'} = $patron->debarred;
2028 my $borrower_debar_dt = dt_from_string( $patron->debarred );
2029 $borrower_debar_dt->truncate(to => 'day');
2030 my $today_dt = $today->clone()->truncate(to => 'day');
2031 if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2032 $messages->{'PrevDebarred'} = $patron->debarred;
2038 # find reserves.....
2039 # if we don't have a reserve with the status W, we launch the Checkreserves routine
2040 my ($resfound, $resrec);
2041 my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2042 ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'}, undef, $lookahead ) unless ( $item->{'withdrawn'} );
2044 $resrec->{'ResFound'} = $resfound;
2045 $messages->{'ResFound'} = $resrec;
2048 # Record the fact that this book was returned.
2052 itemnumber => $itemnumber,
2053 itemtype => $itemtype,
2054 borrowernumber => $borrowernumber,
2055 ccode => $item->{ ccode }
2058 # Send a check-in slip. # NOTE: borrower may be undef. Do not try to send messages then.
2060 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2062 branchcode => $branch,
2063 categorycode => $patron->categorycode,
2064 item_type => $item->{itype},
2065 notification => 'CHECKIN',
2067 if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2068 SendCirculationAlert({
2071 borrower => $patron->unblessed,
2076 logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
2077 if C4::Context->preference("ReturnLog");
2080 # Remove any OVERDUES related debarment if the borrower has no overdues
2081 if ( $borrowernumber
2082 && $patron->debarred
2083 && C4::Context->preference('AutoRemoveOverduesRestrictions')
2084 && !Koha::Patrons->find( $borrowernumber )->has_overdues
2085 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2087 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2090 # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2091 if (!$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) and not $messages->{'WrongTransfer'}){
2092 if (C4::Context->preference("AutomaticItemReturn" ) or
2093 (C4::Context->preference("UseBranchTransferLimits") and
2094 ! IsBranchTransferAllowed($branch, $returnbranch, $item->{C4::Context->preference("BranchTransferLimitsType")} )
2096 $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $returnbranch;
2097 $debug and warn "item: " . Dumper($item);
2098 ModItemTransfer($item->{'itemnumber'}, $branch, $returnbranch);
2099 $messages->{'WasTransfered'} = 1;
2101 $messages->{'NeedsTransfer'} = $returnbranch;
2105 return ( $doreturn, $messages, $issue, ( $patron ? $patron->unblessed : {} ));
2108 =head2 MarkIssueReturned
2110 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
2112 Unconditionally marks an issue as being returned by
2113 moving the C<issues> row to C<old_issues> and
2114 setting C<returndate> to the current date, or
2115 the last non-holiday date of the branccode specified in
2116 C<dropbox_branch> . Assumes you've already checked that
2117 it's safe to do this, i.e. last non-holiday > issuedate.
2119 if C<$returndate> is specified (in iso format), it is used as the date
2120 of the return. It is ignored when a dropbox_branch is passed in.
2122 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2123 the old_issue is immediately anonymised
2125 Ideally, this function would be internal to C<C4::Circulation>,
2126 not exported, but it is currently needed by one
2127 routine in C<C4::Accounts>.
2131 sub MarkIssueReturned {
2132 my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
2135 # Retrieve the issue
2136 my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return;
2137 my $issue_id = $issue->issue_id;
2139 my $anonymouspatron;
2140 if ( $privacy == 2 ) {
2141 # The default of 0 will not work due to foreign key constraints
2142 # The anonymisation will fail if AnonymousPatron is not a valid entry
2143 # We need to check if the anonymous patron exist, Koha will fail loudly if it does not
2144 # Note that a warning should appear on the about page (System information tab).
2145 $anonymouspatron = C4::Context->preference('AnonymousPatron');
2146 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."
2147 unless Koha::Patrons->find( $anonymouspatron );
2149 my $database = Koha::Database->new();
2150 my $schema = $database->schema;
2151 my $dbh = C4::Context->dbh;
2153 my $query = 'UPDATE issues SET returndate=';
2155 if ($dropbox_branch) {
2156 my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
2157 my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
2159 push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2160 } elsif ($returndate) {
2162 push @bind, $returndate;
2164 $query .= ' now() ';
2166 $query .= ' WHERE issue_id = ?';
2167 push @bind, $issue_id;
2169 # FIXME Improve the return value and handle it from callers
2170 $schema->txn_do(sub {
2172 # Update the returndate
2173 $dbh->do( $query, undef, @bind );
2175 # We just updated the returndate, so we need to refetch $issue
2176 $issue->discard_changes;
2178 # Create the old_issues entry
2179 my $old_checkout = Koha::Old::Checkout->new($issue->unblessed)->store;
2181 # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2182 if ( $privacy == 2) {
2183 $dbh->do(q|UPDATE old_issues SET borrowernumber=? WHERE issue_id = ?|, undef, $anonymouspatron, $old_checkout->issue_id);
2186 # And finally delete the issue
2189 ModItem( { 'onloan' => undef }, undef, $itemnumber );
2191 if ( C4::Context->preference('StoreLastBorrower') ) {
2192 my $item = Koha::Items->find( $itemnumber );
2193 my $patron = Koha::Patrons->find( $borrowernumber );
2194 $item->last_returned_by( $patron );
2201 =head2 _debar_user_on_return
2203 _debar_user_on_return($borrower, $item, $datedue, today);
2205 C<$borrower> borrower hashref
2207 C<$item> item hashref
2209 C<$datedue> date due DateTime object
2211 C<$return_date> DateTime object representing the return time
2213 Internal function, called only by AddReturn that calculates and updates
2214 the user fine days, and debars them if necessary.
2216 Should only be called for overdue returns
2220 sub _debar_user_on_return {
2221 my ( $borrower, $item, $dt_due, $return_date ) = @_;
2223 my $branchcode = _GetCircControlBranch( $item, $borrower );
2225 my $circcontrol = C4::Context->preference('CircControl');
2226 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2227 { categorycode => $borrower->{categorycode},
2228 itemtype => $item->{itype},
2229 branchcode => $branchcode
2232 my $finedays = $issuing_rule ? $issuing_rule->finedays : undef;
2233 my $unit = $issuing_rule ? $issuing_rule->lengthunit : undef;
2234 my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $return_date, $branchcode);
2238 # finedays is in days, so hourly loans must multiply by 24
2239 # thus 1 hour late equals 1 day suspension * finedays rate
2240 $finedays = $finedays * 24 if ( $unit eq 'hours' );
2242 # grace period is measured in the same units as the loan
2244 DateTime::Duration->new( $unit => $issuing_rule->firstremind );
2246 my $deltadays = DateTime::Duration->new(
2247 days => $chargeable_units
2249 if ( $deltadays->subtract($grace)->is_positive() ) {
2250 my $suspension_days = $deltadays * $finedays;
2252 # If the max suspension days is < than the suspension days
2253 # the suspension days is limited to this maximum period.
2254 my $max_sd = $issuing_rule->maxsuspensiondays;
2255 if ( defined $max_sd ) {
2256 $max_sd = DateTime::Duration->new( days => $max_sd );
2257 $suspension_days = $max_sd
2258 if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2261 my ( $has_been_extended, $is_a_reminder );
2262 if ( C4::Context->preference('CumulativeRestrictionPeriods') and $borrower->{debarred} ) {
2263 my $debarment = @{ GetDebarments( { borrowernumber => $borrower->{borrowernumber}, type => 'SUSPENSION' } ) }[0];
2265 $return_date = dt_from_string( $debarment->{expiration}, 'sql' );
2266 $has_been_extended = 1;
2271 $return_date->clone()->add_duration( $suspension_days );
2273 Koha::Patron::Debarments::AddUniqueDebarment({
2274 borrowernumber => $borrower->{borrowernumber},
2275 expiration => $new_debar_dt->ymd(),
2276 type => 'SUSPENSION',
2278 # if borrower was already debarred but does not get an extra debarment
2279 my $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
2280 my $new_debarment_str;
2281 if ( $borrower->{debarred} eq $patron->is_debarred ) {
2283 $new_debarment_str = $borrower->{debarred};
2285 $new_debarment_str = $new_debar_dt->ymd();
2287 # FIXME Should return a DateTime object
2288 return $new_debarment_str, $is_a_reminder;
2294 =head2 _FixOverduesOnReturn
2296 &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2298 C<$brn> borrowernumber
2302 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2303 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2305 Internal function, called only by AddReturn
2309 sub _FixOverduesOnReturn {
2310 my ($borrowernumber, $item);
2311 unless ($borrowernumber = shift) {
2312 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2315 unless ($item = shift) {
2316 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2319 my ($exemptfine, $dropbox) = @_;
2320 my $dbh = C4::Context->dbh;
2322 # check for overdue fine
2323 my $accountline = Koha::Account::Lines->search(
2325 borrowernumber => $borrowernumber,
2326 itemnumber => $item,
2328 accounttype => 'FU',
2333 return 0 unless $accountline; # no warning, there's just nothing to fix
2337 my $amountoutstanding = $accountline->amountoutstanding;
2339 $accountline->accounttype('FFOR');
2340 $accountline->amountoutstanding(0);
2342 Koha::Account::Offset->new(
2344 debit_id => $accountline->id,
2346 amount => $amountoutstanding * -1,
2350 if (C4::Context->preference("FinesLog")) {
2351 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2353 } elsif ($dropbox && $accountline->lastincrement) {
2354 my $outstanding = $accountline->amountoutstanding - $accountline->lastincrement;
2355 my $amt = $accountline->amount - $accountline->lastincrement;
2357 Koha::Account::Offset->new(
2359 debit_id => $accountline->id,
2361 amount => $accountline->lastincrement * -1,
2365 if ( C4::Context->preference("FinesLog") ) {
2366 &logaction( "FINES", 'MODIFY', $borrowernumber,
2367 "Dropbox adjustment $amt, item $item" );
2370 $accountline->accounttype('F');
2372 if ( $outstanding >= 0 && $amt >= 0 ) {
2373 $accountline->amount($amt);
2374 $accountline->amountoutstanding($outstanding);
2378 $accountline->accounttype('F');
2381 return $accountline->store();
2384 =head2 _FixAccountForLostAndReturned
2386 &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2388 Calculates the charge for a book lost and returned.
2390 Internal function, not exported, called only by AddReturn.
2394 sub _FixAccountForLostAndReturned {
2395 my $itemnumber = shift or return;
2396 my $borrowernumber = @_ ? shift : undef;
2397 my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
2399 # check for charge made for lost book
2400 my $accountline = Koha::Account::Lines->search(
2402 itemnumber => $itemnumber,
2403 accounttype => { -in => [ 'L', 'Rep', 'W' ] },
2406 order_by => { -desc => [ 'date', 'accountno' ] }
2410 return unless $accountline;
2411 return if $accountline->accounttype eq 'W'; # Written off
2413 $accountline->accounttype('LR');
2414 $accountline->store();
2416 my $account = Koha::Account->new( { patron_id => $accountline->borrowernumber } );
2417 my $credit_id = $account->pay(
2419 amount => $accountline->amount,
2420 description => "Item Returned " . $item_id,
2421 account_type => 'CR',
2422 offset_type => 'Lost Item Return',
2423 accounlines => [$accountline],
2428 ModItem( { paidfor => '' }, undef, $itemnumber );
2433 =head2 _GetCircControlBranch
2435 my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2439 Return the library code to be used to determine which circulation
2440 policy applies to a transaction. Looks up the CircControl and
2441 HomeOrHoldingBranch system preferences.
2443 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2445 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2449 sub _GetCircControlBranch {
2450 my ($item, $borrower) = @_;
2451 my $circcontrol = C4::Context->preference('CircControl');
2454 if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2455 $branch= C4::Context->userenv->{'branch'};
2456 } elsif ($circcontrol eq 'PatronLibrary') {
2457 $branch=$borrower->{branchcode};
2459 my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2460 $branch = $item->{$branchfield};
2461 # default to item home branch if holdingbranch is used
2462 # and is not defined
2463 if (!defined($branch) && $branchfield eq 'holdingbranch') {
2464 $branch = $item->{homebranch};
2472 $issue = GetOpenIssue( $itemnumber );
2474 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2476 C<$itemnumber> is the item's itemnumber
2483 my ( $itemnumber ) = @_;
2484 return unless $itemnumber;
2485 my $dbh = C4::Context->dbh;
2486 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2487 $sth->execute( $itemnumber );
2488 return $sth->fetchrow_hashref();
2492 =head2 GetBiblioIssues
2494 $issues = GetBiblioIssues($biblionumber);
2496 this function get all issues from a biblionumber.
2499 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2500 tables issues and the firstname,surname & cardnumber from borrowers.
2504 sub GetBiblioIssues {
2505 my $biblionumber = shift;
2506 return unless $biblionumber;
2507 my $dbh = C4::Context->dbh;
2509 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2511 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2512 LEFT JOIN items ON issues.itemnumber = items.itemnumber
2513 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2514 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2515 WHERE biblio.biblionumber = ?
2517 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2519 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2520 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2521 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2522 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2523 WHERE biblio.biblionumber = ?
2526 my $sth = $dbh->prepare($query);
2527 $sth->execute($biblionumber, $biblionumber);
2530 while ( my $data = $sth->fetchrow_hashref ) {
2531 push @issues, $data;
2536 =head2 GetUpcomingDueIssues
2538 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2542 sub GetUpcomingDueIssues {
2545 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2546 my $dbh = C4::Context->dbh;
2548 my $statement = <<END_SQL;
2549 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2551 LEFT JOIN items USING (itemnumber)
2552 LEFT OUTER JOIN branches USING (branchcode)
2553 WHERE returndate is NULL
2554 HAVING days_until_due >= 0 AND days_until_due <= ?
2557 my @bind_parameters = ( $params->{'days_in_advance'} );
2559 my $sth = $dbh->prepare( $statement );
2560 $sth->execute( @bind_parameters );
2561 my $upcoming_dues = $sth->fetchall_arrayref({});
2563 return $upcoming_dues;
2566 =head2 CanBookBeRenewed
2568 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2570 Find out whether a borrowed item may be renewed.
2572 C<$borrowernumber> is the borrower number of the patron who currently
2573 has the item on loan.
2575 C<$itemnumber> is the number of the item to renew.
2577 C<$override_limit>, if supplied with a true value, causes
2578 the limit on the number of times that the loan can be renewed
2579 (as controlled by the item type) to be ignored. Overriding also allows
2580 to renew sooner than "No renewal before" and to manually renew loans
2581 that are automatically renewed.
2583 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2584 item must currently be on loan to the specified borrower; renewals
2585 must be allowed for the item's type; and the borrower must not have
2586 already renewed the loan. $error will contain the reason the renewal can not proceed
2590 sub CanBookBeRenewed {
2591 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2593 my $dbh = C4::Context->dbh;
2596 my $item = GetItem($itemnumber) or return ( 0, 'no_item' );
2597 my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return ( 0, 'no_checkout' );
2598 return ( 0, 'onsite_checkout' ) if $issue->onsite_checkout;
2600 $borrowernumber ||= $issue->borrowernumber;
2601 my $patron = Koha::Patrons->find( $borrowernumber )
2604 my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2606 # This item can fill one or more unfilled reserve, can those unfilled reserves
2607 # all be filled by other available items?
2609 && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2611 my $schema = Koha::Database->new()->schema();
2613 my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2615 # There is an item level hold on this item, no other item can fill the hold
2620 # Get all other items that could possibly fill reserves
2621 my @itemnumbers = $schema->resultset('Item')->search(
2623 biblionumber => $resrec->{biblionumber},
2626 -not => { itemnumber => $itemnumber }
2628 { columns => 'itemnumber' }
2629 )->get_column('itemnumber')->all();
2631 # Get all other reserves that could have been filled by this item
2632 my @borrowernumbers;
2634 my ( $reserve_found, $reserve, undef ) =
2635 C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2637 if ($reserve_found) {
2638 push( @borrowernumbers, $reserve->{borrowernumber} );
2645 # If the count of the union of the lists of reservable items for each borrower
2646 # is equal or greater than the number of borrowers, we know that all reserves
2647 # can be filled with available items. We can get the union of the sets simply
2648 # by pushing all the elements onto an array and removing the duplicates.
2651 ITEM: foreach my $i (@itemnumbers) {
2652 my $item = GetItem($i);
2653 next if IsItemOnHoldAndFound($i);
2654 for my $b (@borrowernumbers) {
2655 my $borr = $borrowers{$b} //= Koha::Patrons->find( $b )->unblessed;
2656 next unless IsAvailableForItemLevelRequest($item, $borr);
2657 next unless CanItemBeReserved($b,$i);
2659 push @reservable, $i;
2660 if (@reservable >= @borrowernumbers) {
2669 return ( 0, "on_reserve" ) if $resfound; # '' when no hold was found
2671 return ( 1, undef ) if $override_limit;
2673 my $branchcode = _GetCircControlBranch( $item, $patron->unblessed );
2674 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2675 { categorycode => $patron->categorycode,
2676 itemtype => $item->{itype},
2677 branchcode => $branchcode
2681 return ( 0, "too_many" )
2682 if not $issuing_rule or $issuing_rule->renewalsallowed <= $issue->renewals;
2684 my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2685 my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2686 $patron = Koha::Patrons->find($borrowernumber); # FIXME Is this really useful?
2687 my $restricted = $patron->is_debarred;
2688 my $hasoverdues = $patron->has_overdues;
2690 if ( $restricted and $restrictionblockrenewing ) {
2691 return ( 0, 'restriction');
2692 } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($issue->is_overdue and $overduesblockrenewing eq 'blockitem') ) {
2693 return ( 0, 'overdue');
2696 if ( $issue->auto_renew ) {
2697 if ( defined $issuing_rule->no_auto_renewal_after
2698 and $issuing_rule->no_auto_renewal_after ne "" ) {
2699 # Get issue_date and add no_auto_renewal_after
2700 # If this is greater than today, it's too late for renewal.
2701 my $maximum_renewal_date = dt_from_string($issue->issuedate, 'sql');
2702 $maximum_renewal_date->add(
2703 $issuing_rule->lengthunit => $issuing_rule->no_auto_renewal_after
2705 my $now = dt_from_string;
2706 if ( $now >= $maximum_renewal_date ) {
2707 return ( 0, "auto_too_late" );
2710 if ( defined $issuing_rule->no_auto_renewal_after_hard_limit
2711 and $issuing_rule->no_auto_renewal_after_hard_limit ne "" ) {
2712 # If no_auto_renewal_after_hard_limit is >= today, it's also too late for renewal
2713 if ( dt_from_string >= dt_from_string( $issuing_rule->no_auto_renewal_after_hard_limit ) ) {
2714 return ( 0, "auto_too_late" );
2718 if ( C4::Context->preference('OPACFineNoRenewalsBlockAutoRenew') ) {
2719 my $fine_no_renewals = C4::Context->preference("OPACFineNoRenewals");
2720 my ( $amountoutstanding ) = C4::Members::GetMemberAccountRecords($patron->borrowernumber);
2721 if ( $amountoutstanding and $amountoutstanding > $fine_no_renewals ) {
2722 return ( 0, "auto_too_much_oweing" );
2727 if ( defined $issuing_rule->norenewalbefore
2728 and $issuing_rule->norenewalbefore ne "" )
2731 # Calculate soonest renewal by subtracting 'No renewal before' from due date
2732 my $soonestrenewal = dt_from_string( $issue->date_due, 'sql' )->subtract(
2733 $issuing_rule->lengthunit => $issuing_rule->norenewalbefore );
2735 # Depending on syspref reset the exact time, only check the date
2736 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2737 and $issuing_rule->lengthunit eq 'days' )
2739 $soonestrenewal->truncate( to => 'day' );
2742 if ( $soonestrenewal > DateTime->now( time_zone => C4::Context->tz() ) )
2744 return ( 0, "auto_too_soon" ) if $issue->auto_renew;
2745 return ( 0, "too_soon" );
2747 elsif ( $issue->auto_renew ) {
2748 return ( 0, "auto_renew" );
2752 # Fallback for automatic renewals:
2753 # If norenewalbefore is undef, don't renew before due date.
2754 if ( $issue->auto_renew ) {
2755 my $now = dt_from_string;
2756 return ( 0, "auto_renew" )
2757 if $now >= dt_from_string( $issue->date_due, 'sql' );
2758 return ( 0, "auto_too_soon" );
2761 return ( 1, undef );
2766 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2770 C<$borrowernumber> is the borrower number of the patron who currently
2773 C<$itemnumber> is the number of the item to renew.
2775 C<$branch> is the library where the renewal took place (if any).
2776 The library that controls the circ policies for the renewal is retrieved from the issues record.
2778 C<$datedue> can be a DateTime object used to set the due date.
2780 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
2781 this parameter is not supplied, lastreneweddate is set to the current date.
2783 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2784 from the book's item type.
2789 my $borrowernumber = shift;
2790 my $itemnumber = shift or return;
2792 my $datedue = shift;
2793 my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2795 my $item = GetItem($itemnumber) or return;
2796 my $item_object = Koha::Items->find( $itemnumber ); # Should replace $item
2797 my $biblio = $item_object->biblio;
2799 my $dbh = C4::Context->dbh;
2801 # Find the issues record for this book
2802 my $issue = Koha::Checkouts->find( { itemnumber => $itemnumber } );
2804 return unless $issue;
2806 $borrowernumber ||= $issue->borrowernumber;
2808 if ( defined $datedue && ref $datedue ne 'DateTime' ) {
2809 carp 'Invalid date passed to AddRenewal.';
2813 my $patron = Koha::Patrons->find( $borrowernumber ) or return; # FIXME Should do more than just return
2814 my $patron_unblessed = $patron->unblessed;
2816 if ( C4::Context->preference('CalculateFinesOnReturn') && $issue->is_overdue ) {
2817 _CalculateAndUpdateFine( { issue => $issue, item => $item, borrower => $patron_unblessed } );
2819 _FixOverduesOnReturn( $borrowernumber, $itemnumber );
2821 # If the due date wasn't specified, calculate it by adding the
2822 # book's loan length to today's date or the current due date
2823 # based on the value of the RenewalPeriodBase syspref.
2826 my $itemtype = $item_object->effective_itemtype;
2827 $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2828 dt_from_string( $issue->date_due, 'sql' ) :
2829 DateTime->now( time_zone => C4::Context->tz());
2830 $datedue = CalcDateDue($datedue, $itemtype, _GetCircControlBranch($item, $patron_unblessed), $patron_unblessed, 'is a renewal');
2833 # Update the issues record to have the new due date, and a new count
2834 # of how many times it has been renewed.
2835 my $renews = $issue->renewals + 1;
2836 my $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2837 WHERE borrowernumber=?
2841 $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2843 # Update the renewal count on the item, and tell zebra to reindex
2844 $renews = $item->{renewals} + 1;
2845 ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $item->{biblionumber}, $itemnumber);
2847 # Charge a new rental fee, if applicable?
2848 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2849 if ( $charge > 0 ) {
2850 my $accountno = getnextacctno( $borrowernumber );
2852 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2853 $sth = $dbh->prepare(
2854 "INSERT INTO accountlines
2855 (date, borrowernumber, accountno, amount, manager_id,
2856 description,accounttype, amountoutstanding, itemnumber)
2857 VALUES (now(),?,?,?,?,?,?,?,?)"
2859 $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2860 "Renewal of Rental Item " . $biblio->title . " $item->{'barcode'}",
2861 'Rent', $charge, $itemnumber );
2864 # Send a renewal slip according to checkout alert preferencei
2865 if ( C4::Context->preference('RenewalSendNotice') eq '1' ) {
2866 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2868 branchcode => $branch,
2869 categorycode => $patron->categorycode,
2870 item_type => $item->{itype},
2871 notification => 'CHECKOUT',
2873 if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
2874 SendCirculationAlert(
2878 borrower => $patron->unblessed,
2885 # Remove any OVERDUES related debarment if the borrower has no overdues
2887 && $patron->is_debarred
2888 && ! $patron->has_overdues
2889 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2891 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2894 unless ( C4::Context->interface eq 'opac' ) { #if from opac we are obeying OpacRenewalBranch as calculated in opac-renew.pl
2895 $branch = C4::Context->userenv ? C4::Context->userenv->{branch} : $branch;
2898 # Add the renewal to stats
2904 itemnumber => $itemnumber,
2905 itemtype => $item->{itype},
2906 borrowernumber => $borrowernumber,
2907 ccode => $item->{'ccode'}
2912 logaction("CIRCULATION", "RENEWAL", $borrowernumber, $itemnumber) if C4::Context->preference("RenewalLog");
2917 # check renewal status
2918 my ( $bornum, $itemno ) = @_;
2919 my $dbh = C4::Context->dbh;
2921 my $renewsallowed = 0;
2924 my $patron = Koha::Patrons->find( $bornum );
2925 my $item = GetItem($itemno);
2927 return (0, 0, 0) unless $patron or $item; # Wrong call, no renewal allowed
2929 # Look in the issues table for this item, lent to this borrower,
2930 # and not yet returned.
2932 # FIXME - I think this function could be redone to use only one SQL call.
2933 my $sth = $dbh->prepare(
2934 "select * from issues
2935 where (borrowernumber = ?)
2936 and (itemnumber = ?)"
2938 $sth->execute( $bornum, $itemno );
2939 my $data = $sth->fetchrow_hashref;
2940 $renewcount = $data->{'renewals'} if $data->{'renewals'};
2941 # $item and $borrower should be calculated
2942 my $branchcode = _GetCircControlBranch($item, $patron->unblessed);
2944 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2945 { categorycode => $patron->categorycode,
2946 itemtype => $item->{itype},
2947 branchcode => $branchcode
2951 $renewsallowed = $issuing_rule ? $issuing_rule->renewalsallowed : 0;
2952 $renewsleft = $renewsallowed - $renewcount;
2953 if($renewsleft < 0){ $renewsleft = 0; }
2954 return ( $renewcount, $renewsallowed, $renewsleft );
2957 =head2 GetSoonestRenewDate
2959 $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
2961 Find out the soonest possible renew date of a borrowed item.
2963 C<$borrowernumber> is the borrower number of the patron who currently
2964 has the item on loan.
2966 C<$itemnumber> is the number of the item to renew.
2968 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
2969 renew date, based on the value "No renewal before" of the applicable
2970 issuing rule. Returns the current date if the item can already be
2971 renewed, and returns undefined if the borrower, loan, or item
2976 sub GetSoonestRenewDate {
2977 my ( $borrowernumber, $itemnumber ) = @_;
2979 my $dbh = C4::Context->dbh;
2981 my $item = GetItem($itemnumber) or return;
2982 my $itemissue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return;
2984 $borrowernumber ||= $itemissue->borrowernumber;
2985 my $patron = Koha::Patrons->find( $borrowernumber )
2988 my $branchcode = _GetCircControlBranch( $item, $patron->unblessed );
2989 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2990 { categorycode => $patron->categorycode,
2991 itemtype => $item->{itype},
2992 branchcode => $branchcode
2996 my $now = dt_from_string;
2997 return $now unless $issuing_rule;
2999 if ( defined $issuing_rule->norenewalbefore
3000 and $issuing_rule->norenewalbefore ne "" )
3002 my $soonestrenewal =
3003 dt_from_string( $itemissue->date_due )->subtract(
3004 $issuing_rule->lengthunit => $issuing_rule->norenewalbefore );
3006 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3007 and $issuing_rule->lengthunit eq 'days' )
3009 $soonestrenewal->truncate( to => 'day' );
3011 return $soonestrenewal if $now < $soonestrenewal;
3016 =head2 GetLatestAutoRenewDate
3018 $NoAutoRenewalAfterThisDate = &GetLatestAutoRenewDate($borrowernumber, $itemnumber);
3020 Find out the latest possible auto renew date of a borrowed item.
3022 C<$borrowernumber> is the borrower number of the patron who currently
3023 has the item on loan.
3025 C<$itemnumber> is the number of the item to renew.
3027 C<$GetLatestAutoRenewDate> returns the DateTime of the latest possible
3028 auto renew date, based on the value "No auto renewal after" and the "No auto
3029 renewal after (hard limit) of the applicable issuing rule.
3030 Returns undef if there is no date specify in the circ rules or if the patron, loan,
3031 or item cannot be found.
3035 sub GetLatestAutoRenewDate {
3036 my ( $borrowernumber, $itemnumber ) = @_;
3038 my $dbh = C4::Context->dbh;
3040 my $item = GetItem($itemnumber) or return;
3041 my $itemissue = Koha::Checkouts->find( { itemnumber => $itemnumber } ) or return;
3043 $borrowernumber ||= $itemissue->borrowernumber;
3044 my $patron = Koha::Patrons->find( $borrowernumber )
3047 my $branchcode = _GetCircControlBranch( $item, $patron->unblessed );
3048 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
3049 { categorycode => $patron->categorycode,
3050 itemtype => $item->{itype},
3051 branchcode => $branchcode
3055 return unless $issuing_rule;
3057 if ( not $issuing_rule->no_auto_renewal_after
3058 or $issuing_rule->no_auto_renewal_after eq '' )
3059 and ( not $issuing_rule->no_auto_renewal_after_hard_limit
3060 or $issuing_rule->no_auto_renewal_after_hard_limit eq '' );
3062 my $maximum_renewal_date;
3063 if ( $issuing_rule->no_auto_renewal_after ) {
3064 $maximum_renewal_date = dt_from_string($itemissue->issuedate);
3065 $maximum_renewal_date->add(
3066 $issuing_rule->lengthunit => $issuing_rule->no_auto_renewal_after
3070 if ( $issuing_rule->no_auto_renewal_after_hard_limit ) {
3071 my $dt = dt_from_string( $issuing_rule->no_auto_renewal_after_hard_limit );
3072 $maximum_renewal_date = $dt if not $maximum_renewal_date or $maximum_renewal_date > $dt;
3074 return $maximum_renewal_date;
3078 =head2 GetIssuingCharges
3080 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3082 Calculate how much it would cost for a given patron to borrow a given
3083 item, including any applicable discounts.
3085 C<$itemnumber> is the item number of item the patron wishes to borrow.
3087 C<$borrowernumber> is the patron's borrower number.
3089 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3090 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3095 sub GetIssuingCharges {
3097 # calculate charges due
3098 my ( $itemnumber, $borrowernumber ) = @_;
3100 my $dbh = C4::Context->dbh;
3103 # Get the book's item type and rental charge (via its biblioitem).
3104 my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3105 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3106 $charge_query .= (C4::Context->preference('item-level_itypes'))
3107 ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3108 : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3110 $charge_query .= ' WHERE items.itemnumber =?';
3112 my $sth = $dbh->prepare($charge_query);
3113 $sth->execute($itemnumber);
3114 if ( my $item_data = $sth->fetchrow_hashref ) {
3115 $item_type = $item_data->{itemtype};
3116 $charge = $item_data->{rentalcharge};
3117 my $branch = C4::Context::mybranch();
3118 my $discount_query = q|SELECT rentaldiscount,
3119 issuingrules.itemtype, issuingrules.branchcode
3121 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3122 WHERE borrowers.borrowernumber = ?
3123 AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3124 AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3125 my $discount_sth = $dbh->prepare($discount_query);
3126 $discount_sth->execute( $borrowernumber, $item_type, $branch );
3127 my $discount_rules = $discount_sth->fetchall_arrayref({});
3128 if (@{$discount_rules}) {
3129 # We may have multiple rules so get the most specific
3130 my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3131 $charge = ( $charge * ( 100 - $discount ) ) / 100;
3134 $charge = sprintf '%.2f', $charge; # ensure no fractions of a penny returned
3138 return ( $charge, $item_type );
3141 # Select most appropriate discount rule from those returned
3142 sub _get_discount_from_rule {
3143 my ($rules_ref, $branch, $itemtype) = @_;
3146 if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3147 $discount = $rules_ref->[0]->{rentaldiscount};
3148 return (defined $discount) ? $discount : 0;
3150 # could have up to 4 does one match $branch and $itemtype
3151 my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3153 $discount = $d[0]->{rentaldiscount};
3154 return (defined $discount) ? $discount : 0;
3156 # do we have item type + all branches
3157 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3159 $discount = $d[0]->{rentaldiscount};
3160 return (defined $discount) ? $discount : 0;
3162 # do we all item types + this branch
3163 @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3165 $discount = $d[0]->{rentaldiscount};
3166 return (defined $discount) ? $discount : 0;
3168 # so all and all (surely we wont get here)
3169 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3171 $discount = $d[0]->{rentaldiscount};
3172 return (defined $discount) ? $discount : 0;
3178 =head2 AddIssuingCharge
3180 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3184 sub AddIssuingCharge {
3185 my ( $itemnumber, $borrowernumber, $charge ) = @_;
3187 my $nextaccntno = getnextacctno($borrowernumber);
3190 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3192 my $accountline = Koha::Account::Line->new(
3194 borrowernumber => $borrowernumber,
3195 itemnumber => $itemnumber,
3196 accountno => $nextaccntno,
3198 amountoutstanding => $charge,
3199 manager_id => $manager_id,
3200 description => 'Rental',
3201 accounttype => 'Rent',
3206 Koha::Account::Offset->new(
3208 debit_id => $accountline->id,
3209 type => 'Rental Fee',
3217 GetTransfers($itemnumber);
3222 my ($itemnumber) = @_;
3224 my $dbh = C4::Context->dbh;
3231 FROM branchtransfers
3232 WHERE itemnumber = ?
3233 AND datearrived IS NULL
3235 my $sth = $dbh->prepare($query);
3236 $sth->execute($itemnumber);
3237 my @row = $sth->fetchrow_array();
3241 =head2 GetTransfersFromTo
3243 @results = GetTransfersFromTo($frombranch,$tobranch);
3245 Returns the list of pending transfers between $from and $to branch
3249 sub GetTransfersFromTo {
3250 my ( $frombranch, $tobranch ) = @_;
3251 return unless ( $frombranch && $tobranch );
3252 my $dbh = C4::Context->dbh;
3254 SELECT branchtransfer_id,itemnumber,datesent,frombranch
3255 FROM branchtransfers
3258 AND datearrived IS NULL
3260 my $sth = $dbh->prepare($query);
3261 $sth->execute( $frombranch, $tobranch );
3264 while ( my $data = $sth->fetchrow_hashref ) {
3265 push @gettransfers, $data;
3267 return (@gettransfers);
3270 =head2 DeleteTransfer
3272 &DeleteTransfer($itemnumber);
3276 sub DeleteTransfer {
3277 my ($itemnumber) = @_;
3278 return unless $itemnumber;
3279 my $dbh = C4::Context->dbh;
3280 my $sth = $dbh->prepare(
3281 "DELETE FROM branchtransfers
3283 AND datearrived IS NULL "
3285 return $sth->execute($itemnumber);
3288 =head2 SendCirculationAlert
3290 Send out a C<check-in> or C<checkout> alert using the messaging system.
3298 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3302 Hashref of information about the item being checked in or out.
3306 Hashref of information about the borrower of the item.
3310 The branchcode from where the checkout or check-in took place.
3316 SendCirculationAlert({
3319 borrower => $borrower,
3325 sub SendCirculationAlert {
3327 my ($type, $item, $borrower, $branch) =
3328 ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3329 my %message_name = (
3330 CHECKIN => 'Item_Check_in',
3331 CHECKOUT => 'Item_Checkout',
3332 RENEWAL => 'Item_Checkout',
3334 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3335 borrowernumber => $borrower->{borrowernumber},
3336 message_name => $message_name{$type},
3338 my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3340 my $schema = Koha::Database->new->schema;
3341 my @transports = keys %{ $borrower_preferences->{transports} };
3343 # From the MySQL doc:
3344 # LOCK TABLES is not transaction-safe and implicitly commits any active transaction before attempting to lock the tables.
3345 # If the LOCK/UNLOCK statements are executed from tests, the current transaction will be committed.
3346 # To avoid that we need to guess if this code is execute from tests or not (yes it is a bit hacky)
3347 my $do_not_lock = ( exists $ENV{_} && $ENV{_} =~ m|prove| ) || $ENV{KOHA_NO_TABLE_LOCKS};
3349 for my $mtt (@transports) {
3350 my $letter = C4::Letters::GetPreparedLetter (
3351 module => 'circulation',
3352 letter_code => $type,
3353 branchcode => $branch,
3354 message_transport_type => $mtt,
3355 lang => $borrower->{lang},
3357 $issues_table => $item->{itemnumber},
3358 'items' => $item->{itemnumber},
3359 'biblio' => $item->{biblionumber},
3360 'biblioitems' => $item->{biblionumber},
3361 'borrowers' => $borrower,
3362 'branches' => $branch,
3366 $schema->storage->txn_begin;
3367 C4::Context->dbh->do(q|LOCK TABLE message_queue READ|) unless $do_not_lock;
3368 C4::Context->dbh->do(q|LOCK TABLE message_queue WRITE|) unless $do_not_lock;
3369 my $message = C4::Message->find_last_message($borrower, $type, $mtt);
3370 unless ( $message ) {
3371 C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3372 C4::Message->enqueue($letter, $borrower, $mtt);
3374 $message->append($letter);
3377 C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
3378 $schema->storage->txn_commit;
3384 =head2 updateWrongTransfer
3386 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3388 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
3392 sub updateWrongTransfer {
3393 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3394 my $dbh = C4::Context->dbh;
3395 # first step validate the actual line of transfert .
3398 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3400 $sth->execute($FromLibrary,$itemNumber);
3402 # second step create a new line of branchtransfer to the right location .
3403 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3405 #third step changing holdingbranch of item
3406 UpdateHoldingbranch($FromLibrary,$itemNumber);
3409 =head2 UpdateHoldingbranch
3411 $items = UpdateHoldingbranch($branch,$itmenumber);
3413 Simple methode for updating hodlingbranch in items BDD line
3417 sub UpdateHoldingbranch {
3418 my ( $branch,$itemnumber ) = @_;
3419 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3424 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3426 this function calculates the due date given the start date and configured circulation rules,
3427 checking against the holidays calendar as per the 'useDaysMode' syspref.
3428 C<$startdate> = DateTime object representing start date of loan period (assumed to be today)
3429 C<$itemtype> = itemtype code of item in question
3430 C<$branch> = location whose calendar to use
3431 C<$borrower> = Borrower object
3432 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3437 my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3441 # loanlength now a href
3443 GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3445 my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3451 if (ref $startdate ne 'DateTime' ) {
3452 $datedue = dt_from_string($datedue);
3454 $datedue = $startdate->clone;
3458 DateTime->now( time_zone => C4::Context->tz() )
3459 ->truncate( to => 'minute' );
3463 # calculate the datedue as normal
3464 if ( C4::Context->preference('useDaysMode') eq 'Days' )
3465 { # ignoring calendar
3466 if ( $loanlength->{lengthunit} eq 'hours' ) {
3467 $datedue->add( hours => $loanlength->{$length_key} );
3469 $datedue->add( days => $loanlength->{$length_key} );
3470 $datedue->set_hour(23);
3471 $datedue->set_minute(59);
3475 if ($loanlength->{lengthunit} eq 'hours') {
3476 $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3479 $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3481 my $calendar = Koha::Calendar->new( branchcode => $branch );
3482 $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3483 if ($loanlength->{lengthunit} eq 'days') {
3484 $datedue->set_hour(23);
3485 $datedue->set_minute(59);
3489 # if Hard Due Dates are used, retrieve them and apply as necessary
3490 my ( $hardduedate, $hardduedatecompare ) =
3491 GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3492 if ($hardduedate) { # hardduedates are currently dates
3493 $hardduedate->truncate( to => 'minute' );
3494 $hardduedate->set_hour(23);
3495 $hardduedate->set_minute(59);
3496 my $cmp = DateTime->compare( $hardduedate, $datedue );
3498 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3499 # if the calculated date is before the 'after' Hard Due Date (floor), override
3500 # if the hard due date is set to 'exactly', overrride
3501 if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3502 $datedue = $hardduedate->clone;
3505 # in all other cases, keep the date due as it is
3509 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3510 if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3511 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3512 if( $expiry_dt ) { #skip empty expiry date..
3513 $expiry_dt->set( hour => 23, minute => 59);
3514 my $d1= $datedue->clone->set_time_zone('floating');
3515 if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3516 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3519 if ( C4::Context->preference('useDaysMode') ne 'Days' ) {
3520 my $calendar = Koha::Calendar->new( branchcode => $branch );
3521 if ( $calendar->is_holiday($datedue) ) {
3522 # Don't return on a closed day
3523 $datedue = $calendar->prev_open_day( $datedue );
3532 sub CheckValidBarcode{
3534 my $dbh = C4::Context->dbh;
3535 my $query=qq|SELECT count(*)
3539 my $sth = $dbh->prepare($query);
3540 $sth->execute($barcode);
3541 my $exist=$sth->fetchrow ;
3545 =head2 IsBranchTransferAllowed
3547 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3549 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3553 sub IsBranchTransferAllowed {
3554 my ( $toBranch, $fromBranch, $code ) = @_;
3556 if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3558 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3559 my $dbh = C4::Context->dbh;
3561 my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3562 $sth->execute( $toBranch, $fromBranch, $code );
3563 my $limit = $sth->fetchrow_hashref();
3565 ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3566 if ( $limit->{'limitId'} ) {
3573 =head2 CreateBranchTransferLimit
3575 CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3577 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3581 sub CreateBranchTransferLimit {
3582 my ( $toBranch, $fromBranch, $code ) = @_;
3583 return unless defined($toBranch) && defined($fromBranch);
3584 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3586 my $dbh = C4::Context->dbh;
3588 my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3589 return $sth->execute( $code, $toBranch, $fromBranch );
3592 =head2 DeleteBranchTransferLimits
3594 my $result = DeleteBranchTransferLimits($frombranch);
3596 Deletes all the library transfer limits for one library. Returns the
3597 number of limits deleted, 0e0 if no limits were deleted, or undef if
3598 no arguments are supplied.
3602 sub DeleteBranchTransferLimits {
3604 return unless defined $branch;
3605 my $dbh = C4::Context->dbh;
3606 my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3607 return $sth->execute($branch);
3611 my ( $borrowernumber, $itemnum ) = @_;
3613 MarkIssueReturned( $borrowernumber, $itemnum );
3614 my $patron = Koha::Patrons->find( $borrowernumber );
3615 my $item = C4::Items::GetItem( $itemnum );
3616 my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3617 my @datearr = localtime(time);
3618 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3619 my $bor = $patron->firstname . ' ' . $patron->surname . ' ' . $patron->cardnumber;
3620 ModItem({ paidfor => $old_note."Paid for by $bor $date" }, undef, $itemnum);
3625 my ($itemnumber, $mark_returned) = @_;
3627 $mark_returned //= C4::Context->preference('MarkLostItemsAsReturned');
3629 my $dbh = C4::Context->dbh();
3630 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3632 JOIN items USING (itemnumber)
3633 JOIN biblio USING (biblionumber)
3634 WHERE issues.itemnumber=?");
3635 $sth->execute($itemnumber);
3636 my $issues=$sth->fetchrow_hashref();
3638 # If a borrower lost the item, add a replacement cost to the their record
3639 if ( my $borrowernumber = $issues->{borrowernumber} ){
3640 my $patron = Koha::Patrons->find( $borrowernumber );
3642 if (C4::Context->preference('WhenLostForgiveFine')){
3643 my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3644 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!"; # zero is OK, check defined
3646 if (C4::Context->preference('WhenLostChargeReplacementFee')){
3647 C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3648 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3649 #warn " $issues->{'borrowernumber'} / $itemnumber ";
3652 MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$patron->privacy) if $mark_returned;
3656 sub GetOfflineOperations {
3657 my $dbh = C4::Context->dbh;
3658 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3659 $sth->execute(C4::Context->userenv->{'branch'});
3660 my $results = $sth->fetchall_arrayref({});
3664 sub GetOfflineOperation {
3665 my $operationid = shift;
3666 return unless $operationid;
3667 my $dbh = C4::Context->dbh;
3668 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3669 $sth->execute( $operationid );
3670 return $sth->fetchrow_hashref;
3673 sub AddOfflineOperation {
3674 my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3675 my $dbh = C4::Context->dbh;
3676 my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3677 $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3681 sub DeleteOfflineOperation {
3682 my $dbh = C4::Context->dbh;
3683 my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3684 $sth->execute( shift );
3688 sub ProcessOfflineOperation {
3689 my $operation = shift;
3692 if ( $operation->{action} eq 'return' ) {
3693 $report = ProcessOfflineReturn( $operation );
3694 } elsif ( $operation->{action} eq 'issue' ) {
3695 $report = ProcessOfflineIssue( $operation );
3696 } elsif ( $operation->{action} eq 'payment' ) {
3697 $report = ProcessOfflinePayment( $operation );
3700 DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3705 sub ProcessOfflineReturn {
3706 my $operation = shift;
3708 my $item = Koha::Items->find({barcode => $operation->{barcode}});
3711 my $itemnumber = $item->itemnumber;
3712 my $issue = GetOpenIssue( $itemnumber );
3715 $issue->{borrowernumber},
3718 $operation->{timestamp},
3721 { renewals => 0, onloan => undef },
3722 $issue->{'biblionumber'},
3727 return "Item not issued.";
3730 return "Item not found.";
3734 sub ProcessOfflineIssue {
3735 my $operation = shift;
3737 my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} } );
3740 my $item = Koha::Items->find({ barcode => $operation->{barcode} });
3742 return "Barcode not found.";
3744 my $itemnumber = $item->itemnumber;
3745 my $issue = GetOpenIssue( $itemnumber );
3747 if ( $issue and ( $issue->{borrowernumber} ne $patron->borrowernumber ) ) { # Item already issued to another patron mark it returned
3749 $issue->{borrowernumber},
3752 $operation->{timestamp},
3757 $operation->{'barcode'},
3760 $operation->{timestamp},
3765 return "Borrower not found.";
3769 sub ProcessOfflinePayment {
3770 my $operation = shift;
3772 my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} });
3773 my $amount = $operation->{amount};
3775 Koha::Account->new( { patron_id => $patron->id } )->pay( { amount => $amount } );
3783 TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3785 Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3790 my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3792 my $item = GetItem( $itemnumber, $barcode )
3795 return C4::Letters::GetPreparedLetter (
3796 module => 'circulation',
3797 letter_code => 'TRANSFERSLIP',
3798 branchcode => $branch,
3800 'branches' => $to_branch,
3801 'biblio' => $item->{biblionumber},
3807 =head2 CheckIfIssuedToPatron
3809 CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3811 Return 1 if any record item is issued to patron, otherwise return 0
3815 sub CheckIfIssuedToPatron {
3816 my ($borrowernumber, $biblionumber) = @_;
3818 my $dbh = C4::Context->dbh;
3820 SELECT COUNT(*) FROM issues
3821 LEFT JOIN items ON items.itemnumber = issues.itemnumber
3822 WHERE items.biblionumber = ?
3823 AND issues.borrowernumber = ?
3825 my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
3826 return 1 if $is_issued;
3832 IsItemIssued( $itemnumber )
3834 Return 1 if the item is on loan, otherwise return 0
3839 my $itemnumber = shift;
3840 my $dbh = C4::Context->dbh;
3841 my $sth = $dbh->prepare(q{
3844 WHERE itemnumber = ?
3846 $sth->execute($itemnumber);
3847 return $sth->fetchrow;
3850 =head2 GetAgeRestriction
3852 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3853 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3855 if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as they are older or as old as the agerestriction }
3856 if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3858 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3859 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3860 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3861 Negative days mean the borrower has gone past the age restriction age.
3865 sub GetAgeRestriction {
3866 my ($record_restrictions, $borrower) = @_;
3867 my $markers = C4::Context->preference('AgeRestrictionMarker');
3869 # Split $record_restrictions to something like FSK 16 or PEGI 6
3870 my @values = split ' ', uc($record_restrictions);
3871 return unless @values;
3873 # Search first occurrence of one of the markers
3874 my @markers = split /\|/, uc($markers);
3875 return unless @markers;
3878 my $restriction_year = 0;
3879 for my $value (@values) {
3881 for my $marker (@markers) {
3882 $marker =~ s/^\s+//; #remove leading spaces
3883 $marker =~ s/\s+$//; #remove trailing spaces
3884 if ( $marker eq $value ) {
3885 if ( $index <= $#values ) {
3886 $restriction_year += $values[$index];
3890 elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
3892 # Perhaps it is something like "K16" (as in Finland)
3893 $restriction_year += $1;
3897 last if ( $restriction_year > 0 );
3900 #Check if the borrower is age restricted for this material and for how long.
3901 if ($restriction_year && $borrower) {
3902 if ( $borrower->{'dateofbirth'} ) {
3903 my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3904 $alloweddate[0] += $restriction_year;
3906 #Prevent runime eror on leap year (invalid date)
3907 if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3908 $alloweddate[2] = 28;
3911 #Get how many days the borrower has to reach the age restriction
3912 my @Today = split /-/, DateTime->today->ymd();
3913 my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
3914 #Negative days means the borrower went past the age restriction age
3915 return ($restriction_year, $daysToAgeRestriction);
3919 return ($restriction_year);
3923 =head2 GetPendingOnSiteCheckouts
3927 sub GetPendingOnSiteCheckouts {
3928 my $dbh = C4::Context->dbh;
3929 return $dbh->selectall_arrayref(q|
3935 items.itemcallnumber,
3939 issues.date_due < NOW() AS is_overdue,
3942 borrowers.firstname,
3944 borrowers.cardnumber,
3945 borrowers.borrowernumber
3947 LEFT JOIN issues ON items.itemnumber = issues.itemnumber
3948 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
3949 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
3950 WHERE issues.onsite_checkout = 1
3951 |, { Slice => {} } );
3957 my ($count, $branch, $itemtype, $ccode, $newness)
3958 = @$params{qw(count branch itemtype ccode newness)};
3960 my $dbh = C4::Context->dbh;
3962 SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
3963 bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
3964 i.ccode, SUM(i.issues) AS count
3966 LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
3967 LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
3970 my (@where_strs, @where_args);
3973 push @where_strs, 'i.homebranch = ?';
3974 push @where_args, $branch;
3977 if (C4::Context->preference('item-level_itypes')){
3978 push @where_strs, 'i.itype = ?';
3979 push @where_args, $itemtype;
3981 push @where_strs, 'bi.itemtype = ?';
3982 push @where_args, $itemtype;
3986 push @where_strs, 'i.ccode = ?';
3987 push @where_args, $ccode;
3990 push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
3991 push @where_args, $newness;
3995 $query .= 'WHERE ' . join(' AND ', @where_strs);
3999 GROUP BY b.biblionumber
4004 $count = int($count);
4006 $query .= "LIMIT $count";
4009 my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4014 sub _CalculateAndUpdateFine {
4017 my $borrower = $params->{borrower};
4018 my $item = $params->{item};
4019 my $issue = $params->{issue};
4020 my $return_date = $params->{return_date};
4022 unless ($borrower) { carp "No borrower passed in!" && return; }
4023 unless ($item) { carp "No item passed in!" && return; }
4024 unless ($issue) { carp "No issue passed in!" && return; }
4026 my $datedue = dt_from_string( $issue->date_due );
4028 # we only need to calculate and change the fines if we want to do that on return
4029 # Should be on for hourly loans
4030 my $control = C4::Context->preference('CircControl');
4031 my $control_branchcode =
4032 ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
4033 : ( $control eq 'PatronLibrary' ) ? $borrower->{branchcode}
4034 : $issue->branchcode;
4036 my $date_returned = $return_date ? dt_from_string($return_date) : dt_from_string();
4038 my ( $amount, $type, $unitcounttotal ) =
4039 C4::Overdues::CalcFine( $item, $borrower->{categorycode}, $control_branchcode, $datedue, $date_returned );
4043 if ( C4::Context->preference('finesMode') eq 'production' ) {
4044 if ( $amount > 0 ) {
4045 C4::Overdues::UpdateFine({
4046 issue_id => $issue->issue_id,
4047 itemnumber => $issue->itemnumber,
4048 borrowernumber => $issue->borrowernumber,
4051 due => output_pref($datedue),
4054 elsif ($return_date) {
4056 # Backdated returns may have fines that shouldn't exist,
4057 # so in this case, we need to drop those fines to 0
4059 C4::Overdues::UpdateFine({
4060 issue_id => $issue->issue_id,
4061 itemnumber => $issue->itemnumber,
4062 borrowernumber => $issue->borrowernumber,
4065 due => output_pref($datedue),
4077 Koha Development Team <http://koha-community.org/>