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
38 GetAuthorisedValueByCode
40 GetKohaAuthorisedValueLib
42 use C4::Overdues qw(CalcFine UpdateFine get_chargeable_units);
43 use C4::RotatingCollections qw(GetCollectionItemBranches);
44 use Algorithm::CheckDigits;
51 use Koha::Patron::Debarments;
55 use Koha::RefundLostItemFeeRule;
56 use Koha::RefundLostItemFeeRules;
58 use List::MoreUtils qw( uniq );
59 use Scalar::Util qw( looks_like_number );
69 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
75 # FIXME subs that should probably be elsewhere
80 &GetPendingOnSiteCheckouts
83 # subs to deal with issuing a book
95 &GetBranchBorrowerCircRule
99 &AnonymiseIssueHistory
100 &CheckIfIssuedToPatron
105 # subs to deal with returns
111 # subs to deal with transfers
118 &IsBranchTransferAllowed
119 &CreateBranchTransferLimit
120 &DeleteBranchTransferLimits
124 # subs to deal with offline circulation
126 &GetOfflineOperations
129 &DeleteOfflineOperation
130 &ProcessOfflineOperation
136 C4::Circulation - Koha circulation module
144 The functions in this module deal with circulation, issues, and
145 returns, as well as general information about the library.
146 Also deals with inventory.
152 $str = &barcodedecode($barcode, [$filter]);
154 Generic filter function for barcode string.
155 Called on every circ if the System Pref itemBarcodeInputFilter is set.
156 Will do some manipulation of the barcode for systems that deliver a barcode
157 to circulation.pl that differs from the barcode stored for the item.
158 For proper functioning of this filter, calling the function on the
159 correct barcode string (items.barcode) should return an unaltered barcode.
161 The optional $filter argument is to allow for testing or explicit
162 behavior that ignores the System Pref. Valid values are the same as the
167 # FIXME -- the &decode fcn below should be wrapped into this one.
168 # FIXME -- these plugins should be moved out of Circulation.pm
171 my ($barcode, $filter) = @_;
172 my $branch = C4::Context::mybranch();
173 $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
174 $filter or return $barcode; # ensure filter is defined, else return untouched barcode
175 if ($filter eq 'whitespace') {
177 } elsif ($filter eq 'cuecat') {
179 my @fields = split( /\./, $barcode );
180 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
181 ($#results == 2) and return $results[2];
182 } elsif ($filter eq 'T-prefix') {
183 if ($barcode =~ /^[Tt](\d)/) {
184 (defined($1) and $1 eq '0') and return $barcode;
185 $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1)
187 return sprintf("T%07d", $barcode);
188 # FIXME: $barcode could be "T1", causing warning: substr outside of string
189 # Why drop the nonzero digit after the T?
190 # Why pass non-digits (or empty string) to "T%07d"?
191 } elsif ($filter eq 'libsuite8') {
192 unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it.
193 if($barcode =~ m/^(\d)/i){ #Some barcodes even start with 0's & numbers and are assumed to have b as the item type in the libsuite8 software
194 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
196 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
199 } elsif ($filter eq 'EAN13') {
200 my $ean = CheckDigits('ean');
201 if ( $ean->is_valid($barcode) ) {
202 #$barcode = sprintf('%013d',$barcode); # this doesn't work on 32-bit systems
203 $barcode = '0' x ( 13 - length($barcode) ) . $barcode;
205 warn "# [$barcode] not valid EAN-13/UPC-A\n";
208 return $barcode; # return barcode, modified or not
213 $str = &decode($chunk);
215 Decodes a segment of a string emitted by a CueCat barcode scanner and
218 FIXME: Should be replaced with Barcode::Cuecat from CPAN
219 or Javascript based decoding on the client side.
226 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
227 my @s = map { index( $seq, $_ ); } split( //, $encoded );
228 my $l = ( $#s + 1 ) % 4;
231 # warn "Error: Cuecat decode parsing failed!";
239 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
241 chr( ( $n >> 16 ) ^ 67 )
242 .chr( ( $n >> 8 & 255 ) ^ 67 )
243 .chr( ( $n & 255 ) ^ 67 );
246 $r = substr( $r, 0, length($r) - $l );
252 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
253 $barcode, $ignore_reserves);
255 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
257 C<$newbranch> is the code for the branch to which the item should be transferred.
259 C<$barcode> is the barcode of the item to be transferred.
261 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
262 Otherwise, if an item is reserved, the transfer fails.
264 Returns three values:
270 is true if the transfer was successful.
274 is a reference-to-hash which may have any of the following keys:
280 There is no item in the catalog with the given barcode. The value is C<$barcode>.
284 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.
286 =item C<DestinationEqualsHolding>
288 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.
292 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.
296 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>.
298 =item C<WasTransferred>
300 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
309 my ( $tbr, $barcode, $ignoreRs ) = @_;
312 my $itemnumber = GetItemnumberFromBarcode( $barcode );
313 my $issue = GetItemIssue($itemnumber);
314 my $biblio = GetBiblioFromItemNumber($itemnumber);
317 if ( not $itemnumber ) {
318 $messages->{'BadBarcode'} = $barcode;
322 # get branches of book...
323 my $hbr = $biblio->{'homebranch'};
324 my $fbr = $biblio->{'holdingbranch'};
326 # if using Branch Transfer Limits
327 if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
328 if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
329 if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
330 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
333 } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
334 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
340 # FIXME Is this still used by someone?
341 # See other FIXME in AddReturn
342 my $library = Koha::Libraries->find($hbr);
343 if ( $library and $library->get_categories->search({'me.categorycode' => 'PE'})->count ) {
344 $messages->{'IsPermanent'} = $hbr;
348 # can't transfer book if is already there....
349 if ( $fbr eq $tbr ) {
350 $messages->{'DestinationEqualsHolding'} = 1;
354 # check if it is still issued to someone, return it...
355 if ($issue->{borrowernumber}) {
356 AddReturn( $barcode, $fbr );
357 $messages->{'WasReturned'} = $issue->{borrowernumber};
361 # That'll save a database query.
362 my ( $resfound, $resrec, undef ) =
363 CheckReserves( $itemnumber );
364 if ( $resfound and not $ignoreRs ) {
365 $resrec->{'ResFound'} = $resfound;
367 # $messages->{'ResFound'} = $resrec;
371 #actually do the transfer....
373 ModItemTransfer( $itemnumber, $fbr, $tbr );
375 # don't need to update MARC anymore, we do it in batch now
376 $messages->{'WasTransfered'} = 1;
379 ModDateLastSeen( $itemnumber );
380 return ( $dotransfer, $messages, $biblio );
385 my $borrower = shift;
386 my $biblionumber = shift;
389 my $onsite_checkout = $params->{onsite_checkout} || 0;
390 my $cat_borrower = $borrower->{'categorycode'};
391 my $dbh = C4::Context->dbh;
393 # Get which branchcode we need
394 $branch = _GetCircControlBranch($item,$borrower);
395 my $type = (C4::Context->preference('item-level_itypes'))
396 ? $item->{'itype'} # item-level
397 : $item->{'itemtype'}; # biblio-level
399 # given branch, patron category, and item type, determine
400 # applicable issuing rule
401 my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
403 # if a rule is found and has a loan limit set, count
404 # how many loans the patron already has that meet that
406 if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
409 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
411 JOIN items USING (itemnumber)
414 my $rule_itemtype = $issuing_rule->{itemtype};
415 if ($rule_itemtype eq "*") {
416 # matching rule has the default item type, so count only
417 # those existing loans that don't fall under a more
419 if (C4::Context->preference('item-level_itypes')) {
420 $count_query .= " WHERE items.itype NOT IN (
421 SELECT itemtype FROM issuingrules
423 AND (categorycode = ? OR categorycode = ?)
427 $count_query .= " JOIN biblioitems USING (biblionumber)
428 WHERE biblioitems.itemtype NOT IN (
429 SELECT itemtype FROM issuingrules
431 AND (categorycode = ? OR categorycode = ?)
435 push @bind_params, $issuing_rule->{branchcode};
436 push @bind_params, $issuing_rule->{categorycode};
437 push @bind_params, $cat_borrower;
439 # rule has specific item type, so count loans of that
441 if (C4::Context->preference('item-level_itypes')) {
442 $count_query .= " WHERE items.itype = ? ";
444 $count_query .= " JOIN biblioitems USING (biblionumber)
445 WHERE biblioitems.itemtype= ? ";
447 push @bind_params, $type;
450 $count_query .= " AND borrowernumber = ? ";
451 push @bind_params, $borrower->{'borrowernumber'};
452 my $rule_branch = $issuing_rule->{branchcode};
453 if ($rule_branch ne "*") {
454 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
455 $count_query .= " AND issues.branchcode = ? ";
456 push @bind_params, $branch;
457 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
458 ; # if branch is the patron's home branch, then count all loans by patron
460 $count_query .= " AND items.homebranch = ? ";
461 push @bind_params, $branch;
465 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $count_query, {}, @bind_params );
467 my $max_checkouts_allowed = $issuing_rule->{maxissueqty};
468 my $max_onsite_checkouts_allowed = $issuing_rule->{maxonsiteissueqty};
470 if ( $onsite_checkout ) {
471 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
473 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
474 count => $onsite_checkout_count,
475 max_allowed => $max_onsite_checkouts_allowed,
479 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
480 if ( $checkout_count >= $max_checkouts_allowed ) {
482 reason => 'TOO_MANY_CHECKOUTS',
483 count => $checkout_count,
484 max_allowed => $max_checkouts_allowed,
487 } elsif ( not $onsite_checkout ) {
488 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
490 reason => 'TOO_MANY_CHECKOUTS',
491 count => $checkout_count - $onsite_checkout_count,
492 max_allowed => $max_checkouts_allowed,
498 # Now count total loans against the limit for the branch
499 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
500 if (defined($branch_borrower_circ_rule->{maxissueqty})) {
501 my @bind_params = ();
502 my $branch_count_query = q|
503 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
505 JOIN items USING (itemnumber)
506 WHERE borrowernumber = ?
508 push @bind_params, $borrower->{borrowernumber};
510 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
511 $branch_count_query .= " AND issues.branchcode = ? ";
512 push @bind_params, $branch;
513 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
514 ; # if branch is the patron's home branch, then count all loans by patron
516 $branch_count_query .= " AND items.homebranch = ? ";
517 push @bind_params, $branch;
519 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $branch_count_query, {}, @bind_params );
520 my $max_checkouts_allowed = $branch_borrower_circ_rule->{maxissueqty};
521 my $max_onsite_checkouts_allowed = $branch_borrower_circ_rule->{maxonsiteissueqty};
523 if ( $onsite_checkout ) {
524 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
526 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
527 count => $onsite_checkout_count,
528 max_allowed => $max_onsite_checkouts_allowed,
532 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
533 if ( $checkout_count >= $max_checkouts_allowed ) {
535 reason => 'TOO_MANY_CHECKOUTS',
536 count => $checkout_count,
537 max_allowed => $max_checkouts_allowed,
540 } elsif ( not $onsite_checkout ) {
541 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
543 reason => 'TOO_MANY_CHECKOUTS',
544 count => $checkout_count - $onsite_checkout_count,
545 max_allowed => $max_checkouts_allowed,
551 # OK, the patron can issue !!!
555 =head2 CanBookBeIssued
557 ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower,
558 $barcode, $duedate, $inprocess, $ignore_reserves, $params );
560 Check if a book can be issued.
562 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
566 =item C<$borrower> hash with borrower informations (from GetMember or GetMemberDetails)
568 =item C<$barcode> is the bar code of the book being issued.
570 =item C<$duedates> is a DateTime object.
572 =item C<$inprocess> boolean switch
574 =item C<$ignore_reserves> boolean switch
576 =item C<$params> Hashref of additional parameters
579 override_high_holds - Ignore high holds
580 onsite_checkout - Checkout is an onsite checkout that will not leave the library
588 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
589 Possible values are :
595 sticky due date is invalid
599 borrower gone with no address
603 borrower declared it's card lost
609 =head3 UNKNOWN_BARCODE
623 item is restricted (set by ??)
625 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
626 could be prevented, but ones that can be overriden by the operator.
628 Possible values are :
636 renewing, not issuing
638 =head3 ISSUED_TO_ANOTHER
640 issued to someone else.
644 reserved for someone else.
648 sticky due date is invalid or due date in the past
652 if the borrower borrows to much things
656 sub CanBookBeIssued {
657 my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves, $params ) = @_;
658 my %needsconfirmation; # filled with problems that needs confirmations
659 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
660 my %alerts; # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
661 my %messages; # filled with information messages that should be displayed.
663 my $onsite_checkout = $params->{onsite_checkout} || 0;
664 my $override_high_holds = $params->{override_high_holds} || 0;
666 my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
667 my $issue = GetItemIssue($item->{itemnumber});
668 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
669 $item->{'itemtype'}=$item->{'itype'};
670 my $dbh = C4::Context->dbh;
672 # MANDATORY CHECKS - unless item exists, nothing else matters
673 unless ( $item->{barcode} ) {
674 $issuingimpossible{UNKNOWN_BARCODE} = 1;
676 return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
679 # DUE DATE is OK ? -- should already have checked.
681 if ($duedate && ref $duedate ne 'DateTime') {
682 $duedate = dt_from_string($duedate);
684 my $now = DateTime->now( time_zone => C4::Context->tz() );
685 unless ( $duedate ) {
686 my $issuedate = $now->clone();
688 my $branch = _GetCircControlBranch($item,$borrower);
689 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
690 $duedate = CalcDateDue( $issuedate, $itype, $branch, $borrower );
692 # Offline circ calls AddIssue directly, doesn't run through here
693 # So issuingimpossible should be ok.
696 my $today = $now->clone();
697 $today->truncate( to => 'minute');
698 if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
699 $needsconfirmation{INVALID_DATE} = output_pref($duedate);
702 $issuingimpossible{INVALID_DATE} = output_pref($duedate);
708 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
709 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
711 branch => C4::Context->userenv->{'branch'},
713 itemnumber => $item->{'itemnumber'},
714 itemtype => $item->{'itemtype'},
715 borrowernumber => $borrower->{'borrowernumber'},
716 ccode => $item->{'ccode'}}
718 ModDateLastSeen( $item->{'itemnumber'} );
719 return( { STATS => 1 }, {});
721 if ( ref $borrower->{flags} ) {
722 if ( $borrower->{flags}->{GNA} ) {
723 $issuingimpossible{GNA} = 1;
725 if ( $borrower->{flags}->{'LOST'} ) {
726 $issuingimpossible{CARD_LOST} = 1;
728 if ( $borrower->{flags}->{'DBARRED'} ) {
729 $issuingimpossible{DEBARRED} = 1;
732 if ( !defined $borrower->{dateexpiry} || $borrower->{'dateexpiry'} eq '0000-00-00') {
733 $issuingimpossible{EXPIRED} = 1;
735 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'sql', 'floating' );
736 $expiry_dt->truncate( to => 'day');
737 my $today = $now->clone()->truncate(to => 'day');
738 $today->set_time_zone( 'floating' );
739 if ( DateTime->compare($today, $expiry_dt) == 1 ) {
740 $issuingimpossible{EXPIRED} = 1;
749 my ($balance, $non_issue_charges, $other_charges) =
750 C4::Members::GetMemberAccountBalance( $borrower->{'borrowernumber'} );
752 my $amountlimit = C4::Context->preference("noissuescharge");
753 my $allowfineoverride = C4::Context->preference("AllowFineOverride");
754 my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
756 # Check the debt of this patrons guarantees
757 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
758 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
759 if ( defined $no_issues_charge_guarantees ) {
760 my $p = Koha::Patrons->find( $borrower->{borrowernumber} );
761 my @guarantees = $p->guarantees();
762 my $guarantees_non_issues_charges;
763 foreach my $g ( @guarantees ) {
764 my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
765 $guarantees_non_issues_charges += $n;
768 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && !$allowfineoverride) {
769 $issuingimpossible{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
770 } elsif ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && $allowfineoverride) {
771 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
772 } elsif ( $allfinesneedoverride && $guarantees_non_issues_charges > 0 && $guarantees_non_issues_charges <= $no_issues_charge_guarantees && !$inprocess ) {
773 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
777 if ( C4::Context->preference("IssuingInProcess") ) {
778 if ( $non_issue_charges > $amountlimit && !$inprocess && !$allowfineoverride) {
779 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
780 } elsif ( $non_issue_charges > $amountlimit && !$inprocess && $allowfineoverride) {
781 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
782 } elsif ( $allfinesneedoverride && $non_issue_charges > 0 && $non_issue_charges <= $amountlimit && !$inprocess ) {
783 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
787 if ( $non_issue_charges > $amountlimit && $allowfineoverride ) {
788 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
789 } elsif ( $non_issue_charges > $amountlimit && !$allowfineoverride) {
790 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
791 } elsif ( $non_issue_charges > 0 && $allfinesneedoverride ) {
792 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
796 if ($balance > 0 && $other_charges > 0) {
797 $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges );
800 my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'});
801 if ($blocktype == -1) {
802 ## patron has outstanding overdue loans
803 if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
804 $issuingimpossible{USERBLOCKEDOVERDUE} = $count;
806 elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
807 $needsconfirmation{USERBLOCKEDOVERDUE} = $count;
809 } elsif($blocktype == 1) {
810 # patron has accrued fine days or has a restriction. $count is a date
811 if ($count eq '9999-12-31') {
812 $issuingimpossible{USERBLOCKEDNOENDDATE} = $count;
815 $issuingimpossible{USERBLOCKEDWITHENDDATE} = $count;
820 # JB34 CHECKS IF BORROWERS DON'T HAVE ISSUE TOO MANY BOOKS
822 my $toomany = TooMany( $borrower, $item->{biblionumber}, $item, { onsite_checkout => $onsite_checkout } );
823 # if TooMany max_allowed returns 0 the user doesn't have permission to check out this book
825 if ( $toomany->{max_allowed} == 0 ) {
826 $needsconfirmation{PATRON_CANT} = 1;
828 if ( C4::Context->preference("AllowTooManyOverride") ) {
829 $needsconfirmation{TOO_MANY} = $toomany->{reason};
830 $needsconfirmation{current_loan_count} = $toomany->{count};
831 $needsconfirmation{max_loans_allowed} = $toomany->{max_allowed};
833 $issuingimpossible{TOO_MANY} = $toomany->{reason};
834 $issuingimpossible{current_loan_count} = $toomany->{count};
835 $issuingimpossible{max_loans_allowed} = $toomany->{max_allowed};
840 # CHECKPREVCHECKOUT: CHECK IF ITEM HAS EVER BEEN LENT TO PATRON
842 my $patron = Koha::Patrons->find($borrower->{borrowernumber});
843 my $wants_check = $patron->wants_check_for_previous_checkout;
844 $needsconfirmation{PREVISSUE} = 1
845 if ($wants_check and $patron->do_check_for_previous_checkout($item));
850 if ( $item->{'notforloan'} )
852 if(!C4::Context->preference("AllowNotForLoanOverride")){
853 $issuingimpossible{NOT_FOR_LOAN} = 1;
854 $issuingimpossible{item_notforloan} = $item->{'notforloan'};
856 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
857 $needsconfirmation{item_notforloan} = $item->{'notforloan'};
861 # we have to check itemtypes.notforloan also
862 if (C4::Context->preference('item-level_itypes')){
863 # this should probably be a subroutine
864 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
865 $sth->execute($item->{'itemtype'});
866 my $notforloan=$sth->fetchrow_hashref();
867 if ($notforloan->{'notforloan'}) {
868 if (!C4::Context->preference("AllowNotForLoanOverride")) {
869 $issuingimpossible{NOT_FOR_LOAN} = 1;
870 $issuingimpossible{itemtype_notforloan} = $item->{'itype'};
872 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
873 $needsconfirmation{itemtype_notforloan} = $item->{'itype'};
877 elsif ($biblioitem->{'notforloan'} == 1){
878 if (!C4::Context->preference("AllowNotForLoanOverride")) {
879 $issuingimpossible{NOT_FOR_LOAN} = 1;
880 $issuingimpossible{itemtype_notforloan} = $biblioitem->{'itemtype'};
882 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
883 $needsconfirmation{itemtype_notforloan} = $biblioitem->{'itemtype'};
887 if ( $item->{'withdrawn'} && $item->{'withdrawn'} > 0 )
889 $issuingimpossible{WTHDRAWN} = 1;
891 if ( $item->{'restricted'}
892 && $item->{'restricted'} == 1 )
894 $issuingimpossible{RESTRICTED} = 1;
896 if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
897 my $code = GetAuthorisedValueByCode( 'LOST', $item->{'itemlost'} );
898 $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
899 $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
901 if ( C4::Context->preference("IndependentBranches") ) {
902 my $userenv = C4::Context->userenv;
903 unless ( C4::Context->IsSuperLibrarian() ) {
904 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ){
905 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
906 $issuingimpossible{'itemhomebranch'} = $item->{C4::Context->preference("HomeOrHoldingBranch")};
908 $needsconfirmation{BORRNOTSAMEBRANCH} = $borrower->{'branchcode'}
909 if ( $borrower->{'branchcode'} ne $userenv->{branch} );
913 # CHECK IF THERE IS RENTAL CHARGES. RENTAL MUST BE CONFIRMED BY THE BORROWER
915 my $rentalConfirmation = C4::Context->preference("RentalFeesCheckoutConfirmation");
917 if ( $rentalConfirmation ){
918 my ($rentalCharge) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
919 if ( $rentalCharge > 0 ){
920 $rentalCharge = sprintf("%.02f", $rentalCharge);
921 $needsconfirmation{RENTALCHARGE} = $rentalCharge;
926 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
928 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} ){
930 # Already issued to current borrower.
931 # If it is an on-site checkout if it can be switched to a normal checkout
932 # or ask whether the loan should be renewed
934 if ( $issue->{onsite_checkout}
935 and C4::Context->preference('SwitchOnSiteCheckouts') ) {
936 $messages{ONSITE_CHECKOUT_WILL_BE_SWITCHED} = 1;
938 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
939 $borrower->{'borrowernumber'},
940 $item->{'itemnumber'},
942 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
943 if ( $renewerror eq 'onsite_checkout' ) {
944 $issuingimpossible{NO_RENEWAL_FOR_ONSITE_CHECKOUTS} = 1;
947 $issuingimpossible{NO_MORE_RENEWALS} = 1;
951 $needsconfirmation{RENEW_ISSUE} = 1;
955 elsif ($issue->{borrowernumber}) {
957 # issued to someone else
958 my $currborinfo = C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} );
961 my ( $can_be_returned, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
963 unless ( $can_be_returned ) {
964 $issuingimpossible{RETURN_IMPOSSIBLE} = 1;
965 $issuingimpossible{branch_to_return} = $message;
967 $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
968 $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
969 $needsconfirmation{issued_surname} = $currborinfo->{'surname'};
970 $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
971 $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
975 unless ( $ignore_reserves ) {
976 # See if the item is on reserve.
977 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
979 my $resbor = $res->{'borrowernumber'};
980 if ( $resbor ne $borrower->{'borrowernumber'} ) {
981 my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor );
982 if ( $restype eq "Waiting" )
984 # The item is on reserve and waiting, but has been
985 # reserved by some other patron.
986 $needsconfirmation{RESERVE_WAITING} = 1;
987 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
988 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
989 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
990 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
991 $needsconfirmation{'resbranchcode'} = $res->{branchcode};
992 $needsconfirmation{'reswaitingdate'} = $res->{'waitingdate'};
994 elsif ( $restype eq "Reserved" ) {
995 # The item is on reserve for someone else.
996 $needsconfirmation{RESERVED} = 1;
997 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
998 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
999 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
1000 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
1001 $needsconfirmation{'resbranchcode'} = $res->{branchcode};
1002 $needsconfirmation{'resreservedate'} = $res->{'reservedate'};
1008 ## CHECK AGE RESTRICTION
1009 my $agerestriction = $biblioitem->{'agerestriction'};
1010 my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $borrower );
1011 if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1012 if ( C4::Context->preference('AgeRestrictionOverride') ) {
1013 $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1016 $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1020 ## check for high holds decreasing loan period
1021 if ( C4::Context->preference('decreaseLoanHighHolds') ) {
1022 my $check = checkHighHolds( $item, $borrower );
1024 if ( $check->{exceeded} ) {
1025 if ($override_high_holds) {
1026 $alerts{HIGHHOLDS} = {
1027 num_holds => $check->{outstanding},
1028 duration => $check->{duration},
1029 returndate => output_pref( $check->{due_date} ),
1033 $needsconfirmation{HIGHHOLDS} = {
1034 num_holds => $check->{outstanding},
1035 duration => $check->{duration},
1036 returndate => output_pref( $check->{due_date} ),
1043 !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1044 # don't do the multiple loans per bib check if we've
1045 # already determined that we've got a loan on the same item
1046 !$issuingimpossible{NO_MORE_RENEWALS} &&
1047 !$needsconfirmation{RENEW_ISSUE}
1049 # Check if borrower has already issued an item from the same biblio
1050 # Only if it's not a subscription
1051 my $biblionumber = $item->{biblionumber};
1052 require C4::Serials;
1053 my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1054 unless ($is_a_subscription) {
1055 my $issues = GetIssues( {
1056 borrowernumber => $borrower->{borrowernumber},
1057 biblionumber => $biblionumber,
1059 my @issues = $issues ? @$issues : ();
1060 # if we get here, we don't already have a loan on this item,
1061 # so if there are any loans on this bib, ask for confirmation
1062 if (scalar @issues > 0) {
1063 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1068 return ( \%issuingimpossible, \%needsconfirmation, \%alerts, \%messages, );
1071 =head2 CanBookBeReturned
1073 ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1075 Check whether the item can be returned to the provided branch
1079 =item C<$item> is a hash of item information as returned from GetItem
1081 =item C<$branch> is the branchcode where the return is taking place
1089 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1091 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1097 sub CanBookBeReturned {
1098 my ($item, $branch) = @_;
1099 my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1101 # assume return is allowed to start
1105 # identify all cases where return is forbidden
1106 if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1108 $message = $item->{'homebranch'};
1109 } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1111 $message = $item->{'holdingbranch'};
1112 } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1114 $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1117 return ($allowed, $message);
1120 =head2 CheckHighHolds
1122 used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1123 decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1124 has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1128 sub checkHighHolds {
1129 my ( $item, $borrower ) = @_;
1130 my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1131 my $branch = _GetCircControlBranch( $item, $borrower );
1140 my $holds = Koha::Holds->search( { biblionumber => $item->{'biblionumber'} } );
1142 if ( $holds->count() ) {
1143 $return_data->{outstanding} = $holds->count();
1145 my $decreaseLoanHighHoldsControl = C4::Context->preference('decreaseLoanHighHoldsControl');
1146 my $decreaseLoanHighHoldsValue = C4::Context->preference('decreaseLoanHighHoldsValue');
1147 my $decreaseLoanHighHoldsIgnoreStatuses = C4::Context->preference('decreaseLoanHighHoldsIgnoreStatuses');
1149 my @decreaseLoanHighHoldsIgnoreStatuses = split( /,/, $decreaseLoanHighHoldsIgnoreStatuses );
1151 if ( $decreaseLoanHighHoldsControl eq 'static' ) {
1153 # static means just more than a given number of holds on the record
1155 # If the number of holds is less than the threshold, we can stop here
1156 if ( $holds->count() < $decreaseLoanHighHoldsValue ) {
1157 return $return_data;
1160 elsif ( $decreaseLoanHighHoldsControl eq 'dynamic' ) {
1162 # dynamic means X more than the number of holdable items on the record
1164 # let's get the items
1165 my @items = $holds->next()->biblio()->items();
1167 # Remove any items with status defined to be ignored even if the would not make item unholdable
1168 foreach my $status (@decreaseLoanHighHoldsIgnoreStatuses) {
1169 @items = grep { !$_->$status } @items;
1172 # Remove any items that are not holdable for this patron
1173 @items = grep { CanItemBeReserved( $borrower->{borrowernumber}, $_->itemnumber ) eq 'OK' } @items;
1175 my $items_count = scalar @items;
1177 my $threshold = $items_count + $decreaseLoanHighHoldsValue;
1179 # If the number of holds is less than the count of items we have
1180 # plus the number of holds allowed above that count, we can stop here
1181 if ( $holds->count() <= $threshold ) {
1182 return $return_data;
1186 my $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1188 my $calendar = Koha::Calendar->new( branchcode => $branch );
1191 ( C4::Context->preference('item-level_itypes') )
1192 ? $biblio->{'itype'}
1193 : $biblio->{'itemtype'};
1195 my $orig_due = C4::Circulation::CalcDateDue( $issuedate, $itype, $branch, $borrower );
1197 my $decreaseLoanHighHoldsDuration = C4::Context->preference('decreaseLoanHighHoldsDuration');
1199 my $reduced_datedue = $calendar->addDate( $issuedate, $decreaseLoanHighHoldsDuration );
1201 if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1202 $return_data->{exceeded} = 1;
1203 $return_data->{duration} = $decreaseLoanHighHoldsDuration;
1204 $return_data->{due_date} = $reduced_datedue;
1208 return $return_data;
1213 &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1215 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1219 =item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails).
1221 =item C<$barcode> is the barcode of the item being issued.
1223 =item C<$datedue> is a DateTime object for the max date of return, i.e. the date due (optional).
1224 Calculated if empty.
1226 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1228 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1229 Defaults to today. Unlike C<$datedue>, NOT a DateTime object, unfortunately.
1231 AddIssue does the following things :
1233 - step 01: check that there is a borrowernumber & a barcode provided
1234 - check for RENEWAL (book issued & being issued to the same patron)
1235 - renewal YES = Calculate Charge & renew
1237 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1239 - fill reserve if reserve to this patron
1240 - cancel reserve or not, otherwise
1241 * TRANSFERT PENDING ?
1242 - complete the transfert
1250 my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1252 my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1253 my $switch_onsite_checkout = $params && $params->{switch_onsite_checkout};
1254 my $auto_renew = $params && $params->{auto_renew};
1255 my $dbh = C4::Context->dbh;
1256 my $barcodecheck = CheckValidBarcode($barcode);
1260 if ( $datedue && ref $datedue ne 'DateTime' ) {
1261 $datedue = dt_from_string($datedue);
1264 # $issuedate defaults to today.
1265 if ( !defined $issuedate ) {
1266 $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1269 if ( ref $issuedate ne 'DateTime' ) {
1270 $issuedate = dt_from_string($issuedate);
1275 # Stop here if the patron or barcode doesn't exist
1276 if ( $borrower && $barcode && $barcodecheck ) {
1277 # find which item we issue
1278 my $item = GetItem( '', $barcode )
1279 or return; # if we don't get an Item, abort.
1281 my $branch = _GetCircControlBranch( $item, $borrower );
1283 # get actual issuing if there is one
1284 my $actualissue = GetItemIssue( $item->{itemnumber} );
1286 # get biblioinformation for this item
1287 my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1289 # check if we just renew the issue.
1290 if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}
1291 and not $switch_onsite_checkout ) {
1292 $datedue = AddRenewal(
1293 $borrower->{'borrowernumber'},
1294 $item->{'itemnumber'},
1297 $issuedate, # here interpreted as the renewal date
1301 # it's NOT a renewal
1302 if ( $actualissue->{borrowernumber}
1303 and not $switch_onsite_checkout ) {
1304 # This book is currently on loan, but not to the person
1305 # who wants to borrow it now. mark it returned before issuing to the new borrower
1306 my ( $allowed, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
1307 return unless $allowed;
1308 AddReturn( $item->{'barcode'}, C4::Context->userenv->{'branch'} );
1311 MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1313 # Starting process for transfer job (checking transfert and validate it if we have one)
1314 my ($datesent) = GetTransfers( $item->{'itemnumber'} );
1316 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1317 my $sth = $dbh->prepare(
1318 "UPDATE branchtransfers
1319 SET datearrived = now(),
1321 comments = 'Forced branchtransfer'
1322 WHERE itemnumber= ? AND datearrived IS NULL"
1324 $sth->execute( C4::Context->userenv->{'branch'},
1325 $item->{'itemnumber'} );
1328 # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1329 unless ($auto_renew) {
1330 my $issuingrule = GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branch );
1331 $auto_renew = $issuingrule->{auto_renew};
1334 # Record in the database the fact that the book was issued.
1337 ( C4::Context->preference('item-level_itypes') )
1338 ? $biblio->{'itype'}
1339 : $biblio->{'itemtype'};
1340 $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1343 $datedue->truncate( to => 'minute' );
1345 $issue = Koha::Database->new()->schema()->resultset('Issue')->update_or_create(
1347 borrowernumber => $borrower->{'borrowernumber'},
1348 itemnumber => $item->{'itemnumber'},
1349 issuedate => $issuedate->strftime('%Y-%m-%d %H:%M:%S'),
1350 date_due => $datedue->strftime('%Y-%m-%d %H:%M:%S'),
1351 branchcode => C4::Context->userenv->{'branch'},
1352 onsite_checkout => $onsite_checkout,
1353 auto_renew => $auto_renew ? 1 : 0
1357 if ( C4::Context->preference('ReturnToShelvingCart') ) {
1358 # ReturnToShelvingCart is on, anything issued should be taken off the cart.
1359 CartToShelf( $item->{'itemnumber'} );
1361 $item->{'issues'}++;
1362 if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1363 UpdateTotalIssues( $item->{'biblionumber'}, 1 );
1366 ## If item was lost, it has now been found, reverse any list item charges if necessary.
1367 if ( $item->{'itemlost'} ) {
1369 Koha::RefundLostItemFeeRules->should_refund(
1371 current_branch => C4::Context->userenv->{branch},
1372 item_home_branch => $item->{homebranch},
1373 item_holding_branch => $item->{holdingbranch}
1378 _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef,
1379 $item->{'barcode'} );
1385 issues => $item->{'issues'},
1386 holdingbranch => C4::Context->userenv->{'branch'},
1388 onloan => $datedue->ymd(),
1389 datelastborrowed => DateTime->now( time_zone => C4::Context->tz() )->ymd(),
1391 $item->{'biblionumber'},
1392 $item->{'itemnumber'}
1394 ModDateLastSeen( $item->{'itemnumber'} );
1396 # If it costs to borrow this book, charge it to the patron's account.
1397 my ( $charge, $itemtype ) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
1398 if ( $charge > 0 ) {
1399 AddIssuingCharge( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge );
1400 $item->{'charge'} = $charge;
1403 # Record the fact that this book was issued.
1406 branch => C4::Context->userenv->{'branch'},
1407 type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1409 other => ( $sipmode ? "SIP-$sipmode" : '' ),
1410 itemnumber => $item->{'itemnumber'},
1411 itemtype => $item->{'itype'},
1412 borrowernumber => $borrower->{'borrowernumber'},
1413 ccode => $item->{'ccode'}
1417 # Send a checkout slip.
1418 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1420 branchcode => $branch,
1421 categorycode => $borrower->{categorycode},
1422 item_type => $item->{itype},
1423 notification => 'CHECKOUT',
1425 if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
1426 SendCirculationAlert(
1430 borrower => $borrower,
1438 "CIRCULATION", "ISSUE",
1439 $borrower->{'borrowernumber'},
1440 $biblio->{'itemnumber'}
1441 ) if C4::Context->preference("IssueLog");
1446 =head2 GetLoanLength
1448 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1450 Get loan length for an itemtype, a borrower type and a branch
1455 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1456 my $dbh = C4::Context->dbh;
1457 my $sth = $dbh->prepare(qq{
1458 SELECT issuelength, lengthunit, renewalperiod
1460 WHERE categorycode=?
1463 AND issuelength IS NOT NULL
1466 # try to find issuelength & return the 1st available.
1467 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1468 $sth->execute( $borrowertype, $itemtype, $branchcode );
1469 my $loanlength = $sth->fetchrow_hashref;
1472 if defined($loanlength) && defined $loanlength->{issuelength};
1474 $sth->execute( $borrowertype, '*', $branchcode );
1475 $loanlength = $sth->fetchrow_hashref;
1477 if defined($loanlength) && defined $loanlength->{issuelength};
1479 $sth->execute( '*', $itemtype, $branchcode );
1480 $loanlength = $sth->fetchrow_hashref;
1482 if defined($loanlength) && defined $loanlength->{issuelength};
1484 $sth->execute( '*', '*', $branchcode );
1485 $loanlength = $sth->fetchrow_hashref;
1487 if defined($loanlength) && defined $loanlength->{issuelength};
1489 $sth->execute( $borrowertype, $itemtype, '*' );
1490 $loanlength = $sth->fetchrow_hashref;
1492 if defined($loanlength) && defined $loanlength->{issuelength};
1494 $sth->execute( $borrowertype, '*', '*' );
1495 $loanlength = $sth->fetchrow_hashref;
1497 if defined($loanlength) && defined $loanlength->{issuelength};
1499 $sth->execute( '*', $itemtype, '*' );
1500 $loanlength = $sth->fetchrow_hashref;
1502 if defined($loanlength) && defined $loanlength->{issuelength};
1504 $sth->execute( '*', '*', '*' );
1505 $loanlength = $sth->fetchrow_hashref;
1507 if defined($loanlength) && defined $loanlength->{issuelength};
1509 # if no rule is set => 0 day (hardcoded)
1513 lengthunit => 'days',
1519 =head2 GetHardDueDate
1521 my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1523 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1527 sub GetHardDueDate {
1528 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1530 my $rule = GetIssuingRule( $borrowertype, $itemtype, $branchcode );
1532 if ( defined( $rule ) ) {
1533 if ( $rule->{hardduedate} ) {
1534 return (dt_from_string($rule->{hardduedate}, 'iso'),$rule->{hardduedatecompare});
1536 return (undef, undef);
1541 =head2 GetIssuingRule
1543 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1545 FIXME - This is a copy-paste of GetLoanLength
1546 as a stop-gap. Do not wish to change API for GetLoanLength
1547 this close to release.
1549 Get the issuing rule for an itemtype, a borrower type and a branch
1550 Returns a hashref from the issuingrules table.
1554 sub GetIssuingRule {
1555 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1556 my $dbh = C4::Context->dbh;
1557 my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=?" );
1560 $sth->execute( $borrowertype, $itemtype, $branchcode );
1561 $irule = $sth->fetchrow_hashref;
1562 return $irule if defined($irule) ;
1564 $sth->execute( $borrowertype, "*", $branchcode );
1565 $irule = $sth->fetchrow_hashref;
1566 return $irule if defined($irule) ;
1568 $sth->execute( "*", $itemtype, $branchcode );
1569 $irule = $sth->fetchrow_hashref;
1570 return $irule if defined($irule) ;
1572 $sth->execute( "*", "*", $branchcode );
1573 $irule = $sth->fetchrow_hashref;
1574 return $irule if defined($irule) ;
1576 $sth->execute( $borrowertype, $itemtype, "*" );
1577 $irule = $sth->fetchrow_hashref;
1578 return $irule if defined($irule) ;
1580 $sth->execute( $borrowertype, "*", "*" );
1581 $irule = $sth->fetchrow_hashref;
1582 return $irule if defined($irule) ;
1584 $sth->execute( "*", $itemtype, "*" );
1585 $irule = $sth->fetchrow_hashref;
1586 return $irule if defined($irule) ;
1588 $sth->execute( "*", "*", "*" );
1589 $irule = $sth->fetchrow_hashref;
1590 return $irule if defined($irule) ;
1592 # if no rule matches,
1596 =head2 GetBranchBorrowerCircRule
1598 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1600 Retrieves circulation rule attributes that apply to the given
1601 branch and patron category, regardless of item type.
1602 The return value is a hashref containing the following key:
1604 maxissueqty - maximum number of loans that a
1605 patron of the given category can have at the given
1606 branch. If the value is undef, no limit.
1608 maxonsiteissueqty - maximum of on-site checkouts that a
1609 patron of the given category can have at the given
1610 branch. If the value is undef, no limit.
1612 This will first check for a specific branch and
1613 category match from branch_borrower_circ_rules.
1615 If no rule is found, it will then check default_branch_circ_rules
1616 (same branch, default category). If no rule is found,
1617 it will then check default_borrower_circ_rules (default
1618 branch, same category), then failing that, default_circ_rules
1619 (default branch, default category).
1621 If no rule has been found in the database, it will default to
1625 maxonsiteissueqty - undef
1627 C<$branchcode> and C<$categorycode> should contain the
1628 literal branch code and patron category code, respectively - no
1633 sub GetBranchBorrowerCircRule {
1634 my ( $branchcode, $categorycode ) = @_;
1637 my $dbh = C4::Context->dbh();
1638 $rules = $dbh->selectrow_hashref( q|
1639 SELECT maxissueqty, maxonsiteissueqty
1640 FROM branch_borrower_circ_rules
1641 WHERE branchcode = ?
1642 AND categorycode = ?
1643 |, {}, $branchcode, $categorycode ) ;
1644 return $rules if $rules;
1646 # try same branch, default borrower category
1647 $rules = $dbh->selectrow_hashref( q|
1648 SELECT maxissueqty, maxonsiteissueqty
1649 FROM default_branch_circ_rules
1650 WHERE branchcode = ?
1651 |, {}, $branchcode ) ;
1652 return $rules if $rules;
1654 # try default branch, same borrower category
1655 $rules = $dbh->selectrow_hashref( q|
1656 SELECT maxissueqty, maxonsiteissueqty
1657 FROM default_borrower_circ_rules
1658 WHERE categorycode = ?
1659 |, {}, $categorycode ) ;
1660 return $rules if $rules;
1662 # try default branch, default borrower category
1663 $rules = $dbh->selectrow_hashref( q|
1664 SELECT maxissueqty, maxonsiteissueqty
1665 FROM default_circ_rules
1667 return $rules if $rules;
1669 # built-in default circulation rule
1671 maxissueqty => undef,
1672 maxonsiteissueqty => undef,
1676 =head2 GetBranchItemRule
1678 my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1680 Retrieves circulation rule attributes that apply to the given
1681 branch and item type, regardless of patron category.
1683 The return value is a hashref containing the following keys:
1685 holdallowed => Hold policy for this branch and itemtype. Possible values:
1686 0: No holds allowed.
1687 1: Holds allowed only by patrons that have the same homebranch as the item.
1688 2: Holds allowed from any patron.
1690 returnbranch => branch to which to return item. Possible values:
1691 noreturn: do not return, let item remain where checked in (floating collections)
1692 homebranch: return to item's home branch
1693 holdingbranch: return to issuer branch
1695 This searches branchitemrules in the following order:
1697 * Same branchcode and itemtype
1698 * Same branchcode, itemtype '*'
1699 * branchcode '*', same itemtype
1700 * branchcode and itemtype '*'
1702 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1706 sub GetBranchItemRule {
1707 my ( $branchcode, $itemtype ) = @_;
1708 my $dbh = C4::Context->dbh();
1712 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1713 FROM branch_item_rules
1714 WHERE branchcode = ?
1715 AND itemtype = ?', $branchcode, $itemtype],
1716 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1717 FROM default_branch_circ_rules
1718 WHERE branchcode = ?', $branchcode],
1719 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1720 FROM default_branch_item_rules
1721 WHERE itemtype = ?', $itemtype],
1722 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1723 FROM default_circ_rules'],
1726 foreach my $attempt (@attempts) {
1727 my ($query, @bind_params) = @{$attempt};
1728 my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1731 # Since branch/category and branch/itemtype use the same per-branch
1732 # defaults tables, we have to check that the key we want is set, not
1733 # just that a row was returned
1734 $result->{'holdallowed'} = $search_result->{'holdallowed'} unless ( defined $result->{'holdallowed'} );
1735 $result->{'hold_fulfillment_policy'} = $search_result->{'hold_fulfillment_policy'} unless ( defined $result->{'hold_fulfillment_policy'} );
1736 $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1739 # built-in default circulation rule
1740 $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1741 $result->{'hold_fulfillment_policy'} = 'any' unless ( defined $result->{'hold_fulfillment_policy'} );
1742 $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1749 ($doreturn, $messages, $iteminformation, $borrower) =
1750 &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
1756 =item C<$barcode> is the bar code of the book being returned.
1758 =item C<$branch> is the code of the branch where the book is being returned.
1760 =item C<$exemptfine> indicates that overdue charges for the item will be
1763 =item C<$dropbox> indicates that the check-in date is assumed to be
1764 yesterday, or the last non-holiday as defined in C4::Calendar . If
1765 overdue charges are applied and C<$dropbox> is true, the last charge
1766 will be removed. This assumes that the fines accrual script has run
1767 for _today_. Optional.
1769 =item C<$return_date> allows the default return date to be overridden
1770 by the given return date. Optional.
1774 C<&AddReturn> returns a list of four items:
1776 C<$doreturn> is true iff the return succeeded.
1778 C<$messages> is a reference-to-hash giving feedback on the operation.
1779 The keys of the hash are:
1785 No item with this barcode exists. The value is C<$barcode>.
1789 The book is not currently on loan. The value is C<$barcode>.
1791 =item C<IsPermanent>
1793 The book's home branch is a permanent collection. If you have borrowed
1794 this book, you are not allowed to return it. The value is the code for
1795 the book's home branch.
1799 This book has been withdrawn/cancelled. The value should be ignored.
1801 =item C<Wrongbranch>
1803 This book has was returned to the wrong branch. The value is a hashref
1804 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1805 contain the branchcode of the incorrect and correct return library, respectively.
1809 The item was reserved. The value is a reference-to-hash whose keys are
1810 fields from the reserves table of the Koha database, and
1811 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1812 either C<Waiting>, C<Reserved>, or 0.
1814 =item C<WasReturned>
1816 Value 1 if return is successful.
1818 =item C<NeedsTransfer>
1820 If AutomaticItemReturn is disabled, return branch is given as value of NeedsTransfer.
1824 C<$iteminformation> is a reference-to-hash, giving information about the
1825 returned item from the issues table.
1827 C<$borrower> is a reference-to-hash, giving information about the
1828 patron who last borrowed the book.
1833 my ( $barcode, $branch, $exemptfine, $dropbox, $return_date, $dropboxdate ) = @_;
1835 if ($branch and not Koha::Libraries->find($branch)) {
1836 warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
1839 $branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
1844 my $validTransfert = 0;
1845 my $stat_type = 'return';
1847 # get information on item
1848 my $itemnumber = GetItemnumberFromBarcode( $barcode );
1849 unless ($itemnumber) {
1850 return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower. bail out.
1852 my $issue = GetItemIssue($itemnumber);
1853 if ($issue and $issue->{borrowernumber}) {
1854 $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1855 or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existent borrowernumber '$issue->{borrowernumber}'\n"
1856 . Dumper($issue) . "\n";
1858 $messages->{'NotIssued'} = $barcode;
1859 # even though item is not on loan, it may still be transferred; therefore, get current branch info
1861 # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later.
1862 # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1863 if (C4::Context->preference("RecordLocalUseOnReturn")) {
1864 $messages->{'LocalUse'} = 1;
1865 $stat_type = 'localuse';
1869 my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1871 if ( $item->{'location'} eq 'PROC' ) {
1872 if ( C4::Context->preference("InProcessingToShelvingCart") ) {
1873 $item->{'location'} = 'CART';
1876 $item->{location} = $item->{permanent_location};
1879 ModItem( $item, $item->{'biblionumber'}, $item->{'itemnumber'} );
1882 # full item data, but no borrowernumber or checkout info (no issue)
1883 # we know GetItem should work because GetItemnumberFromBarcode worked
1884 my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1885 # get the proper branch to which to return the item
1886 my $returnbranch = $item->{$hbr} || $branch ;
1887 # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1889 my $borrowernumber = $borrower->{'borrowernumber'} || undef; # we don't know if we had a borrower or not
1891 my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
1893 $yaml = "$yaml\n\n"; # YAML is anal on ending \n. Surplus does not hurt
1895 eval { $rules = YAML::Load($yaml); };
1897 warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
1900 foreach my $key ( keys %$rules ) {
1901 if ( $item->{notforloan} eq $key ) {
1902 $messages->{'NotForLoanStatusUpdated'} = { from => $item->{notforloan}, to => $rules->{$key} };
1903 ModItem( { notforloan => $rules->{$key} }, undef, $itemnumber );
1911 # check if the book is in a permanent collection....
1912 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1913 if ( $returnbranch ) {
1914 my $library = Koha::Libraries->find($returnbranch);
1915 if ( $library and $library->get_categories->search({'me.categorycode' => 'PE'})->count ) {
1916 $messages->{'IsPermanent'} = $returnbranch;
1920 # check if the return is allowed at this branch
1921 my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
1922 unless ($returnallowed){
1923 $messages->{'Wrongbranch'} = {
1924 Wrongbranch => $branch,
1925 Rightbranch => $message
1928 return ( $doreturn, $messages, $issue, $borrower );
1931 if ( $item->{'withdrawn'} ) { # book has been cancelled
1932 $messages->{'withdrawn'} = 1;
1933 $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
1936 # case of a return of document (deal with issues and holdingbranch)
1937 my $today = DateTime->now( time_zone => C4::Context->tz() );
1940 my $datedue = $issue->{date_due};
1941 $borrower or warn "AddReturn without current borrower";
1942 my $circControlBranch;
1944 # define circControlBranch only if dropbox mode is set
1945 # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1946 # FIXME: check issuedate > returndate, factoring in holidays
1948 $circControlBranch = _GetCircControlBranch($item,$borrower);
1949 $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $dropboxdate ) == -1 ? 1 : 0;
1952 if ($borrowernumber) {
1953 if ( ( C4::Context->preference('CalculateFinesOnReturn') && $issue->{'overdue'} ) || $return_date ) {
1954 _CalculateAndUpdateFine( { issue => $issue, item => $item, borrower => $borrower, return_date => $return_date } );
1958 MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
1959 $circControlBranch, $return_date, $borrower->{'privacy'} );
1962 $messages->{'Wrongbranch'} = {
1963 Wrongbranch => $branch,
1964 Rightbranch => $message
1967 return ( 0, { WasReturned => 0 }, $issue, $borrower );
1970 # FIXME is the "= 1" right? This could be the borrower hash.
1971 $messages->{'WasReturned'} = 1;
1975 ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1978 # the holdingbranch is updated if the document is returned to another location.
1979 # this is always done regardless of whether the item was on loan or not
1980 my $item_holding_branch = $item->{ holdingbranch };
1981 if ($item->{'holdingbranch'} ne $branch) {
1982 UpdateHoldingbranch($branch, $item->{'itemnumber'});
1983 $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1985 ModDateLastSeen( $item->{'itemnumber'} );
1987 # check if we have a transfer for this document
1988 my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1990 # if we have a transfer to do, we update the line of transfers with the datearrived
1991 my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->{'itemnumber'} );
1993 if ( $tobranch eq $branch ) {
1994 my $sth = C4::Context->dbh->prepare(
1995 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1997 $sth->execute( $item->{'itemnumber'} );
1998 # if we have a reservation with valid transfer, we can set it's status to 'W'
1999 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
2000 C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
2002 $messages->{'WrongTransfer'} = $tobranch;
2003 $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
2005 $validTransfert = 1;
2007 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
2010 # fix up the accounts.....
2011 if ( $item->{'itemlost'} ) {
2012 $messages->{'WasLost'} = 1;
2014 if ( $item->{'itemlost'} ) {
2016 Koha::RefundLostItemFeeRules->should_refund(
2018 current_branch => C4::Context->userenv->{branch},
2019 item_home_branch => $item->{homebranch},
2020 item_holding_branch => $item_holding_branch
2025 _FixAccountForLostAndReturned( $item->{'itemnumber'}, $borrowernumber, $barcode );
2026 $messages->{'LostItemFeeRefunded'} = 1;
2031 # fix up the overdues in accounts...
2032 if ($borrowernumber) {
2033 my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
2034 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
2036 if ( $issue->{overdue} && $issue->{date_due} ) {
2038 $today = $dropboxdate if $dropbox;
2039 my ($debardate,$reminder) = _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today );
2041 $messages->{'PrevDebarred'} = $debardate;
2043 $messages->{'Debarred'} = $debardate if $debardate;
2045 # there's no overdue on the item but borrower had been previously debarred
2046 } elsif ( $issue->{date_due} and $borrower->{'debarred'} ) {
2047 if ( $borrower->{debarred} eq "9999-12-31") {
2048 $messages->{'ForeverDebarred'} = $borrower->{'debarred'};
2050 my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
2051 $borrower_debar_dt->truncate(to => 'day');
2052 my $today_dt = $today->clone()->truncate(to => 'day');
2053 if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2054 $messages->{'PrevDebarred'} = $borrower->{'debarred'};
2060 # find reserves.....
2061 # if we don't have a reserve with the status W, we launch the Checkreserves routine
2062 my ($resfound, $resrec);
2063 my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2064 ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'}, undef, $lookahead ) unless ( $item->{'withdrawn'} );
2066 $resrec->{'ResFound'} = $resfound;
2067 $messages->{'ResFound'} = $resrec;
2070 # Record the fact that this book was returned.
2071 # FIXME itemtype should record item level type, not bibliolevel type
2075 itemnumber => $item->{'itemnumber'},
2076 itemtype => $biblio->{'itemtype'},
2077 borrowernumber => $borrowernumber,
2078 ccode => $item->{'ccode'}}
2081 # Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then.
2082 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2084 branchcode => $branch,
2085 categorycode => $borrower->{categorycode},
2086 item_type => $item->{itype},
2087 notification => 'CHECKIN',
2089 if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2090 SendCirculationAlert({
2093 borrower => $borrower,
2098 logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
2099 if C4::Context->preference("ReturnLog");
2101 # Remove any OVERDUES related debarment if the borrower has no overdues
2102 if ( $borrowernumber
2103 && $borrower->{'debarred'}
2104 && C4::Context->preference('AutoRemoveOverduesRestrictions')
2105 && !Koha::Patrons->find( $borrowernumber )->has_overdues
2106 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2108 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2111 # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2112 if (!$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) and not $messages->{'WrongTransfer'}){
2113 if (C4::Context->preference("AutomaticItemReturn" ) or
2114 (C4::Context->preference("UseBranchTransferLimits") and
2115 ! IsBranchTransferAllowed($branch, $returnbranch, $item->{C4::Context->preference("BranchTransferLimitsType")} )
2117 $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $returnbranch;
2118 $debug and warn "item: " . Dumper($item);
2119 ModItemTransfer($item->{'itemnumber'}, $branch, $returnbranch);
2120 $messages->{'WasTransfered'} = 1;
2122 $messages->{'NeedsTransfer'} = $returnbranch;
2126 return ( $doreturn, $messages, $issue, $borrower );
2129 =head2 MarkIssueReturned
2131 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
2133 Unconditionally marks an issue as being returned by
2134 moving the C<issues> row to C<old_issues> and
2135 setting C<returndate> to the current date, or
2136 the last non-holiday date of the branccode specified in
2137 C<dropbox_branch> . Assumes you've already checked that
2138 it's safe to do this, i.e. last non-holiday > issuedate.
2140 if C<$returndate> is specified (in iso format), it is used as the date
2141 of the return. It is ignored when a dropbox_branch is passed in.
2143 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2144 the old_issue is immediately anonymised
2146 Ideally, this function would be internal to C<C4::Circulation>,
2147 not exported, but it is currently needed by one
2148 routine in C<C4::Accounts>.
2152 sub MarkIssueReturned {
2153 my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
2155 my $anonymouspatron;
2156 if ( $privacy == 2 ) {
2157 # The default of 0 will not work due to foreign key constraints
2158 # The anonymisation will fail if AnonymousPatron is not a valid entry
2159 # We need to check if the anonymous patron exist, Koha will fail loudly if it does not
2160 # Note that a warning should appear on the about page (System information tab).
2161 $anonymouspatron = C4::Context->preference('AnonymousPatron');
2162 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."
2163 unless C4::Members::GetMember( borrowernumber => $anonymouspatron );
2165 my $dbh = C4::Context->dbh;
2166 my $query = 'UPDATE issues SET returndate=';
2168 if ($dropbox_branch) {
2169 my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
2170 my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
2172 push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2173 } elsif ($returndate) {
2175 push @bind, $returndate;
2177 $query .= ' now() ';
2179 $query .= ' WHERE borrowernumber = ? AND itemnumber = ?';
2180 push @bind, $borrowernumber, $itemnumber;
2182 my $sth_upd = $dbh->prepare($query);
2183 $sth_upd->execute(@bind);
2184 my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
2185 WHERE borrowernumber = ?
2186 AND itemnumber = ?');
2187 $sth_copy->execute($borrowernumber, $itemnumber);
2188 # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2189 if ( $privacy == 2) {
2190 my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
2191 WHERE borrowernumber = ?
2192 AND itemnumber = ?");
2193 $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
2195 my $sth_del = $dbh->prepare("DELETE FROM issues
2196 WHERE borrowernumber = ?
2197 AND itemnumber = ?");
2198 $sth_del->execute($borrowernumber, $itemnumber);
2200 ModItem( { 'onloan' => undef }, undef, $itemnumber );
2202 if ( C4::Context->preference('StoreLastBorrower') ) {
2203 my $item = Koha::Items->find( $itemnumber );
2204 my $patron = Koha::Patrons->find( $borrowernumber );
2205 $item->last_returned_by( $patron );
2209 =head2 _debar_user_on_return
2211 _debar_user_on_return($borrower, $item, $datedue, today);
2213 C<$borrower> borrower hashref
2215 C<$item> item hashref
2217 C<$datedue> date due DateTime object
2219 C<$today> DateTime object representing the return time
2221 Internal function, called only by AddReturn that calculates and updates
2222 the user fine days, and debars him if necessary.
2224 Should only be called for overdue returns
2228 sub _debar_user_on_return {
2229 my ( $borrower, $item, $dt_due, $dt_today ) = @_;
2231 my $branchcode = _GetCircControlBranch( $item, $borrower );
2233 my $circcontrol = C4::Context->preference('CircControl');
2235 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2236 my $finedays = $issuingrule->{finedays};
2237 my $unit = $issuingrule->{lengthunit};
2238 my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $dt_today, $branchcode);
2242 # finedays is in days, so hourly loans must multiply by 24
2243 # thus 1 hour late equals 1 day suspension * finedays rate
2244 $finedays = $finedays * 24 if ( $unit eq 'hours' );
2246 # grace period is measured in the same units as the loan
2248 DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
2250 my $deltadays = DateTime::Duration->new(
2251 days => $chargeable_units
2253 if ( $deltadays->subtract($grace)->is_positive() ) {
2254 my $suspension_days = $deltadays * $finedays;
2256 # If the max suspension days is < than the suspension days
2257 # the suspension days is limited to this maximum period.
2258 my $max_sd = $issuingrule->{maxsuspensiondays};
2259 if ( defined $max_sd ) {
2260 $max_sd = DateTime::Duration->new( days => $max_sd );
2261 $suspension_days = $max_sd
2262 if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2266 $dt_today->clone()->add_duration( $suspension_days );
2268 Koha::Patron::Debarments::AddUniqueDebarment({
2269 borrowernumber => $borrower->{borrowernumber},
2270 expiration => $new_debar_dt->ymd(),
2271 type => 'SUSPENSION',
2273 # if borrower was already debarred but does not get an extra debarment
2274 my $patron = Koha::Patrons->find( $borrower->{borrowernumber} );
2275 if ( $borrower->{debarred} eq $patron->is_debarred ) {
2276 return ($borrower->{debarred},1);
2278 return $new_debar_dt->ymd();
2284 =head2 _FixOverduesOnReturn
2286 &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2288 C<$brn> borrowernumber
2292 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2293 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2295 Internal function, called only by AddReturn
2299 sub _FixOverduesOnReturn {
2300 my ($borrowernumber, $item);
2301 unless ($borrowernumber = shift) {
2302 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2305 unless ($item = shift) {
2306 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2309 my ($exemptfine, $dropbox) = @_;
2310 my $dbh = C4::Context->dbh;
2312 # check for overdue fine
2313 my $sth = $dbh->prepare(
2314 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
2316 $sth->execute( $borrowernumber, $item );
2318 # alter fine to show that the book has been returned
2319 my $data = $sth->fetchrow_hashref;
2320 return 0 unless $data; # no warning, there's just nothing to fix
2323 my @bind = ($data->{'accountlines_id'});
2325 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2326 if (C4::Context->preference("FinesLog")) {
2327 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2329 } elsif ($dropbox && $data->{lastincrement}) {
2330 my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2331 my $amt = $data->{amount} - $data->{lastincrement} ;
2332 if (C4::Context->preference("FinesLog")) {
2333 &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2335 $uquery = "update accountlines set accounttype='F' ";
2336 if($outstanding >= 0 && $amt >=0) {
2337 $uquery .= ", amount = ? , amountoutstanding=? ";
2338 unshift @bind, ($amt, $outstanding) ;
2341 $uquery = "update accountlines set accounttype='F' ";
2343 $uquery .= " where (accountlines_id = ?)";
2344 my $usth = $dbh->prepare($uquery);
2345 return $usth->execute(@bind);
2348 =head2 _FixAccountForLostAndReturned
2350 &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2352 Calculates the charge for a book lost and returned.
2354 Internal function, not exported, called only by AddReturn.
2356 FIXME: This function reflects how inscrutable fines logic is. Fix both.
2357 FIXME: Give a positive return value on success. It might be the $borrowernumber who received credit, or the amount forgiven.
2361 sub _FixAccountForLostAndReturned {
2362 my $itemnumber = shift or return;
2363 my $borrowernumber = @_ ? shift : undef;
2364 my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
2365 my $dbh = C4::Context->dbh;
2366 # check for charge made for lost book
2367 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2368 $sth->execute($itemnumber);
2369 my $data = $sth->fetchrow_hashref;
2370 $data or return; # bail if there is nothing to do
2371 $data->{accounttype} eq 'W' and return; # Written off
2373 # writeoff this amount
2375 my $amount = $data->{'amount'};
2376 my $acctno = $data->{'accountno'};
2377 my $amountleft; # Starts off undef/zero.
2378 if ($data->{'amountoutstanding'} == $amount) {
2379 $offset = $data->{'amount'};
2380 $amountleft = 0; # Hey, it's zero here, too.
2382 $offset = $amount - $data->{'amountoutstanding'}; # Um, isn't this the same as ZERO? We just tested those two things are ==
2383 $amountleft = $data->{'amountoutstanding'} - $amount; # Um, isn't this the same as ZERO? We just tested those two things are ==
2385 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2386 WHERE (accountlines_id = ?)");
2387 $usth->execute($data->{'accountlines_id'}); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in.
2388 #check if any credit is left if so writeoff other accounts
2389 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2390 $amountleft *= -1 if ($amountleft < 0);
2391 if ($amountleft > 0) {
2392 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2393 AND (amountoutstanding >0) ORDER BY date"); # might want to order by amountoustanding ASC (pay smallest first)
2394 $msth->execute($data->{'borrowernumber'});
2395 # offset transactions
2398 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2399 if ($accdata->{'amountoutstanding'} < $amountleft) {
2401 $amountleft -= $accdata->{'amountoutstanding'};
2403 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2406 my $thisacct = $accdata->{'accountlines_id'};
2407 # FIXME: move prepares outside while loop!
2408 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2409 WHERE (accountlines_id = ?)");
2410 $usth->execute($newamtos,$thisacct);
2411 $usth = $dbh->prepare("INSERT INTO accountoffsets
2412 (borrowernumber, accountno, offsetaccount, offsetamount)
2415 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2418 $amountleft *= -1 if ($amountleft > 0);
2419 my $desc = "Item Returned " . $item_id;
2420 $usth = $dbh->prepare("INSERT INTO accountlines
2421 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2422 VALUES (?,?,now(),?,?,'CR',?)");
2423 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2424 if ($borrowernumber) {
2425 # FIXME: same as query above. use 1 sth for both
2426 $usth = $dbh->prepare("INSERT INTO accountoffsets
2427 (borrowernumber, accountno, offsetaccount, offsetamount)
2429 $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2431 ModItem({ paidfor => '' }, undef, $itemnumber);
2435 =head2 _GetCircControlBranch
2437 my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2441 Return the library code to be used to determine which circulation
2442 policy applies to a transaction. Looks up the CircControl and
2443 HomeOrHoldingBranch system preferences.
2445 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2447 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2451 sub _GetCircControlBranch {
2452 my ($item, $borrower) = @_;
2453 my $circcontrol = C4::Context->preference('CircControl');
2456 if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2457 $branch= C4::Context->userenv->{'branch'};
2458 } elsif ($circcontrol eq 'PatronLibrary') {
2459 $branch=$borrower->{branchcode};
2461 my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2462 $branch = $item->{$branchfield};
2463 # default to item home branch if holdingbranch is used
2464 # and is not defined
2465 if (!defined($branch) && $branchfield eq 'holdingbranch') {
2466 $branch = $item->{homebranch};
2479 $issue = &GetItemIssue($itemnumber);
2481 Returns patron currently having a book, or undef if not checked out.
2483 C<$itemnumber> is the itemnumber.
2485 C<$issue> is a hashref of the row from the issues table.
2490 my ($itemnumber) = @_;
2491 return unless $itemnumber;
2492 my $sth = C4::Context->dbh->prepare(
2493 "SELECT items.*, issues.*
2495 LEFT JOIN items ON issues.itemnumber=items.itemnumber
2496 WHERE issues.itemnumber=?");
2497 $sth->execute($itemnumber);
2498 my $data = $sth->fetchrow_hashref;
2499 return unless $data;
2500 $data->{issuedate_sql} = $data->{issuedate};
2501 $data->{date_due_sql} = $data->{date_due};
2502 $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2503 $data->{issuedate}->truncate(to => 'minute');
2504 $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2505 $data->{date_due}->truncate(to => 'minute');
2506 my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2507 $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2513 $issue = GetOpenIssue( $itemnumber );
2515 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2517 C<$itemnumber> is the item's itemnumber
2524 my ( $itemnumber ) = @_;
2525 return unless $itemnumber;
2526 my $dbh = C4::Context->dbh;
2527 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2528 $sth->execute( $itemnumber );
2529 return $sth->fetchrow_hashref();
2535 $issues = GetIssues({}); # return all issues!
2536 $issues = GetIssues({ borrowernumber => $borrowernumber, biblionumber => $biblionumber });
2538 Returns all pending issues that match given criteria.
2539 Returns a arrayref or undef if an error occurs.
2541 Allowed criteria are:
2545 =item * borrowernumber
2547 =item * biblionumber
2556 my ($criteria) = @_;
2560 my @allowed = qw(borrowernumber biblionumber itemnumber);
2561 foreach (@allowed) {
2562 if (defined $criteria->{$_}) {
2565 value => $criteria->{$_},
2570 # Do we need to join other tables ?
2572 if (defined $criteria->{biblionumber}) {
2579 $where = "WHERE " . join(' AND ', map { "$_->{field} = ?" } @filters);
2585 if (defined $join{items}) {
2587 LEFT JOIN items ON (issues.itemnumber = items.itemnumber)
2593 my $dbh = C4::Context->dbh;
2594 my $sth = $dbh->prepare($query);
2595 my $rv = $sth->execute(map { $_->{value} } @filters);
2597 return $rv ? $sth->fetchall_arrayref({}) : undef;
2600 =head2 GetItemIssues
2602 $issues = &GetItemIssues($itemnumber, $history);
2604 Returns patrons that have issued a book
2606 C<$itemnumber> is the itemnumber
2607 C<$history> is false if you just want the current "issuer" (if any)
2608 and true if you want issues history from old_issues also.
2610 Returns reference to an array of hashes
2615 my ( $itemnumber, $history ) = @_;
2617 my $today = DateTime->now( time_zome => C4::Context->tz); # get today date
2618 $today->truncate( to => 'minute' );
2619 my $sql = "SELECT * FROM issues
2620 JOIN borrowers USING (borrowernumber)
2621 JOIN items USING (itemnumber)
2622 WHERE issues.itemnumber = ? ";
2625 SELECT * FROM old_issues
2626 LEFT JOIN borrowers USING (borrowernumber)
2627 JOIN items USING (itemnumber)
2628 WHERE old_issues.itemnumber = ? ";
2630 $sql .= "ORDER BY date_due DESC";
2631 my $sth = C4::Context->dbh->prepare($sql);
2633 $sth->execute($itemnumber, $itemnumber);
2635 $sth->execute($itemnumber);
2637 my $results = $sth->fetchall_arrayref({});
2638 foreach (@$results) {
2639 my $date_due = dt_from_string($_->{date_due},'sql');
2640 $date_due->truncate( to => 'minute' );
2642 $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2647 =head2 GetBiblioIssues
2649 $issues = GetBiblioIssues($biblionumber);
2651 this function get all issues from a biblionumber.
2654 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2655 tables issues and the firstname,surname & cardnumber from borrowers.
2659 sub GetBiblioIssues {
2660 my $biblionumber = shift;
2661 return unless $biblionumber;
2662 my $dbh = C4::Context->dbh;
2664 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2666 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2667 LEFT JOIN items ON issues.itemnumber = items.itemnumber
2668 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2669 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2670 WHERE biblio.biblionumber = ?
2672 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2674 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2675 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2676 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2677 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2678 WHERE biblio.biblionumber = ?
2681 my $sth = $dbh->prepare($query);
2682 $sth->execute($biblionumber, $biblionumber);
2685 while ( my $data = $sth->fetchrow_hashref ) {
2686 push @issues, $data;
2691 =head2 GetUpcomingDueIssues
2693 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2697 sub GetUpcomingDueIssues {
2700 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2701 my $dbh = C4::Context->dbh;
2703 my $statement = <<END_SQL;
2704 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2706 LEFT JOIN items USING (itemnumber)
2707 LEFT OUTER JOIN branches USING (branchcode)
2708 WHERE returndate is NULL
2709 HAVING days_until_due >= 0 AND days_until_due <= ?
2712 my @bind_parameters = ( $params->{'days_in_advance'} );
2714 my $sth = $dbh->prepare( $statement );
2715 $sth->execute( @bind_parameters );
2716 my $upcoming_dues = $sth->fetchall_arrayref({});
2718 return $upcoming_dues;
2721 =head2 CanBookBeRenewed
2723 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2725 Find out whether a borrowed item may be renewed.
2727 C<$borrowernumber> is the borrower number of the patron who currently
2728 has the item on loan.
2730 C<$itemnumber> is the number of the item to renew.
2732 C<$override_limit>, if supplied with a true value, causes
2733 the limit on the number of times that the loan can be renewed
2734 (as controlled by the item type) to be ignored. Overriding also allows
2735 to renew sooner than "No renewal before" and to manually renew loans
2736 that are automatically renewed.
2738 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2739 item must currently be on loan to the specified borrower; renewals
2740 must be allowed for the item's type; and the borrower must not have
2741 already renewed the loan. $error will contain the reason the renewal can not proceed
2745 sub CanBookBeRenewed {
2746 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2748 my $dbh = C4::Context->dbh;
2751 my $item = GetItem($itemnumber) or return ( 0, 'no_item' );
2752 my $itemissue = GetItemIssue($itemnumber) or return ( 0, 'no_checkout' );
2753 return ( 0, 'onsite_checkout' ) if $itemissue->{onsite_checkout};
2755 $borrowernumber ||= $itemissue->{borrowernumber};
2756 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
2759 my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2761 # This item can fill one or more unfilled reserve, can those unfilled reserves
2762 # all be filled by other available items?
2764 && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2766 my $schema = Koha::Database->new()->schema();
2768 my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2770 # There is an item level hold on this item, no other item can fill the hold
2775 # Get all other items that could possibly fill reserves
2776 my @itemnumbers = $schema->resultset('Item')->search(
2778 biblionumber => $resrec->{biblionumber},
2781 -not => { itemnumber => $itemnumber }
2783 { columns => 'itemnumber' }
2784 )->get_column('itemnumber')->all();
2786 # Get all other reserves that could have been filled by this item
2787 my @borrowernumbers;
2789 my ( $reserve_found, $reserve, undef ) =
2790 C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2792 if ($reserve_found) {
2793 push( @borrowernumbers, $reserve->{borrowernumber} );
2800 # If the count of the union of the lists of reservable items for each borrower
2801 # is equal or greater than the number of borrowers, we know that all reserves
2802 # can be filled with available items. We can get the union of the sets simply
2803 # by pushing all the elements onto an array and removing the duplicates.
2805 foreach my $b (@borrowernumbers) {
2806 my ($borr) = C4::Members::GetMemberDetails($b);
2807 foreach my $i (@itemnumbers) {
2808 my $item = GetItem($i);
2809 if ( IsAvailableForItemLevelRequest( $item, $borr )
2810 && CanItemBeReserved( $b, $i )
2811 && !IsItemOnHoldAndFound($i) )
2813 push( @reservable, $i );
2818 @reservable = uniq(@reservable);
2820 if ( @reservable >= @borrowernumbers ) {
2825 return ( 0, "on_reserve" ) if $resfound; # '' when no hold was found
2827 return ( 1, undef ) if $override_limit;
2829 my $branchcode = _GetCircControlBranch( $item, $borrower );
2831 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2833 return ( 0, "too_many" )
2834 if $issuingrule->{renewalsallowed} <= $itemissue->{renewals};
2836 my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2837 my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2838 my $patron = Koha::Patrons->find($borrowernumber);
2839 my $restricted = $patron->is_debarred;
2840 my $hasoverdues = $patron->has_overdues;
2842 if ( $restricted and $restrictionblockrenewing ) {
2843 return ( 0, 'restriction');
2844 } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($itemissue->{overdue} and $overduesblockrenewing eq 'blockitem') ) {
2845 return ( 0, 'overdue');
2848 if ( defined $issuingrule->{norenewalbefore}
2849 and $issuingrule->{norenewalbefore} ne "" )
2852 # Calculate soonest renewal by subtracting 'No renewal before' from due date
2853 my $soonestrenewal =
2854 $itemissue->{date_due}->clone()
2856 $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
2858 # Depending on syspref reset the exact time, only check the date
2859 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2860 and $issuingrule->{lengthunit} eq 'days' )
2862 $soonestrenewal->truncate( to => 'day' );
2865 if ( $soonestrenewal > DateTime->now( time_zone => C4::Context->tz() ) )
2867 return ( 0, "auto_too_soon" ) if $itemissue->{auto_renew};
2868 return ( 0, "too_soon" );
2870 elsif ( $itemissue->{auto_renew} ) {
2871 return ( 0, "auto_renew" );
2875 # Fallback for automatic renewals:
2876 # If norenewalbefore is undef, don't renew before due date.
2877 elsif ( $itemissue->{auto_renew} ) {
2878 my $now = dt_from_string;
2879 return ( 0, "auto_renew" )
2880 if $now >= $itemissue->{date_due};
2881 return ( 0, "auto_too_soon" );
2884 return ( 1, undef );
2889 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2893 C<$borrowernumber> is the borrower number of the patron who currently
2896 C<$itemnumber> is the number of the item to renew.
2898 C<$branch> is the library where the renewal took place (if any).
2899 The library that controls the circ policies for the renewal is retrieved from the issues record.
2901 C<$datedue> can be a DateTime object used to set the due date.
2903 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
2904 this parameter is not supplied, lastreneweddate is set to the current date.
2906 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2907 from the book's item type.
2912 my $borrowernumber = shift;
2913 my $itemnumber = shift or return;
2915 my $datedue = shift;
2916 my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2918 my $item = GetItem($itemnumber) or return;
2919 my $biblio = GetBiblioFromItemNumber($itemnumber) or return;
2921 my $dbh = C4::Context->dbh;
2923 # Find the issues record for this book
2924 my $issuedata = GetItemIssue($itemnumber);
2926 return unless ( $issuedata );
2928 $borrowernumber ||= $issuedata->{borrowernumber};
2930 if ( defined $datedue && ref $datedue ne 'DateTime' ) {
2931 carp 'Invalid date passed to AddRenewal.';
2935 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return;
2937 if ( C4::Context->preference('CalculateFinesOnReturn') && $issuedata->{overdue} ) {
2938 _CalculateAndUpdateFine( { issue => $issuedata, item => $item, borrower => $borrower } );
2940 _FixOverduesOnReturn( $borrowernumber, $itemnumber );
2942 # If the due date wasn't specified, calculate it by adding the
2943 # book's loan length to today's date or the current due date
2944 # based on the value of the RenewalPeriodBase syspref.
2947 my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2949 $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2950 dt_from_string( $issuedata->{date_due} ) :
2951 DateTime->now( time_zone => C4::Context->tz());
2952 $datedue = CalcDateDue($datedue, $itemtype, $issuedata->{'branchcode'}, $borrower, 'is a renewal');
2955 # Update the issues record to have the new due date, and a new count
2956 # of how many times it has been renewed.
2957 my $renews = $issuedata->{'renewals'} + 1;
2958 my $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2959 WHERE borrowernumber=?
2963 $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2965 # Update the renewal count on the item, and tell zebra to reindex
2966 $renews = $biblio->{'renewals'} + 1;
2967 ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
2969 # Charge a new rental fee, if applicable?
2970 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2971 if ( $charge > 0 ) {
2972 my $accountno = getnextacctno( $borrowernumber );
2973 my $item = GetBiblioFromItemNumber($itemnumber);
2975 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2976 $sth = $dbh->prepare(
2977 "INSERT INTO accountlines
2978 (date, borrowernumber, accountno, amount, manager_id,
2979 description,accounttype, amountoutstanding, itemnumber)
2980 VALUES (now(),?,?,?,?,?,?,?,?)"
2982 $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2983 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2984 'Rent', $charge, $itemnumber );
2987 # Send a renewal slip according to checkout alert preferencei
2988 if ( C4::Context->preference('RenewalSendNotice') eq '1' ) {
2989 $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
2990 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2992 branchcode => $branch,
2993 categorycode => $borrower->{categorycode},
2994 item_type => $item->{itype},
2995 notification => 'CHECKOUT',
2997 if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
2998 SendCirculationAlert(
3002 borrower => $borrower,
3009 # Remove any OVERDUES related debarment if the borrower has no overdues
3010 $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
3011 if ( $borrowernumber
3012 && $borrower->{'debarred'}
3013 && !Koha::Patrons->find( $borrowernumber )->has_overdues
3014 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
3016 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
3020 UpdateStats({branch => $branch,
3023 itemnumber => $itemnumber,
3024 itemtype => $item->{itype},
3025 borrowernumber => $borrowernumber,
3026 ccode => $item->{'ccode'}}
3032 # check renewal status
3033 my ( $bornum, $itemno ) = @_;
3034 my $dbh = C4::Context->dbh;
3036 my $renewsallowed = 0;
3039 my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
3040 my $item = GetItem($itemno);
3042 # Look in the issues table for this item, lent to this borrower,
3043 # and not yet returned.
3045 # FIXME - I think this function could be redone to use only one SQL call.
3046 my $sth = $dbh->prepare(
3047 "select * from issues
3048 where (borrowernumber = ?)
3049 and (itemnumber = ?)"
3051 $sth->execute( $bornum, $itemno );
3052 my $data = $sth->fetchrow_hashref;
3053 $renewcount = $data->{'renewals'} if $data->{'renewals'};
3054 # $item and $borrower should be calculated
3055 my $branchcode = _GetCircControlBranch($item, $borrower);
3057 my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
3059 $renewsallowed = $issuingrule->{'renewalsallowed'};
3060 $renewsleft = $renewsallowed - $renewcount;
3061 if($renewsleft < 0){ $renewsleft = 0; }
3062 return ( $renewcount, $renewsallowed, $renewsleft );
3065 =head2 GetSoonestRenewDate
3067 $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
3069 Find out the soonest possible renew date of a borrowed item.
3071 C<$borrowernumber> is the borrower number of the patron who currently
3072 has the item on loan.
3074 C<$itemnumber> is the number of the item to renew.
3076 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3077 renew date, based on the value "No renewal before" of the applicable
3078 issuing rule. Returns the current date if the item can already be
3079 renewed, and returns undefined if the borrower, loan, or item
3084 sub GetSoonestRenewDate {
3085 my ( $borrowernumber, $itemnumber ) = @_;
3087 my $dbh = C4::Context->dbh;
3089 my $item = GetItem($itemnumber) or return;
3090 my $itemissue = GetItemIssue($itemnumber) or return;
3092 $borrowernumber ||= $itemissue->{borrowernumber};
3093 my $borrower = C4::Members::GetMemberDetails($borrowernumber)
3096 my $branchcode = _GetCircControlBranch( $item, $borrower );
3098 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
3100 my $now = dt_from_string;
3102 if ( defined $issuingrule->{norenewalbefore}
3103 and $issuingrule->{norenewalbefore} ne "" )
3105 my $soonestrenewal =
3106 $itemissue->{date_due}->clone()
3108 $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
3110 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3111 and $issuingrule->{lengthunit} eq 'days' )
3113 $soonestrenewal->truncate( to => 'day' );
3115 return $soonestrenewal if $now < $soonestrenewal;
3120 =head2 GetIssuingCharges
3122 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3124 Calculate how much it would cost for a given patron to borrow a given
3125 item, including any applicable discounts.
3127 C<$itemnumber> is the item number of item the patron wishes to borrow.
3129 C<$borrowernumber> is the patron's borrower number.
3131 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3132 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3137 sub GetIssuingCharges {
3139 # calculate charges due
3140 my ( $itemnumber, $borrowernumber ) = @_;
3142 my $dbh = C4::Context->dbh;
3145 # Get the book's item type and rental charge (via its biblioitem).
3146 my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3147 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3148 $charge_query .= (C4::Context->preference('item-level_itypes'))
3149 ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3150 : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3152 $charge_query .= ' WHERE items.itemnumber =?';
3154 my $sth = $dbh->prepare($charge_query);
3155 $sth->execute($itemnumber);
3156 if ( my $item_data = $sth->fetchrow_hashref ) {
3157 $item_type = $item_data->{itemtype};
3158 $charge = $item_data->{rentalcharge};
3159 my $branch = C4::Context::mybranch();
3160 my $discount_query = q|SELECT rentaldiscount,
3161 issuingrules.itemtype, issuingrules.branchcode
3163 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3164 WHERE borrowers.borrowernumber = ?
3165 AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3166 AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3167 my $discount_sth = $dbh->prepare($discount_query);
3168 $discount_sth->execute( $borrowernumber, $item_type, $branch );
3169 my $discount_rules = $discount_sth->fetchall_arrayref({});
3170 if (@{$discount_rules}) {
3171 # We may have multiple rules so get the most specific
3172 my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3173 $charge = ( $charge * ( 100 - $discount ) ) / 100;
3177 return ( $charge, $item_type );
3180 # Select most appropriate discount rule from those returned
3181 sub _get_discount_from_rule {
3182 my ($rules_ref, $branch, $itemtype) = @_;
3185 if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3186 $discount = $rules_ref->[0]->{rentaldiscount};
3187 return (defined $discount) ? $discount : 0;
3189 # could have up to 4 does one match $branch and $itemtype
3190 my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3192 $discount = $d[0]->{rentaldiscount};
3193 return (defined $discount) ? $discount : 0;
3195 # do we have item type + all branches
3196 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3198 $discount = $d[0]->{rentaldiscount};
3199 return (defined $discount) ? $discount : 0;
3201 # do we all item types + this branch
3202 @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3204 $discount = $d[0]->{rentaldiscount};
3205 return (defined $discount) ? $discount : 0;
3207 # so all and all (surely we wont get here)
3208 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3210 $discount = $d[0]->{rentaldiscount};
3211 return (defined $discount) ? $discount : 0;
3217 =head2 AddIssuingCharge
3219 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3223 sub AddIssuingCharge {
3224 my ( $itemnumber, $borrowernumber, $charge ) = @_;
3225 my $dbh = C4::Context->dbh;
3226 my $nextaccntno = getnextacctno( $borrowernumber );
3228 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3230 INSERT INTO accountlines
3231 (borrowernumber, itemnumber, accountno,
3232 date, amount, description, accounttype,
3233 amountoutstanding, manager_id)
3234 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
3236 my $sth = $dbh->prepare($query);
3237 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
3242 GetTransfers($itemnumber);
3247 my ($itemnumber) = @_;
3249 my $dbh = C4::Context->dbh;
3255 FROM branchtransfers
3256 WHERE itemnumber = ?
3257 AND datearrived IS NULL
3259 my $sth = $dbh->prepare($query);
3260 $sth->execute($itemnumber);
3261 my @row = $sth->fetchrow_array();
3265 =head2 GetTransfersFromTo
3267 @results = GetTransfersFromTo($frombranch,$tobranch);
3269 Returns the list of pending transfers between $from and $to branch
3273 sub GetTransfersFromTo {
3274 my ( $frombranch, $tobranch ) = @_;
3275 return unless ( $frombranch && $tobranch );
3276 my $dbh = C4::Context->dbh;
3278 SELECT itemnumber,datesent,frombranch
3279 FROM branchtransfers
3282 AND datearrived IS NULL
3284 my $sth = $dbh->prepare($query);
3285 $sth->execute( $frombranch, $tobranch );
3288 while ( my $data = $sth->fetchrow_hashref ) {
3289 push @gettransfers, $data;
3291 return (@gettransfers);
3294 =head2 DeleteTransfer
3296 &DeleteTransfer($itemnumber);
3300 sub DeleteTransfer {
3301 my ($itemnumber) = @_;
3302 return unless $itemnumber;
3303 my $dbh = C4::Context->dbh;
3304 my $sth = $dbh->prepare(
3305 "DELETE FROM branchtransfers
3307 AND datearrived IS NULL "
3309 return $sth->execute($itemnumber);
3312 =head2 AnonymiseIssueHistory
3314 ($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)
3316 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
3317 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
3319 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
3320 setting (force delete).
3322 return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.
3326 sub AnonymiseIssueHistory {
3328 my $borrowernumber = shift;
3329 my $dbh = C4::Context->dbh;
3332 SET borrowernumber = ?
3333 WHERE returndate < ?
3334 AND borrowernumber IS NOT NULL
3337 # The default of 0 does not work due to foreign key constraints
3338 # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
3339 # Set it to undef (NULL)
3340 my $anonymouspatron = C4::Context->preference('AnonymousPatron') || undef;
3341 my @bind_params = ($anonymouspatron, $date);
3342 if (defined $borrowernumber) {
3343 $query .= " AND borrowernumber = ?";
3344 push @bind_params, $borrowernumber;
3346 $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
3348 my $sth = $dbh->prepare($query);
3349 $sth->execute(@bind_params);
3350 my $anonymisation_err = $dbh->err;
3351 my $rows_affected = $sth->rows; ### doublecheck row count return function
3352 return ($rows_affected, $anonymisation_err);
3355 =head2 SendCirculationAlert
3357 Send out a C<check-in> or C<checkout> alert using the messaging system.
3365 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3369 Hashref of information about the item being checked in or out.
3373 Hashref of information about the borrower of the item.
3377 The branchcode from where the checkout or check-in took place.
3383 SendCirculationAlert({
3386 borrower => $borrower,
3392 sub SendCirculationAlert {
3394 my ($type, $item, $borrower, $branch) =
3395 ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3396 my %message_name = (
3397 CHECKIN => 'Item_Check_in',
3398 CHECKOUT => 'Item_Checkout',
3399 RENEWAL => 'Item_Checkout',
3401 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3402 borrowernumber => $borrower->{borrowernumber},
3403 message_name => $message_name{$type},
3405 my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3407 my @transports = keys %{ $borrower_preferences->{transports} };
3408 # warn "no transports" unless @transports;
3410 # warn "transport: $_";
3411 my $message = C4::Message->find_last_message($borrower, $type, $_);
3413 #warn "create new message";
3414 my $letter = C4::Letters::GetPreparedLetter (
3415 module => 'circulation',
3416 letter_code => $type,
3417 branchcode => $branch,
3418 message_transport_type => $_,
3420 $issues_table => $item->{itemnumber},
3421 'items' => $item->{itemnumber},
3422 'biblio' => $item->{biblionumber},
3423 'biblioitems' => $item->{biblionumber},
3424 'borrowers' => $borrower,
3425 'branches' => $branch,
3428 C4::Message->enqueue($letter, $borrower, $_);
3430 #warn "append to old message";
3431 my $letter = C4::Letters::GetPreparedLetter (
3432 module => 'circulation',
3433 letter_code => $type,
3434 branchcode => $branch,
3435 message_transport_type => $_,
3437 $issues_table => $item->{itemnumber},
3438 'items' => $item->{itemnumber},
3439 'biblio' => $item->{biblionumber},
3440 'biblioitems' => $item->{biblionumber},
3441 'borrowers' => $borrower,
3442 'branches' => $branch,
3445 $message->append($letter);
3453 =head2 updateWrongTransfer
3455 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3457 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
3461 sub updateWrongTransfer {
3462 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3463 my $dbh = C4::Context->dbh;
3464 # first step validate the actual line of transfert .
3467 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3469 $sth->execute($FromLibrary,$itemNumber);
3471 # second step create a new line of branchtransfer to the right location .
3472 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3474 #third step changing holdingbranch of item
3475 UpdateHoldingbranch($FromLibrary,$itemNumber);
3478 =head2 UpdateHoldingbranch
3480 $items = UpdateHoldingbranch($branch,$itmenumber);
3482 Simple methode for updating hodlingbranch in items BDD line
3486 sub UpdateHoldingbranch {
3487 my ( $branch,$itemnumber ) = @_;
3488 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3493 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3495 this function calculates the due date given the start date and configured circulation rules,
3496 checking against the holidays calendar as per the 'useDaysMode' syspref.
3497 C<$startdate> = DateTime object representing start date of loan period (assumed to be today)
3498 C<$itemtype> = itemtype code of item in question
3499 C<$branch> = location whose calendar to use
3500 C<$borrower> = Borrower object
3501 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3506 my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3510 # loanlength now a href
3512 GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3514 my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3520 if (ref $startdate ne 'DateTime' ) {
3521 $datedue = dt_from_string($datedue);
3523 $datedue = $startdate->clone;
3527 DateTime->now( time_zone => C4::Context->tz() )
3528 ->truncate( to => 'minute' );
3532 # calculate the datedue as normal
3533 if ( C4::Context->preference('useDaysMode') eq 'Days' )
3534 { # ignoring calendar
3535 if ( $loanlength->{lengthunit} eq 'hours' ) {
3536 $datedue->add( hours => $loanlength->{$length_key} );
3538 $datedue->add( days => $loanlength->{$length_key} );
3539 $datedue->set_hour(23);
3540 $datedue->set_minute(59);
3544 if ($loanlength->{lengthunit} eq 'hours') {
3545 $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3548 $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3550 my $calendar = Koha::Calendar->new( branchcode => $branch );
3551 $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3552 if ($loanlength->{lengthunit} eq 'days') {
3553 $datedue->set_hour(23);
3554 $datedue->set_minute(59);
3558 # if Hard Due Dates are used, retrieve them and apply as necessary
3559 my ( $hardduedate, $hardduedatecompare ) =
3560 GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3561 if ($hardduedate) { # hardduedates are currently dates
3562 $hardduedate->truncate( to => 'minute' );
3563 $hardduedate->set_hour(23);
3564 $hardduedate->set_minute(59);
3565 my $cmp = DateTime->compare( $hardduedate, $datedue );
3567 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3568 # if the calculated date is before the 'after' Hard Due Date (floor), override
3569 # if the hard due date is set to 'exactly', overrride
3570 if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3571 $datedue = $hardduedate->clone;
3574 # in all other cases, keep the date due as it is
3578 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3579 if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3580 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3581 if( $expiry_dt ) { #skip empty expiry date..
3582 $expiry_dt->set( hour => 23, minute => 59);
3583 my $d1= $datedue->clone->set_time_zone('floating');
3584 if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3585 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3594 sub CheckValidBarcode{
3596 my $dbh = C4::Context->dbh;
3597 my $query=qq|SELECT count(*)
3601 my $sth = $dbh->prepare($query);
3602 $sth->execute($barcode);
3603 my $exist=$sth->fetchrow ;
3607 =head2 IsBranchTransferAllowed
3609 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3611 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3615 sub IsBranchTransferAllowed {
3616 my ( $toBranch, $fromBranch, $code ) = @_;
3618 if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3620 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3621 my $dbh = C4::Context->dbh;
3623 my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3624 $sth->execute( $toBranch, $fromBranch, $code );
3625 my $limit = $sth->fetchrow_hashref();
3627 ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3628 if ( $limit->{'limitId'} ) {
3635 =head2 CreateBranchTransferLimit
3637 CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3639 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3643 sub CreateBranchTransferLimit {
3644 my ( $toBranch, $fromBranch, $code ) = @_;
3645 return unless defined($toBranch) && defined($fromBranch);
3646 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3648 my $dbh = C4::Context->dbh;
3650 my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3651 return $sth->execute( $code, $toBranch, $fromBranch );
3654 =head2 DeleteBranchTransferLimits
3656 my $result = DeleteBranchTransferLimits($frombranch);
3658 Deletes all the library transfer limits for one library. Returns the
3659 number of limits deleted, 0e0 if no limits were deleted, or undef if
3660 no arguments are supplied.
3664 sub DeleteBranchTransferLimits {
3666 return unless defined $branch;
3667 my $dbh = C4::Context->dbh;
3668 my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3669 return $sth->execute($branch);
3673 my ( $borrowernumber, $itemnum ) = @_;
3675 MarkIssueReturned( $borrowernumber, $itemnum );
3676 my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3677 my $item = C4::Items::GetItem( $itemnum );
3678 my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3679 my @datearr = localtime(time);
3680 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3681 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3682 ModItem({ paidfor => $old_note."Paid for by $bor $date" }, undef, $itemnum);
3687 my ($itemnumber, $mark_returned) = @_;
3689 my $dbh = C4::Context->dbh();
3690 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3692 JOIN items USING (itemnumber)
3693 JOIN biblio USING (biblionumber)
3694 WHERE issues.itemnumber=?");
3695 $sth->execute($itemnumber);
3696 my $issues=$sth->fetchrow_hashref();
3698 # If a borrower lost the item, add a replacement cost to the their record
3699 if ( my $borrowernumber = $issues->{borrowernumber} ){
3700 my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3702 if (C4::Context->preference('WhenLostForgiveFine')){
3703 my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3704 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!"; # zero is OK, check defined
3706 if (C4::Context->preference('WhenLostChargeReplacementFee')){
3707 C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3708 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3709 #warn " $issues->{'borrowernumber'} / $itemnumber ";
3712 MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3716 sub GetOfflineOperations {
3717 my $dbh = C4::Context->dbh;
3718 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3719 $sth->execute(C4::Context->userenv->{'branch'});
3720 my $results = $sth->fetchall_arrayref({});
3724 sub GetOfflineOperation {
3725 my $operationid = shift;
3726 return unless $operationid;
3727 my $dbh = C4::Context->dbh;
3728 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3729 $sth->execute( $operationid );
3730 return $sth->fetchrow_hashref;
3733 sub AddOfflineOperation {
3734 my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3735 my $dbh = C4::Context->dbh;
3736 my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3737 $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3741 sub DeleteOfflineOperation {
3742 my $dbh = C4::Context->dbh;
3743 my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3744 $sth->execute( shift );
3748 sub ProcessOfflineOperation {
3749 my $operation = shift;
3752 if ( $operation->{action} eq 'return' ) {
3753 $report = ProcessOfflineReturn( $operation );
3754 } elsif ( $operation->{action} eq 'issue' ) {
3755 $report = ProcessOfflineIssue( $operation );
3756 } elsif ( $operation->{action} eq 'payment' ) {
3757 $report = ProcessOfflinePayment( $operation );
3760 DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3765 sub ProcessOfflineReturn {
3766 my $operation = shift;
3768 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3770 if ( $itemnumber ) {
3771 my $issue = GetOpenIssue( $itemnumber );
3774 $issue->{borrowernumber},
3777 $operation->{timestamp},
3780 { renewals => 0, onloan => undef },
3781 $issue->{'biblionumber'},
3786 return "Item not issued.";
3789 return "Item not found.";
3793 sub ProcessOfflineIssue {
3794 my $operation = shift;
3796 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3798 if ( $borrower->{borrowernumber} ) {
3799 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3800 unless ($itemnumber) {
3801 return "Barcode not found.";
3803 my $issue = GetOpenIssue( $itemnumber );
3805 if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3807 $issue->{borrowernumber},
3810 $operation->{timestamp},
3815 $operation->{'barcode'},
3818 $operation->{timestamp},
3823 return "Borrower not found.";
3827 sub ProcessOfflinePayment {
3828 my $operation = shift;
3830 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3831 my $amount = $operation->{amount};
3833 recordpayment( $borrower->{borrowernumber}, $amount );
3841 TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3843 Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3848 my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3850 my $item = GetItem( $itemnumber, $barcode )
3853 return C4::Letters::GetPreparedLetter (
3854 module => 'circulation',
3855 letter_code => 'TRANSFERSLIP',
3856 branchcode => $branch,
3858 'branches' => $to_branch,
3859 'biblio' => $item->{biblionumber},
3865 =head2 CheckIfIssuedToPatron
3867 CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3869 Return 1 if any record item is issued to patron, otherwise return 0
3873 sub CheckIfIssuedToPatron {
3874 my ($borrowernumber, $biblionumber) = @_;
3876 my $dbh = C4::Context->dbh;
3878 SELECT COUNT(*) FROM issues
3879 LEFT JOIN items ON items.itemnumber = issues.itemnumber
3880 WHERE items.biblionumber = ?
3881 AND issues.borrowernumber = ?
3883 my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
3884 return 1 if $is_issued;
3890 IsItemIssued( $itemnumber )
3892 Return 1 if the item is on loan, otherwise return 0
3897 my $itemnumber = shift;
3898 my $dbh = C4::Context->dbh;
3899 my $sth = $dbh->prepare(q{
3902 WHERE itemnumber = ?
3904 $sth->execute($itemnumber);
3905 return $sth->fetchrow;
3908 =head2 GetAgeRestriction
3910 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3911 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3913 if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }
3914 if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3916 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3917 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3918 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3919 Negative days mean the borrower has gone past the age restriction age.
3923 sub GetAgeRestriction {
3924 my ($record_restrictions, $borrower) = @_;
3925 my $markers = C4::Context->preference('AgeRestrictionMarker');
3927 # Split $record_restrictions to something like FSK 16 or PEGI 6
3928 my @values = split ' ', uc($record_restrictions);
3929 return unless @values;
3931 # Search first occurrence of one of the markers
3932 my @markers = split /\|/, uc($markers);
3933 return unless @markers;
3936 my $restriction_year = 0;
3937 for my $value (@values) {
3939 for my $marker (@markers) {
3940 $marker =~ s/^\s+//; #remove leading spaces
3941 $marker =~ s/\s+$//; #remove trailing spaces
3942 if ( $marker eq $value ) {
3943 if ( $index <= $#values ) {
3944 $restriction_year += $values[$index];
3948 elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
3950 # Perhaps it is something like "K16" (as in Finland)
3951 $restriction_year += $1;
3955 last if ( $restriction_year > 0 );
3958 #Check if the borrower is age restricted for this material and for how long.
3959 if ($restriction_year && $borrower) {
3960 if ( $borrower->{'dateofbirth'} ) {
3961 my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3962 $alloweddate[0] += $restriction_year;
3964 #Prevent runime eror on leap year (invalid date)
3965 if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3966 $alloweddate[2] = 28;
3969 #Get how many days the borrower has to reach the age restriction
3970 my @Today = split /-/, DateTime->today->ymd();
3971 my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
3972 #Negative days means the borrower went past the age restriction age
3973 return ($restriction_year, $daysToAgeRestriction);
3977 return ($restriction_year);
3981 =head2 GetPendingOnSiteCheckouts
3985 sub GetPendingOnSiteCheckouts {
3986 my $dbh = C4::Context->dbh;
3987 return $dbh->selectall_arrayref(q|
3993 items.itemcallnumber,
3997 issues.date_due < NOW() AS is_overdue,
4000 borrowers.firstname,
4002 borrowers.cardnumber,
4003 borrowers.borrowernumber
4005 LEFT JOIN issues ON items.itemnumber = issues.itemnumber
4006 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
4007 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
4008 WHERE issues.onsite_checkout = 1
4009 |, { Slice => {} } );
4015 my ($count, $branch, $itemtype, $ccode, $newness)
4016 = @$params{qw(count branch itemtype ccode newness)};
4018 my $dbh = C4::Context->dbh;
4020 SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4021 bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4022 i.ccode, SUM(i.issues) AS count
4024 LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
4025 LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
4028 my (@where_strs, @where_args);
4031 push @where_strs, 'i.homebranch = ?';
4032 push @where_args, $branch;
4035 if (C4::Context->preference('item-level_itypes')){
4036 push @where_strs, 'i.itype = ?';
4037 push @where_args, $itemtype;
4039 push @where_strs, 'bi.itemtype = ?';
4040 push @where_args, $itemtype;
4044 push @where_strs, 'i.ccode = ?';
4045 push @where_args, $ccode;
4048 push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4049 push @where_args, $newness;
4053 $query .= 'WHERE ' . join(' AND ', @where_strs);
4057 GROUP BY b.biblionumber
4062 $count = int($count);
4064 $query .= "LIMIT $count";
4067 my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4072 sub _CalculateAndUpdateFine {
4075 my $borrower = $params->{borrower};
4076 my $item = $params->{item};
4077 my $issue = $params->{issue};
4078 my $return_date = $params->{return_date};
4080 unless ($borrower) { carp "No borrower passed in!" && return; }
4081 unless ($item) { carp "No item passed in!" && return; }
4082 unless ($issue) { carp "No issue passed in!" && return; }
4084 my $datedue = $issue->{date_due};
4086 # we only need to calculate and change the fines if we want to do that on return
4087 # Should be on for hourly loans
4088 my $control = C4::Context->preference('CircControl');
4089 my $control_branchcode =
4090 ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
4091 : ( $control eq 'PatronLibrary' ) ? $borrower->{branchcode}
4092 : $issue->{branchcode};
4094 my $date_returned = $return_date ? dt_from_string($return_date) : dt_from_string();
4096 my ( $amount, $type, $unitcounttotal ) =
4097 C4::Overdues::CalcFine( $item, $borrower->{categorycode}, $control_branchcode, $datedue, $date_returned );
4101 if ( C4::Context->preference('finesMode') eq 'production' ) {
4102 if ( $amount > 0 ) {
4103 C4::Overdues::UpdateFine({
4104 issue_id => $issue->{issue_id},
4105 itemnumber => $issue->{itemnumber},
4106 borrowernumber => $issue->{borrowernumber},
4109 due => output_pref($datedue),
4112 elsif ($return_date) {
4114 # Backdated returns may have fines that shouldn't exist,
4115 # so in this case, we need to drop those fines to 0
4117 C4::Overdues::UpdateFine({
4118 issue_id => $issue->{issue_id},
4119 itemnumber => $issue->{itemnumber},
4120 borrowernumber => $issue->{borrowernumber},
4123 due => output_pref($datedue),
4135 Koha Development Team <http://koha-community.org/>