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::Branch; # GetBranches
37 use C4::Log; # logaction
39 GetAuthorisedValueByCode
41 GetKohaAuthorisedValueLib
43 use C4::Overdues qw(CalcFine UpdateFine get_chargeable_units);
44 use C4::RotatingCollections qw(GetCollectionItemBranches);
45 use Algorithm::CheckDigits;
52 use Koha::Patron::Debarments;
56 use Koha::RefundLostItemFeeRule;
57 use Koha::RefundLostItemFeeRules;
59 use List::MoreUtils qw( uniq );
60 use Scalar::Util qw( looks_like_number );
70 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
76 # FIXME subs that should probably be elsewhere
81 &GetPendingOnSiteCheckouts
84 # subs to deal with issuing a book
96 &GetBranchBorrowerCircRule
100 &AnonymiseIssueHistory
101 &CheckIfIssuedToPatron
106 # subs to deal with returns
112 # subs to deal with transfers
119 &IsBranchTransferAllowed
120 &CreateBranchTransferLimit
121 &DeleteBranchTransferLimits
125 # subs to deal with offline circulation
127 &GetOfflineOperations
130 &DeleteOfflineOperation
131 &ProcessOfflineOperation
137 C4::Circulation - Koha circulation module
145 The functions in this module deal with circulation, issues, and
146 returns, as well as general information about the library.
147 Also deals with inventory.
153 $str = &barcodedecode($barcode, [$filter]);
155 Generic filter function for barcode string.
156 Called on every circ if the System Pref itemBarcodeInputFilter is set.
157 Will do some manipulation of the barcode for systems that deliver a barcode
158 to circulation.pl that differs from the barcode stored for the item.
159 For proper functioning of this filter, calling the function on the
160 correct barcode string (items.barcode) should return an unaltered barcode.
162 The optional $filter argument is to allow for testing or explicit
163 behavior that ignores the System Pref. Valid values are the same as the
168 # FIXME -- the &decode fcn below should be wrapped into this one.
169 # FIXME -- these plugins should be moved out of Circulation.pm
172 my ($barcode, $filter) = @_;
173 my $branch = C4::Branch::mybranch();
174 $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
175 $filter or return $barcode; # ensure filter is defined, else return untouched barcode
176 if ($filter eq 'whitespace') {
178 } elsif ($filter eq 'cuecat') {
180 my @fields = split( /\./, $barcode );
181 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
182 ($#results == 2) and return $results[2];
183 } elsif ($filter eq 'T-prefix') {
184 if ($barcode =~ /^[Tt](\d)/) {
185 (defined($1) and $1 eq '0') and return $barcode;
186 $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1)
188 return sprintf("T%07d", $barcode);
189 # FIXME: $barcode could be "T1", causing warning: substr outside of string
190 # Why drop the nonzero digit after the T?
191 # Why pass non-digits (or empty string) to "T%07d"?
192 } elsif ($filter eq 'libsuite8') {
193 unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it.
194 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
195 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
197 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
200 } elsif ($filter eq 'EAN13') {
201 my $ean = CheckDigits('ean');
202 if ( $ean->is_valid($barcode) ) {
203 #$barcode = sprintf('%013d',$barcode); # this doesn't work on 32-bit systems
204 $barcode = '0' x ( 13 - length($barcode) ) . $barcode;
206 warn "# [$barcode] not valid EAN-13/UPC-A\n";
209 return $barcode; # return barcode, modified or not
214 $str = &decode($chunk);
216 Decodes a segment of a string emitted by a CueCat barcode scanner and
219 FIXME: Should be replaced with Barcode::Cuecat from CPAN
220 or Javascript based decoding on the client side.
227 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
228 my @s = map { index( $seq, $_ ); } split( //, $encoded );
229 my $l = ( $#s + 1 ) % 4;
232 # warn "Error: Cuecat decode parsing failed!";
240 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
242 chr( ( $n >> 16 ) ^ 67 )
243 .chr( ( $n >> 8 & 255 ) ^ 67 )
244 .chr( ( $n & 255 ) ^ 67 );
247 $r = substr( $r, 0, length($r) - $l );
253 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
254 $barcode, $ignore_reserves);
256 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
258 C<$newbranch> is the code for the branch to which the item should be transferred.
260 C<$barcode> is the barcode of the item to be transferred.
262 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
263 Otherwise, if an item is reserved, the transfer fails.
265 Returns three values:
271 is true if the transfer was successful.
275 is a reference-to-hash which may have any of the following keys:
281 There is no item in the catalog with the given barcode. The value is C<$barcode>.
285 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.
287 =item C<DestinationEqualsHolding>
289 The item is already at the branch to which it is being transferred. The transfer is nonetheless considered to have failed. The value should be ignored.
293 The item was on loan, and C<&transferbook> automatically returned it before transferring it. The value is the borrower number of the patron who had the item.
297 The item was reserved. The value is a reference-to-hash whose keys are fields from the reserves table of the Koha database, and C<biblioitemnumber>. It also has the key C<ResFound>, whose value is either C<Waiting> or C<Reserved>.
299 =item C<WasTransferred>
301 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
310 my ( $tbr, $barcode, $ignoreRs ) = @_;
313 my $branches = GetBranches();
314 my $itemnumber = GetItemnumberFromBarcode( $barcode );
315 my $issue = GetItemIssue($itemnumber);
316 my $biblio = GetBiblioFromItemNumber($itemnumber);
319 if ( not $itemnumber ) {
320 $messages->{'BadBarcode'} = $barcode;
324 # get branches of book...
325 my $hbr = $biblio->{'homebranch'};
326 my $fbr = $biblio->{'holdingbranch'};
328 # if using Branch Transfer Limits
329 if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
330 if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
331 if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
332 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
335 } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
336 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
342 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
343 $messages->{'IsPermanent'} = $hbr;
347 # can't transfer book if is already there....
348 if ( $fbr eq $tbr ) {
349 $messages->{'DestinationEqualsHolding'} = 1;
353 # check if it is still issued to someone, return it...
354 if ($issue->{borrowernumber}) {
355 AddReturn( $barcode, $fbr );
356 $messages->{'WasReturned'} = $issue->{borrowernumber};
360 # That'll save a database query.
361 my ( $resfound, $resrec, undef ) =
362 CheckReserves( $itemnumber );
363 if ( $resfound and not $ignoreRs ) {
364 $resrec->{'ResFound'} = $resfound;
366 # $messages->{'ResFound'} = $resrec;
370 #actually do the transfer....
372 ModItemTransfer( $itemnumber, $fbr, $tbr );
374 # don't need to update MARC anymore, we do it in batch now
375 $messages->{'WasTransfered'} = 1;
378 ModDateLastSeen( $itemnumber );
379 return ( $dotransfer, $messages, $biblio );
384 my $borrower = shift;
385 my $biblionumber = shift;
388 my $onsite_checkout = $params->{onsite_checkout} || 0;
389 my $cat_borrower = $borrower->{'categorycode'};
390 my $dbh = C4::Context->dbh;
392 # Get which branchcode we need
393 $branch = _GetCircControlBranch($item,$borrower);
394 my $type = (C4::Context->preference('item-level_itypes'))
395 ? $item->{'itype'} # item-level
396 : $item->{'itemtype'}; # biblio-level
398 # given branch, patron category, and item type, determine
399 # applicable issuing rule
400 my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
402 # if a rule is found and has a loan limit set, count
403 # how many loans the patron already has that meet that
405 if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
408 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
410 JOIN items USING (itemnumber)
413 my $rule_itemtype = $issuing_rule->{itemtype};
414 if ($rule_itemtype eq "*") {
415 # matching rule has the default item type, so count only
416 # those existing loans that don't fall under a more
418 if (C4::Context->preference('item-level_itypes')) {
419 $count_query .= " WHERE items.itype NOT IN (
420 SELECT itemtype FROM issuingrules
422 AND (categorycode = ? OR categorycode = ?)
426 $count_query .= " JOIN biblioitems USING (biblionumber)
427 WHERE biblioitems.itemtype NOT IN (
428 SELECT itemtype FROM issuingrules
430 AND (categorycode = ? OR categorycode = ?)
434 push @bind_params, $issuing_rule->{branchcode};
435 push @bind_params, $issuing_rule->{categorycode};
436 push @bind_params, $cat_borrower;
438 # rule has specific item type, so count loans of that
440 if (C4::Context->preference('item-level_itypes')) {
441 $count_query .= " WHERE items.itype = ? ";
443 $count_query .= " JOIN biblioitems USING (biblionumber)
444 WHERE biblioitems.itemtype= ? ";
446 push @bind_params, $type;
449 $count_query .= " AND borrowernumber = ? ";
450 push @bind_params, $borrower->{'borrowernumber'};
451 my $rule_branch = $issuing_rule->{branchcode};
452 if ($rule_branch ne "*") {
453 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
454 $count_query .= " AND issues.branchcode = ? ";
455 push @bind_params, $branch;
456 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
457 ; # if branch is the patron's home branch, then count all loans by patron
459 $count_query .= " AND items.homebranch = ? ";
460 push @bind_params, $branch;
464 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $count_query, {}, @bind_params );
466 my $max_checkouts_allowed = $issuing_rule->{maxissueqty};
467 my $max_onsite_checkouts_allowed = $issuing_rule->{maxonsiteissueqty};
469 if ( $onsite_checkout ) {
470 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
472 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
473 count => $onsite_checkout_count,
474 max_allowed => $max_onsite_checkouts_allowed,
478 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
479 if ( $checkout_count >= $max_checkouts_allowed ) {
481 reason => 'TOO_MANY_CHECKOUTS',
482 count => $checkout_count,
483 max_allowed => $max_checkouts_allowed,
486 } elsif ( not $onsite_checkout ) {
487 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
489 reason => 'TOO_MANY_CHECKOUTS',
490 count => $checkout_count - $onsite_checkout_count,
491 max_allowed => $max_checkouts_allowed,
497 # Now count total loans against the limit for the branch
498 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
499 if (defined($branch_borrower_circ_rule->{maxissueqty})) {
500 my @bind_params = ();
501 my $branch_count_query = q|
502 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
504 JOIN items USING (itemnumber)
505 WHERE borrowernumber = ?
507 push @bind_params, $borrower->{borrowernumber};
509 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
510 $branch_count_query .= " AND issues.branchcode = ? ";
511 push @bind_params, $branch;
512 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
513 ; # if branch is the patron's home branch, then count all loans by patron
515 $branch_count_query .= " AND items.homebranch = ? ";
516 push @bind_params, $branch;
518 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $branch_count_query, {}, @bind_params );
519 my $max_checkouts_allowed = $branch_borrower_circ_rule->{maxissueqty};
520 my $max_onsite_checkouts_allowed = $branch_borrower_circ_rule->{maxonsiteissueqty};
522 if ( $onsite_checkout ) {
523 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
525 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
526 count => $onsite_checkout_count,
527 max_allowed => $max_onsite_checkouts_allowed,
531 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
532 if ( $checkout_count >= $max_checkouts_allowed ) {
534 reason => 'TOO_MANY_CHECKOUTS',
535 count => $checkout_count,
536 max_allowed => $max_checkouts_allowed,
539 } elsif ( not $onsite_checkout ) {
540 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
542 reason => 'TOO_MANY_CHECKOUTS',
543 count => $checkout_count - $onsite_checkout_count,
544 max_allowed => $max_checkouts_allowed,
550 # OK, the patron can issue !!!
556 @issues = &itemissues($biblioitemnumber, $biblio);
558 Looks up information about who has borrowed the bookZ<>(s) with the
559 given biblioitemnumber.
561 C<$biblio> is ignored.
563 C<&itemissues> returns an array of references-to-hash. The keys
564 include the fields from the C<items> table in the Koha database.
565 Additional keys include:
571 If the item is currently on loan, this gives the due date.
573 If the item is not on loan, then this is either "Available" or
574 "Cancelled", if the item has been withdrawn.
578 If the item is currently on loan, this gives the card number of the
579 patron who currently has the item.
581 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
583 These give the timestamp for the last three times the item was
586 =item C<card0>, C<card1>, C<card2>
588 The card number of the last three patrons who borrowed this item.
590 =item C<borrower0>, C<borrower1>, C<borrower2>
592 The borrower number of the last three patrons who borrowed this item.
600 my ( $bibitem, $biblio ) = @_;
601 my $dbh = C4::Context->dbh;
603 $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
608 $sth->execute($bibitem) || die $sth->errstr;
610 while ( my $data = $sth->fetchrow_hashref ) {
612 # Find out who currently has this item.
613 # FIXME - Wouldn't it be better to do this as a left join of
614 # some sort? Currently, this code assumes that if
615 # fetchrow_hashref() fails, then the book is on the shelf.
616 # fetchrow_hashref() can fail for any number of reasons (e.g.,
617 # database server crash), not just because no items match the
619 my $sth2 = $dbh->prepare(
620 "SELECT * FROM issues
621 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
626 $sth2->execute( $data->{'itemnumber'} );
627 if ( my $data2 = $sth2->fetchrow_hashref ) {
628 $data->{'date_due'} = $data2->{'date_due'};
629 $data->{'card'} = $data2->{'cardnumber'};
630 $data->{'borrower'} = $data2->{'borrowernumber'};
633 $data->{'date_due'} = ($data->{'withdrawn'} eq '1') ? 'Cancelled' : 'Available';
637 # Find the last 3 people who borrowed this item.
638 $sth2 = $dbh->prepare(
639 "SELECT * FROM old_issues
640 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
642 ORDER BY returndate DESC,timestamp DESC"
645 $sth2->execute( $data->{'itemnumber'} );
646 for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
647 { # FIXME : error if there is less than 3 pple borrowing this item
648 if ( my $data2 = $sth2->fetchrow_hashref ) {
649 $data->{"timestamp$i2"} = $data2->{'timestamp'};
650 $data->{"card$i2"} = $data2->{'cardnumber'};
651 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
655 $results[$i] = $data;
662 =head2 CanBookBeIssued
664 ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower,
665 $barcode, $duedate, $inprocess, $ignore_reserves, $params );
667 Check if a book can be issued.
669 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
673 =item C<$borrower> hash with borrower informations (from GetMember or GetMemberDetails)
675 =item C<$barcode> is the bar code of the book being issued.
677 =item C<$duedates> is a DateTime object.
679 =item C<$inprocess> boolean switch
681 =item C<$ignore_reserves> boolean switch
683 =item C<$params> Hashref of additional parameters
686 override_high_holds - Ignore high holds
687 onsite_checkout - Checkout is an onsite checkout that will not leave the library
695 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
696 Possible values are :
702 sticky due date is invalid
706 borrower gone with no address
710 borrower declared it's card lost
716 =head3 UNKNOWN_BARCODE
730 item is restricted (set by ??)
732 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
733 could be prevented, but ones that can be overriden by the operator.
735 Possible values are :
743 renewing, not issuing
745 =head3 ISSUED_TO_ANOTHER
747 issued to someone else.
751 reserved for someone else.
755 sticky due date is invalid or due date in the past
759 if the borrower borrows to much things
763 sub CanBookBeIssued {
764 my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves, $params ) = @_;
765 my %needsconfirmation; # filled with problems that needs confirmations
766 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
767 my %alerts; # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
769 my $onsite_checkout = $params->{onsite_checkout} || 0;
770 my $override_high_holds = $params->{override_high_holds} || 0;
772 my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
773 my $issue = GetItemIssue($item->{itemnumber});
774 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
775 $item->{'itemtype'}=$item->{'itype'};
776 my $dbh = C4::Context->dbh;
778 # MANDATORY CHECKS - unless item exists, nothing else matters
779 unless ( $item->{barcode} ) {
780 $issuingimpossible{UNKNOWN_BARCODE} = 1;
782 return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
785 # DUE DATE is OK ? -- should already have checked.
787 if ($duedate && ref $duedate ne 'DateTime') {
788 $duedate = dt_from_string($duedate);
790 my $now = DateTime->now( time_zone => C4::Context->tz() );
791 unless ( $duedate ) {
792 my $issuedate = $now->clone();
794 my $branch = _GetCircControlBranch($item,$borrower);
795 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
796 $duedate = CalcDateDue( $issuedate, $itype, $branch, $borrower );
798 # Offline circ calls AddIssue directly, doesn't run through here
799 # So issuingimpossible should be ok.
802 my $today = $now->clone();
803 $today->truncate( to => 'minute');
804 if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
805 $needsconfirmation{INVALID_DATE} = output_pref($duedate);
808 $issuingimpossible{INVALID_DATE} = output_pref($duedate);
814 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
815 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
817 branch => C4::Context->userenv->{'branch'},
819 itemnumber => $item->{'itemnumber'},
820 itemtype => $item->{'itemtype'},
821 borrowernumber => $borrower->{'borrowernumber'},
822 ccode => $item->{'ccode'}}
824 ModDateLastSeen( $item->{'itemnumber'} );
825 return( { STATS => 1 }, {});
827 if ( ref $borrower->{flags} ) {
828 if ( $borrower->{flags}->{GNA} ) {
829 $issuingimpossible{GNA} = 1;
831 if ( $borrower->{flags}->{'LOST'} ) {
832 $issuingimpossible{CARD_LOST} = 1;
834 if ( $borrower->{flags}->{'DBARRED'} ) {
835 $issuingimpossible{DEBARRED} = 1;
838 if ( !defined $borrower->{dateexpiry} || $borrower->{'dateexpiry'} eq '0000-00-00') {
839 $issuingimpossible{EXPIRED} = 1;
841 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'sql', 'floating' );
842 $expiry_dt->truncate( to => 'day');
843 my $today = $now->clone()->truncate(to => 'day');
844 $today->set_time_zone( 'floating' );
845 if ( DateTime->compare($today, $expiry_dt) == 1 ) {
846 $issuingimpossible{EXPIRED} = 1;
855 my ($balance, $non_issue_charges, $other_charges) =
856 C4::Members::GetMemberAccountBalance( $borrower->{'borrowernumber'} );
858 my $amountlimit = C4::Context->preference("noissuescharge");
859 my $allowfineoverride = C4::Context->preference("AllowFineOverride");
860 my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
862 # Check the debt of this patrons guarantees
863 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
864 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
865 if ( defined $no_issues_charge_guarantees ) {
866 my $p = Koha::Patrons->find( $borrower->{borrowernumber} );
867 my @guarantees = $p->guarantees();
868 my $guarantees_non_issues_charges;
869 foreach my $g ( @guarantees ) {
870 my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
871 $guarantees_non_issues_charges += $n;
874 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && !$allowfineoverride) {
875 $issuingimpossible{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
876 } elsif ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && $allowfineoverride) {
877 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
878 } elsif ( $allfinesneedoverride && $guarantees_non_issues_charges > 0 && $guarantees_non_issues_charges <= $no_issues_charge_guarantees && !$inprocess ) {
879 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
883 if ( C4::Context->preference("IssuingInProcess") ) {
884 if ( $non_issue_charges > $amountlimit && !$inprocess && !$allowfineoverride) {
885 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
886 } elsif ( $non_issue_charges > $amountlimit && !$inprocess && $allowfineoverride) {
887 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
888 } elsif ( $allfinesneedoverride && $non_issue_charges > 0 && $non_issue_charges <= $amountlimit && !$inprocess ) {
889 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
893 if ( $non_issue_charges > $amountlimit && $allowfineoverride ) {
894 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
895 } elsif ( $non_issue_charges > $amountlimit && !$allowfineoverride) {
896 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
897 } elsif ( $non_issue_charges > 0 && $allfinesneedoverride ) {
898 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
902 if ($balance > 0 && $other_charges > 0) {
903 $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges );
906 my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'});
907 if ($blocktype == -1) {
908 ## patron has outstanding overdue loans
909 if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
910 $issuingimpossible{USERBLOCKEDOVERDUE} = $count;
912 elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
913 $needsconfirmation{USERBLOCKEDOVERDUE} = $count;
915 } elsif($blocktype == 1) {
916 # patron has accrued fine days or has a restriction. $count is a date
917 if ($count eq '9999-12-31') {
918 $issuingimpossible{USERBLOCKEDNOENDDATE} = $count;
921 $issuingimpossible{USERBLOCKEDWITHENDDATE} = $count;
926 # JB34 CHECKS IF BORROWERS DON'T HAVE ISSUE TOO MANY BOOKS
928 my $toomany = TooMany( $borrower, $item->{biblionumber}, $item, { onsite_checkout => $onsite_checkout } );
929 # if TooMany max_allowed returns 0 the user doesn't have permission to check out this book
931 if ( $toomany->{max_allowed} == 0 ) {
932 $needsconfirmation{PATRON_CANT} = 1;
934 if ( C4::Context->preference("AllowTooManyOverride") ) {
935 $needsconfirmation{TOO_MANY} = $toomany->{reason};
936 $needsconfirmation{current_loan_count} = $toomany->{count};
937 $needsconfirmation{max_loans_allowed} = $toomany->{max_allowed};
939 $issuingimpossible{TOO_MANY} = $toomany->{reason};
940 $issuingimpossible{current_loan_count} = $toomany->{count};
941 $issuingimpossible{max_loans_allowed} = $toomany->{max_allowed};
948 if ( $item->{'notforloan'} )
950 if(!C4::Context->preference("AllowNotForLoanOverride")){
951 $issuingimpossible{NOT_FOR_LOAN} = 1;
952 $issuingimpossible{item_notforloan} = $item->{'notforloan'};
954 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
955 $needsconfirmation{item_notforloan} = $item->{'notforloan'};
959 # we have to check itemtypes.notforloan also
960 if (C4::Context->preference('item-level_itypes')){
961 # this should probably be a subroutine
962 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
963 $sth->execute($item->{'itemtype'});
964 my $notforloan=$sth->fetchrow_hashref();
965 if ($notforloan->{'notforloan'}) {
966 if (!C4::Context->preference("AllowNotForLoanOverride")) {
967 $issuingimpossible{NOT_FOR_LOAN} = 1;
968 $issuingimpossible{itemtype_notforloan} = $item->{'itype'};
970 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
971 $needsconfirmation{itemtype_notforloan} = $item->{'itype'};
975 elsif ($biblioitem->{'notforloan'} == 1){
976 if (!C4::Context->preference("AllowNotForLoanOverride")) {
977 $issuingimpossible{NOT_FOR_LOAN} = 1;
978 $issuingimpossible{itemtype_notforloan} = $biblioitem->{'itemtype'};
980 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
981 $needsconfirmation{itemtype_notforloan} = $biblioitem->{'itemtype'};
985 if ( $item->{'withdrawn'} && $item->{'withdrawn'} > 0 )
987 $issuingimpossible{WTHDRAWN} = 1;
989 if ( $item->{'restricted'}
990 && $item->{'restricted'} == 1 )
992 $issuingimpossible{RESTRICTED} = 1;
994 if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
995 my $code = GetAuthorisedValueByCode( 'LOST', $item->{'itemlost'} );
996 $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
997 $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
999 if ( C4::Context->preference("IndependentBranches") ) {
1000 my $userenv = C4::Context->userenv;
1001 unless ( C4::Context->IsSuperLibrarian() ) {
1002 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ){
1003 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
1004 $issuingimpossible{'itemhomebranch'} = $item->{C4::Context->preference("HomeOrHoldingBranch")};
1006 $needsconfirmation{BORRNOTSAMEBRANCH} = GetBranchName( $borrower->{'branchcode'} )
1007 if ( $borrower->{'branchcode'} ne $userenv->{branch} );
1011 # CHECK IF THERE IS RENTAL CHARGES. RENTAL MUST BE CONFIRMED BY THE BORROWER
1013 my $rentalConfirmation = C4::Context->preference("RentalFeesCheckoutConfirmation");
1015 if ( $rentalConfirmation ){
1016 my ($rentalCharge) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
1017 if ( $rentalCharge > 0 ){
1018 $rentalCharge = sprintf("%.02f", $rentalCharge);
1019 $needsconfirmation{RENTALCHARGE} = $rentalCharge;
1024 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
1026 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} ){
1028 # Already issued to current borrower. Ask whether the loan should
1030 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
1031 $borrower->{'borrowernumber'},
1032 $item->{'itemnumber'}
1034 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
1035 if ( $renewerror eq 'onsite_checkout' ) {
1036 $issuingimpossible{NO_RENEWAL_FOR_ONSITE_CHECKOUTS} = 1;
1039 $issuingimpossible{NO_MORE_RENEWALS} = 1;
1043 $needsconfirmation{RENEW_ISSUE} = 1;
1046 elsif ($issue->{borrowernumber}) {
1048 # issued to someone else
1049 my $currborinfo = C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} );
1052 my ( $can_be_returned, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
1054 unless ( $can_be_returned ) {
1055 $issuingimpossible{RETURN_IMPOSSIBLE} = 1;
1056 $issuingimpossible{branch_to_return} = $message;
1058 $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
1059 $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
1060 $needsconfirmation{issued_surname} = $currborinfo->{'surname'};
1061 $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
1062 $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
1066 unless ( $ignore_reserves ) {
1067 # See if the item is on reserve.
1068 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
1070 my $resbor = $res->{'borrowernumber'};
1071 if ( $resbor ne $borrower->{'borrowernumber'} ) {
1072 my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor );
1073 my $branchname = GetBranchName( $res->{'branchcode'} );
1074 if ( $restype eq "Waiting" )
1076 # The item is on reserve and waiting, but has been
1077 # reserved by some other patron.
1078 $needsconfirmation{RESERVE_WAITING} = 1;
1079 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
1080 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
1081 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
1082 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
1083 $needsconfirmation{'resbranchname'} = $branchname;
1084 $needsconfirmation{'reswaitingdate'} = $res->{'waitingdate'};
1086 elsif ( $restype eq "Reserved" ) {
1087 # The item is on reserve for someone else.
1088 $needsconfirmation{RESERVED} = 1;
1089 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
1090 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
1091 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
1092 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
1093 $needsconfirmation{'resbranchname'} = $branchname;
1094 $needsconfirmation{'resreservedate'} = $res->{'reservedate'};
1100 ## CHECK AGE RESTRICTION
1101 my $agerestriction = $biblioitem->{'agerestriction'};
1102 my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $borrower );
1103 if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1104 if ( C4::Context->preference('AgeRestrictionOverride') ) {
1105 $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1108 $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1112 ## check for high holds decreasing loan period
1113 if ( C4::Context->preference('decreaseLoanHighHolds') ) {
1114 my $check = checkHighHolds( $item, $borrower );
1116 if ( $check->{exceeded} ) {
1117 if ($override_high_holds) {
1118 $alerts{HIGHHOLDS} = {
1119 num_holds => $check->{outstanding},
1120 duration => $check->{duration},
1121 returndate => output_pref( $check->{due_date} ),
1125 $needsconfirmation{HIGHHOLDS} = {
1126 num_holds => $check->{outstanding},
1127 duration => $check->{duration},
1128 returndate => output_pref( $check->{due_date} ),
1135 !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1136 # don't do the multiple loans per bib check if we've
1137 # already determined that we've got a loan on the same item
1138 !$issuingimpossible{NO_MORE_RENEWALS} &&
1139 !$needsconfirmation{RENEW_ISSUE}
1141 # Check if borrower has already issued an item from the same biblio
1142 # Only if it's not a subscription
1143 my $biblionumber = $item->{biblionumber};
1144 require C4::Serials;
1145 my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1146 unless ($is_a_subscription) {
1147 my $issues = GetIssues( {
1148 borrowernumber => $borrower->{borrowernumber},
1149 biblionumber => $biblionumber,
1151 my @issues = $issues ? @$issues : ();
1152 # if we get here, we don't already have a loan on this item,
1153 # so if there are any loans on this bib, ask for confirmation
1154 if (scalar @issues > 0) {
1155 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1160 return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
1163 =head2 CanBookBeReturned
1165 ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1167 Check whether the item can be returned to the provided branch
1171 =item C<$item> is a hash of item information as returned from GetItem
1173 =item C<$branch> is the branchcode where the return is taking place
1181 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1183 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1189 sub CanBookBeReturned {
1190 my ($item, $branch) = @_;
1191 my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1193 # assume return is allowed to start
1197 # identify all cases where return is forbidden
1198 if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1200 $message = $item->{'homebranch'};
1201 } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1203 $message = $item->{'holdingbranch'};
1204 } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1206 $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1209 return ($allowed, $message);
1212 =head2 CheckHighHolds
1214 used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1215 decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1216 has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1220 sub checkHighHolds {
1221 my ( $item, $borrower ) = @_;
1222 my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1223 my $branch = _GetCircControlBranch( $item, $borrower );
1232 my $holds = Koha::Holds->search( { biblionumber => $item->{'biblionumber'} } );
1234 if ( $holds->count() ) {
1235 $return_data->{outstanding} = $holds->count();
1237 my $decreaseLoanHighHoldsControl = C4::Context->preference('decreaseLoanHighHoldsControl');
1238 my $decreaseLoanHighHoldsValue = C4::Context->preference('decreaseLoanHighHoldsValue');
1239 my $decreaseLoanHighHoldsIgnoreStatuses = C4::Context->preference('decreaseLoanHighHoldsIgnoreStatuses');
1241 my @decreaseLoanHighHoldsIgnoreStatuses = split( /,/, $decreaseLoanHighHoldsIgnoreStatuses );
1243 if ( $decreaseLoanHighHoldsControl eq 'static' ) {
1245 # static means just more than a given number of holds on the record
1247 # If the number of holds is less than the threshold, we can stop here
1248 if ( $holds->count() < $decreaseLoanHighHoldsValue ) {
1249 return $return_data;
1252 elsif ( $decreaseLoanHighHoldsControl eq 'dynamic' ) {
1254 # dynamic means X more than the number of holdable items on the record
1256 # let's get the items
1257 my @items = $holds->next()->biblio()->items();
1259 # Remove any items with status defined to be ignored even if the would not make item unholdable
1260 foreach my $status (@decreaseLoanHighHoldsIgnoreStatuses) {
1261 @items = grep { !$_->$status } @items;
1264 # Remove any items that are not holdable for this patron
1265 @items = grep { CanItemBeReserved( $borrower->{borrowernumber}, $_->itemnumber ) eq 'OK' } @items;
1267 my $items_count = scalar @items;
1269 my $threshold = $items_count + $decreaseLoanHighHoldsValue;
1271 # If the number of holds is less than the count of items we have
1272 # plus the number of holds allowed above that count, we can stop here
1273 if ( $holds->count() <= $threshold ) {
1274 return $return_data;
1278 my $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1280 my $calendar = Koha::Calendar->new( branchcode => $branch );
1283 ( C4::Context->preference('item-level_itypes') )
1284 ? $biblio->{'itype'}
1285 : $biblio->{'itemtype'};
1287 my $orig_due = C4::Circulation::CalcDateDue( $issuedate, $itype, $branch, $borrower );
1289 my $decreaseLoanHighHoldsDuration = C4::Context->preference('decreaseLoanHighHoldsDuration');
1291 my $reduced_datedue = $calendar->addDate( $issuedate, $decreaseLoanHighHoldsDuration );
1293 if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1294 $return_data->{exceeded} = 1;
1295 $return_data->{duration} = $decreaseLoanHighHoldsDuration;
1296 $return_data->{due_date} = $reduced_datedue;
1300 return $return_data;
1305 &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1307 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1311 =item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails).
1313 =item C<$barcode> is the barcode of the item being issued.
1315 =item C<$datedue> is a DateTime object for the max date of return, i.e. the date due (optional).
1316 Calculated if empty.
1318 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1320 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1321 Defaults to today. Unlike C<$datedue>, NOT a DateTime object, unfortunately.
1323 AddIssue does the following things :
1325 - step 01: check that there is a borrowernumber & a barcode provided
1326 - check for RENEWAL (book issued & being issued to the same patron)
1327 - renewal YES = Calculate Charge & renew
1329 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1331 - fill reserve if reserve to this patron
1332 - cancel reserve or not, otherwise
1333 * TRANSFERT PENDING ?
1334 - complete the transfert
1342 my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1344 my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1345 my $auto_renew = $params && $params->{auto_renew};
1346 my $dbh = C4::Context->dbh;
1347 my $barcodecheck = CheckValidBarcode($barcode);
1351 if ( $datedue && ref $datedue ne 'DateTime' ) {
1352 $datedue = dt_from_string($datedue);
1355 # $issuedate defaults to today.
1356 if ( !defined $issuedate ) {
1357 $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1360 if ( ref $issuedate ne 'DateTime' ) {
1361 $issuedate = dt_from_string($issuedate);
1366 # Stop here if the patron or barcode doesn't exist
1367 if ( $borrower && $barcode && $barcodecheck ) {
1368 # find which item we issue
1369 my $item = GetItem( '', $barcode )
1370 or return; # if we don't get an Item, abort.
1372 my $branch = _GetCircControlBranch( $item, $borrower );
1374 # get actual issuing if there is one
1375 my $actualissue = GetItemIssue( $item->{itemnumber} );
1377 # get biblioinformation for this item
1378 my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1380 # check if we just renew the issue.
1381 if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) {
1382 $datedue = AddRenewal(
1383 $borrower->{'borrowernumber'},
1384 $item->{'itemnumber'},
1387 $issuedate, # here interpreted as the renewal date
1391 # it's NOT a renewal
1392 if ( $actualissue->{borrowernumber} ) {
1393 # This book is currently on loan, but not to the person
1394 # who wants to borrow it now. mark it returned before issuing to the new borrower
1395 my ( $allowed, $message ) = CanBookBeReturned( $item, C4::Context->userenv->{branch} );
1396 return unless $allowed;
1397 AddReturn( $item->{'barcode'}, C4::Context->userenv->{'branch'} );
1400 MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1402 # Starting process for transfer job (checking transfert and validate it if we have one)
1403 my ($datesent) = GetTransfers( $item->{'itemnumber'} );
1405 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1406 my $sth = $dbh->prepare(
1407 "UPDATE branchtransfers
1408 SET datearrived = now(),
1410 comments = 'Forced branchtransfer'
1411 WHERE itemnumber= ? AND datearrived IS NULL"
1413 $sth->execute( C4::Context->userenv->{'branch'},
1414 $item->{'itemnumber'} );
1417 # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1418 unless ($auto_renew) {
1419 my $issuingrule = GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branch );
1420 $auto_renew = $issuingrule->{auto_renew};
1423 # Record in the database the fact that the book was issued.
1426 ( C4::Context->preference('item-level_itypes') )
1427 ? $biblio->{'itype'}
1428 : $biblio->{'itemtype'};
1429 $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1432 $datedue->truncate( to => 'minute' );
1434 $issue = Koha::Database->new()->schema()->resultset('Issue')->create(
1436 borrowernumber => $borrower->{'borrowernumber'},
1437 itemnumber => $item->{'itemnumber'},
1438 issuedate => $issuedate->strftime('%Y-%m-%d %H:%M:%S'),
1439 date_due => $datedue->strftime('%Y-%m-%d %H:%M:%S'),
1440 branchcode => C4::Context->userenv->{'branch'},
1441 onsite_checkout => $onsite_checkout,
1442 auto_renew => $auto_renew ? 1 : 0
1446 if ( C4::Context->preference('ReturnToShelvingCart') ) {
1447 # ReturnToShelvingCart is on, anything issued should be taken off the cart.
1448 CartToShelf( $item->{'itemnumber'} );
1450 $item->{'issues'}++;
1451 if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1452 UpdateTotalIssues( $item->{'biblionumber'}, 1 );
1455 ## If item was lost, it has now been found, reverse any list item charges if necessary.
1456 if ( $item->{'itemlost'} ) {
1458 Koha::RefundLostItemFeeRules->should_refund(
1460 current_branch => C4::Context->userenv->{branch},
1461 item_home_branch => $item->{homebranch},
1462 item_holding_branch => $item->{holdingbranch}
1467 _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef,
1468 $item->{'barcode'} );
1474 issues => $item->{'issues'},
1475 holdingbranch => C4::Context->userenv->{'branch'},
1477 onloan => $datedue->ymd(),
1478 datelastborrowed => DateTime->now( time_zone => C4::Context->tz() )->ymd(),
1480 $item->{'biblionumber'},
1481 $item->{'itemnumber'}
1483 ModDateLastSeen( $item->{'itemnumber'} );
1485 # If it costs to borrow this book, charge it to the patron's account.
1486 my ( $charge, $itemtype ) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
1487 if ( $charge > 0 ) {
1488 AddIssuingCharge( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge );
1489 $item->{'charge'} = $charge;
1492 # Record the fact that this book was issued.
1495 branch => C4::Context->userenv->{'branch'},
1496 type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1498 other => ( $sipmode ? "SIP-$sipmode" : '' ),
1499 itemnumber => $item->{'itemnumber'},
1500 itemtype => $item->{'itype'},
1501 borrowernumber => $borrower->{'borrowernumber'},
1502 ccode => $item->{'ccode'}
1506 # Send a checkout slip.
1507 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1509 branchcode => $branch,
1510 categorycode => $borrower->{categorycode},
1511 item_type => $item->{itype},
1512 notification => 'CHECKOUT',
1514 if ( $circulation_alert->is_enabled_for( \%conditions ) ) {
1515 SendCirculationAlert(
1519 borrower => $borrower,
1527 "CIRCULATION", "ISSUE",
1528 $borrower->{'borrowernumber'},
1529 $biblio->{'itemnumber'}
1530 ) if C4::Context->preference("IssueLog");
1535 =head2 GetLoanLength
1537 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1539 Get loan length for an itemtype, a borrower type and a branch
1544 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1545 my $dbh = C4::Context->dbh;
1546 my $sth = $dbh->prepare(qq{
1547 SELECT issuelength, lengthunit, renewalperiod
1549 WHERE categorycode=?
1552 AND issuelength IS NOT NULL
1555 # try to find issuelength & return the 1st available.
1556 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1557 $sth->execute( $borrowertype, $itemtype, $branchcode );
1558 my $loanlength = $sth->fetchrow_hashref;
1561 if defined($loanlength) && defined $loanlength->{issuelength};
1563 $sth->execute( $borrowertype, '*', $branchcode );
1564 $loanlength = $sth->fetchrow_hashref;
1566 if defined($loanlength) && defined $loanlength->{issuelength};
1568 $sth->execute( '*', $itemtype, $branchcode );
1569 $loanlength = $sth->fetchrow_hashref;
1571 if defined($loanlength) && defined $loanlength->{issuelength};
1573 $sth->execute( '*', '*', $branchcode );
1574 $loanlength = $sth->fetchrow_hashref;
1576 if defined($loanlength) && defined $loanlength->{issuelength};
1578 $sth->execute( $borrowertype, $itemtype, '*' );
1579 $loanlength = $sth->fetchrow_hashref;
1581 if defined($loanlength) && defined $loanlength->{issuelength};
1583 $sth->execute( $borrowertype, '*', '*' );
1584 $loanlength = $sth->fetchrow_hashref;
1586 if defined($loanlength) && defined $loanlength->{issuelength};
1588 $sth->execute( '*', $itemtype, '*' );
1589 $loanlength = $sth->fetchrow_hashref;
1591 if defined($loanlength) && defined $loanlength->{issuelength};
1593 $sth->execute( '*', '*', '*' );
1594 $loanlength = $sth->fetchrow_hashref;
1596 if defined($loanlength) && defined $loanlength->{issuelength};
1598 # if no rule is set => 0 day (hardcoded)
1602 lengthunit => 'days',
1608 =head2 GetHardDueDate
1610 my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1612 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1616 sub GetHardDueDate {
1617 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1619 my $rule = GetIssuingRule( $borrowertype, $itemtype, $branchcode );
1621 if ( defined( $rule ) ) {
1622 if ( $rule->{hardduedate} ) {
1623 return (dt_from_string($rule->{hardduedate}, 'iso'),$rule->{hardduedatecompare});
1625 return (undef, undef);
1630 =head2 GetIssuingRule
1632 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1634 FIXME - This is a copy-paste of GetLoanLength
1635 as a stop-gap. Do not wish to change API for GetLoanLength
1636 this close to release.
1638 Get the issuing rule for an itemtype, a borrower type and a branch
1639 Returns a hashref from the issuingrules table.
1643 sub GetIssuingRule {
1644 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1645 my $dbh = C4::Context->dbh;
1646 my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=?" );
1649 $sth->execute( $borrowertype, $itemtype, $branchcode );
1650 $irule = $sth->fetchrow_hashref;
1651 return $irule if defined($irule) ;
1653 $sth->execute( $borrowertype, "*", $branchcode );
1654 $irule = $sth->fetchrow_hashref;
1655 return $irule if defined($irule) ;
1657 $sth->execute( "*", $itemtype, $branchcode );
1658 $irule = $sth->fetchrow_hashref;
1659 return $irule if defined($irule) ;
1661 $sth->execute( "*", "*", $branchcode );
1662 $irule = $sth->fetchrow_hashref;
1663 return $irule if defined($irule) ;
1665 $sth->execute( $borrowertype, $itemtype, "*" );
1666 $irule = $sth->fetchrow_hashref;
1667 return $irule if defined($irule) ;
1669 $sth->execute( $borrowertype, "*", "*" );
1670 $irule = $sth->fetchrow_hashref;
1671 return $irule if defined($irule) ;
1673 $sth->execute( "*", $itemtype, "*" );
1674 $irule = $sth->fetchrow_hashref;
1675 return $irule if defined($irule) ;
1677 $sth->execute( "*", "*", "*" );
1678 $irule = $sth->fetchrow_hashref;
1679 return $irule if defined($irule) ;
1681 # if no rule matches,
1685 =head2 GetBranchBorrowerCircRule
1687 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1689 Retrieves circulation rule attributes that apply to the given
1690 branch and patron category, regardless of item type.
1691 The return value is a hashref containing the following key:
1693 maxissueqty - maximum number of loans that a
1694 patron of the given category can have at the given
1695 branch. If the value is undef, no limit.
1697 maxonsiteissueqty - maximum of on-site checkouts that a
1698 patron of the given category can have at the given
1699 branch. If the value is undef, no limit.
1701 This will first check for a specific branch and
1702 category match from branch_borrower_circ_rules.
1704 If no rule is found, it will then check default_branch_circ_rules
1705 (same branch, default category). If no rule is found,
1706 it will then check default_borrower_circ_rules (default
1707 branch, same category), then failing that, default_circ_rules
1708 (default branch, default category).
1710 If no rule has been found in the database, it will default to
1714 maxonsiteissueqty - undef
1716 C<$branchcode> and C<$categorycode> should contain the
1717 literal branch code and patron category code, respectively - no
1722 sub GetBranchBorrowerCircRule {
1723 my ( $branchcode, $categorycode ) = @_;
1726 my $dbh = C4::Context->dbh();
1727 $rules = $dbh->selectrow_hashref( q|
1728 SELECT maxissueqty, maxonsiteissueqty
1729 FROM branch_borrower_circ_rules
1730 WHERE branchcode = ?
1731 AND categorycode = ?
1732 |, {}, $branchcode, $categorycode ) ;
1733 return $rules if $rules;
1735 # try same branch, default borrower category
1736 $rules = $dbh->selectrow_hashref( q|
1737 SELECT maxissueqty, maxonsiteissueqty
1738 FROM default_branch_circ_rules
1739 WHERE branchcode = ?
1740 |, {}, $branchcode ) ;
1741 return $rules if $rules;
1743 # try default branch, same borrower category
1744 $rules = $dbh->selectrow_hashref( q|
1745 SELECT maxissueqty, maxonsiteissueqty
1746 FROM default_borrower_circ_rules
1747 WHERE categorycode = ?
1748 |, {}, $categorycode ) ;
1749 return $rules if $rules;
1751 # try default branch, default borrower category
1752 $rules = $dbh->selectrow_hashref( q|
1753 SELECT maxissueqty, maxonsiteissueqty
1754 FROM default_circ_rules
1756 return $rules if $rules;
1758 # built-in default circulation rule
1760 maxissueqty => undef,
1761 maxonsiteissueqty => undef,
1765 =head2 GetBranchItemRule
1767 my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1769 Retrieves circulation rule attributes that apply to the given
1770 branch and item type, regardless of patron category.
1772 The return value is a hashref containing the following keys:
1774 holdallowed => Hold policy for this branch and itemtype. Possible values:
1775 0: No holds allowed.
1776 1: Holds allowed only by patrons that have the same homebranch as the item.
1777 2: Holds allowed from any patron.
1779 returnbranch => branch to which to return item. Possible values:
1780 noreturn: do not return, let item remain where checked in (floating collections)
1781 homebranch: return to item's home branch
1782 holdingbranch: return to issuer branch
1784 This searches branchitemrules in the following order:
1786 * Same branchcode and itemtype
1787 * Same branchcode, itemtype '*'
1788 * branchcode '*', same itemtype
1789 * branchcode and itemtype '*'
1791 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1795 sub GetBranchItemRule {
1796 my ( $branchcode, $itemtype ) = @_;
1797 my $dbh = C4::Context->dbh();
1801 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1802 FROM branch_item_rules
1803 WHERE branchcode = ?
1804 AND itemtype = ?', $branchcode, $itemtype],
1805 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1806 FROM default_branch_circ_rules
1807 WHERE branchcode = ?', $branchcode],
1808 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1809 FROM default_branch_item_rules
1810 WHERE itemtype = ?', $itemtype],
1811 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1812 FROM default_circ_rules'],
1815 foreach my $attempt (@attempts) {
1816 my ($query, @bind_params) = @{$attempt};
1817 my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1820 # Since branch/category and branch/itemtype use the same per-branch
1821 # defaults tables, we have to check that the key we want is set, not
1822 # just that a row was returned
1823 $result->{'holdallowed'} = $search_result->{'holdallowed'} unless ( defined $result->{'holdallowed'} );
1824 $result->{'hold_fulfillment_policy'} = $search_result->{'hold_fulfillment_policy'} unless ( defined $result->{'hold_fulfillment_policy'} );
1825 $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1828 # built-in default circulation rule
1829 $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1830 $result->{'hold_fulfillment_policy'} = 'any' unless ( defined $result->{'hold_fulfillment_policy'} );
1831 $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1838 ($doreturn, $messages, $iteminformation, $borrower) =
1839 &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
1845 =item C<$barcode> is the bar code of the book being returned.
1847 =item C<$branch> is the code of the branch where the book is being returned.
1849 =item C<$exemptfine> indicates that overdue charges for the item will be
1852 =item C<$dropbox> indicates that the check-in date is assumed to be
1853 yesterday, or the last non-holiday as defined in C4::Calendar . If
1854 overdue charges are applied and C<$dropbox> is true, the last charge
1855 will be removed. This assumes that the fines accrual script has run
1856 for _today_. Optional.
1858 =item C<$return_date> allows the default return date to be overridden
1859 by the given return date. Optional.
1863 C<&AddReturn> returns a list of four items:
1865 C<$doreturn> is true iff the return succeeded.
1867 C<$messages> is a reference-to-hash giving feedback on the operation.
1868 The keys of the hash are:
1874 No item with this barcode exists. The value is C<$barcode>.
1878 The book is not currently on loan. The value is C<$barcode>.
1880 =item C<IsPermanent>
1882 The book's home branch is a permanent collection. If you have borrowed
1883 this book, you are not allowed to return it. The value is the code for
1884 the book's home branch.
1888 This book has been withdrawn/cancelled. The value should be ignored.
1890 =item C<Wrongbranch>
1892 This book has was returned to the wrong branch. The value is a hashref
1893 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1894 contain the branchcode of the incorrect and correct return library, respectively.
1898 The item was reserved. The value is a reference-to-hash whose keys are
1899 fields from the reserves table of the Koha database, and
1900 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1901 either C<Waiting>, C<Reserved>, or 0.
1903 =item C<WasReturned>
1905 Value 1 if return is successful.
1907 =item C<NeedsTransfer>
1909 If AutomaticItemReturn is disabled, return branch is given as value of NeedsTransfer.
1913 C<$iteminformation> is a reference-to-hash, giving information about the
1914 returned item from the issues table.
1916 C<$borrower> is a reference-to-hash, giving information about the
1917 patron who last borrowed the book.
1922 my ( $barcode, $branch, $exemptfine, $dropbox, $return_date, $dropboxdate ) = @_;
1924 if ($branch and not Koha::Libraries->find($branch)) {
1925 warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
1928 $branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
1933 my $validTransfert = 0;
1934 my $stat_type = 'return';
1936 # get information on item
1937 my $itemnumber = GetItemnumberFromBarcode( $barcode );
1938 unless ($itemnumber) {
1939 return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower. bail out.
1941 my $issue = GetItemIssue($itemnumber);
1942 if ($issue and $issue->{borrowernumber}) {
1943 $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1944 or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existent borrowernumber '$issue->{borrowernumber}'\n"
1945 . Dumper($issue) . "\n";
1947 $messages->{'NotIssued'} = $barcode;
1948 # even though item is not on loan, it may still be transferred; therefore, get current branch info
1950 # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later.
1951 # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1952 if (C4::Context->preference("RecordLocalUseOnReturn")) {
1953 $messages->{'LocalUse'} = 1;
1954 $stat_type = 'localuse';
1958 my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1960 if ( $item->{'location'} eq 'PROC' ) {
1961 if ( C4::Context->preference("InProcessingToShelvingCart") ) {
1962 $item->{'location'} = 'CART';
1965 $item->{location} = $item->{permanent_location};
1968 ModItem( $item, $item->{'biblionumber'}, $item->{'itemnumber'} );
1971 # full item data, but no borrowernumber or checkout info (no issue)
1972 # we know GetItem should work because GetItemnumberFromBarcode worked
1973 my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1974 # get the proper branch to which to return the item
1975 my $returnbranch = $item->{$hbr} || $branch ;
1976 # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1978 my $borrowernumber = $borrower->{'borrowernumber'} || undef; # we don't know if we had a borrower or not
1980 my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
1982 $yaml = "$yaml\n\n"; # YAML is anal on ending \n. Surplus does not hurt
1984 eval { $rules = YAML::Load($yaml); };
1986 warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
1989 foreach my $key ( keys %$rules ) {
1990 if ( $item->{notforloan} eq $key ) {
1991 $messages->{'NotForLoanStatusUpdated'} = { from => $item->{notforloan}, to => $rules->{$key} };
1992 ModItem( { notforloan => $rules->{$key} }, undef, $itemnumber );
2000 # check if the book is in a permanent collection....
2001 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
2002 if ( $returnbranch ) {
2003 my $branches = GetBranches(); # a potentially expensive call for a non-feature.
2004 $branches->{$returnbranch}->{PE} and $messages->{'IsPermanent'} = $returnbranch;
2007 # check if the return is allowed at this branch
2008 my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
2009 unless ($returnallowed){
2010 $messages->{'Wrongbranch'} = {
2011 Wrongbranch => $branch,
2012 Rightbranch => $message
2015 return ( $doreturn, $messages, $issue, $borrower );
2018 if ( $item->{'withdrawn'} ) { # book has been cancelled
2019 $messages->{'withdrawn'} = 1;
2020 $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
2023 # case of a return of document (deal with issues and holdingbranch)
2024 my $today = DateTime->now( time_zone => C4::Context->tz() );
2027 my $datedue = $issue->{date_due};
2028 $borrower or warn "AddReturn without current borrower";
2029 my $circControlBranch;
2031 # define circControlBranch only if dropbox mode is set
2032 # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
2033 # FIXME: check issuedate > returndate, factoring in holidays
2035 $circControlBranch = _GetCircControlBranch($item,$borrower);
2036 $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $dropboxdate ) == -1 ? 1 : 0;
2039 if ($borrowernumber) {
2040 if ( ( C4::Context->preference('CalculateFinesOnReturn') && $issue->{'overdue'} ) || $return_date ) {
2041 # we only need to calculate and change the fines if we want to do that on return
2042 # Should be on for hourly loans
2043 my $control = C4::Context->preference('CircControl');
2044 my $control_branchcode =
2045 ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
2046 : ( $control eq 'PatronLibrary' ) ? $borrower->{branchcode}
2047 : $issue->{branchcode};
2050 $return_date ? dt_from_string($return_date) : $today;
2052 my ( $amount, $type, $unitcounttotal ) =
2053 C4::Overdues::CalcFine( $item, $borrower->{categorycode},
2054 $control_branchcode, $datedue, $date_returned );
2058 if ( C4::Context->preference('finesMode') eq 'production' ) {
2059 if ( $amount > 0 ) {
2060 C4::Overdues::UpdateFine(
2062 issue_id => $issue->{issue_id},
2063 itemnumber => $issue->{itemnumber},
2064 borrowernumber => $issue->{borrowernumber},
2067 due => output_pref($datedue),
2071 elsif ($return_date) {
2073 # Backdated returns may have fines that shouldn't exist,
2074 # so in this case, we need to drop those fines to 0
2076 C4::Overdues::UpdateFine(
2078 issue_id => $issue->{issue_id},
2079 itemnumber => $issue->{itemnumber},
2080 borrowernumber => $issue->{borrowernumber},
2083 due => output_pref($datedue),
2091 MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
2092 $circControlBranch, $return_date, $borrower->{'privacy'} );
2095 $messages->{'Wrongbranch'} = {
2096 Wrongbranch => $branch,
2097 Rightbranch => $message
2100 return ( 0, { WasReturned => 0 }, $issue, $borrower );
2103 # FIXME is the "= 1" right? This could be the borrower hash.
2104 $messages->{'WasReturned'} = 1;
2108 ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
2111 # the holdingbranch is updated if the document is returned to another location.
2112 # this is always done regardless of whether the item was on loan or not
2113 my $item_holding_branch = $item->{ holdingbranch };
2114 if ($item->{'holdingbranch'} ne $branch) {
2115 UpdateHoldingbranch($branch, $item->{'itemnumber'});
2116 $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
2118 ModDateLastSeen( $item->{'itemnumber'} );
2120 # check if we have a transfer for this document
2121 my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
2123 # if we have a transfer to do, we update the line of transfers with the datearrived
2124 my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->{'itemnumber'} );
2126 if ( $tobranch eq $branch ) {
2127 my $sth = C4::Context->dbh->prepare(
2128 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
2130 $sth->execute( $item->{'itemnumber'} );
2131 # if we have a reservation with valid transfer, we can set it's status to 'W'
2132 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
2133 C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
2135 $messages->{'WrongTransfer'} = $tobranch;
2136 $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
2138 $validTransfert = 1;
2140 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
2143 # fix up the accounts.....
2144 if ( $item->{'itemlost'} ) {
2145 $messages->{'WasLost'} = 1;
2147 if ( $item->{'itemlost'} ) {
2149 Koha::RefundLostItemFeeRules->should_refund(
2151 current_branch => C4::Context->userenv->{branch},
2152 item_home_branch => $item->{homebranch},
2153 item_holding_branch => $item_holding_branch
2158 _FixAccountForLostAndReturned( $item->{'itemnumber'}, $borrowernumber, $barcode );
2159 $messages->{'LostItemFeeRefunded'} = 1;
2164 # fix up the overdues in accounts...
2165 if ($borrowernumber) {
2166 my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
2167 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
2169 if ( $issue->{overdue} && $issue->{date_due} ) {
2171 $today = $dropboxdate if $dropbox;
2172 my ($debardate,$reminder) = _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today );
2174 $messages->{'PrevDebarred'} = $debardate;
2176 $messages->{'Debarred'} = $debardate if $debardate;
2178 # there's no overdue on the item but borrower had been previously debarred
2179 } elsif ( $issue->{date_due} and $borrower->{'debarred'} ) {
2180 if ( $borrower->{debarred} eq "9999-12-31") {
2181 $messages->{'ForeverDebarred'} = $borrower->{'debarred'};
2183 my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
2184 $borrower_debar_dt->truncate(to => 'day');
2185 my $today_dt = $today->clone()->truncate(to => 'day');
2186 if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2187 $messages->{'PrevDebarred'} = $borrower->{'debarred'};
2193 # find reserves.....
2194 # if we don't have a reserve with the status W, we launch the Checkreserves routine
2195 my ($resfound, $resrec);
2196 my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2197 ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'}, undef, $lookahead ) unless ( $item->{'withdrawn'} );
2199 $resrec->{'ResFound'} = $resfound;
2200 $messages->{'ResFound'} = $resrec;
2203 # Record the fact that this book was returned.
2204 # FIXME itemtype should record item level type, not bibliolevel type
2208 itemnumber => $item->{'itemnumber'},
2209 itemtype => $biblio->{'itemtype'},
2210 borrowernumber => $borrowernumber,
2211 ccode => $item->{'ccode'}}
2214 # Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then.
2215 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2217 branchcode => $branch,
2218 categorycode => $borrower->{categorycode},
2219 item_type => $item->{itype},
2220 notification => 'CHECKIN',
2222 if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2223 SendCirculationAlert({
2226 borrower => $borrower,
2231 logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
2232 if C4::Context->preference("ReturnLog");
2234 # Remove any OVERDUES related debarment if the borrower has no overdues
2235 if ( $borrowernumber
2236 && $borrower->{'debarred'}
2237 && C4::Context->preference('AutoRemoveOverduesRestrictions')
2238 && !C4::Members::HasOverdues( $borrowernumber )
2239 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2241 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2244 # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2245 if (!$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) and not $messages->{'WrongTransfer'}){
2246 if (C4::Context->preference("AutomaticItemReturn" ) or
2247 (C4::Context->preference("UseBranchTransferLimits") and
2248 ! IsBranchTransferAllowed($branch, $returnbranch, $item->{C4::Context->preference("BranchTransferLimitsType")} )
2250 $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $returnbranch;
2251 $debug and warn "item: " . Dumper($item);
2252 ModItemTransfer($item->{'itemnumber'}, $branch, $returnbranch);
2253 $messages->{'WasTransfered'} = 1;
2255 $messages->{'NeedsTransfer'} = $returnbranch;
2259 return ( $doreturn, $messages, $issue, $borrower );
2262 =head2 MarkIssueReturned
2264 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
2266 Unconditionally marks an issue as being returned by
2267 moving the C<issues> row to C<old_issues> and
2268 setting C<returndate> to the current date, or
2269 the last non-holiday date of the branccode specified in
2270 C<dropbox_branch> . Assumes you've already checked that
2271 it's safe to do this, i.e. last non-holiday > issuedate.
2273 if C<$returndate> is specified (in iso format), it is used as the date
2274 of the return. It is ignored when a dropbox_branch is passed in.
2276 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2277 the old_issue is immediately anonymised
2279 Ideally, this function would be internal to C<C4::Circulation>,
2280 not exported, but it is currently needed by one
2281 routine in C<C4::Accounts>.
2285 sub MarkIssueReturned {
2286 my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
2288 my $anonymouspatron;
2289 if ( $privacy == 2 ) {
2290 # The default of 0 will not work due to foreign key constraints
2291 # The anonymisation will fail if AnonymousPatron is not a valid entry
2292 # We need to check if the anonymous patron exist, Koha will fail loudly if it does not
2293 # Note that a warning should appear on the about page (System information tab).
2294 $anonymouspatron = C4::Context->preference('AnonymousPatron');
2295 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."
2296 unless C4::Members::GetMember( borrowernumber => $anonymouspatron );
2298 my $dbh = C4::Context->dbh;
2299 my $query = 'UPDATE issues SET returndate=';
2301 if ($dropbox_branch) {
2302 my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
2303 my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
2305 push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2306 } elsif ($returndate) {
2308 push @bind, $returndate;
2310 $query .= ' now() ';
2312 $query .= ' WHERE borrowernumber = ? AND itemnumber = ?';
2313 push @bind, $borrowernumber, $itemnumber;
2315 my $sth_upd = $dbh->prepare($query);
2316 $sth_upd->execute(@bind);
2317 my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
2318 WHERE borrowernumber = ?
2319 AND itemnumber = ?');
2320 $sth_copy->execute($borrowernumber, $itemnumber);
2321 # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2322 if ( $privacy == 2) {
2323 my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
2324 WHERE borrowernumber = ?
2325 AND itemnumber = ?");
2326 $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
2328 my $sth_del = $dbh->prepare("DELETE FROM issues
2329 WHERE borrowernumber = ?
2330 AND itemnumber = ?");
2331 $sth_del->execute($borrowernumber, $itemnumber);
2333 ModItem( { 'onloan' => undef }, undef, $itemnumber );
2335 if ( C4::Context->preference('StoreLastBorrower') ) {
2336 my $item = Koha::Items->find( $itemnumber );
2337 my $patron = Koha::Patrons->find( $borrowernumber );
2338 $item->last_returned_by( $patron );
2342 =head2 _debar_user_on_return
2344 _debar_user_on_return($borrower, $item, $datedue, today);
2346 C<$borrower> borrower hashref
2348 C<$item> item hashref
2350 C<$datedue> date due DateTime object
2352 C<$today> DateTime object representing the return time
2354 Internal function, called only by AddReturn that calculates and updates
2355 the user fine days, and debars him if necessary.
2357 Should only be called for overdue returns
2361 sub _debar_user_on_return {
2362 my ( $borrower, $item, $dt_due, $dt_today ) = @_;
2364 my $branchcode = _GetCircControlBranch( $item, $borrower );
2366 my $circcontrol = C4::Context->preference('CircControl');
2368 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2369 my $finedays = $issuingrule->{finedays};
2370 my $unit = $issuingrule->{lengthunit};
2371 my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $dt_today, $branchcode);
2375 # finedays is in days, so hourly loans must multiply by 24
2376 # thus 1 hour late equals 1 day suspension * finedays rate
2377 $finedays = $finedays * 24 if ( $unit eq 'hours' );
2379 # grace period is measured in the same units as the loan
2381 DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
2383 my $deltadays = DateTime::Duration->new(
2384 days => $chargeable_units
2386 if ( $deltadays->subtract($grace)->is_positive() ) {
2387 my $suspension_days = $deltadays * $finedays;
2389 # If the max suspension days is < than the suspension days
2390 # the suspension days is limited to this maximum period.
2391 my $max_sd = $issuingrule->{maxsuspensiondays};
2392 if ( defined $max_sd ) {
2393 $max_sd = DateTime::Duration->new( days => $max_sd );
2394 $suspension_days = $max_sd
2395 if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2399 $dt_today->clone()->add_duration( $suspension_days );
2401 Koha::Patron::Debarments::AddUniqueDebarment({
2402 borrowernumber => $borrower->{borrowernumber},
2403 expiration => $new_debar_dt->ymd(),
2404 type => 'SUSPENSION',
2406 # if borrower was already debarred but does not get an extra debarment
2407 if ( $borrower->{debarred} eq Koha::Patron::Debarments::IsDebarred($borrower->{borrowernumber}) ) {
2408 return ($borrower->{debarred},1);
2410 return $new_debar_dt->ymd();
2416 =head2 _FixOverduesOnReturn
2418 &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2420 C<$brn> borrowernumber
2424 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2425 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2427 Internal function, called only by AddReturn
2431 sub _FixOverduesOnReturn {
2432 my ($borrowernumber, $item);
2433 unless ($borrowernumber = shift) {
2434 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2437 unless ($item = shift) {
2438 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2441 my ($exemptfine, $dropbox) = @_;
2442 my $dbh = C4::Context->dbh;
2444 # check for overdue fine
2445 my $sth = $dbh->prepare(
2446 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
2448 $sth->execute( $borrowernumber, $item );
2450 # alter fine to show that the book has been returned
2451 my $data = $sth->fetchrow_hashref;
2452 return 0 unless $data; # no warning, there's just nothing to fix
2455 my @bind = ($data->{'accountlines_id'});
2457 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2458 if (C4::Context->preference("FinesLog")) {
2459 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2461 } elsif ($dropbox && $data->{lastincrement}) {
2462 my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2463 my $amt = $data->{amount} - $data->{lastincrement} ;
2464 if (C4::Context->preference("FinesLog")) {
2465 &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2467 $uquery = "update accountlines set accounttype='F' ";
2468 if($outstanding >= 0 && $amt >=0) {
2469 $uquery .= ", amount = ? , amountoutstanding=? ";
2470 unshift @bind, ($amt, $outstanding) ;
2473 $uquery = "update accountlines set accounttype='F' ";
2475 $uquery .= " where (accountlines_id = ?)";
2476 my $usth = $dbh->prepare($uquery);
2477 return $usth->execute(@bind);
2480 =head2 _FixAccountForLostAndReturned
2482 &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2484 Calculates the charge for a book lost and returned.
2486 Internal function, not exported, called only by AddReturn.
2488 FIXME: This function reflects how inscrutable fines logic is. Fix both.
2489 FIXME: Give a positive return value on success. It might be the $borrowernumber who received credit, or the amount forgiven.
2493 sub _FixAccountForLostAndReturned {
2494 my $itemnumber = shift or return;
2495 my $borrowernumber = @_ ? shift : undef;
2496 my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
2497 my $dbh = C4::Context->dbh;
2498 # check for charge made for lost book
2499 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2500 $sth->execute($itemnumber);
2501 my $data = $sth->fetchrow_hashref;
2502 $data or return; # bail if there is nothing to do
2503 $data->{accounttype} eq 'W' and return; # Written off
2505 # writeoff this amount
2507 my $amount = $data->{'amount'};
2508 my $acctno = $data->{'accountno'};
2509 my $amountleft; # Starts off undef/zero.
2510 if ($data->{'amountoutstanding'} == $amount) {
2511 $offset = $data->{'amount'};
2512 $amountleft = 0; # Hey, it's zero here, too.
2514 $offset = $amount - $data->{'amountoutstanding'}; # Um, isn't this the same as ZERO? We just tested those two things are ==
2515 $amountleft = $data->{'amountoutstanding'} - $amount; # Um, isn't this the same as ZERO? We just tested those two things are ==
2517 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2518 WHERE (accountlines_id = ?)");
2519 $usth->execute($data->{'accountlines_id'}); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in.
2520 #check if any credit is left if so writeoff other accounts
2521 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2522 $amountleft *= -1 if ($amountleft < 0);
2523 if ($amountleft > 0) {
2524 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2525 AND (amountoutstanding >0) ORDER BY date"); # might want to order by amountoustanding ASC (pay smallest first)
2526 $msth->execute($data->{'borrowernumber'});
2527 # offset transactions
2530 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2531 if ($accdata->{'amountoutstanding'} < $amountleft) {
2533 $amountleft -= $accdata->{'amountoutstanding'};
2535 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2538 my $thisacct = $accdata->{'accountlines_id'};
2539 # FIXME: move prepares outside while loop!
2540 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2541 WHERE (accountlines_id = ?)");
2542 $usth->execute($newamtos,$thisacct);
2543 $usth = $dbh->prepare("INSERT INTO accountoffsets
2544 (borrowernumber, accountno, offsetaccount, offsetamount)
2547 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2550 $amountleft *= -1 if ($amountleft > 0);
2551 my $desc = "Item Returned " . $item_id;
2552 $usth = $dbh->prepare("INSERT INTO accountlines
2553 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2554 VALUES (?,?,now(),?,?,'CR',?)");
2555 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2556 if ($borrowernumber) {
2557 # FIXME: same as query above. use 1 sth for both
2558 $usth = $dbh->prepare("INSERT INTO accountoffsets
2559 (borrowernumber, accountno, offsetaccount, offsetamount)
2561 $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2563 ModItem({ paidfor => '' }, undef, $itemnumber);
2567 =head2 _GetCircControlBranch
2569 my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2573 Return the library code to be used to determine which circulation
2574 policy applies to a transaction. Looks up the CircControl and
2575 HomeOrHoldingBranch system preferences.
2577 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2579 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2583 sub _GetCircControlBranch {
2584 my ($item, $borrower) = @_;
2585 my $circcontrol = C4::Context->preference('CircControl');
2588 if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2589 $branch= C4::Context->userenv->{'branch'};
2590 } elsif ($circcontrol eq 'PatronLibrary') {
2591 $branch=$borrower->{branchcode};
2593 my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2594 $branch = $item->{$branchfield};
2595 # default to item home branch if holdingbranch is used
2596 # and is not defined
2597 if (!defined($branch) && $branchfield eq 'holdingbranch') {
2598 $branch = $item->{homebranch};
2611 $issue = &GetItemIssue($itemnumber);
2613 Returns patron currently having a book, or undef if not checked out.
2615 C<$itemnumber> is the itemnumber.
2617 C<$issue> is a hashref of the row from the issues table.
2622 my ($itemnumber) = @_;
2623 return unless $itemnumber;
2624 my $sth = C4::Context->dbh->prepare(
2625 "SELECT items.*, issues.*
2627 LEFT JOIN items ON issues.itemnumber=items.itemnumber
2628 WHERE issues.itemnumber=?");
2629 $sth->execute($itemnumber);
2630 my $data = $sth->fetchrow_hashref;
2631 return unless $data;
2632 $data->{issuedate_sql} = $data->{issuedate};
2633 $data->{date_due_sql} = $data->{date_due};
2634 $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2635 $data->{issuedate}->truncate(to => 'minute');
2636 $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2637 $data->{date_due}->truncate(to => 'minute');
2638 my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2639 $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2645 $issue = GetOpenIssue( $itemnumber );
2647 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2649 C<$itemnumber> is the item's itemnumber
2656 my ( $itemnumber ) = @_;
2657 return unless $itemnumber;
2658 my $dbh = C4::Context->dbh;
2659 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2660 $sth->execute( $itemnumber );
2661 return $sth->fetchrow_hashref();
2667 $issues = GetIssues({}); # return all issues!
2668 $issues = GetIssues({ borrowernumber => $borrowernumber, biblionumber => $biblionumber });
2670 Returns all pending issues that match given criteria.
2671 Returns a arrayref or undef if an error occurs.
2673 Allowed criteria are:
2677 =item * borrowernumber
2679 =item * biblionumber
2688 my ($criteria) = @_;
2692 my @allowed = qw(borrowernumber biblionumber itemnumber);
2693 foreach (@allowed) {
2694 if (defined $criteria->{$_}) {
2697 value => $criteria->{$_},
2702 # Do we need to join other tables ?
2704 if (defined $criteria->{biblionumber}) {
2711 $where = "WHERE " . join(' AND ', map { "$_->{field} = ?" } @filters);
2717 if (defined $join{items}) {
2719 LEFT JOIN items ON (issues.itemnumber = items.itemnumber)
2725 my $dbh = C4::Context->dbh;
2726 my $sth = $dbh->prepare($query);
2727 my $rv = $sth->execute(map { $_->{value} } @filters);
2729 return $rv ? $sth->fetchall_arrayref({}) : undef;
2732 =head2 GetItemIssues
2734 $issues = &GetItemIssues($itemnumber, $history);
2736 Returns patrons that have issued a book
2738 C<$itemnumber> is the itemnumber
2739 C<$history> is false if you just want the current "issuer" (if any)
2740 and true if you want issues history from old_issues also.
2742 Returns reference to an array of hashes
2747 my ( $itemnumber, $history ) = @_;
2749 my $today = DateTime->now( time_zome => C4::Context->tz); # get today date
2750 $today->truncate( to => 'minute' );
2751 my $sql = "SELECT * FROM issues
2752 JOIN borrowers USING (borrowernumber)
2753 JOIN items USING (itemnumber)
2754 WHERE issues.itemnumber = ? ";
2757 SELECT * FROM old_issues
2758 LEFT JOIN borrowers USING (borrowernumber)
2759 JOIN items USING (itemnumber)
2760 WHERE old_issues.itemnumber = ? ";
2762 $sql .= "ORDER BY date_due DESC";
2763 my $sth = C4::Context->dbh->prepare($sql);
2765 $sth->execute($itemnumber, $itemnumber);
2767 $sth->execute($itemnumber);
2769 my $results = $sth->fetchall_arrayref({});
2770 foreach (@$results) {
2771 my $date_due = dt_from_string($_->{date_due},'sql');
2772 $date_due->truncate( to => 'minute' );
2774 $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2779 =head2 GetBiblioIssues
2781 $issues = GetBiblioIssues($biblionumber);
2783 this function get all issues from a biblionumber.
2786 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2787 tables issues and the firstname,surname & cardnumber from borrowers.
2791 sub GetBiblioIssues {
2792 my $biblionumber = shift;
2793 return unless $biblionumber;
2794 my $dbh = C4::Context->dbh;
2796 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2798 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2799 LEFT JOIN items ON issues.itemnumber = items.itemnumber
2800 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2801 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2802 WHERE biblio.biblionumber = ?
2804 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2806 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2807 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2808 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2809 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2810 WHERE biblio.biblionumber = ?
2813 my $sth = $dbh->prepare($query);
2814 $sth->execute($biblionumber, $biblionumber);
2817 while ( my $data = $sth->fetchrow_hashref ) {
2818 push @issues, $data;
2823 =head2 GetUpcomingDueIssues
2825 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2829 sub GetUpcomingDueIssues {
2832 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2833 my $dbh = C4::Context->dbh;
2835 my $statement = <<END_SQL;
2836 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2838 LEFT JOIN items USING (itemnumber)
2839 LEFT OUTER JOIN branches USING (branchcode)
2840 WHERE returndate is NULL
2841 HAVING days_until_due >= 0 AND days_until_due <= ?
2844 my @bind_parameters = ( $params->{'days_in_advance'} );
2846 my $sth = $dbh->prepare( $statement );
2847 $sth->execute( @bind_parameters );
2848 my $upcoming_dues = $sth->fetchall_arrayref({});
2850 return $upcoming_dues;
2853 =head2 CanBookBeRenewed
2855 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2857 Find out whether a borrowed item may be renewed.
2859 C<$borrowernumber> is the borrower number of the patron who currently
2860 has the item on loan.
2862 C<$itemnumber> is the number of the item to renew.
2864 C<$override_limit>, if supplied with a true value, causes
2865 the limit on the number of times that the loan can be renewed
2866 (as controlled by the item type) to be ignored. Overriding also allows
2867 to renew sooner than "No renewal before" and to manually renew loans
2868 that are automatically renewed.
2870 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2871 item must currently be on loan to the specified borrower; renewals
2872 must be allowed for the item's type; and the borrower must not have
2873 already renewed the loan. $error will contain the reason the renewal can not proceed
2877 sub CanBookBeRenewed {
2878 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2880 my $dbh = C4::Context->dbh;
2883 my $item = GetItem($itemnumber) or return ( 0, 'no_item' );
2884 my $itemissue = GetItemIssue($itemnumber) or return ( 0, 'no_checkout' );
2885 return ( 0, 'onsite_checkout' ) if $itemissue->{onsite_checkout};
2887 $borrowernumber ||= $itemissue->{borrowernumber};
2888 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
2891 my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2893 # This item can fill one or more unfilled reserve, can those unfilled reserves
2894 # all be filled by other available items?
2896 && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2898 my $schema = Koha::Database->new()->schema();
2900 my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2902 # There is an item level hold on this item, no other item can fill the hold
2907 # Get all other items that could possibly fill reserves
2908 my @itemnumbers = $schema->resultset('Item')->search(
2910 biblionumber => $resrec->{biblionumber},
2913 -not => { itemnumber => $itemnumber }
2915 { columns => 'itemnumber' }
2916 )->get_column('itemnumber')->all();
2918 # Get all other reserves that could have been filled by this item
2919 my @borrowernumbers;
2921 my ( $reserve_found, $reserve, undef ) =
2922 C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2924 if ($reserve_found) {
2925 push( @borrowernumbers, $reserve->{borrowernumber} );
2932 # If the count of the union of the lists of reservable items for each borrower
2933 # is equal or greater than the number of borrowers, we know that all reserves
2934 # can be filled with available items. We can get the union of the sets simply
2935 # by pushing all the elements onto an array and removing the duplicates.
2937 foreach my $b (@borrowernumbers) {
2938 my ($borr) = C4::Members::GetMemberDetails($b);
2939 foreach my $i (@itemnumbers) {
2940 my $item = GetItem($i);
2941 if ( IsAvailableForItemLevelRequest( $item, $borr )
2942 && CanItemBeReserved( $b, $i )
2943 && !IsItemOnHoldAndFound($i) )
2945 push( @reservable, $i );
2950 @reservable = uniq(@reservable);
2952 if ( @reservable >= @borrowernumbers ) {
2957 return ( 0, "on_reserve" ) if $resfound; # '' when no hold was found
2959 return ( 1, undef ) if $override_limit;
2961 my $branchcode = _GetCircControlBranch( $item, $borrower );
2963 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2965 return ( 0, "too_many" )
2966 if $issuingrule->{renewalsallowed} <= $itemissue->{renewals};
2968 my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2969 my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2970 my $restricted = Koha::Patron::Debarments::IsDebarred($borrowernumber);
2971 my $hasoverdues = C4::Members::HasOverdues($borrowernumber);
2973 if ( $restricted and $restrictionblockrenewing ) {
2974 return ( 0, 'restriction');
2975 } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($itemissue->{overdue} and $overduesblockrenewing eq 'blockitem') ) {
2976 return ( 0, 'overdue');
2979 if ( defined $issuingrule->{norenewalbefore}
2980 and $issuingrule->{norenewalbefore} ne "" )
2983 # Calculate soonest renewal by subtracting 'No renewal before' from due date
2984 my $soonestrenewal =
2985 $itemissue->{date_due}->clone()
2987 $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
2989 # Depending on syspref reset the exact time, only check the date
2990 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2991 and $issuingrule->{lengthunit} eq 'days' )
2993 $soonestrenewal->truncate( to => 'day' );
2996 if ( $soonestrenewal > DateTime->now( time_zone => C4::Context->tz() ) )
2998 return ( 0, "auto_too_soon" ) if $itemissue->{auto_renew};
2999 return ( 0, "too_soon" );
3001 elsif ( $itemissue->{auto_renew} ) {
3002 return ( 0, "auto_renew" );
3006 # Fallback for automatic renewals:
3007 # If norenewalbefore is undef, don't renew before due date.
3008 elsif ( $itemissue->{auto_renew} ) {
3009 my $now = dt_from_string;
3010 return ( 0, "auto_renew" )
3011 if $now >= $itemissue->{date_due};
3012 return ( 0, "auto_too_soon" );
3015 return ( 1, undef );
3020 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
3024 C<$borrowernumber> is the borrower number of the patron who currently
3027 C<$itemnumber> is the number of the item to renew.
3029 C<$branch> is the library where the renewal took place (if any).
3030 The library that controls the circ policies for the renewal is retrieved from the issues record.
3032 C<$datedue> can be a DateTime object used to set the due date.
3034 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
3035 this parameter is not supplied, lastreneweddate is set to the current date.
3037 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
3038 from the book's item type.
3043 my $borrowernumber = shift;
3044 my $itemnumber = shift or return;
3046 my $datedue = shift;
3047 my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
3049 my $item = GetItem($itemnumber) or return;
3050 my $biblio = GetBiblioFromItemNumber($itemnumber) or return;
3052 my $dbh = C4::Context->dbh;
3054 # Find the issues record for this book
3056 $dbh->prepare("SELECT * FROM issues WHERE itemnumber = ?");
3057 $sth->execute( $itemnumber );
3058 my $issuedata = $sth->fetchrow_hashref;
3060 return unless ( $issuedata );
3062 $borrowernumber ||= $issuedata->{borrowernumber};
3064 if ( defined $datedue && ref $datedue ne 'DateTime' ) {
3065 carp 'Invalid date passed to AddRenewal.';
3069 # If the due date wasn't specified, calculate it by adding the
3070 # book's loan length to today's date or the current due date
3071 # based on the value of the RenewalPeriodBase syspref.
3074 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return;
3075 my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
3077 $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
3078 dt_from_string( $issuedata->{date_due} ) :
3079 DateTime->now( time_zone => C4::Context->tz());
3080 $datedue = CalcDateDue($datedue, $itemtype, $issuedata->{'branchcode'}, $borrower, 'is a renewal');
3083 # Update the issues record to have the new due date, and a new count
3084 # of how many times it has been renewed.
3085 my $renews = $issuedata->{'renewals'} + 1;
3086 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
3087 WHERE borrowernumber=?
3091 $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
3093 # Update the renewal count on the item, and tell zebra to reindex
3094 $renews = $biblio->{'renewals'} + 1;
3095 ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
3097 # Charge a new rental fee, if applicable?
3098 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
3099 if ( $charge > 0 ) {
3100 my $accountno = getnextacctno( $borrowernumber );
3101 my $item = GetBiblioFromItemNumber($itemnumber);
3103 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3104 $sth = $dbh->prepare(
3105 "INSERT INTO accountlines
3106 (date, borrowernumber, accountno, amount, manager_id,
3107 description,accounttype, amountoutstanding, itemnumber)
3108 VALUES (now(),?,?,?,?,?,?,?,?)"
3110 $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
3111 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
3112 'Rent', $charge, $itemnumber );
3115 # Send a renewal slip according to checkout alert preferencei
3116 if ( C4::Context->preference('RenewalSendNotice') eq '1') {
3117 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
3118 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
3120 branchcode => $branch,
3121 categorycode => $borrower->{categorycode},
3122 item_type => $item->{itype},
3123 notification => 'CHECKOUT',
3125 if ($circulation_alert->is_enabled_for(\%conditions)) {
3126 SendCirculationAlert({
3129 borrower => $borrower,
3135 # Remove any OVERDUES related debarment if the borrower has no overdues
3136 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
3137 if ( $borrowernumber
3138 && $borrower->{'debarred'}
3139 && !C4::Members::HasOverdues( $borrowernumber )
3140 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
3142 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
3146 UpdateStats({branch => $branch,
3149 itemnumber => $itemnumber,
3150 itemtype => $item->{itype},
3151 borrowernumber => $borrowernumber,
3152 ccode => $item->{'ccode'}}
3158 # check renewal status
3159 my ( $bornum, $itemno ) = @_;
3160 my $dbh = C4::Context->dbh;
3162 my $renewsallowed = 0;
3165 my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
3166 my $item = GetItem($itemno);
3168 # Look in the issues table for this item, lent to this borrower,
3169 # and not yet returned.
3171 # FIXME - I think this function could be redone to use only one SQL call.
3172 my $sth = $dbh->prepare(
3173 "select * from issues
3174 where (borrowernumber = ?)
3175 and (itemnumber = ?)"
3177 $sth->execute( $bornum, $itemno );
3178 my $data = $sth->fetchrow_hashref;
3179 $renewcount = $data->{'renewals'} if $data->{'renewals'};
3180 # $item and $borrower should be calculated
3181 my $branchcode = _GetCircControlBranch($item, $borrower);
3183 my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
3185 $renewsallowed = $issuingrule->{'renewalsallowed'};
3186 $renewsleft = $renewsallowed - $renewcount;
3187 if($renewsleft < 0){ $renewsleft = 0; }
3188 return ( $renewcount, $renewsallowed, $renewsleft );
3191 =head2 GetSoonestRenewDate
3193 $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
3195 Find out the soonest possible renew date of a borrowed item.
3197 C<$borrowernumber> is the borrower number of the patron who currently
3198 has the item on loan.
3200 C<$itemnumber> is the number of the item to renew.
3202 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3203 renew date, based on the value "No renewal before" of the applicable
3204 issuing rule. Returns the current date if the item can already be
3205 renewed, and returns undefined if the borrower, loan, or item
3210 sub GetSoonestRenewDate {
3211 my ( $borrowernumber, $itemnumber ) = @_;
3213 my $dbh = C4::Context->dbh;
3215 my $item = GetItem($itemnumber) or return;
3216 my $itemissue = GetItemIssue($itemnumber) or return;
3218 $borrowernumber ||= $itemissue->{borrowernumber};
3219 my $borrower = C4::Members::GetMemberDetails($borrowernumber)
3222 my $branchcode = _GetCircControlBranch( $item, $borrower );
3224 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
3226 my $now = dt_from_string;
3228 if ( defined $issuingrule->{norenewalbefore}
3229 and $issuingrule->{norenewalbefore} ne "" )
3231 my $soonestrenewal =
3232 $itemissue->{date_due}->clone()
3234 $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
3236 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3237 and $issuingrule->{lengthunit} eq 'days' )
3239 $soonestrenewal->truncate( to => 'day' );
3241 return $soonestrenewal if $now < $soonestrenewal;
3246 =head2 GetIssuingCharges
3248 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3250 Calculate how much it would cost for a given patron to borrow a given
3251 item, including any applicable discounts.
3253 C<$itemnumber> is the item number of item the patron wishes to borrow.
3255 C<$borrowernumber> is the patron's borrower number.
3257 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3258 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3263 sub GetIssuingCharges {
3265 # calculate charges due
3266 my ( $itemnumber, $borrowernumber ) = @_;
3268 my $dbh = C4::Context->dbh;
3271 # Get the book's item type and rental charge (via its biblioitem).
3272 my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3273 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3274 $charge_query .= (C4::Context->preference('item-level_itypes'))
3275 ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3276 : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3278 $charge_query .= ' WHERE items.itemnumber =?';
3280 my $sth = $dbh->prepare($charge_query);
3281 $sth->execute($itemnumber);
3282 if ( my $item_data = $sth->fetchrow_hashref ) {
3283 $item_type = $item_data->{itemtype};
3284 $charge = $item_data->{rentalcharge};
3285 my $branch = C4::Branch::mybranch();
3286 my $discount_query = q|SELECT rentaldiscount,
3287 issuingrules.itemtype, issuingrules.branchcode
3289 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3290 WHERE borrowers.borrowernumber = ?
3291 AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3292 AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3293 my $discount_sth = $dbh->prepare($discount_query);
3294 $discount_sth->execute( $borrowernumber, $item_type, $branch );
3295 my $discount_rules = $discount_sth->fetchall_arrayref({});
3296 if (@{$discount_rules}) {
3297 # We may have multiple rules so get the most specific
3298 my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3299 $charge = ( $charge * ( 100 - $discount ) ) / 100;
3303 return ( $charge, $item_type );
3306 # Select most appropriate discount rule from those returned
3307 sub _get_discount_from_rule {
3308 my ($rules_ref, $branch, $itemtype) = @_;
3311 if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3312 $discount = $rules_ref->[0]->{rentaldiscount};
3313 return (defined $discount) ? $discount : 0;
3315 # could have up to 4 does one match $branch and $itemtype
3316 my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3318 $discount = $d[0]->{rentaldiscount};
3319 return (defined $discount) ? $discount : 0;
3321 # do we have item type + all branches
3322 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3324 $discount = $d[0]->{rentaldiscount};
3325 return (defined $discount) ? $discount : 0;
3327 # do we all item types + this branch
3328 @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3330 $discount = $d[0]->{rentaldiscount};
3331 return (defined $discount) ? $discount : 0;
3333 # so all and all (surely we wont get here)
3334 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3336 $discount = $d[0]->{rentaldiscount};
3337 return (defined $discount) ? $discount : 0;
3343 =head2 AddIssuingCharge
3345 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3349 sub AddIssuingCharge {
3350 my ( $itemnumber, $borrowernumber, $charge ) = @_;
3351 my $dbh = C4::Context->dbh;
3352 my $nextaccntno = getnextacctno( $borrowernumber );
3354 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3356 INSERT INTO accountlines
3357 (borrowernumber, itemnumber, accountno,
3358 date, amount, description, accounttype,
3359 amountoutstanding, manager_id)
3360 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
3362 my $sth = $dbh->prepare($query);
3363 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
3368 GetTransfers($itemnumber);
3373 my ($itemnumber) = @_;
3375 my $dbh = C4::Context->dbh;
3381 FROM branchtransfers
3382 WHERE itemnumber = ?
3383 AND datearrived IS NULL
3385 my $sth = $dbh->prepare($query);
3386 $sth->execute($itemnumber);
3387 my @row = $sth->fetchrow_array();
3391 =head2 GetTransfersFromTo
3393 @results = GetTransfersFromTo($frombranch,$tobranch);
3395 Returns the list of pending transfers between $from and $to branch
3399 sub GetTransfersFromTo {
3400 my ( $frombranch, $tobranch ) = @_;
3401 return unless ( $frombranch && $tobranch );
3402 my $dbh = C4::Context->dbh;
3404 SELECT itemnumber,datesent,frombranch
3405 FROM branchtransfers
3408 AND datearrived IS NULL
3410 my $sth = $dbh->prepare($query);
3411 $sth->execute( $frombranch, $tobranch );
3414 while ( my $data = $sth->fetchrow_hashref ) {
3415 push @gettransfers, $data;
3417 return (@gettransfers);
3420 =head2 DeleteTransfer
3422 &DeleteTransfer($itemnumber);
3426 sub DeleteTransfer {
3427 my ($itemnumber) = @_;
3428 return unless $itemnumber;
3429 my $dbh = C4::Context->dbh;
3430 my $sth = $dbh->prepare(
3431 "DELETE FROM branchtransfers
3433 AND datearrived IS NULL "
3435 return $sth->execute($itemnumber);
3438 =head2 AnonymiseIssueHistory
3440 ($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)
3442 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
3443 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
3445 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
3446 setting (force delete).
3448 return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.
3452 sub AnonymiseIssueHistory {
3454 my $borrowernumber = shift;
3455 my $dbh = C4::Context->dbh;
3458 SET borrowernumber = ?
3459 WHERE returndate < ?
3460 AND borrowernumber IS NOT NULL
3463 # The default of 0 does not work due to foreign key constraints
3464 # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
3465 # Set it to undef (NULL)
3466 my $anonymouspatron = C4::Context->preference('AnonymousPatron') || undef;
3467 my @bind_params = ($anonymouspatron, $date);
3468 if (defined $borrowernumber) {
3469 $query .= " AND borrowernumber = ?";
3470 push @bind_params, $borrowernumber;
3472 $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
3474 my $sth = $dbh->prepare($query);
3475 $sth->execute(@bind_params);
3476 my $anonymisation_err = $dbh->err;
3477 my $rows_affected = $sth->rows; ### doublecheck row count return function
3478 return ($rows_affected, $anonymisation_err);
3481 =head2 SendCirculationAlert
3483 Send out a C<check-in> or C<checkout> alert using the messaging system.
3491 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3495 Hashref of information about the item being checked in or out.
3499 Hashref of information about the borrower of the item.
3503 The branchcode from where the checkout or check-in took place.
3509 SendCirculationAlert({
3512 borrower => $borrower,
3518 sub SendCirculationAlert {
3520 my ($type, $item, $borrower, $branch) =
3521 ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3522 my %message_name = (
3523 CHECKIN => 'Item_Check_in',
3524 CHECKOUT => 'Item_Checkout',
3525 RENEWAL => 'Item_Checkout',
3527 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3528 borrowernumber => $borrower->{borrowernumber},
3529 message_name => $message_name{$type},
3531 my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3533 my @transports = keys %{ $borrower_preferences->{transports} };
3534 # warn "no transports" unless @transports;
3536 # warn "transport: $_";
3537 my $message = C4::Message->find_last_message($borrower, $type, $_);
3539 #warn "create new message";
3540 my $letter = C4::Letters::GetPreparedLetter (
3541 module => 'circulation',
3542 letter_code => $type,
3543 branchcode => $branch,
3544 message_transport_type => $_,
3546 $issues_table => $item->{itemnumber},
3547 'items' => $item->{itemnumber},
3548 'biblio' => $item->{biblionumber},
3549 'biblioitems' => $item->{biblionumber},
3550 'borrowers' => $borrower,
3551 'branches' => $branch,
3554 C4::Message->enqueue($letter, $borrower, $_);
3556 #warn "append to old message";
3557 my $letter = C4::Letters::GetPreparedLetter (
3558 module => 'circulation',
3559 letter_code => $type,
3560 branchcode => $branch,
3561 message_transport_type => $_,
3563 $issues_table => $item->{itemnumber},
3564 'items' => $item->{itemnumber},
3565 'biblio' => $item->{biblionumber},
3566 'biblioitems' => $item->{biblionumber},
3567 'borrowers' => $borrower,
3568 'branches' => $branch,
3571 $message->append($letter);
3579 =head2 updateWrongTransfer
3581 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3583 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
3587 sub updateWrongTransfer {
3588 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3589 my $dbh = C4::Context->dbh;
3590 # first step validate the actual line of transfert .
3593 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3595 $sth->execute($FromLibrary,$itemNumber);
3597 # second step create a new line of branchtransfer to the right location .
3598 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3600 #third step changing holdingbranch of item
3601 UpdateHoldingbranch($FromLibrary,$itemNumber);
3604 =head2 UpdateHoldingbranch
3606 $items = UpdateHoldingbranch($branch,$itmenumber);
3608 Simple methode for updating hodlingbranch in items BDD line
3612 sub UpdateHoldingbranch {
3613 my ( $branch,$itemnumber ) = @_;
3614 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3619 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3621 this function calculates the due date given the start date and configured circulation rules,
3622 checking against the holidays calendar as per the 'useDaysMode' syspref.
3623 C<$startdate> = DateTime object representing start date of loan period (assumed to be today)
3624 C<$itemtype> = itemtype code of item in question
3625 C<$branch> = location whose calendar to use
3626 C<$borrower> = Borrower object
3627 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3632 my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3636 # loanlength now a href
3638 GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3640 my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3646 if (ref $startdate ne 'DateTime' ) {
3647 $datedue = dt_from_string($datedue);
3649 $datedue = $startdate->clone;
3653 DateTime->now( time_zone => C4::Context->tz() )
3654 ->truncate( to => 'minute' );
3658 # calculate the datedue as normal
3659 if ( C4::Context->preference('useDaysMode') eq 'Days' )
3660 { # ignoring calendar
3661 if ( $loanlength->{lengthunit} eq 'hours' ) {
3662 $datedue->add( hours => $loanlength->{$length_key} );
3664 $datedue->add( days => $loanlength->{$length_key} );
3665 $datedue->set_hour(23);
3666 $datedue->set_minute(59);
3670 if ($loanlength->{lengthunit} eq 'hours') {
3671 $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3674 $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3676 my $calendar = Koha::Calendar->new( branchcode => $branch );
3677 $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3678 if ($loanlength->{lengthunit} eq 'days') {
3679 $datedue->set_hour(23);
3680 $datedue->set_minute(59);
3684 # if Hard Due Dates are used, retrieve them and apply as necessary
3685 my ( $hardduedate, $hardduedatecompare ) =
3686 GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3687 if ($hardduedate) { # hardduedates are currently dates
3688 $hardduedate->truncate( to => 'minute' );
3689 $hardduedate->set_hour(23);
3690 $hardduedate->set_minute(59);
3691 my $cmp = DateTime->compare( $hardduedate, $datedue );
3693 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3694 # if the calculated date is before the 'after' Hard Due Date (floor), override
3695 # if the hard due date is set to 'exactly', overrride
3696 if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3697 $datedue = $hardduedate->clone;
3700 # in all other cases, keep the date due as it is
3704 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3705 if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3706 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3707 if( $expiry_dt ) { #skip empty expiry date..
3708 $expiry_dt->set( hour => 23, minute => 59);
3709 my $d1= $datedue->clone->set_time_zone('floating');
3710 if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3711 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3720 sub CheckValidBarcode{
3722 my $dbh = C4::Context->dbh;
3723 my $query=qq|SELECT count(*)
3727 my $sth = $dbh->prepare($query);
3728 $sth->execute($barcode);
3729 my $exist=$sth->fetchrow ;
3733 =head2 IsBranchTransferAllowed
3735 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3737 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3741 sub IsBranchTransferAllowed {
3742 my ( $toBranch, $fromBranch, $code ) = @_;
3744 if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3746 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3747 my $dbh = C4::Context->dbh;
3749 my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3750 $sth->execute( $toBranch, $fromBranch, $code );
3751 my $limit = $sth->fetchrow_hashref();
3753 ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3754 if ( $limit->{'limitId'} ) {
3761 =head2 CreateBranchTransferLimit
3763 CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3765 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3769 sub CreateBranchTransferLimit {
3770 my ( $toBranch, $fromBranch, $code ) = @_;
3771 return unless defined($toBranch) && defined($fromBranch);
3772 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3774 my $dbh = C4::Context->dbh;
3776 my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3777 return $sth->execute( $code, $toBranch, $fromBranch );
3780 =head2 DeleteBranchTransferLimits
3782 my $result = DeleteBranchTransferLimits($frombranch);
3784 Deletes all the library transfer limits for one library. Returns the
3785 number of limits deleted, 0e0 if no limits were deleted, or undef if
3786 no arguments are supplied.
3790 sub DeleteBranchTransferLimits {
3792 return unless defined $branch;
3793 my $dbh = C4::Context->dbh;
3794 my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3795 return $sth->execute($branch);
3799 my ( $borrowernumber, $itemnum ) = @_;
3801 MarkIssueReturned( $borrowernumber, $itemnum );
3802 my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3803 my $item = C4::Items::GetItem( $itemnum );
3804 my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3805 my @datearr = localtime(time);
3806 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3807 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3808 ModItem({ paidfor => $old_note."Paid for by $bor $date" }, undef, $itemnum);
3813 my ($itemnumber, $mark_returned) = @_;
3815 my $dbh = C4::Context->dbh();
3816 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3818 JOIN items USING (itemnumber)
3819 JOIN biblio USING (biblionumber)
3820 WHERE issues.itemnumber=?");
3821 $sth->execute($itemnumber);
3822 my $issues=$sth->fetchrow_hashref();
3824 # If a borrower lost the item, add a replacement cost to the their record
3825 if ( my $borrowernumber = $issues->{borrowernumber} ){
3826 my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3828 if (C4::Context->preference('WhenLostForgiveFine')){
3829 my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3830 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!"; # zero is OK, check defined
3832 if (C4::Context->preference('WhenLostChargeReplacementFee')){
3833 C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3834 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3835 #warn " $issues->{'borrowernumber'} / $itemnumber ";
3838 MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3842 sub GetOfflineOperations {
3843 my $dbh = C4::Context->dbh;
3844 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3845 $sth->execute(C4::Context->userenv->{'branch'});
3846 my $results = $sth->fetchall_arrayref({});
3850 sub GetOfflineOperation {
3851 my $operationid = shift;
3852 return unless $operationid;
3853 my $dbh = C4::Context->dbh;
3854 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3855 $sth->execute( $operationid );
3856 return $sth->fetchrow_hashref;
3859 sub AddOfflineOperation {
3860 my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3861 my $dbh = C4::Context->dbh;
3862 my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3863 $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3867 sub DeleteOfflineOperation {
3868 my $dbh = C4::Context->dbh;
3869 my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3870 $sth->execute( shift );
3874 sub ProcessOfflineOperation {
3875 my $operation = shift;
3878 if ( $operation->{action} eq 'return' ) {
3879 $report = ProcessOfflineReturn( $operation );
3880 } elsif ( $operation->{action} eq 'issue' ) {
3881 $report = ProcessOfflineIssue( $operation );
3882 } elsif ( $operation->{action} eq 'payment' ) {
3883 $report = ProcessOfflinePayment( $operation );
3886 DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3891 sub ProcessOfflineReturn {
3892 my $operation = shift;
3894 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3896 if ( $itemnumber ) {
3897 my $issue = GetOpenIssue( $itemnumber );
3900 $issue->{borrowernumber},
3903 $operation->{timestamp},
3906 { renewals => 0, onloan => undef },
3907 $issue->{'biblionumber'},
3912 return "Item not issued.";
3915 return "Item not found.";
3919 sub ProcessOfflineIssue {
3920 my $operation = shift;
3922 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3924 if ( $borrower->{borrowernumber} ) {
3925 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3926 unless ($itemnumber) {
3927 return "Barcode not found.";
3929 my $issue = GetOpenIssue( $itemnumber );
3931 if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3933 $issue->{borrowernumber},
3936 $operation->{timestamp},
3941 $operation->{'barcode'},
3944 $operation->{timestamp},
3949 return "Borrower not found.";
3953 sub ProcessOfflinePayment {
3954 my $operation = shift;
3956 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3957 my $amount = $operation->{amount};
3959 recordpayment( $borrower->{borrowernumber}, $amount );
3967 TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3969 Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3974 my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3976 my $item = GetItem( $itemnumber, $barcode )
3979 return C4::Letters::GetPreparedLetter (
3980 module => 'circulation',
3981 letter_code => 'TRANSFERSLIP',
3982 branchcode => $branch,
3984 'branches' => $to_branch,
3985 'biblio' => $item->{biblionumber},
3991 =head2 CheckIfIssuedToPatron
3993 CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3995 Return 1 if any record item is issued to patron, otherwise return 0
3999 sub CheckIfIssuedToPatron {
4000 my ($borrowernumber, $biblionumber) = @_;
4002 my $dbh = C4::Context->dbh;
4004 SELECT COUNT(*) FROM issues
4005 LEFT JOIN items ON items.itemnumber = issues.itemnumber
4006 WHERE items.biblionumber = ?
4007 AND issues.borrowernumber = ?
4009 my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
4010 return 1 if $is_issued;
4016 IsItemIssued( $itemnumber )
4018 Return 1 if the item is on loan, otherwise return 0
4023 my $itemnumber = shift;
4024 my $dbh = C4::Context->dbh;
4025 my $sth = $dbh->prepare(q{
4028 WHERE itemnumber = ?
4030 $sth->execute($itemnumber);
4031 return $sth->fetchrow;
4034 =head2 GetAgeRestriction
4036 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
4037 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
4039 if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }
4040 if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
4042 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
4043 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
4044 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
4045 Negative days mean the borrower has gone past the age restriction age.
4049 sub GetAgeRestriction {
4050 my ($record_restrictions, $borrower) = @_;
4051 my $markers = C4::Context->preference('AgeRestrictionMarker');
4053 # Split $record_restrictions to something like FSK 16 or PEGI 6
4054 my @values = split ' ', uc($record_restrictions);
4055 return unless @values;
4057 # Search first occurrence of one of the markers
4058 my @markers = split /\|/, uc($markers);
4059 return unless @markers;
4062 my $restriction_year = 0;
4063 for my $value (@values) {
4065 for my $marker (@markers) {
4066 $marker =~ s/^\s+//; #remove leading spaces
4067 $marker =~ s/\s+$//; #remove trailing spaces
4068 if ( $marker eq $value ) {
4069 if ( $index <= $#values ) {
4070 $restriction_year += $values[$index];
4074 elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
4076 # Perhaps it is something like "K16" (as in Finland)
4077 $restriction_year += $1;
4081 last if ( $restriction_year > 0 );
4084 #Check if the borrower is age restricted for this material and for how long.
4085 if ($restriction_year && $borrower) {
4086 if ( $borrower->{'dateofbirth'} ) {
4087 my @alloweddate = split /-/, $borrower->{'dateofbirth'};
4088 $alloweddate[0] += $restriction_year;
4090 #Prevent runime eror on leap year (invalid date)
4091 if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
4092 $alloweddate[2] = 28;
4095 #Get how many days the borrower has to reach the age restriction
4096 my @Today = split /-/, DateTime->today->ymd();
4097 my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
4098 #Negative days means the borrower went past the age restriction age
4099 return ($restriction_year, $daysToAgeRestriction);
4103 return ($restriction_year);
4107 =head2 GetPendingOnSiteCheckouts
4111 sub GetPendingOnSiteCheckouts {
4112 my $dbh = C4::Context->dbh;
4113 return $dbh->selectall_arrayref(q|
4119 items.itemcallnumber,
4123 issues.date_due < NOW() AS is_overdue,
4126 borrowers.firstname,
4128 borrowers.cardnumber,
4129 borrowers.borrowernumber
4131 LEFT JOIN issues ON items.itemnumber = issues.itemnumber
4132 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
4133 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
4134 WHERE issues.onsite_checkout = 1
4135 |, { Slice => {} } );
4141 my ($count, $branch, $itemtype, $ccode, $newness)
4142 = @$params{qw(count branch itemtype ccode newness)};
4144 my $dbh = C4::Context->dbh;
4146 SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4147 bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4148 i.ccode, SUM(i.issues) AS count
4150 LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
4151 LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
4154 my (@where_strs, @where_args);
4157 push @where_strs, 'i.homebranch = ?';
4158 push @where_args, $branch;
4161 if (C4::Context->preference('item-level_itypes')){
4162 push @where_strs, 'i.itype = ?';
4163 push @where_args, $itemtype;
4165 push @where_strs, 'bi.itemtype = ?';
4166 push @where_args, $itemtype;
4170 push @where_strs, 'i.ccode = ?';
4171 push @where_args, $ccode;
4174 push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4175 push @where_args, $newness;
4179 $query .= 'WHERE ' . join(' AND ', @where_strs);
4183 GROUP BY b.biblionumber
4188 $count = int($count);
4190 $query .= "LIMIT $count";
4193 my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4203 Koha Development Team <http://koha-community.org/>