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;
47 use Koha::IssuingRules;
50 use Koha::Patron::Debarments;
54 use Koha::RefundLostItemFeeRule;
55 use Koha::RefundLostItemFeeRules;
57 use List::MoreUtils qw( uniq );
58 use Scalar::Util qw( looks_like_number );
68 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
74 # FIXME subs that should probably be elsewhere
79 &GetPendingOnSiteCheckouts
82 # subs to deal with issuing a book
90 &GetLatestAutoRenewDate
93 &GetBranchBorrowerCircRule
97 &AnonymiseIssueHistory
98 &CheckIfIssuedToPatron
103 # subs to deal with returns
109 # subs to deal with transfers
116 &IsBranchTransferAllowed
117 &CreateBranchTransferLimit
118 &DeleteBranchTransferLimits
122 # subs to deal with offline circulation
124 &GetOfflineOperations
127 &DeleteOfflineOperation
128 &ProcessOfflineOperation
134 C4::Circulation - Koha circulation module
142 The functions in this module deal with circulation, issues, and
143 returns, as well as general information about the library.
144 Also deals with inventory.
150 $str = &barcodedecode($barcode, [$filter]);
152 Generic filter function for barcode string.
153 Called on every circ if the System Pref itemBarcodeInputFilter is set.
154 Will do some manipulation of the barcode for systems that deliver a barcode
155 to circulation.pl that differs from the barcode stored for the item.
156 For proper functioning of this filter, calling the function on the
157 correct barcode string (items.barcode) should return an unaltered barcode.
159 The optional $filter argument is to allow for testing or explicit
160 behavior that ignores the System Pref. Valid values are the same as the
165 # FIXME -- the &decode fcn below should be wrapped into this one.
166 # FIXME -- these plugins should be moved out of Circulation.pm
169 my ($barcode, $filter) = @_;
170 my $branch = C4::Context::mybranch();
171 $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
172 $filter or return $barcode; # ensure filter is defined, else return untouched barcode
173 if ($filter eq 'whitespace') {
175 } elsif ($filter eq 'cuecat') {
177 my @fields = split( /\./, $barcode );
178 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
179 ($#results == 2) and return $results[2];
180 } elsif ($filter eq 'T-prefix') {
181 if ($barcode =~ /^[Tt](\d)/) {
182 (defined($1) and $1 eq '0') and return $barcode;
183 $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1)
185 return sprintf("T%07d", $barcode);
186 # FIXME: $barcode could be "T1", causing warning: substr outside of string
187 # Why drop the nonzero digit after the T?
188 # Why pass non-digits (or empty string) to "T%07d"?
189 } elsif ($filter eq 'libsuite8') {
190 unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it.
191 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
192 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
194 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
197 } elsif ($filter eq 'EAN13') {
198 my $ean = CheckDigits('ean');
199 if ( $ean->is_valid($barcode) ) {
200 #$barcode = sprintf('%013d',$barcode); # this doesn't work on 32-bit systems
201 $barcode = '0' x ( 13 - length($barcode) ) . $barcode;
203 warn "# [$barcode] not valid EAN-13/UPC-A\n";
206 return $barcode; # return barcode, modified or not
211 $str = &decode($chunk);
213 Decodes a segment of a string emitted by a CueCat barcode scanner and
216 FIXME: Should be replaced with Barcode::Cuecat from CPAN
217 or Javascript based decoding on the client side.
224 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
225 my @s = map { index( $seq, $_ ); } split( //, $encoded );
226 my $l = ( $#s + 1 ) % 4;
229 # warn "Error: Cuecat decode parsing failed!";
237 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
239 chr( ( $n >> 16 ) ^ 67 )
240 .chr( ( $n >> 8 & 255 ) ^ 67 )
241 .chr( ( $n & 255 ) ^ 67 );
244 $r = substr( $r, 0, length($r) - $l );
250 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
251 $barcode, $ignore_reserves);
253 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
255 C<$newbranch> is the code for the branch to which the item should be transferred.
257 C<$barcode> is the barcode of the item to be transferred.
259 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
260 Otherwise, if an item is reserved, the transfer fails.
262 Returns three values:
268 is true if the transfer was successful.
272 is a reference-to-hash which may have any of the following keys:
278 There is no item in the catalog with the given barcode. The value is C<$barcode>.
282 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.
284 =item C<DestinationEqualsHolding>
286 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.
290 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.
294 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>.
296 =item C<WasTransferred>
298 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
307 my ( $tbr, $barcode, $ignoreRs ) = @_;
310 my $itemnumber = GetItemnumberFromBarcode( $barcode );
311 my $issue = GetItemIssue($itemnumber);
312 my $biblio = GetBiblioFromItemNumber($itemnumber);
315 if ( not $itemnumber ) {
316 $messages->{'BadBarcode'} = $barcode;
320 # get branches of book...
321 my $hbr = $biblio->{'homebranch'};
322 my $fbr = $biblio->{'holdingbranch'};
324 # if using Branch Transfer Limits
325 if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
326 if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
327 if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
328 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
331 } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
332 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
338 # FIXME Is this still used by someone?
339 # See other FIXME in AddReturn
340 my $library = Koha::Libraries->find($hbr);
341 if ( $library and $library->get_categories->search({'me.categorycode' => 'PE'})->count ) {
342 $messages->{'IsPermanent'} = $hbr;
346 # can't transfer book if is already there....
347 if ( $fbr eq $tbr ) {
348 $messages->{'DestinationEqualsHolding'} = 1;
352 # check if it is still issued to someone, return it...
353 if ($issue->{borrowernumber}) {
354 AddReturn( $barcode, $fbr );
355 $messages->{'WasReturned'} = $issue->{borrowernumber};
359 # That'll save a database query.
360 my ( $resfound, $resrec, undef ) =
361 CheckReserves( $itemnumber );
362 if ( $resfound and not $ignoreRs ) {
363 $resrec->{'ResFound'} = $resfound;
365 # $messages->{'ResFound'} = $resrec;
369 #actually do the transfer....
371 ModItemTransfer( $itemnumber, $fbr, $tbr );
373 # don't need to update MARC anymore, we do it in batch now
374 $messages->{'WasTransfered'} = 1;
377 ModDateLastSeen( $itemnumber );
378 return ( $dotransfer, $messages, $biblio );
383 my $borrower = shift;
384 my $biblionumber = shift;
387 my $onsite_checkout = $params->{onsite_checkout} || 0;
388 my $switch_onsite_checkout = $params->{switch_onsite_checkout} || 0;
389 my $cat_borrower = $borrower->{'categorycode'};
390 my $dbh = C4::Context->dbh;
392 # Get which branchcode we need
393 $branch = _GetCircControlBranch($item,$borrower);
394 my $type = (C4::Context->preference('item-level_itypes'))
395 ? $item->{'itype'} # item-level
396 : $item->{'itemtype'}; # biblio-level
398 # given branch, patron category, and item type, determine
399 # applicable issuing rule
400 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
401 { categorycode => $cat_borrower,
403 branchcode => $branch
408 # if a rule is found and has a loan limit set, count
409 # how many loans the patron already has that meet that
411 if (defined($issuing_rule) and defined($issuing_rule->maxissueqty)) {
414 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
416 JOIN items USING (itemnumber)
419 my $rule_itemtype = $issuing_rule->itemtype;
420 if ($rule_itemtype eq "*") {
421 # matching rule has the default item type, so count only
422 # those existing loans that don't fall under a more
424 if (C4::Context->preference('item-level_itypes')) {
425 $count_query .= " WHERE items.itype NOT IN (
426 SELECT itemtype FROM issuingrules
428 AND (categorycode = ? OR categorycode = ?)
432 $count_query .= " JOIN biblioitems USING (biblionumber)
433 WHERE biblioitems.itemtype NOT IN (
434 SELECT itemtype FROM issuingrules
436 AND (categorycode = ? OR categorycode = ?)
440 push @bind_params, $issuing_rule->branchcode;
441 push @bind_params, $issuing_rule->categorycode;
442 push @bind_params, $cat_borrower;
444 # rule has specific item type, so count loans of that
446 if (C4::Context->preference('item-level_itypes')) {
447 $count_query .= " WHERE items.itype = ? ";
449 $count_query .= " JOIN biblioitems USING (biblionumber)
450 WHERE biblioitems.itemtype= ? ";
452 push @bind_params, $type;
455 $count_query .= " AND borrowernumber = ? ";
456 push @bind_params, $borrower->{'borrowernumber'};
457 my $rule_branch = $issuing_rule->branchcode;
458 if ($rule_branch ne "*") {
459 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
460 $count_query .= " AND issues.branchcode = ? ";
461 push @bind_params, $branch;
462 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
463 ; # if branch is the patron's home branch, then count all loans by patron
465 $count_query .= " AND items.homebranch = ? ";
466 push @bind_params, $branch;
470 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $count_query, {}, @bind_params );
472 my $max_checkouts_allowed = $issuing_rule->maxissueqty;
473 my $max_onsite_checkouts_allowed = $issuing_rule->maxonsiteissueqty;
475 if ( $onsite_checkout ) {
476 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
478 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
479 count => $onsite_checkout_count,
480 max_allowed => $max_onsite_checkouts_allowed,
484 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
485 my $delta = $switch_onsite_checkout ? 1 : 0;
486 if ( $checkout_count >= $max_checkouts_allowed + $delta ) {
488 reason => 'TOO_MANY_CHECKOUTS',
489 count => $checkout_count,
490 max_allowed => $max_checkouts_allowed,
493 } elsif ( not $onsite_checkout ) {
494 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
496 reason => 'TOO_MANY_CHECKOUTS',
497 count => $checkout_count - $onsite_checkout_count,
498 max_allowed => $max_checkouts_allowed,
504 # Now count total loans against the limit for the branch
505 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
506 if (defined($branch_borrower_circ_rule->{maxissueqty})) {
507 my @bind_params = ();
508 my $branch_count_query = q|
509 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
511 JOIN items USING (itemnumber)
512 WHERE borrowernumber = ?
514 push @bind_params, $borrower->{borrowernumber};
516 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
517 $branch_count_query .= " AND issues.branchcode = ? ";
518 push @bind_params, $branch;
519 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
520 ; # if branch is the patron's home branch, then count all loans by patron
522 $branch_count_query .= " AND items.homebranch = ? ";
523 push @bind_params, $branch;
525 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $branch_count_query, {}, @bind_params );
526 my $max_checkouts_allowed = $branch_borrower_circ_rule->{maxissueqty};
527 my $max_onsite_checkouts_allowed = $branch_borrower_circ_rule->{maxonsiteissueqty};
529 if ( $onsite_checkout ) {
530 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
532 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
533 count => $onsite_checkout_count,
534 max_allowed => $max_onsite_checkouts_allowed,
538 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
539 my $delta = $switch_onsite_checkout ? 1 : 0;
540 if ( $checkout_count >= $max_checkouts_allowed + $delta ) {
542 reason => 'TOO_MANY_CHECKOUTS',
543 count => $checkout_count,
544 max_allowed => $max_checkouts_allowed,
547 } elsif ( not $onsite_checkout ) {
548 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
550 reason => 'TOO_MANY_CHECKOUTS',
551 count => $checkout_count - $onsite_checkout_count,
552 max_allowed => $max_checkouts_allowed,
558 if ( not defined( $issuing_rule ) and not defined($branch_borrower_circ_rule->{maxissueqty}) ) {
559 return { reason => 'NO_RULE_DEFINED', max_allowed => 0 };
562 # OK, the patron can issue !!!
566 =head2 CanBookBeIssued
568 ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower,
569 $barcode, $duedate, $inprocess, $ignore_reserves, $params );
571 Check if a book can be issued.
573 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
577 =item C<$borrower> hash with borrower informations (from GetMember)
579 =item C<$barcode> is the bar code of the book being issued.
581 =item C<$duedates> is a DateTime object.
583 =item C<$inprocess> boolean switch
585 =item C<$ignore_reserves> boolean switch
587 =item C<$params> Hashref of additional parameters
590 override_high_holds - Ignore high holds
591 onsite_checkout - Checkout is an onsite checkout that will not leave the library
599 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
600 Possible values are :
606 sticky due date is invalid
610 borrower gone with no address
614 borrower declared it's card lost
620 =head3 UNKNOWN_BARCODE
634 item is restricted (set by ??)
636 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
637 could be prevented, but ones that can be overriden by the operator.
639 Possible values are :
647 renewing, not issuing
649 =head3 ISSUED_TO_ANOTHER
651 issued to someone else.
655 reserved for someone else.
659 sticky due date is invalid or due date in the past
663 if the borrower borrows to much things
667 sub CanBookBeIssued {
668 my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves, $params ) = @_;
669 my %needsconfirmation; # filled with problems that needs confirmations
670 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
671 my %alerts; # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
672 my %messages; # filled with information messages that should be displayed.
674 my $onsite_checkout = $params->{onsite_checkout} || 0;
675 my $override_high_holds = $params->{override_high_holds} || 0;
677 my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
678 my $issue = GetItemIssue($item->{itemnumber});
679 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
680 $item->{'itemtype'}=$item->{'itype'};
681 my $dbh = C4::Context->dbh;
683 # MANDATORY CHECKS - unless item exists, nothing else matters
684 unless ( $item->{barcode} ) {
685 $issuingimpossible{UNKNOWN_BARCODE} = 1;
687 return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
690 # DUE DATE is OK ? -- should already have checked.
692 if ($duedate && ref $duedate ne 'DateTime') {
693 $duedate = dt_from_string($duedate);
695 my $now = DateTime->now( time_zone => C4::Context->tz() );
696 unless ( $duedate ) {
697 my $issuedate = $now->clone();
699 my $branch = _GetCircControlBranch($item,$borrower);
700 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
701 $duedate = CalcDateDue( $issuedate, $itype, $branch, $borrower );
703 # Offline circ calls AddIssue directly, doesn't run through here
704 # So issuingimpossible should be ok.
707 my $today = $now->clone();
708 $today->truncate( to => 'minute');
709 if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
710 $needsconfirmation{INVALID_DATE} = output_pref($duedate);
713 $issuingimpossible{INVALID_DATE} = output_pref($duedate);
719 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
720 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
722 branch => C4::Context->userenv->{'branch'},
724 itemnumber => $item->{'itemnumber'},
725 itemtype => $item->{'itype'},
726 borrowernumber => $borrower->{'borrowernumber'},
727 ccode => $item->{'ccode'}}
729 ModDateLastSeen( $item->{'itemnumber'} );
730 return( { STATS => 1 }, {});
733 my $flags = C4::Members::patronflags( $borrower );
735 if ( $flags->{GNA} ) {
736 $issuingimpossible{GNA} = 1;
738 if ( $flags->{'LOST'} ) {
739 $issuingimpossible{CARD_LOST} = 1;
741 if ( $flags->{'DBARRED'} ) {
742 $issuingimpossible{DEBARRED} = 1;
745 if ( !defined $borrower->{dateexpiry} || $borrower->{'dateexpiry'} eq '0000-00-00') {
746 $issuingimpossible{EXPIRED} = 1;
748 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'sql', 'floating' );
749 $expiry_dt->truncate( to => 'day');
750 my $today = $now->clone()->truncate(to => 'day');
751 $today->set_time_zone( 'floating' );
752 if ( DateTime->compare($today, $expiry_dt) == 1 ) {
753 $issuingimpossible{EXPIRED} = 1;
762 my ($balance, $non_issue_charges, $other_charges) =
763 C4::Members::GetMemberAccountBalance( $borrower->{'borrowernumber'} );
765 my $amountlimit = C4::Context->preference("noissuescharge");
766 my $allowfineoverride = C4::Context->preference("AllowFineOverride");
767 my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
769 # Check the debt of this patrons guarantees
770 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
771 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
772 if ( defined $no_issues_charge_guarantees ) {
773 my $p = Koha::Patrons->find( $borrower->{borrowernumber} );
774 my @guarantees = $p->guarantees();
775 my $guarantees_non_issues_charges;
776 foreach my $g ( @guarantees ) {
777 my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
778 $guarantees_non_issues_charges += $n;
781 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && !$allowfineoverride) {
782 $issuingimpossible{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
783 } elsif ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && $allowfineoverride) {
784 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
785 } elsif ( $allfinesneedoverride && $guarantees_non_issues_charges > 0 && $guarantees_non_issues_charges <= $no_issues_charge_guarantees && !$inprocess ) {
786 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
790 if ( C4::Context->preference("IssuingInProcess") ) {
791 if ( $non_issue_charges > $amountlimit && !$inprocess && !$allowfineoverride) {
792 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
793 } elsif ( $non_issue_charges > $amountlimit && !$inprocess && $allowfineoverride) {
794 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
795 } elsif ( $allfinesneedoverride && $non_issue_charges > 0 && $non_issue_charges <= $amountlimit && !$inprocess ) {
796 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
800 if ( $non_issue_charges > $amountlimit && $allowfineoverride ) {
801 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
802 } elsif ( $non_issue_charges > $amountlimit && !$allowfineoverride) {
803 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
804 } elsif ( $non_issue_charges > 0 && $allfinesneedoverride ) {
805 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
809 if ($balance > 0 && $other_charges > 0) {
810 $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges );
813 my $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
814 if ( my $debarred_date = $patron->is_debarred ) {
815 # patron has accrued fine days or has a restriction. $count is a date
816 if ($debarred_date eq '9999-12-31') {
817 $issuingimpossible{USERBLOCKEDNOENDDATE} = $debarred_date;
820 $issuingimpossible{USERBLOCKEDWITHENDDATE} = $debarred_date;
822 } elsif ( my $num_overdues = $patron->has_overdues ) {
823 ## patron has outstanding overdue loans
824 if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
825 $issuingimpossible{USERBLOCKEDOVERDUE} = $num_overdues;
827 elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
828 $needsconfirmation{USERBLOCKEDOVERDUE} = $num_overdues;
832 # JB34 CHECKS IF BORROWERS DON'T HAVE ISSUE TOO MANY BOOKS
834 my $switch_onsite_checkout =
835 C4::Context->preference('SwitchOnSiteCheckouts')
836 and $issue->{onsite_checkout}
838 and $issue->{borrowernumber} == $borrower->{'borrowernumber'} ? 1 : 0;
839 my $toomany = TooMany( $borrower, $item->{biblionumber}, $item, { onsite_checkout => $onsite_checkout, switch_onsite_checkout => $switch_onsite_checkout, } );
840 # if TooMany max_allowed returns 0 the user doesn't have permission to check out this book
842 if ( $toomany->{max_allowed} == 0 ) {
843 $needsconfirmation{PATRON_CANT} = 1;
845 if ( C4::Context->preference("AllowTooManyOverride") ) {
846 $needsconfirmation{TOO_MANY} = $toomany->{reason};
847 $needsconfirmation{current_loan_count} = $toomany->{count};
848 $needsconfirmation{max_loans_allowed} = $toomany->{max_allowed};
850 $issuingimpossible{TOO_MANY} = $toomany->{reason};
851 $issuingimpossible{current_loan_count} = $toomany->{count};
852 $issuingimpossible{max_loans_allowed} = $toomany->{max_allowed};
857 # CHECKPREVCHECKOUT: CHECK IF ITEM HAS EVER BEEN LENT TO PATRON
859 $patron = Koha::Patrons->find($borrower->{borrowernumber});
860 my $wants_check = $patron->wants_check_for_previous_checkout;
861 $needsconfirmation{PREVISSUE} = 1
862 if ($wants_check and $patron->do_check_for_previous_checkout($item));
867 if ( $item->{'notforloan'} )
869 if(!C4::Context->preference("AllowNotForLoanOverride")){
870 $issuingimpossible{NOT_FOR_LOAN} = 1;
871 $issuingimpossible{item_notforloan} = $item->{'notforloan'};
873 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
874 $needsconfirmation{item_notforloan} = $item->{'notforloan'};
878 # we have to check itemtypes.notforloan also
879 if (C4::Context->preference('item-level_itypes')){
880 # this should probably be a subroutine
881 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
882 $sth->execute($item->{'itemtype'});
883 my $notforloan=$sth->fetchrow_hashref();
884 if ($notforloan->{'notforloan'}) {
885 if (!C4::Context->preference("AllowNotForLoanOverride")) {
886 $issuingimpossible{NOT_FOR_LOAN} = 1;
887 $issuingimpossible{itemtype_notforloan} = $item->{'itype'};
889 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
890 $needsconfirmation{itemtype_notforloan} = $item->{'itype'};
894 elsif ($biblioitem->{'notforloan'} == 1){
895 if (!C4::Context->preference("AllowNotForLoanOverride")) {
896 $issuingimpossible{NOT_FOR_LOAN} = 1;
897 $issuingimpossible{itemtype_notforloan} = $biblioitem->{'itemtype'};
899 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
900 $needsconfirmation{itemtype_notforloan} = $biblioitem->{'itemtype'};
904 if ( $item->{'withdrawn'} && $item->{'withdrawn'} > 0 )
906 $issuingimpossible{WTHDRAWN} = 1;
908 if ( $item->{'restricted'}
909 && $item->{'restricted'} == 1 )
911 $issuingimpossible{RESTRICTED} = 1;
913 if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
914 my $av = Koha::AuthorisedValues->search({ category => 'LOST', authorised_value => $item->{itemlost} });
915 my $code = $av->count ? $av->next->lib : '';
916 $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
917 $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
919 if ( C4::Context->preference("IndependentBranches") ) {
920 my $userenv = C4::Context->userenv;
921 unless ( C4::Context->IsSuperLibrarian() ) {
922 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ){
923 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
924 $issuingimpossible{'itemhomebranch'} = $item->{C4::Context->preference("HomeOrHoldingBranch")};
926 $needsconfirmation{BORRNOTSAMEBRANCH} = $borrower->{'branchcode'}
927 if ( $borrower->{'branchcode'} ne $userenv->{branch} );
931 # CHECK IF THERE IS RENTAL CHARGES. RENTAL MUST BE CONFIRMED BY THE BORROWER
933 my $rentalConfirmation = C4::Context->preference("RentalFeesCheckoutConfirmation");
935 if ( $rentalConfirmation ){
936 my ($rentalCharge) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
937 if ( $rentalCharge > 0 ){
938 $rentalCharge = sprintf("%.02f", $rentalCharge);
939 $needsconfirmation{RENTALCHARGE} = $rentalCharge;
944 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
946 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} ){
948 # Already issued to current borrower.
949 # If it is an on-site checkout if it can be switched to a normal checkout
950 # or ask whether the loan should be renewed
952 if ( $issue->{onsite_checkout}
953 and C4::Context->preference('SwitchOnSiteCheckouts') ) {
954 $messages{ONSITE_CHECKOUT_WILL_BE_SWITCHED} = 1;
956 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
957 $borrower->{'borrowernumber'},
958 $item->{'itemnumber'},
960 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
961 if ( $renewerror eq 'onsite_checkout' ) {
962 $issuingimpossible{NO_RENEWAL_FOR_ONSITE_CHECKOUTS} = 1;
965 $issuingimpossible{NO_MORE_RENEWALS} = 1;
969 $needsconfirmation{RENEW_ISSUE} = 1;
973 elsif ($issue->{borrowernumber}) {
975 # issued to someone else
976 my $currborinfo = C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} );
979 my ( $can_be_returned, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
981 unless ( $can_be_returned ) {
982 $issuingimpossible{RETURN_IMPOSSIBLE} = 1;
983 $issuingimpossible{branch_to_return} = $message;
985 $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
986 $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
987 $needsconfirmation{issued_surname} = $currborinfo->{'surname'};
988 $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
989 $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
993 unless ( $ignore_reserves ) {
994 # See if the item is on reserve.
995 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
997 my $resbor = $res->{'borrowernumber'};
998 if ( $resbor ne $borrower->{'borrowernumber'} ) {
999 my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor );
1000 if ( $restype eq "Waiting" )
1002 # The item is on reserve and waiting, but has been
1003 # reserved by some other patron.
1004 $needsconfirmation{RESERVE_WAITING} = 1;
1005 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
1006 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
1007 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
1008 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
1009 $needsconfirmation{'resbranchcode'} = $res->{branchcode};
1010 $needsconfirmation{'reswaitingdate'} = $res->{'waitingdate'};
1012 elsif ( $restype eq "Reserved" ) {
1013 # The item is on reserve for someone else.
1014 $needsconfirmation{RESERVED} = 1;
1015 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
1016 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
1017 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
1018 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
1019 $needsconfirmation{'resbranchcode'} = $res->{branchcode};
1020 $needsconfirmation{'resreservedate'} = $res->{'reservedate'};
1026 ## CHECK AGE RESTRICTION
1027 my $agerestriction = $biblioitem->{'agerestriction'};
1028 my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $borrower );
1029 if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1030 if ( C4::Context->preference('AgeRestrictionOverride') ) {
1031 $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1034 $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1038 ## check for high holds decreasing loan period
1039 if ( C4::Context->preference('decreaseLoanHighHolds') ) {
1040 my $check = checkHighHolds( $item, $borrower );
1042 if ( $check->{exceeded} ) {
1043 if ($override_high_holds) {
1044 $alerts{HIGHHOLDS} = {
1045 num_holds => $check->{outstanding},
1046 duration => $check->{duration},
1047 returndate => output_pref( $check->{due_date} ),
1051 $needsconfirmation{HIGHHOLDS} = {
1052 num_holds => $check->{outstanding},
1053 duration => $check->{duration},
1054 returndate => output_pref( $check->{due_date} ),
1061 !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1062 # don't do the multiple loans per bib check if we've
1063 # already determined that we've got a loan on the same item
1064 !$issuingimpossible{NO_MORE_RENEWALS} &&
1065 !$needsconfirmation{RENEW_ISSUE}
1067 # Check if borrower has already issued an item from the same biblio
1068 # Only if it's not a subscription
1069 my $biblionumber = $item->{biblionumber};
1070 require C4::Serials;
1071 my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1072 unless ($is_a_subscription) {
1073 my $checkouts = Koha::Checkouts->search(
1075 borrowernumber => $borrower->{borrowernumber},
1076 biblionumber => $biblionumber,
1082 # if we get here, we don't already have a loan on this item,
1083 # so if there are any loans on this bib, ask for confirmation
1084 if ( $checkouts->count ) {
1085 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1090 return ( \%issuingimpossible, \%needsconfirmation, \%alerts, \%messages, );
1093 =head2 CanBookBeReturned
1095 ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1097 Check whether the item can be returned to the provided branch
1101 =item C<$item> is a hash of item information as returned from GetItem
1103 =item C<$branch> is the branchcode where the return is taking place
1111 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1113 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1119 sub CanBookBeReturned {
1120 my ($item, $branch) = @_;
1121 my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1123 # assume return is allowed to start
1127 # identify all cases where return is forbidden
1128 if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1130 $message = $item->{'homebranch'};
1131 } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1133 $message = $item->{'holdingbranch'};
1134 } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1136 $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1139 return ($allowed, $message);
1142 =head2 CheckHighHolds
1144 used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1145 decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1146 has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1150 sub checkHighHolds {
1151 my ( $item, $borrower ) = @_;
1152 my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1153 my $branch = _GetCircControlBranch( $item, $borrower );
1162 my $holds = Koha::Holds->search( { biblionumber => $item->{'biblionumber'} } );
1164 if ( $holds->count() ) {
1165 $return_data->{outstanding} = $holds->count();
1167 my $decreaseLoanHighHoldsControl = C4::Context->preference('decreaseLoanHighHoldsControl');
1168 my $decreaseLoanHighHoldsValue = C4::Context->preference('decreaseLoanHighHoldsValue');
1169 my $decreaseLoanHighHoldsIgnoreStatuses = C4::Context->preference('decreaseLoanHighHoldsIgnoreStatuses');
1171 my @decreaseLoanHighHoldsIgnoreStatuses = split( /,/, $decreaseLoanHighHoldsIgnoreStatuses );
1173 if ( $decreaseLoanHighHoldsControl eq 'static' ) {
1175 # static means just more than a given number of holds on the record
1177 # If the number of holds is less than the threshold, we can stop here
1178 if ( $holds->count() < $decreaseLoanHighHoldsValue ) {
1179 return $return_data;
1182 elsif ( $decreaseLoanHighHoldsControl eq 'dynamic' ) {
1184 # dynamic means X more than the number of holdable items on the record
1186 # let's get the items
1187 my @items = $holds->next()->biblio()->items();
1189 # Remove any items with status defined to be ignored even if the would not make item unholdable
1190 foreach my $status (@decreaseLoanHighHoldsIgnoreStatuses) {
1191 @items = grep { !$_->$status } @items;
1194 # Remove any items that are not holdable for this patron
1195 @items = grep { CanItemBeReserved( $borrower->{borrowernumber}, $_->itemnumber ) eq 'OK' } @items;
1197 my $items_count = scalar @items;
1199 my $threshold = $items_count + $decreaseLoanHighHoldsValue;
1201 # If the number of holds is less than the count of items we have
1202 # plus the number of holds allowed above that count, we can stop here
1203 if ( $holds->count() <= $threshold ) {
1204 return $return_data;
1208 my $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1210 my $calendar = Koha::Calendar->new( branchcode => $branch );
1213 ( C4::Context->preference('item-level_itypes') )
1214 ? $biblio->{'itype'}
1215 : $biblio->{'itemtype'};
1217 my $orig_due = C4::Circulation::CalcDateDue( $issuedate, $itype, $branch, $borrower );
1219 my $decreaseLoanHighHoldsDuration = C4::Context->preference('decreaseLoanHighHoldsDuration');
1221 my $reduced_datedue = $calendar->addDate( $issuedate, $decreaseLoanHighHoldsDuration );
1223 if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1224 $return_data->{exceeded} = 1;
1225 $return_data->{duration} = $decreaseLoanHighHoldsDuration;
1226 $return_data->{due_date} = $reduced_datedue;
1230 return $return_data;
1235 &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1237 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1241 =item C<$borrower> is a hash with borrower informations (from GetMember).
1243 =item C<$barcode> is the barcode of the item being issued.
1245 =item C<$datedue> is a DateTime object for the max date of return, i.e. the date due (optional).
1246 Calculated if empty.
1248 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1250 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1251 Defaults to today. Unlike C<$datedue>, NOT a DateTime object, unfortunately.
1253 AddIssue does the following things :
1255 - step 01: check that there is a borrowernumber & a barcode provided
1256 - check for RENEWAL (book issued & being issued to the same patron)
1257 - renewal YES = Calculate Charge & renew
1259 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1261 - fill reserve if reserve to this patron
1262 - cancel reserve or not, otherwise
1263 * TRANSFERT PENDING ?
1264 - complete the transfert
1272 my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1274 my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1275 my $switch_onsite_checkout = $params && $params->{switch_onsite_checkout};
1276 my $auto_renew = $params && $params->{auto_renew};
1277 my $dbh = C4::Context->dbh;
1278 my $barcodecheck = CheckValidBarcode($barcode);
1282 if ( $datedue && ref $datedue ne 'DateTime' ) {
1283 $datedue = dt_from_string($datedue);
1286 # $issuedate defaults to today.
1287 if ( !defined $issuedate ) {
1288 $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1291 if ( ref $issuedate ne 'DateTime' ) {
1292 $issuedate = dt_from_string($issuedate);
1297 # Stop here if the patron or barcode doesn't exist
1298 if ( $borrower && $barcode && $barcodecheck ) {
1299 # find which item we issue
1300 my $item = GetItem( '', $barcode )
1301 or return; # if we don't get an Item, abort.
1303 my $branch = _GetCircControlBranch( $item, $borrower );
1305 # get actual issuing if there is one
1306 my $actualissue = GetItemIssue( $item->{itemnumber} );
1308 # get biblioinformation for this item
1309 my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1311 # check if we just renew the issue.
1312 if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}
1313 and not $switch_onsite_checkout ) {
1314 $datedue = AddRenewal(
1315 $borrower->{'borrowernumber'},
1316 $item->{'itemnumber'},
1319 $issuedate, # here interpreted as the renewal date
1323 # it's NOT a renewal
1324 if ( $actualissue->{borrowernumber}
1325 and not $switch_onsite_checkout ) {
1326 # This book is currently on loan, but not to the person
1327 # who wants to borrow it now. mark it returned before issuing to the new borrower
1328 my ( $allowed, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
1329 return unless $allowed;
1330 AddReturn( $item->{'barcode'}, C4::Context->userenv->{'branch'} );
1333 MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1335 # Starting process for transfer job (checking transfert and validate it if we have one)
1336 my ($datesent) = GetTransfers( $item->{'itemnumber'} );
1338 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1339 my $sth = $dbh->prepare(
1340 "UPDATE branchtransfers
1341 SET datearrived = now(),
1343 comments = 'Forced branchtransfer'
1344 WHERE itemnumber= ? AND datearrived IS NULL"
1346 $sth->execute( C4::Context->userenv->{'branch'},
1347 $item->{'itemnumber'} );
1350 # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1351 unless ($auto_renew) {
1352 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
1353 { categorycode => $borrower->{categorycode},
1354 itemtype => $item->{itype},
1355 branchcode => $branch
1359 $auto_renew = $issuing_rule->auto_renew if $issuing_rule;
1362 # Record in the database the fact that the book was issued.
1365 ( C4::Context->preference('item-level_itypes') )
1366 ? $biblio->{'itype'}
1367 : $biblio->{'itemtype'};
1368 $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1371 $datedue->truncate( to => 'minute' );
1373 $issue = Koha::Database->new()->schema()->resultset('Issue')->update_or_create(
1375 borrowernumber => $borrower->{'borrowernumber'},
1376 itemnumber => $item->{'itemnumber'},
1377 issuedate => $issuedate->strftime('%Y-%m-%d %H:%M:%S'),
1378 date_due => $datedue->strftime('%Y-%m-%d %H:%M:%S'),
1379 branchcode => C4::Context->userenv->{'branch'},
1380 onsite_checkout => $onsite_checkout,
1381 auto_renew => $auto_renew ? 1 : 0
1385 if ( C4::Context->preference('ReturnToShelvingCart') ) {
1386 # ReturnToShelvingCart is on, anything issued should be taken off the cart.
1387 CartToShelf( $item->{'itemnumber'} );
1389 $item->{'issues'}++;
1390 if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1391 UpdateTotalIssues( $item->{'biblionumber'}, 1 );
1394 ## If item was lost, it has now been found, reverse any list item charges if necessary.
1395 if ( $item->{'itemlost'} ) {
1397 Koha::RefundLostItemFeeRules->should_refund(
1399 current_branch => C4::Context->userenv->{branch},
1400 item_home_branch => $item->{homebranch},
1401 item_holding_branch => $item->{holdingbranch}
1406 _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef,
1407 $item->{'barcode'} );
1413 issues => $item->{'issues'},
1414 holdingbranch => C4::Context->userenv->{'branch'},
1416 onloan => $datedue->ymd(),
1417 datelastborrowed => DateTime->now( time_zone => C4::Context->tz() )->ymd(),
1419 $item->{'biblionumber'},
1420 $item->{'itemnumber'}
1422 ModDateLastSeen( $item->{'itemnumber'} );
1424 # If it costs to borrow this book, charge it to the patron's account.
1425 my ( $charge, $itemtype ) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
1426 if ( $charge > 0 ) {
1427 AddIssuingCharge( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge );
1428 $item->{'charge'} = $charge;
1431 # Record the fact that this book was issued.
1434 branch => C4::Context->userenv->{'branch'},
1435 type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1437 other => ( $sipmode ? "SIP-$sipmode" : '' ),
1438 itemnumber => $item->{'itemnumber'},
1439 itemtype => $item->{'itype'},
1440 borrowernumber => $borrower->{'borrowernumber'},
1441 ccode => $item->{'ccode'}
1445 # Send a checkout slip.
1446 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1448 branchcode => $branch,
1449 categorycode => $borrower->{categorycode},
1450 item_type => $item->{itype},
1451 notification => 'CHECKOUT',
1453 if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
1454 SendCirculationAlert(
1458 borrower => $borrower,
1466 "CIRCULATION", "ISSUE",
1467 $borrower->{'borrowernumber'},
1468 $biblio->{'itemnumber'}
1469 ) if C4::Context->preference("IssueLog");
1474 =head2 GetLoanLength
1476 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1478 Get loan length for an itemtype, a borrower type and a branch
1483 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1484 my $dbh = C4::Context->dbh;
1485 my $sth = $dbh->prepare(qq{
1486 SELECT issuelength, lengthunit, renewalperiod
1488 WHERE categorycode=?
1491 AND issuelength IS NOT NULL
1494 # try to find issuelength & return the 1st available.
1495 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1496 $sth->execute( $borrowertype, $itemtype, $branchcode );
1497 my $loanlength = $sth->fetchrow_hashref;
1500 if defined($loanlength) && defined $loanlength->{issuelength};
1502 $sth->execute( $borrowertype, '*', $branchcode );
1503 $loanlength = $sth->fetchrow_hashref;
1505 if defined($loanlength) && defined $loanlength->{issuelength};
1507 $sth->execute( '*', $itemtype, $branchcode );
1508 $loanlength = $sth->fetchrow_hashref;
1510 if defined($loanlength) && defined $loanlength->{issuelength};
1512 $sth->execute( '*', '*', $branchcode );
1513 $loanlength = $sth->fetchrow_hashref;
1515 if defined($loanlength) && defined $loanlength->{issuelength};
1517 $sth->execute( $borrowertype, $itemtype, '*' );
1518 $loanlength = $sth->fetchrow_hashref;
1520 if defined($loanlength) && defined $loanlength->{issuelength};
1522 $sth->execute( $borrowertype, '*', '*' );
1523 $loanlength = $sth->fetchrow_hashref;
1525 if defined($loanlength) && defined $loanlength->{issuelength};
1527 $sth->execute( '*', $itemtype, '*' );
1528 $loanlength = $sth->fetchrow_hashref;
1530 if defined($loanlength) && defined $loanlength->{issuelength};
1532 $sth->execute( '*', '*', '*' );
1533 $loanlength = $sth->fetchrow_hashref;
1535 if defined($loanlength) && defined $loanlength->{issuelength};
1537 # if no rule is set => 0 day (hardcoded)
1541 lengthunit => 'days',
1547 =head2 GetHardDueDate
1549 my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1551 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1555 sub GetHardDueDate {
1556 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1558 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
1559 { categorycode => $borrowertype,
1560 itemtype => $itemtype,
1561 branchcode => $branchcode
1566 if ( defined( $issuing_rule ) ) {
1567 if ( $issuing_rule->hardduedate ) {
1568 return (dt_from_string($issuing_rule->hardduedate, 'iso'),$issuing_rule->hardduedatecompare);
1570 return (undef, undef);
1575 =head2 GetBranchBorrowerCircRule
1577 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1579 Retrieves circulation rule attributes that apply to the given
1580 branch and patron category, regardless of item type.
1581 The return value is a hashref containing the following key:
1583 maxissueqty - maximum number of loans that a
1584 patron of the given category can have at the given
1585 branch. If the value is undef, no limit.
1587 maxonsiteissueqty - maximum of on-site checkouts that a
1588 patron of the given category can have at the given
1589 branch. If the value is undef, no limit.
1591 This will first check for a specific branch and
1592 category match from branch_borrower_circ_rules.
1594 If no rule is found, it will then check default_branch_circ_rules
1595 (same branch, default category). If no rule is found,
1596 it will then check default_borrower_circ_rules (default
1597 branch, same category), then failing that, default_circ_rules
1598 (default branch, default category).
1600 If no rule has been found in the database, it will default to
1604 maxonsiteissueqty - undef
1606 C<$branchcode> and C<$categorycode> should contain the
1607 literal branch code and patron category code, respectively - no
1612 sub GetBranchBorrowerCircRule {
1613 my ( $branchcode, $categorycode ) = @_;
1616 my $dbh = C4::Context->dbh();
1617 $rules = $dbh->selectrow_hashref( q|
1618 SELECT maxissueqty, maxonsiteissueqty
1619 FROM branch_borrower_circ_rules
1620 WHERE branchcode = ?
1621 AND categorycode = ?
1622 |, {}, $branchcode, $categorycode ) ;
1623 return $rules if $rules;
1625 # try same branch, default borrower category
1626 $rules = $dbh->selectrow_hashref( q|
1627 SELECT maxissueqty, maxonsiteissueqty
1628 FROM default_branch_circ_rules
1629 WHERE branchcode = ?
1630 |, {}, $branchcode ) ;
1631 return $rules if $rules;
1633 # try default branch, same borrower category
1634 $rules = $dbh->selectrow_hashref( q|
1635 SELECT maxissueqty, maxonsiteissueqty
1636 FROM default_borrower_circ_rules
1637 WHERE categorycode = ?
1638 |, {}, $categorycode ) ;
1639 return $rules if $rules;
1641 # try default branch, default borrower category
1642 $rules = $dbh->selectrow_hashref( q|
1643 SELECT maxissueqty, maxonsiteissueqty
1644 FROM default_circ_rules
1646 return $rules if $rules;
1648 # built-in default circulation rule
1650 maxissueqty => undef,
1651 maxonsiteissueqty => undef,
1655 =head2 GetBranchItemRule
1657 my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1659 Retrieves circulation rule attributes that apply to the given
1660 branch and item type, regardless of patron category.
1662 The return value is a hashref containing the following keys:
1664 holdallowed => Hold policy for this branch and itemtype. Possible values:
1665 0: No holds allowed.
1666 1: Holds allowed only by patrons that have the same homebranch as the item.
1667 2: Holds allowed from any patron.
1669 returnbranch => branch to which to return item. Possible values:
1670 noreturn: do not return, let item remain where checked in (floating collections)
1671 homebranch: return to item's home branch
1672 holdingbranch: return to issuer branch
1674 This searches branchitemrules in the following order:
1676 * Same branchcode and itemtype
1677 * Same branchcode, itemtype '*'
1678 * branchcode '*', same itemtype
1679 * branchcode and itemtype '*'
1681 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1685 sub GetBranchItemRule {
1686 my ( $branchcode, $itemtype ) = @_;
1687 my $dbh = C4::Context->dbh();
1691 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1692 FROM branch_item_rules
1693 WHERE branchcode = ?
1694 AND itemtype = ?', $branchcode, $itemtype],
1695 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1696 FROM default_branch_circ_rules
1697 WHERE branchcode = ?', $branchcode],
1698 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1699 FROM default_branch_item_rules
1700 WHERE itemtype = ?', $itemtype],
1701 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1702 FROM default_circ_rules'],
1705 foreach my $attempt (@attempts) {
1706 my ($query, @bind_params) = @{$attempt};
1707 my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1710 # Since branch/category and branch/itemtype use the same per-branch
1711 # defaults tables, we have to check that the key we want is set, not
1712 # just that a row was returned
1713 $result->{'holdallowed'} = $search_result->{'holdallowed'} unless ( defined $result->{'holdallowed'} );
1714 $result->{'hold_fulfillment_policy'} = $search_result->{'hold_fulfillment_policy'} unless ( defined $result->{'hold_fulfillment_policy'} );
1715 $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1718 # built-in default circulation rule
1719 $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1720 $result->{'hold_fulfillment_policy'} = 'any' unless ( defined $result->{'hold_fulfillment_policy'} );
1721 $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1728 ($doreturn, $messages, $iteminformation, $borrower) =
1729 &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
1735 =item C<$barcode> is the bar code of the book being returned.
1737 =item C<$branch> is the code of the branch where the book is being returned.
1739 =item C<$exemptfine> indicates that overdue charges for the item will be
1742 =item C<$dropbox> indicates that the check-in date is assumed to be
1743 yesterday, or the last non-holiday as defined in C4::Calendar . If
1744 overdue charges are applied and C<$dropbox> is true, the last charge
1745 will be removed. This assumes that the fines accrual script has run
1746 for _today_. Optional.
1748 =item C<$return_date> allows the default return date to be overridden
1749 by the given return date. Optional.
1753 C<&AddReturn> returns a list of four items:
1755 C<$doreturn> is true iff the return succeeded.
1757 C<$messages> is a reference-to-hash giving feedback on the operation.
1758 The keys of the hash are:
1764 No item with this barcode exists. The value is C<$barcode>.
1768 The book is not currently on loan. The value is C<$barcode>.
1770 =item C<IsPermanent>
1772 The book's home branch is a permanent collection. If you have borrowed
1773 this book, you are not allowed to return it. The value is the code for
1774 the book's home branch.
1778 This book has been withdrawn/cancelled. The value should be ignored.
1780 =item C<Wrongbranch>
1782 This book has was returned to the wrong branch. The value is a hashref
1783 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1784 contain the branchcode of the incorrect and correct return library, respectively.
1788 The item was reserved. The value is a reference-to-hash whose keys are
1789 fields from the reserves table of the Koha database, and
1790 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1791 either C<Waiting>, C<Reserved>, or 0.
1793 =item C<WasReturned>
1795 Value 1 if return is successful.
1797 =item C<NeedsTransfer>
1799 If AutomaticItemReturn is disabled, return branch is given as value of NeedsTransfer.
1803 C<$iteminformation> is a reference-to-hash, giving information about the
1804 returned item from the issues table.
1806 C<$borrower> is a reference-to-hash, giving information about the
1807 patron who last borrowed the book.
1812 my ( $barcode, $branch, $exemptfine, $dropbox, $return_date, $dropboxdate ) = @_;
1814 if ($branch and not Koha::Libraries->find($branch)) {
1815 warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
1818 $branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
1822 my $validTransfert = 0;
1823 my $stat_type = 'return';
1825 # get information on item
1826 my $item = GetItem( undef, $barcode );
1828 return ( 0, { BadBarcode => $barcode } ); # no barcode means no item or borrower. bail out.
1831 my $itemnumber = $item->{ itemnumber };
1833 my $item_level_itypes = C4::Context->preference("item-level_itypes");
1834 my $biblio = $item_level_itypes ? undef : GetBiblioData( $item->{ biblionumber } ); # don't get bib data unless we need it
1835 my $itemtype = $item_level_itypes ? $item->{itype} : $biblio->{itemtype};
1837 my $issue = GetItemIssue($itemnumber);
1838 if ($issue and $issue->{borrowernumber}) {
1839 $borrower = C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} )
1840 or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existent borrowernumber '$issue->{borrowernumber}'\n"
1841 . Dumper($issue) . "\n";
1843 $messages->{'NotIssued'} = $barcode;
1844 # even though item is not on loan, it may still be transferred; therefore, get current branch info
1846 # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later.
1847 # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1848 if (C4::Context->preference("RecordLocalUseOnReturn")) {
1849 $messages->{'LocalUse'} = 1;
1850 $stat_type = 'localuse';
1854 if ( $item->{'location'} eq 'PROC' ) {
1855 if ( C4::Context->preference("InProcessingToShelvingCart") ) {
1856 $item->{'location'} = 'CART';
1859 $item->{location} = $item->{permanent_location};
1862 ModItem( $item, $item->{'biblionumber'}, $item->{'itemnumber'} );
1865 # full item data, but no borrowernumber or checkout info (no issue)
1866 # we know GetItem should work because GetItemnumberFromBarcode worked
1867 my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1868 # get the proper branch to which to return the item
1869 my $returnbranch = $item->{$hbr} || $branch ;
1870 # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1872 my $borrowernumber = $borrower->{'borrowernumber'} || undef; # we don't know if we had a borrower or not
1874 my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
1876 $yaml = "$yaml\n\n"; # YAML is anal on ending \n. Surplus does not hurt
1878 eval { $rules = YAML::Load($yaml); };
1880 warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
1883 foreach my $key ( keys %$rules ) {
1884 if ( $item->{notforloan} eq $key ) {
1885 $messages->{'NotForLoanStatusUpdated'} = { from => $item->{notforloan}, to => $rules->{$key} };
1886 ModItem( { notforloan => $rules->{$key} }, undef, $itemnumber );
1894 # check if the book is in a permanent collection....
1895 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1896 if ( $returnbranch ) {
1897 my $library = Koha::Libraries->find($returnbranch);
1898 if ( $library and $library->get_categories->search({'me.categorycode' => 'PE'})->count ) {
1899 $messages->{'IsPermanent'} = $returnbranch;
1903 # check if the return is allowed at this branch
1904 my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
1905 unless ($returnallowed){
1906 $messages->{'Wrongbranch'} = {
1907 Wrongbranch => $branch,
1908 Rightbranch => $message
1911 return ( $doreturn, $messages, $issue, $borrower );
1914 if ( $item->{'withdrawn'} ) { # book has been cancelled
1915 $messages->{'withdrawn'} = 1;
1916 $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
1919 # case of a return of document (deal with issues and holdingbranch)
1920 my $today = DateTime->now( time_zone => C4::Context->tz() );
1923 my $datedue = $issue->{date_due};
1924 $borrower or warn "AddReturn without current borrower";
1925 my $circControlBranch;
1927 # define circControlBranch only if dropbox mode is set
1928 # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1929 # FIXME: check issuedate > returndate, factoring in holidays
1931 $circControlBranch = _GetCircControlBranch($item,$borrower);
1932 $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $dropboxdate ) == -1 ? 1 : 0;
1935 if ($borrowernumber) {
1936 if ( ( C4::Context->preference('CalculateFinesOnReturn') && $issue->{'overdue'} ) || $return_date ) {
1937 _CalculateAndUpdateFine( { issue => $issue, item => $item, borrower => $borrower, return_date => $return_date } );
1941 MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
1942 $circControlBranch, $return_date, $borrower->{'privacy'} );
1945 $messages->{'Wrongbranch'} = {
1946 Wrongbranch => $branch,
1947 Rightbranch => $message
1950 return ( 0, { WasReturned => 0 }, $issue, $borrower );
1953 # FIXME is the "= 1" right? This could be the borrower hash.
1954 $messages->{'WasReturned'} = 1;
1958 ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1961 # the holdingbranch is updated if the document is returned to another location.
1962 # this is always done regardless of whether the item was on loan or not
1963 my $item_holding_branch = $item->{ holdingbranch };
1964 if ($item->{'holdingbranch'} ne $branch) {
1965 UpdateHoldingbranch($branch, $item->{'itemnumber'});
1966 $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1968 ModDateLastSeen( $item->{'itemnumber'} );
1970 # check if we have a transfer for this document
1971 my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1973 # if we have a transfer to do, we update the line of transfers with the datearrived
1974 my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->{'itemnumber'} );
1976 if ( $tobranch eq $branch ) {
1977 my $sth = C4::Context->dbh->prepare(
1978 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1980 $sth->execute( $item->{'itemnumber'} );
1981 # if we have a reservation with valid transfer, we can set it's status to 'W'
1982 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1983 C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1985 $messages->{'WrongTransfer'} = $tobranch;
1986 $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1988 $validTransfert = 1;
1990 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1993 # fix up the accounts.....
1994 if ( $item->{'itemlost'} ) {
1995 $messages->{'WasLost'} = 1;
1997 if ( $item->{'itemlost'} ) {
1999 Koha::RefundLostItemFeeRules->should_refund(
2001 current_branch => C4::Context->userenv->{branch},
2002 item_home_branch => $item->{homebranch},
2003 item_holding_branch => $item_holding_branch
2008 _FixAccountForLostAndReturned( $item->{'itemnumber'}, $borrowernumber, $barcode );
2009 $messages->{'LostItemFeeRefunded'} = 1;
2014 # fix up the overdues in accounts...
2015 if ($borrowernumber) {
2016 my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
2017 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
2019 if ( $issue->{overdue} && $issue->{date_due} ) {
2021 $today = $dropboxdate if $dropbox;
2022 my ($debardate,$reminder) = _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today );
2024 $messages->{'PrevDebarred'} = $debardate;
2026 $messages->{'Debarred'} = $debardate if $debardate;
2028 # there's no overdue on the item but borrower had been previously debarred
2029 } elsif ( $issue->{date_due} and $borrower->{'debarred'} ) {
2030 if ( $borrower->{debarred} eq "9999-12-31") {
2031 $messages->{'ForeverDebarred'} = $borrower->{'debarred'};
2033 my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
2034 $borrower_debar_dt->truncate(to => 'day');
2035 my $today_dt = $today->clone()->truncate(to => 'day');
2036 if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2037 $messages->{'PrevDebarred'} = $borrower->{'debarred'};
2043 # find reserves.....
2044 # if we don't have a reserve with the status W, we launch the Checkreserves routine
2045 my ($resfound, $resrec);
2046 my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2047 ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'}, undef, $lookahead ) unless ( $item->{'withdrawn'} );
2049 $resrec->{'ResFound'} = $resfound;
2050 $messages->{'ResFound'} = $resrec;
2053 # Record the fact that this book was returned.
2057 itemnumber => $itemnumber,
2058 itemtype => $itemtype,
2059 borrowernumber => $borrowernumber,
2060 ccode => $item->{ ccode }
2063 # Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then.
2064 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2066 branchcode => $branch,
2067 categorycode => $borrower->{categorycode},
2068 item_type => $item->{itype},
2069 notification => 'CHECKIN',
2071 if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2072 SendCirculationAlert({
2075 borrower => $borrower,
2080 logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
2081 if C4::Context->preference("ReturnLog");
2083 # Remove any OVERDUES related debarment if the borrower has no overdues
2084 if ( $borrowernumber
2085 && $borrower->{'debarred'}
2086 && C4::Context->preference('AutoRemoveOverduesRestrictions')
2087 && !Koha::Patrons->find( $borrowernumber )->has_overdues
2088 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2090 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2093 # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2094 if (!$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) and not $messages->{'WrongTransfer'}){
2095 if (C4::Context->preference("AutomaticItemReturn" ) or
2096 (C4::Context->preference("UseBranchTransferLimits") and
2097 ! IsBranchTransferAllowed($branch, $returnbranch, $item->{C4::Context->preference("BranchTransferLimitsType")} )
2099 $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $returnbranch;
2100 $debug and warn "item: " . Dumper($item);
2101 ModItemTransfer($item->{'itemnumber'}, $branch, $returnbranch);
2102 $messages->{'WasTransfered'} = 1;
2104 $messages->{'NeedsTransfer'} = $returnbranch;
2108 return ( $doreturn, $messages, $issue, $borrower );
2111 =head2 MarkIssueReturned
2113 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
2115 Unconditionally marks an issue as being returned by
2116 moving the C<issues> row to C<old_issues> and
2117 setting C<returndate> to the current date, or
2118 the last non-holiday date of the branccode specified in
2119 C<dropbox_branch> . Assumes you've already checked that
2120 it's safe to do this, i.e. last non-holiday > issuedate.
2122 if C<$returndate> is specified (in iso format), it is used as the date
2123 of the return. It is ignored when a dropbox_branch is passed in.
2125 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2126 the old_issue is immediately anonymised
2128 Ideally, this function would be internal to C<C4::Circulation>,
2129 not exported, but it is currently needed by one
2130 routine in C<C4::Accounts>.
2134 sub MarkIssueReturned {
2135 my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
2137 my $anonymouspatron;
2138 if ( $privacy == 2 ) {
2139 # The default of 0 will not work due to foreign key constraints
2140 # The anonymisation will fail if AnonymousPatron is not a valid entry
2141 # We need to check if the anonymous patron exist, Koha will fail loudly if it does not
2142 # Note that a warning should appear on the about page (System information tab).
2143 $anonymouspatron = C4::Context->preference('AnonymousPatron');
2144 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."
2145 unless C4::Members::GetMember( borrowernumber => $anonymouspatron );
2147 my $dbh = C4::Context->dbh;
2148 my $query = 'UPDATE issues SET returndate=';
2150 if ($dropbox_branch) {
2151 my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
2152 my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
2154 push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2155 } elsif ($returndate) {
2157 push @bind, $returndate;
2159 $query .= ' now() ';
2161 $query .= ' WHERE borrowernumber = ? AND itemnumber = ?';
2162 push @bind, $borrowernumber, $itemnumber;
2164 my $sth_upd = $dbh->prepare($query);
2165 $sth_upd->execute(@bind);
2166 my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
2167 WHERE borrowernumber = ?
2168 AND itemnumber = ?');
2169 $sth_copy->execute($borrowernumber, $itemnumber);
2170 # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2171 if ( $privacy == 2) {
2172 my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
2173 WHERE borrowernumber = ?
2174 AND itemnumber = ?");
2175 $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
2177 my $sth_del = $dbh->prepare("DELETE FROM issues
2178 WHERE borrowernumber = ?
2179 AND itemnumber = ?");
2180 $sth_del->execute($borrowernumber, $itemnumber);
2182 ModItem( { 'onloan' => undef }, undef, $itemnumber );
2184 if ( C4::Context->preference('StoreLastBorrower') ) {
2185 my $item = Koha::Items->find( $itemnumber );
2186 my $patron = Koha::Patrons->find( $borrowernumber );
2187 $item->last_returned_by( $patron );
2191 =head2 _debar_user_on_return
2193 _debar_user_on_return($borrower, $item, $datedue, today);
2195 C<$borrower> borrower hashref
2197 C<$item> item hashref
2199 C<$datedue> date due DateTime object
2201 C<$today> DateTime object representing the return time
2203 Internal function, called only by AddReturn that calculates and updates
2204 the user fine days, and debars him if necessary.
2206 Should only be called for overdue returns
2210 sub _debar_user_on_return {
2211 my ( $borrower, $item, $dt_due, $dt_today ) = @_;
2213 my $branchcode = _GetCircControlBranch( $item, $borrower );
2215 my $circcontrol = C4::Context->preference('CircControl');
2216 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2217 { categorycode => $borrower->{categorycode},
2218 itemtype => $item->{itype},
2219 branchcode => $branchcode
2222 my $finedays = $issuing_rule ? $issuing_rule->finedays : undef;
2223 my $unit = $issuing_rule ? $issuing_rule->lengthunit : undef;
2224 my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $dt_today, $branchcode);
2228 # finedays is in days, so hourly loans must multiply by 24
2229 # thus 1 hour late equals 1 day suspension * finedays rate
2230 $finedays = $finedays * 24 if ( $unit eq 'hours' );
2232 # grace period is measured in the same units as the loan
2234 DateTime::Duration->new( $unit => $issuing_rule->firstremind );
2236 my $deltadays = DateTime::Duration->new(
2237 days => $chargeable_units
2239 if ( $deltadays->subtract($grace)->is_positive() ) {
2240 my $suspension_days = $deltadays * $finedays;
2242 # If the max suspension days is < than the suspension days
2243 # the suspension days is limited to this maximum period.
2244 my $max_sd = $issuing_rule->maxsuspensiondays;
2245 if ( defined $max_sd ) {
2246 $max_sd = DateTime::Duration->new( days => $max_sd );
2247 $suspension_days = $max_sd
2248 if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2252 $dt_today->clone()->add_duration( $suspension_days );
2254 Koha::Patron::Debarments::AddUniqueDebarment({
2255 borrowernumber => $borrower->{borrowernumber},
2256 expiration => $new_debar_dt->ymd(),
2257 type => 'SUSPENSION',
2259 # if borrower was already debarred but does not get an extra debarment
2260 my $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
2261 if ( $borrower->{debarred} eq $patron->is_debarred ) {
2262 return ($borrower->{debarred},1);
2264 return $new_debar_dt->ymd();
2270 =head2 _FixOverduesOnReturn
2272 &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2274 C<$brn> borrowernumber
2278 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2279 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2281 Internal function, called only by AddReturn
2285 sub _FixOverduesOnReturn {
2286 my ($borrowernumber, $item);
2287 unless ($borrowernumber = shift) {
2288 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2291 unless ($item = shift) {
2292 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2295 my ($exemptfine, $dropbox) = @_;
2296 my $dbh = C4::Context->dbh;
2298 # check for overdue fine
2299 my $sth = $dbh->prepare(
2300 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
2302 $sth->execute( $borrowernumber, $item );
2304 # alter fine to show that the book has been returned
2305 my $data = $sth->fetchrow_hashref;
2306 return 0 unless $data; # no warning, there's just nothing to fix
2309 my @bind = ($data->{'accountlines_id'});
2311 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2312 if (C4::Context->preference("FinesLog")) {
2313 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2315 } elsif ($dropbox && $data->{lastincrement}) {
2316 my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2317 my $amt = $data->{amount} - $data->{lastincrement} ;
2318 if (C4::Context->preference("FinesLog")) {
2319 &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2321 $uquery = "update accountlines set accounttype='F' ";
2322 if($outstanding >= 0 && $amt >=0) {
2323 $uquery .= ", amount = ? , amountoutstanding=? ";
2324 unshift @bind, ($amt, $outstanding) ;
2327 $uquery = "update accountlines set accounttype='F' ";
2329 $uquery .= " where (accountlines_id = ?)";
2330 my $usth = $dbh->prepare($uquery);
2331 return $usth->execute(@bind);
2334 =head2 _FixAccountForLostAndReturned
2336 &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2338 Calculates the charge for a book lost and returned.
2340 Internal function, not exported, called only by AddReturn.
2342 FIXME: This function reflects how inscrutable fines logic is. Fix both.
2343 FIXME: Give a positive return value on success. It might be the $borrowernumber who received credit, or the amount forgiven.
2347 sub _FixAccountForLostAndReturned {
2348 my $itemnumber = shift or return;
2349 my $borrowernumber = @_ ? shift : undef;
2350 my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
2351 my $dbh = C4::Context->dbh;
2352 # check for charge made for lost book
2353 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2354 $sth->execute($itemnumber);
2355 my $data = $sth->fetchrow_hashref;
2356 $data or return; # bail if there is nothing to do
2357 $data->{accounttype} eq 'W' and return; # Written off
2359 # writeoff this amount
2361 my $amount = $data->{'amount'};
2362 my $acctno = $data->{'accountno'};
2363 my $amountleft; # Starts off undef/zero.
2364 if ($data->{'amountoutstanding'} == $amount) {
2365 $offset = $data->{'amount'};
2366 $amountleft = 0; # Hey, it's zero here, too.
2368 $offset = $amount - $data->{'amountoutstanding'}; # Um, isn't this the same as ZERO? We just tested those two things are ==
2369 $amountleft = $data->{'amountoutstanding'} - $amount; # Um, isn't this the same as ZERO? We just tested those two things are ==
2371 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2372 WHERE (accountlines_id = ?)");
2373 $usth->execute($data->{'accountlines_id'}); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in.
2374 #check if any credit is left if so writeoff other accounts
2375 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2376 $amountleft *= -1 if ($amountleft < 0);
2377 if ($amountleft > 0) {
2378 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2379 AND (amountoutstanding >0) ORDER BY date"); # might want to order by amountoustanding ASC (pay smallest first)
2380 $msth->execute($data->{'borrowernumber'});
2381 # offset transactions
2384 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2385 if ($accdata->{'amountoutstanding'} < $amountleft) {
2387 $amountleft -= $accdata->{'amountoutstanding'};
2389 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2392 my $thisacct = $accdata->{'accountlines_id'};
2393 # FIXME: move prepares outside while loop!
2394 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2395 WHERE (accountlines_id = ?)");
2396 $usth->execute($newamtos,$thisacct);
2397 $usth = $dbh->prepare("INSERT INTO accountoffsets
2398 (borrowernumber, accountno, offsetaccount, offsetamount)
2401 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2404 $amountleft *= -1 if ($amountleft > 0);
2405 my $desc = "Item Returned " . $item_id;
2406 $usth = $dbh->prepare("INSERT INTO accountlines
2407 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2408 VALUES (?,?,now(),?,?,'CR',?)");
2409 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2410 if ($borrowernumber) {
2411 # FIXME: same as query above. use 1 sth for both
2412 $usth = $dbh->prepare("INSERT INTO accountoffsets
2413 (borrowernumber, accountno, offsetaccount, offsetamount)
2415 $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2417 ModItem({ paidfor => '' }, undef, $itemnumber);
2421 =head2 _GetCircControlBranch
2423 my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2427 Return the library code to be used to determine which circulation
2428 policy applies to a transaction. Looks up the CircControl and
2429 HomeOrHoldingBranch system preferences.
2431 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2433 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2437 sub _GetCircControlBranch {
2438 my ($item, $borrower) = @_;
2439 my $circcontrol = C4::Context->preference('CircControl');
2442 if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2443 $branch= C4::Context->userenv->{'branch'};
2444 } elsif ($circcontrol eq 'PatronLibrary') {
2445 $branch=$borrower->{branchcode};
2447 my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2448 $branch = $item->{$branchfield};
2449 # default to item home branch if holdingbranch is used
2450 # and is not defined
2451 if (!defined($branch) && $branchfield eq 'holdingbranch') {
2452 $branch = $item->{homebranch};
2465 $issue = &GetItemIssue($itemnumber);
2467 Returns patron currently having a book, or undef if not checked out.
2469 C<$itemnumber> is the itemnumber.
2471 C<$issue> is a hashref of the row from the issues table.
2476 my ($itemnumber) = @_;
2477 return unless $itemnumber;
2478 my $sth = C4::Context->dbh->prepare(
2479 "SELECT items.*, issues.*
2481 LEFT JOIN items ON issues.itemnumber=items.itemnumber
2482 WHERE issues.itemnumber=?");
2483 $sth->execute($itemnumber);
2484 my $data = $sth->fetchrow_hashref;
2485 return unless $data;
2486 $data->{issuedate_sql} = $data->{issuedate};
2487 $data->{date_due_sql} = $data->{date_due};
2488 $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2489 $data->{issuedate}->truncate(to => 'minute');
2490 $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2491 $data->{date_due}->truncate(to => 'minute');
2492 my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2493 $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2499 $issue = GetOpenIssue( $itemnumber );
2501 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2503 C<$itemnumber> is the item's itemnumber
2510 my ( $itemnumber ) = @_;
2511 return unless $itemnumber;
2512 my $dbh = C4::Context->dbh;
2513 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2514 $sth->execute( $itemnumber );
2515 return $sth->fetchrow_hashref();
2519 =head2 GetBiblioIssues
2521 $issues = GetBiblioIssues($biblionumber);
2523 this function get all issues from a biblionumber.
2526 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2527 tables issues and the firstname,surname & cardnumber from borrowers.
2531 sub GetBiblioIssues {
2532 my $biblionumber = shift;
2533 return unless $biblionumber;
2534 my $dbh = C4::Context->dbh;
2536 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2538 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2539 LEFT JOIN items ON issues.itemnumber = items.itemnumber
2540 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2541 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2542 WHERE biblio.biblionumber = ?
2544 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2546 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2547 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2548 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2549 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2550 WHERE biblio.biblionumber = ?
2553 my $sth = $dbh->prepare($query);
2554 $sth->execute($biblionumber, $biblionumber);
2557 while ( my $data = $sth->fetchrow_hashref ) {
2558 push @issues, $data;
2563 =head2 GetUpcomingDueIssues
2565 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2569 sub GetUpcomingDueIssues {
2572 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2573 my $dbh = C4::Context->dbh;
2575 my $statement = <<END_SQL;
2576 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2578 LEFT JOIN items USING (itemnumber)
2579 LEFT OUTER JOIN branches USING (branchcode)
2580 WHERE returndate is NULL
2581 HAVING days_until_due >= 0 AND days_until_due <= ?
2584 my @bind_parameters = ( $params->{'days_in_advance'} );
2586 my $sth = $dbh->prepare( $statement );
2587 $sth->execute( @bind_parameters );
2588 my $upcoming_dues = $sth->fetchall_arrayref({});
2590 return $upcoming_dues;
2593 =head2 CanBookBeRenewed
2595 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2597 Find out whether a borrowed item may be renewed.
2599 C<$borrowernumber> is the borrower number of the patron who currently
2600 has the item on loan.
2602 C<$itemnumber> is the number of the item to renew.
2604 C<$override_limit>, if supplied with a true value, causes
2605 the limit on the number of times that the loan can be renewed
2606 (as controlled by the item type) to be ignored. Overriding also allows
2607 to renew sooner than "No renewal before" and to manually renew loans
2608 that are automatically renewed.
2610 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2611 item must currently be on loan to the specified borrower; renewals
2612 must be allowed for the item's type; and the borrower must not have
2613 already renewed the loan. $error will contain the reason the renewal can not proceed
2617 sub CanBookBeRenewed {
2618 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2620 my $dbh = C4::Context->dbh;
2623 my $item = GetItem($itemnumber) or return ( 0, 'no_item' );
2624 my $itemissue = GetItemIssue($itemnumber) or return ( 0, 'no_checkout' );
2625 return ( 0, 'onsite_checkout' ) if $itemissue->{onsite_checkout};
2627 $borrowernumber ||= $itemissue->{borrowernumber};
2628 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
2631 my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2633 # This item can fill one or more unfilled reserve, can those unfilled reserves
2634 # all be filled by other available items?
2636 && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2638 my $schema = Koha::Database->new()->schema();
2640 my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2642 # There is an item level hold on this item, no other item can fill the hold
2647 # Get all other items that could possibly fill reserves
2648 my @itemnumbers = $schema->resultset('Item')->search(
2650 biblionumber => $resrec->{biblionumber},
2653 -not => { itemnumber => $itemnumber }
2655 { columns => 'itemnumber' }
2656 )->get_column('itemnumber')->all();
2658 # Get all other reserves that could have been filled by this item
2659 my @borrowernumbers;
2661 my ( $reserve_found, $reserve, undef ) =
2662 C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2664 if ($reserve_found) {
2665 push( @borrowernumbers, $reserve->{borrowernumber} );
2672 # If the count of the union of the lists of reservable items for each borrower
2673 # is equal or greater than the number of borrowers, we know that all reserves
2674 # can be filled with available items. We can get the union of the sets simply
2675 # by pushing all the elements onto an array and removing the duplicates.
2677 foreach my $b (@borrowernumbers) {
2678 my ($borr) = C4::Members::GetMember( borrowernumber => $b);
2679 foreach my $i (@itemnumbers) {
2680 my $item = GetItem($i);
2681 if ( !IsItemOnHoldAndFound($i)
2682 && IsAvailableForItemLevelRequest( $item, $borr )
2683 && CanItemBeReserved( $b, $i ) )
2685 push( @reservable, $i );
2690 @reservable = uniq(@reservable);
2692 if ( @reservable >= @borrowernumbers ) {
2697 return ( 0, "on_reserve" ) if $resfound; # '' when no hold was found
2699 return ( 1, undef ) if $override_limit;
2701 my $branchcode = _GetCircControlBranch( $item, $borrower );
2702 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2703 { categorycode => $borrower->{categorycode},
2704 itemtype => $item->{itype},
2705 branchcode => $branchcode
2709 return ( 0, "too_many" )
2710 if not $issuing_rule or $issuing_rule->renewalsallowed <= $itemissue->{renewals};
2712 my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2713 my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2714 my $patron = Koha::Patrons->find($borrowernumber);
2715 my $restricted = $patron->is_debarred;
2716 my $hasoverdues = $patron->has_overdues;
2718 if ( $restricted and $restrictionblockrenewing ) {
2719 return ( 0, 'restriction');
2720 } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($itemissue->{overdue} and $overduesblockrenewing eq 'blockitem') ) {
2721 return ( 0, 'overdue');
2724 if ( $itemissue->{auto_renew}
2725 and defined $issuing_rule->no_auto_renewal_after
2726 and $issuing_rule->no_auto_renewal_after ne "" ) {
2728 # Get issue_date and add no_auto_renewal_after
2729 # If this is greater than today, it's too late for renewal.
2730 my $maximum_renewal_date = dt_from_string($itemissue->{issuedate});
2731 $maximum_renewal_date->add(
2732 $issuing_rule->lengthunit => $issuing_rule->no_auto_renewal_after
2734 my $now = dt_from_string;
2735 if ( $now >= $maximum_renewal_date ) {
2736 return ( 0, "auto_too_late" );
2740 if ( defined $issuing_rule->norenewalbefore
2741 and $issuing_rule->norenewalbefore ne "" )
2744 # Calculate soonest renewal by subtracting 'No renewal before' from due date
2745 my $soonestrenewal =
2746 $itemissue->{date_due}->clone()
2748 $issuing_rule->lengthunit => $issuing_rule->norenewalbefore );
2750 # Depending on syspref reset the exact time, only check the date
2751 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2752 and $issuing_rule->lengthunit eq 'days' )
2754 $soonestrenewal->truncate( to => 'day' );
2757 if ( $soonestrenewal > DateTime->now( time_zone => C4::Context->tz() ) )
2759 return ( 0, "auto_too_soon" ) if $itemissue->{auto_renew};
2760 return ( 0, "too_soon" );
2762 elsif ( $itemissue->{auto_renew} ) {
2763 return ( 0, "auto_renew" );
2767 # Fallback for automatic renewals:
2768 # If norenewalbefore is undef, don't renew before due date.
2769 if ( $itemissue->{auto_renew} ) {
2770 my $now = dt_from_string;
2771 return ( 0, "auto_renew" )
2772 if $now >= $itemissue->{date_due};
2773 return ( 0, "auto_too_soon" );
2776 return ( 1, undef );
2781 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2785 C<$borrowernumber> is the borrower number of the patron who currently
2788 C<$itemnumber> is the number of the item to renew.
2790 C<$branch> is the library where the renewal took place (if any).
2791 The library that controls the circ policies for the renewal is retrieved from the issues record.
2793 C<$datedue> can be a DateTime object used to set the due date.
2795 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
2796 this parameter is not supplied, lastreneweddate is set to the current date.
2798 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2799 from the book's item type.
2804 my $borrowernumber = shift;
2805 my $itemnumber = shift or return;
2807 my $datedue = shift;
2808 my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2810 my $item = GetItem($itemnumber) or return;
2811 my $biblio = GetBiblioFromItemNumber($itemnumber) or return;
2813 my $dbh = C4::Context->dbh;
2815 # Find the issues record for this book
2816 my $issuedata = GetItemIssue($itemnumber);
2818 return unless ( $issuedata );
2820 $borrowernumber ||= $issuedata->{borrowernumber};
2822 if ( defined $datedue && ref $datedue ne 'DateTime' ) {
2823 carp 'Invalid date passed to AddRenewal.';
2827 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return;
2829 if ( C4::Context->preference('CalculateFinesOnReturn') && $issuedata->{overdue} ) {
2830 _CalculateAndUpdateFine( { issue => $issuedata, item => $item, borrower => $borrower } );
2832 _FixOverduesOnReturn( $borrowernumber, $itemnumber );
2834 # If the due date wasn't specified, calculate it by adding the
2835 # book's loan length to today's date or the current due date
2836 # based on the value of the RenewalPeriodBase syspref.
2839 my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2841 $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2842 dt_from_string( $issuedata->{date_due} ) :
2843 DateTime->now( time_zone => C4::Context->tz());
2844 $datedue = CalcDateDue($datedue, $itemtype, $issuedata->{'branchcode'}, $borrower, 'is a renewal');
2847 # Update the issues record to have the new due date, and a new count
2848 # of how many times it has been renewed.
2849 my $renews = $issuedata->{'renewals'} + 1;
2850 my $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2851 WHERE borrowernumber=?
2855 $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2857 # Update the renewal count on the item, and tell zebra to reindex
2858 $renews = $biblio->{'renewals'} + 1;
2859 ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
2861 # Charge a new rental fee, if applicable?
2862 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2863 if ( $charge > 0 ) {
2864 my $accountno = getnextacctno( $borrowernumber );
2865 my $item = GetBiblioFromItemNumber($itemnumber);
2867 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2868 $sth = $dbh->prepare(
2869 "INSERT INTO accountlines
2870 (date, borrowernumber, accountno, amount, manager_id,
2871 description,accounttype, amountoutstanding, itemnumber)
2872 VALUES (now(),?,?,?,?,?,?,?,?)"
2874 $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2875 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2876 'Rent', $charge, $itemnumber );
2879 # Send a renewal slip according to checkout alert preferencei
2880 if ( C4::Context->preference('RenewalSendNotice') eq '1' ) {
2881 $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
2882 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2884 branchcode => $branch,
2885 categorycode => $borrower->{categorycode},
2886 item_type => $item->{itype},
2887 notification => 'CHECKOUT',
2889 if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
2890 SendCirculationAlert(
2894 borrower => $borrower,
2901 # Remove any OVERDUES related debarment if the borrower has no overdues
2902 $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
2903 if ( $borrowernumber
2904 && $borrower->{'debarred'}
2905 && !Koha::Patrons->find( $borrowernumber )->has_overdues
2906 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2908 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2914 branch => C4::Context->userenv ? C4::Context->userenv->{branch} : $branch,
2917 itemnumber => $itemnumber,
2918 itemtype => $item->{itype},
2919 borrowernumber => $borrowernumber,
2920 ccode => $item->{'ccode'}
2928 # check renewal status
2929 my ( $bornum, $itemno ) = @_;
2930 my $dbh = C4::Context->dbh;
2932 my $renewsallowed = 0;
2935 my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
2936 my $item = GetItem($itemno);
2938 # Look in the issues table for this item, lent to this borrower,
2939 # and not yet returned.
2941 # FIXME - I think this function could be redone to use only one SQL call.
2942 my $sth = $dbh->prepare(
2943 "select * from issues
2944 where (borrowernumber = ?)
2945 and (itemnumber = ?)"
2947 $sth->execute( $bornum, $itemno );
2948 my $data = $sth->fetchrow_hashref;
2949 $renewcount = $data->{'renewals'} if $data->{'renewals'};
2950 # $item and $borrower should be calculated
2951 my $branchcode = _GetCircControlBranch($item, $borrower);
2953 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2954 { categorycode => $borrower->{categorycode},
2955 itemtype => $item->{itype},
2956 branchcode => $branchcode
2960 $renewsallowed = $issuing_rule ? $issuing_rule->renewalsallowed : undef; # FIXME Just replace undef with 0 to get what we expected. But what about the side-effects? TODO LATER
2961 $renewsleft = $renewsallowed - $renewcount;
2962 if($renewsleft < 0){ $renewsleft = 0; }
2963 return ( $renewcount, $renewsallowed, $renewsleft );
2966 =head2 GetSoonestRenewDate
2968 $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
2970 Find out the soonest possible renew date of a borrowed item.
2972 C<$borrowernumber> is the borrower number of the patron who currently
2973 has the item on loan.
2975 C<$itemnumber> is the number of the item to renew.
2977 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
2978 renew date, based on the value "No renewal before" of the applicable
2979 issuing rule. Returns the current date if the item can already be
2980 renewed, and returns undefined if the borrower, loan, or item
2985 sub GetSoonestRenewDate {
2986 my ( $borrowernumber, $itemnumber ) = @_;
2988 my $dbh = C4::Context->dbh;
2990 my $item = GetItem($itemnumber) or return;
2991 my $itemissue = GetItemIssue($itemnumber) or return;
2993 $borrowernumber ||= $itemissue->{borrowernumber};
2994 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
2997 my $branchcode = _GetCircControlBranch( $item, $borrower );
2998 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
2999 { categorycode => $borrower->{categorycode},
3000 itemtype => $item->{itype},
3001 branchcode => $branchcode
3005 my $now = dt_from_string;
3006 return $now unless $issuing_rule;
3008 if ( defined $issuing_rule->norenewalbefore
3009 and $issuing_rule->norenewalbefore ne "" )
3011 my $soonestrenewal =
3012 $itemissue->{date_due}->clone()
3014 $issuing_rule->lengthunit => $issuing_rule->norenewalbefore );
3016 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3017 and $issuing_rule->lengthunit eq 'days' )
3019 $soonestrenewal->truncate( to => 'day' );
3021 return $soonestrenewal if $now < $soonestrenewal;
3026 =head2 GetLatestAutoRenewDate
3028 $NoAutoRenewalAfterThisDate = &GetLatestAutoRenewDate($borrowernumber, $itemnumber);
3030 Find out the latest possible auto renew date of a borrowed item.
3032 C<$borrowernumber> is the borrower number of the patron who currently
3033 has the item on loan.
3035 C<$itemnumber> is the number of the item to renew.
3037 C<$GetLatestAutoRenewDate> returns the DateTime of the latest possible
3038 auto renew date, based on the value "No auto renewal after" of the applicable
3040 Returns undef if there is no date specify in the circ rules or if the patron, loan,
3041 or item cannot be found.
3045 sub GetLatestAutoRenewDate {
3046 my ( $borrowernumber, $itemnumber ) = @_;
3048 my $dbh = C4::Context->dbh;
3050 my $item = GetItem($itemnumber) or return;
3051 my $itemissue = GetItemIssue($itemnumber) or return;
3053 $borrowernumber ||= $itemissue->{borrowernumber};
3054 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
3057 my $branchcode = _GetCircControlBranch( $item, $borrower );
3058 my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule(
3059 { categorycode => $borrower->{categorycode},
3060 itemtype => $item->{itype},
3061 branchcode => $branchcode
3065 return unless $issuing_rule;
3066 return if not $issuing_rule->no_auto_renewal_after
3067 or $issuing_rule->no_auto_renewal_after eq '';
3069 my $maximum_renewal_date = dt_from_string($itemissue->{issuedate});
3070 $maximum_renewal_date->add(
3071 $issuing_rule->lengthunit => $issuing_rule->no_auto_renewal_after
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;
3135 return ( $charge, $item_type );
3138 # Select most appropriate discount rule from those returned
3139 sub _get_discount_from_rule {
3140 my ($rules_ref, $branch, $itemtype) = @_;
3143 if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3144 $discount = $rules_ref->[0]->{rentaldiscount};
3145 return (defined $discount) ? $discount : 0;
3147 # could have up to 4 does one match $branch and $itemtype
3148 my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3150 $discount = $d[0]->{rentaldiscount};
3151 return (defined $discount) ? $discount : 0;
3153 # do we have item type + all branches
3154 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3156 $discount = $d[0]->{rentaldiscount};
3157 return (defined $discount) ? $discount : 0;
3159 # do we all item types + this branch
3160 @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3162 $discount = $d[0]->{rentaldiscount};
3163 return (defined $discount) ? $discount : 0;
3165 # so all and all (surely we wont get here)
3166 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3168 $discount = $d[0]->{rentaldiscount};
3169 return (defined $discount) ? $discount : 0;
3175 =head2 AddIssuingCharge
3177 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3181 sub AddIssuingCharge {
3182 my ( $itemnumber, $borrowernumber, $charge ) = @_;
3183 my $dbh = C4::Context->dbh;
3184 my $nextaccntno = getnextacctno( $borrowernumber );
3186 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3188 INSERT INTO accountlines
3189 (borrowernumber, itemnumber, accountno,
3190 date, amount, description, accounttype,
3191 amountoutstanding, manager_id)
3192 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
3194 my $sth = $dbh->prepare($query);
3195 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
3200 GetTransfers($itemnumber);
3205 my ($itemnumber) = @_;
3207 my $dbh = C4::Context->dbh;
3214 FROM branchtransfers
3215 WHERE itemnumber = ?
3216 AND datearrived IS NULL
3218 my $sth = $dbh->prepare($query);
3219 $sth->execute($itemnumber);
3220 my @row = $sth->fetchrow_array();
3224 =head2 GetTransfersFromTo
3226 @results = GetTransfersFromTo($frombranch,$tobranch);
3228 Returns the list of pending transfers between $from and $to branch
3232 sub GetTransfersFromTo {
3233 my ( $frombranch, $tobranch ) = @_;
3234 return unless ( $frombranch && $tobranch );
3235 my $dbh = C4::Context->dbh;
3237 SELECT branchtransfer_id,itemnumber,datesent,frombranch
3238 FROM branchtransfers
3241 AND datearrived IS NULL
3243 my $sth = $dbh->prepare($query);
3244 $sth->execute( $frombranch, $tobranch );
3247 while ( my $data = $sth->fetchrow_hashref ) {
3248 push @gettransfers, $data;
3250 return (@gettransfers);
3253 =head2 DeleteTransfer
3255 &DeleteTransfer($itemnumber);
3259 sub DeleteTransfer {
3260 my ($itemnumber) = @_;
3261 return unless $itemnumber;
3262 my $dbh = C4::Context->dbh;
3263 my $sth = $dbh->prepare(
3264 "DELETE FROM branchtransfers
3266 AND datearrived IS NULL "
3268 return $sth->execute($itemnumber);
3271 =head2 AnonymiseIssueHistory
3273 ($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)
3275 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
3276 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
3278 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
3279 setting (force delete).
3281 return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.
3285 sub AnonymiseIssueHistory {
3287 my $borrowernumber = shift;
3288 my $dbh = C4::Context->dbh;
3291 SET borrowernumber = ?
3292 WHERE returndate < ?
3293 AND borrowernumber IS NOT NULL
3296 # The default of 0 does not work due to foreign key constraints
3297 # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
3298 # Set it to undef (NULL)
3299 my $anonymouspatron = C4::Context->preference('AnonymousPatron') || undef;
3300 my @bind_params = ($anonymouspatron, $date);
3301 if (defined $borrowernumber) {
3302 $query .= " AND borrowernumber = ?";
3303 push @bind_params, $borrowernumber;
3305 $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
3307 my $sth = $dbh->prepare($query);
3308 $sth->execute(@bind_params);
3309 my $anonymisation_err = $dbh->err;
3310 my $rows_affected = $sth->rows; ### doublecheck row count return function
3311 return ($rows_affected, $anonymisation_err);
3314 =head2 SendCirculationAlert
3316 Send out a C<check-in> or C<checkout> alert using the messaging system.
3324 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3328 Hashref of information about the item being checked in or out.
3332 Hashref of information about the borrower of the item.
3336 The branchcode from where the checkout or check-in took place.
3342 SendCirculationAlert({
3345 borrower => $borrower,
3351 sub SendCirculationAlert {
3353 my ($type, $item, $borrower, $branch) =
3354 ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3355 my %message_name = (
3356 CHECKIN => 'Item_Check_in',
3357 CHECKOUT => 'Item_Checkout',
3358 RENEWAL => 'Item_Checkout',
3360 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3361 borrowernumber => $borrower->{borrowernumber},
3362 message_name => $message_name{$type},
3364 my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3366 my @transports = keys %{ $borrower_preferences->{transports} };
3367 # warn "no transports" unless @transports;
3369 # warn "transport: $_";
3370 my $message = C4::Message->find_last_message($borrower, $type, $_);
3372 #warn "create new message";
3373 my $letter = C4::Letters::GetPreparedLetter (
3374 module => 'circulation',
3375 letter_code => $type,
3376 branchcode => $branch,
3377 message_transport_type => $_,
3379 $issues_table => $item->{itemnumber},
3380 'items' => $item->{itemnumber},
3381 'biblio' => $item->{biblionumber},
3382 'biblioitems' => $item->{biblionumber},
3383 'borrowers' => $borrower,
3384 'branches' => $branch,
3387 C4::Message->enqueue($letter, $borrower, $_);
3389 #warn "append to old message";
3390 my $letter = C4::Letters::GetPreparedLetter (
3391 module => 'circulation',
3392 letter_code => $type,
3393 branchcode => $branch,
3394 message_transport_type => $_,
3396 $issues_table => $item->{itemnumber},
3397 'items' => $item->{itemnumber},
3398 'biblio' => $item->{biblionumber},
3399 'biblioitems' => $item->{biblionumber},
3400 'borrowers' => $borrower,
3401 'branches' => $branch,
3404 $message->append($letter);
3412 =head2 updateWrongTransfer
3414 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3416 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
3420 sub updateWrongTransfer {
3421 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3422 my $dbh = C4::Context->dbh;
3423 # first step validate the actual line of transfert .
3426 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3428 $sth->execute($FromLibrary,$itemNumber);
3430 # second step create a new line of branchtransfer to the right location .
3431 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3433 #third step changing holdingbranch of item
3434 UpdateHoldingbranch($FromLibrary,$itemNumber);
3437 =head2 UpdateHoldingbranch
3439 $items = UpdateHoldingbranch($branch,$itmenumber);
3441 Simple methode for updating hodlingbranch in items BDD line
3445 sub UpdateHoldingbranch {
3446 my ( $branch,$itemnumber ) = @_;
3447 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3452 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3454 this function calculates the due date given the start date and configured circulation rules,
3455 checking against the holidays calendar as per the 'useDaysMode' syspref.
3456 C<$startdate> = DateTime object representing start date of loan period (assumed to be today)
3457 C<$itemtype> = itemtype code of item in question
3458 C<$branch> = location whose calendar to use
3459 C<$borrower> = Borrower object
3460 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3465 my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3469 # loanlength now a href
3471 GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3473 my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3479 if (ref $startdate ne 'DateTime' ) {
3480 $datedue = dt_from_string($datedue);
3482 $datedue = $startdate->clone;
3486 DateTime->now( time_zone => C4::Context->tz() )
3487 ->truncate( to => 'minute' );
3491 # calculate the datedue as normal
3492 if ( C4::Context->preference('useDaysMode') eq 'Days' )
3493 { # ignoring calendar
3494 if ( $loanlength->{lengthunit} eq 'hours' ) {
3495 $datedue->add( hours => $loanlength->{$length_key} );
3497 $datedue->add( days => $loanlength->{$length_key} );
3498 $datedue->set_hour(23);
3499 $datedue->set_minute(59);
3503 if ($loanlength->{lengthunit} eq 'hours') {
3504 $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3507 $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3509 my $calendar = Koha::Calendar->new( branchcode => $branch );
3510 $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3511 if ($loanlength->{lengthunit} eq 'days') {
3512 $datedue->set_hour(23);
3513 $datedue->set_minute(59);
3517 # if Hard Due Dates are used, retrieve them and apply as necessary
3518 my ( $hardduedate, $hardduedatecompare ) =
3519 GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3520 if ($hardduedate) { # hardduedates are currently dates
3521 $hardduedate->truncate( to => 'minute' );
3522 $hardduedate->set_hour(23);
3523 $hardduedate->set_minute(59);
3524 my $cmp = DateTime->compare( $hardduedate, $datedue );
3526 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3527 # if the calculated date is before the 'after' Hard Due Date (floor), override
3528 # if the hard due date is set to 'exactly', overrride
3529 if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3530 $datedue = $hardduedate->clone;
3533 # in all other cases, keep the date due as it is
3537 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3538 if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3539 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3540 if( $expiry_dt ) { #skip empty expiry date..
3541 $expiry_dt->set( hour => 23, minute => 59);
3542 my $d1= $datedue->clone->set_time_zone('floating');
3543 if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3544 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3553 sub CheckValidBarcode{
3555 my $dbh = C4::Context->dbh;
3556 my $query=qq|SELECT count(*)
3560 my $sth = $dbh->prepare($query);
3561 $sth->execute($barcode);
3562 my $exist=$sth->fetchrow ;
3566 =head2 IsBranchTransferAllowed
3568 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3570 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3574 sub IsBranchTransferAllowed {
3575 my ( $toBranch, $fromBranch, $code ) = @_;
3577 if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3579 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3580 my $dbh = C4::Context->dbh;
3582 my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3583 $sth->execute( $toBranch, $fromBranch, $code );
3584 my $limit = $sth->fetchrow_hashref();
3586 ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3587 if ( $limit->{'limitId'} ) {
3594 =head2 CreateBranchTransferLimit
3596 CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3598 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3602 sub CreateBranchTransferLimit {
3603 my ( $toBranch, $fromBranch, $code ) = @_;
3604 return unless defined($toBranch) && defined($fromBranch);
3605 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3607 my $dbh = C4::Context->dbh;
3609 my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3610 return $sth->execute( $code, $toBranch, $fromBranch );
3613 =head2 DeleteBranchTransferLimits
3615 my $result = DeleteBranchTransferLimits($frombranch);
3617 Deletes all the library transfer limits for one library. Returns the
3618 number of limits deleted, 0e0 if no limits were deleted, or undef if
3619 no arguments are supplied.
3623 sub DeleteBranchTransferLimits {
3625 return unless defined $branch;
3626 my $dbh = C4::Context->dbh;
3627 my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3628 return $sth->execute($branch);
3632 my ( $borrowernumber, $itemnum ) = @_;
3634 MarkIssueReturned( $borrowernumber, $itemnum );
3635 my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3636 my $item = C4::Items::GetItem( $itemnum );
3637 my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3638 my @datearr = localtime(time);
3639 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3640 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3641 ModItem({ paidfor => $old_note."Paid for by $bor $date" }, undef, $itemnum);
3646 my ($itemnumber, $mark_returned) = @_;
3648 my $dbh = C4::Context->dbh();
3649 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3651 JOIN items USING (itemnumber)
3652 JOIN biblio USING (biblionumber)
3653 WHERE issues.itemnumber=?");
3654 $sth->execute($itemnumber);
3655 my $issues=$sth->fetchrow_hashref();
3657 # If a borrower lost the item, add a replacement cost to the their record
3658 if ( my $borrowernumber = $issues->{borrowernumber} ){
3659 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
3661 if (C4::Context->preference('WhenLostForgiveFine')){
3662 my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3663 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!"; # zero is OK, check defined
3665 if (C4::Context->preference('WhenLostChargeReplacementFee')){
3666 C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3667 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3668 #warn " $issues->{'borrowernumber'} / $itemnumber ";
3671 MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3675 sub GetOfflineOperations {
3676 my $dbh = C4::Context->dbh;
3677 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3678 $sth->execute(C4::Context->userenv->{'branch'});
3679 my $results = $sth->fetchall_arrayref({});
3683 sub GetOfflineOperation {
3684 my $operationid = shift;
3685 return unless $operationid;
3686 my $dbh = C4::Context->dbh;
3687 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3688 $sth->execute( $operationid );
3689 return $sth->fetchrow_hashref;
3692 sub AddOfflineOperation {
3693 my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3694 my $dbh = C4::Context->dbh;
3695 my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3696 $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3700 sub DeleteOfflineOperation {
3701 my $dbh = C4::Context->dbh;
3702 my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3703 $sth->execute( shift );
3707 sub ProcessOfflineOperation {
3708 my $operation = shift;
3711 if ( $operation->{action} eq 'return' ) {
3712 $report = ProcessOfflineReturn( $operation );
3713 } elsif ( $operation->{action} eq 'issue' ) {
3714 $report = ProcessOfflineIssue( $operation );
3715 } elsif ( $operation->{action} eq 'payment' ) {
3716 $report = ProcessOfflinePayment( $operation );
3719 DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3724 sub ProcessOfflineReturn {
3725 my $operation = shift;
3727 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3729 if ( $itemnumber ) {
3730 my $issue = GetOpenIssue( $itemnumber );
3733 $issue->{borrowernumber},
3736 $operation->{timestamp},
3739 { renewals => 0, onloan => undef },
3740 $issue->{'biblionumber'},
3745 return "Item not issued.";
3748 return "Item not found.";
3752 sub ProcessOfflineIssue {
3753 my $operation = shift;
3755 my $borrower = C4::Members::GetMember( cardnumber => $operation->{cardnumber} );
3757 if ( $borrower->{borrowernumber} ) {
3758 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3759 unless ($itemnumber) {
3760 return "Barcode not found.";
3762 my $issue = GetOpenIssue( $itemnumber );
3764 if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3766 $issue->{borrowernumber},
3769 $operation->{timestamp},
3774 $operation->{'barcode'},
3777 $operation->{timestamp},
3782 return "Borrower not found.";
3786 sub ProcessOfflinePayment {
3787 my $operation = shift;
3789 my $patron = Koha::Patrons->find( { cardnumber => $operation->{cardnumber} });
3790 my $amount = $operation->{amount};
3792 Koha::Account->new( { patron_id => $patron->id } )->pay( { amount => $amount } );
3800 TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3802 Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3807 my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3809 my $item = GetItem( $itemnumber, $barcode )
3812 return C4::Letters::GetPreparedLetter (
3813 module => 'circulation',
3814 letter_code => 'TRANSFERSLIP',
3815 branchcode => $branch,
3817 'branches' => $to_branch,
3818 'biblio' => $item->{biblionumber},
3824 =head2 CheckIfIssuedToPatron
3826 CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3828 Return 1 if any record item is issued to patron, otherwise return 0
3832 sub CheckIfIssuedToPatron {
3833 my ($borrowernumber, $biblionumber) = @_;
3835 my $dbh = C4::Context->dbh;
3837 SELECT COUNT(*) FROM issues
3838 LEFT JOIN items ON items.itemnumber = issues.itemnumber
3839 WHERE items.biblionumber = ?
3840 AND issues.borrowernumber = ?
3842 my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
3843 return 1 if $is_issued;
3849 IsItemIssued( $itemnumber )
3851 Return 1 if the item is on loan, otherwise return 0
3856 my $itemnumber = shift;
3857 my $dbh = C4::Context->dbh;
3858 my $sth = $dbh->prepare(q{
3861 WHERE itemnumber = ?
3863 $sth->execute($itemnumber);
3864 return $sth->fetchrow;
3867 =head2 GetAgeRestriction
3869 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3870 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3872 if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }
3873 if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3875 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3876 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3877 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3878 Negative days mean the borrower has gone past the age restriction age.
3882 sub GetAgeRestriction {
3883 my ($record_restrictions, $borrower) = @_;
3884 my $markers = C4::Context->preference('AgeRestrictionMarker');
3886 # Split $record_restrictions to something like FSK 16 or PEGI 6
3887 my @values = split ' ', uc($record_restrictions);
3888 return unless @values;
3890 # Search first occurrence of one of the markers
3891 my @markers = split /\|/, uc($markers);
3892 return unless @markers;
3895 my $restriction_year = 0;
3896 for my $value (@values) {
3898 for my $marker (@markers) {
3899 $marker =~ s/^\s+//; #remove leading spaces
3900 $marker =~ s/\s+$//; #remove trailing spaces
3901 if ( $marker eq $value ) {
3902 if ( $index <= $#values ) {
3903 $restriction_year += $values[$index];
3907 elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
3909 # Perhaps it is something like "K16" (as in Finland)
3910 $restriction_year += $1;
3914 last if ( $restriction_year > 0 );
3917 #Check if the borrower is age restricted for this material and for how long.
3918 if ($restriction_year && $borrower) {
3919 if ( $borrower->{'dateofbirth'} ) {
3920 my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3921 $alloweddate[0] += $restriction_year;
3923 #Prevent runime eror on leap year (invalid date)
3924 if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3925 $alloweddate[2] = 28;
3928 #Get how many days the borrower has to reach the age restriction
3929 my @Today = split /-/, DateTime->today->ymd();
3930 my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
3931 #Negative days means the borrower went past the age restriction age
3932 return ($restriction_year, $daysToAgeRestriction);
3936 return ($restriction_year);
3940 =head2 GetPendingOnSiteCheckouts
3944 sub GetPendingOnSiteCheckouts {
3945 my $dbh = C4::Context->dbh;
3946 return $dbh->selectall_arrayref(q|
3952 items.itemcallnumber,
3956 issues.date_due < NOW() AS is_overdue,
3959 borrowers.firstname,
3961 borrowers.cardnumber,
3962 borrowers.borrowernumber
3964 LEFT JOIN issues ON items.itemnumber = issues.itemnumber
3965 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
3966 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
3967 WHERE issues.onsite_checkout = 1
3968 |, { Slice => {} } );
3974 my ($count, $branch, $itemtype, $ccode, $newness)
3975 = @$params{qw(count branch itemtype ccode newness)};
3977 my $dbh = C4::Context->dbh;
3979 SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
3980 bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
3981 i.ccode, SUM(i.issues) AS count
3983 LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
3984 LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
3987 my (@where_strs, @where_args);
3990 push @where_strs, 'i.homebranch = ?';
3991 push @where_args, $branch;
3994 if (C4::Context->preference('item-level_itypes')){
3995 push @where_strs, 'i.itype = ?';
3996 push @where_args, $itemtype;
3998 push @where_strs, 'bi.itemtype = ?';
3999 push @where_args, $itemtype;
4003 push @where_strs, 'i.ccode = ?';
4004 push @where_args, $ccode;
4007 push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4008 push @where_args, $newness;
4012 $query .= 'WHERE ' . join(' AND ', @where_strs);
4016 GROUP BY b.biblionumber
4021 $count = int($count);
4023 $query .= "LIMIT $count";
4026 my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4031 sub _CalculateAndUpdateFine {
4034 my $borrower = $params->{borrower};
4035 my $item = $params->{item};
4036 my $issue = $params->{issue};
4037 my $return_date = $params->{return_date};
4039 unless ($borrower) { carp "No borrower passed in!" && return; }
4040 unless ($item) { carp "No item passed in!" && return; }
4041 unless ($issue) { carp "No issue passed in!" && return; }
4043 my $datedue = $issue->{date_due};
4045 # we only need to calculate and change the fines if we want to do that on return
4046 # Should be on for hourly loans
4047 my $control = C4::Context->preference('CircControl');
4048 my $control_branchcode =
4049 ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
4050 : ( $control eq 'PatronLibrary' ) ? $borrower->{branchcode}
4051 : $issue->{branchcode};
4053 my $date_returned = $return_date ? dt_from_string($return_date) : dt_from_string();
4055 my ( $amount, $type, $unitcounttotal ) =
4056 C4::Overdues::CalcFine( $item, $borrower->{categorycode}, $control_branchcode, $datedue, $date_returned );
4060 if ( C4::Context->preference('finesMode') eq 'production' ) {
4061 if ( $amount > 0 ) {
4062 C4::Overdues::UpdateFine({
4063 issue_id => $issue->{issue_id},
4064 itemnumber => $issue->{itemnumber},
4065 borrowernumber => $issue->{borrowernumber},
4068 due => output_pref($datedue),
4071 elsif ($return_date) {
4073 # Backdated returns may have fines that shouldn't exist,
4074 # so in this case, we need to drop those fines to 0
4076 C4::Overdues::UpdateFine({
4077 issue_id => $issue->{issue_id},
4078 itemnumber => $issue->{itemnumber},
4079 borrowernumber => $issue->{borrowernumber},
4082 due => output_pref($datedue),
4094 Koha Development Team <http://koha-community.org/>