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 if ($item->{'holdingbranch'} ne $branch) {
2114 UpdateHoldingbranch($branch, $item->{'itemnumber'});
2115 $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
2117 ModDateLastSeen( $item->{'itemnumber'} );
2119 # check if we have a transfer for this document
2120 my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
2122 # if we have a transfer to do, we update the line of transfers with the datearrived
2123 my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->{'itemnumber'} );
2125 if ( $tobranch eq $branch ) {
2126 my $sth = C4::Context->dbh->prepare(
2127 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
2129 $sth->execute( $item->{'itemnumber'} );
2130 # if we have a reservation with valid transfer, we can set it's status to 'W'
2131 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
2132 C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
2134 $messages->{'WrongTransfer'} = $tobranch;
2135 $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
2137 $validTransfert = 1;
2139 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
2142 # fix up the accounts.....
2143 if ( $item->{'itemlost'} ) {
2144 $messages->{'WasLost'} = 1;
2146 if ( $item->{'itemlost'} ) {
2148 Koha::RefundLostItemFeeRules->should_refund(
2150 current_branch => C4::Context->userenv->{branch},
2151 item_home_branch => $item->{homebranch},
2152 item_holding_branch => $item->{holdingbranch}
2157 _FixAccountForLostAndReturned( $item->{'itemnumber'}, $borrowernumber, $barcode );
2158 $messages->{'LostItemFeeRefunded'} = 1;
2163 # fix up the overdues in accounts...
2164 if ($borrowernumber) {
2165 my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
2166 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
2168 if ( $issue->{overdue} && $issue->{date_due} ) {
2170 $today = $dropboxdate if $dropbox;
2171 my ($debardate,$reminder) = _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today );
2173 $messages->{'PrevDebarred'} = $debardate;
2175 $messages->{'Debarred'} = $debardate if $debardate;
2177 # there's no overdue on the item but borrower had been previously debarred
2178 } elsif ( $issue->{date_due} and $borrower->{'debarred'} ) {
2179 if ( $borrower->{debarred} eq "9999-12-31") {
2180 $messages->{'ForeverDebarred'} = $borrower->{'debarred'};
2182 my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
2183 $borrower_debar_dt->truncate(to => 'day');
2184 my $today_dt = $today->clone()->truncate(to => 'day');
2185 if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2186 $messages->{'PrevDebarred'} = $borrower->{'debarred'};
2192 # find reserves.....
2193 # if we don't have a reserve with the status W, we launch the Checkreserves routine
2194 my ($resfound, $resrec);
2195 my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2196 ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'}, undef, $lookahead ) unless ( $item->{'withdrawn'} );
2198 $resrec->{'ResFound'} = $resfound;
2199 $messages->{'ResFound'} = $resrec;
2202 # Record the fact that this book was returned.
2203 # FIXME itemtype should record item level type, not bibliolevel type
2207 itemnumber => $item->{'itemnumber'},
2208 itemtype => $biblio->{'itemtype'},
2209 borrowernumber => $borrowernumber,
2210 ccode => $item->{'ccode'}}
2213 # Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then.
2214 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2216 branchcode => $branch,
2217 categorycode => $borrower->{categorycode},
2218 item_type => $item->{itype},
2219 notification => 'CHECKIN',
2221 if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2222 SendCirculationAlert({
2225 borrower => $borrower,
2230 logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
2231 if C4::Context->preference("ReturnLog");
2233 # Remove any OVERDUES related debarment if the borrower has no overdues
2234 if ( $borrowernumber
2235 && $borrower->{'debarred'}
2236 && C4::Context->preference('AutoRemoveOverduesRestrictions')
2237 && !C4::Members::HasOverdues( $borrowernumber )
2238 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2240 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2243 # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2244 if (!$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) and not $messages->{'WrongTransfer'}){
2245 if (C4::Context->preference("AutomaticItemReturn" ) or
2246 (C4::Context->preference("UseBranchTransferLimits") and
2247 ! IsBranchTransferAllowed($branch, $returnbranch, $item->{C4::Context->preference("BranchTransferLimitsType")} )
2249 $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $returnbranch;
2250 $debug and warn "item: " . Dumper($item);
2251 ModItemTransfer($item->{'itemnumber'}, $branch, $returnbranch);
2252 $messages->{'WasTransfered'} = 1;
2254 $messages->{'NeedsTransfer'} = $returnbranch;
2258 return ( $doreturn, $messages, $issue, $borrower );
2261 =head2 MarkIssueReturned
2263 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
2265 Unconditionally marks an issue as being returned by
2266 moving the C<issues> row to C<old_issues> and
2267 setting C<returndate> to the current date, or
2268 the last non-holiday date of the branccode specified in
2269 C<dropbox_branch> . Assumes you've already checked that
2270 it's safe to do this, i.e. last non-holiday > issuedate.
2272 if C<$returndate> is specified (in iso format), it is used as the date
2273 of the return. It is ignored when a dropbox_branch is passed in.
2275 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2276 the old_issue is immediately anonymised
2278 Ideally, this function would be internal to C<C4::Circulation>,
2279 not exported, but it is currently needed by one
2280 routine in C<C4::Accounts>.
2284 sub MarkIssueReturned {
2285 my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
2287 my $anonymouspatron;
2288 if ( $privacy == 2 ) {
2289 # The default of 0 will not work due to foreign key constraints
2290 # The anonymisation will fail if AnonymousPatron is not a valid entry
2291 # We need to check if the anonymous patron exist, Koha will fail loudly if it does not
2292 # Note that a warning should appear on the about page (System information tab).
2293 $anonymouspatron = C4::Context->preference('AnonymousPatron');
2294 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."
2295 unless C4::Members::GetMember( borrowernumber => $anonymouspatron );
2297 my $dbh = C4::Context->dbh;
2298 my $query = 'UPDATE issues SET returndate=';
2300 if ($dropbox_branch) {
2301 my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
2302 my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
2304 push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2305 } elsif ($returndate) {
2307 push @bind, $returndate;
2309 $query .= ' now() ';
2311 $query .= ' WHERE borrowernumber = ? AND itemnumber = ?';
2312 push @bind, $borrowernumber, $itemnumber;
2314 my $sth_upd = $dbh->prepare($query);
2315 $sth_upd->execute(@bind);
2316 my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
2317 WHERE borrowernumber = ?
2318 AND itemnumber = ?');
2319 $sth_copy->execute($borrowernumber, $itemnumber);
2320 # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2321 if ( $privacy == 2) {
2322 my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
2323 WHERE borrowernumber = ?
2324 AND itemnumber = ?");
2325 $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
2327 my $sth_del = $dbh->prepare("DELETE FROM issues
2328 WHERE borrowernumber = ?
2329 AND itemnumber = ?");
2330 $sth_del->execute($borrowernumber, $itemnumber);
2332 ModItem( { 'onloan' => undef }, undef, $itemnumber );
2334 if ( C4::Context->preference('StoreLastBorrower') ) {
2335 my $item = Koha::Items->find( $itemnumber );
2336 my $patron = Koha::Patrons->find( $borrowernumber );
2337 $item->last_returned_by( $patron );
2341 =head2 _debar_user_on_return
2343 _debar_user_on_return($borrower, $item, $datedue, today);
2345 C<$borrower> borrower hashref
2347 C<$item> item hashref
2349 C<$datedue> date due DateTime object
2351 C<$today> DateTime object representing the return time
2353 Internal function, called only by AddReturn that calculates and updates
2354 the user fine days, and debars him if necessary.
2356 Should only be called for overdue returns
2360 sub _debar_user_on_return {
2361 my ( $borrower, $item, $dt_due, $dt_today ) = @_;
2363 my $branchcode = _GetCircControlBranch( $item, $borrower );
2365 my $circcontrol = C4::Context->preference('CircControl');
2367 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2368 my $finedays = $issuingrule->{finedays};
2369 my $unit = $issuingrule->{lengthunit};
2370 my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $dt_today, $branchcode);
2374 # finedays is in days, so hourly loans must multiply by 24
2375 # thus 1 hour late equals 1 day suspension * finedays rate
2376 $finedays = $finedays * 24 if ( $unit eq 'hours' );
2378 # grace period is measured in the same units as the loan
2380 DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
2382 my $deltadays = DateTime::Duration->new(
2383 days => $chargeable_units
2385 if ( $deltadays->subtract($grace)->is_positive() ) {
2386 my $suspension_days = $deltadays * $finedays;
2388 # If the max suspension days is < than the suspension days
2389 # the suspension days is limited to this maximum period.
2390 my $max_sd = $issuingrule->{maxsuspensiondays};
2391 if ( defined $max_sd ) {
2392 $max_sd = DateTime::Duration->new( days => $max_sd );
2393 $suspension_days = $max_sd
2394 if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2398 $dt_today->clone()->add_duration( $suspension_days );
2400 Koha::Patron::Debarments::AddUniqueDebarment({
2401 borrowernumber => $borrower->{borrowernumber},
2402 expiration => $new_debar_dt->ymd(),
2403 type => 'SUSPENSION',
2405 # if borrower was already debarred but does not get an extra debarment
2406 if ( $borrower->{debarred} eq Koha::Patron::Debarments::IsDebarred($borrower->{borrowernumber}) ) {
2407 return ($borrower->{debarred},1);
2409 return $new_debar_dt->ymd();
2415 =head2 _FixOverduesOnReturn
2417 &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2419 C<$brn> borrowernumber
2423 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2424 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2426 Internal function, called only by AddReturn
2430 sub _FixOverduesOnReturn {
2431 my ($borrowernumber, $item);
2432 unless ($borrowernumber = shift) {
2433 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2436 unless ($item = shift) {
2437 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2440 my ($exemptfine, $dropbox) = @_;
2441 my $dbh = C4::Context->dbh;
2443 # check for overdue fine
2444 my $sth = $dbh->prepare(
2445 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
2447 $sth->execute( $borrowernumber, $item );
2449 # alter fine to show that the book has been returned
2450 my $data = $sth->fetchrow_hashref;
2451 return 0 unless $data; # no warning, there's just nothing to fix
2454 my @bind = ($data->{'accountlines_id'});
2456 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2457 if (C4::Context->preference("FinesLog")) {
2458 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2460 } elsif ($dropbox && $data->{lastincrement}) {
2461 my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2462 my $amt = $data->{amount} - $data->{lastincrement} ;
2463 if (C4::Context->preference("FinesLog")) {
2464 &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2466 $uquery = "update accountlines set accounttype='F' ";
2467 if($outstanding >= 0 && $amt >=0) {
2468 $uquery .= ", amount = ? , amountoutstanding=? ";
2469 unshift @bind, ($amt, $outstanding) ;
2472 $uquery = "update accountlines set accounttype='F' ";
2474 $uquery .= " where (accountlines_id = ?)";
2475 my $usth = $dbh->prepare($uquery);
2476 return $usth->execute(@bind);
2479 =head2 _FixAccountForLostAndReturned
2481 &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2483 Calculates the charge for a book lost and returned.
2485 Internal function, not exported, called only by AddReturn.
2487 FIXME: This function reflects how inscrutable fines logic is. Fix both.
2488 FIXME: Give a positive return value on success. It might be the $borrowernumber who received credit, or the amount forgiven.
2492 sub _FixAccountForLostAndReturned {
2493 my $itemnumber = shift or return;
2494 my $borrowernumber = @_ ? shift : undef;
2495 my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
2496 my $dbh = C4::Context->dbh;
2497 # check for charge made for lost book
2498 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2499 $sth->execute($itemnumber);
2500 my $data = $sth->fetchrow_hashref;
2501 $data or return; # bail if there is nothing to do
2502 $data->{accounttype} eq 'W' and return; # Written off
2504 # writeoff this amount
2506 my $amount = $data->{'amount'};
2507 my $acctno = $data->{'accountno'};
2508 my $amountleft; # Starts off undef/zero.
2509 if ($data->{'amountoutstanding'} == $amount) {
2510 $offset = $data->{'amount'};
2511 $amountleft = 0; # Hey, it's zero here, too.
2513 $offset = $amount - $data->{'amountoutstanding'}; # Um, isn't this the same as ZERO? We just tested those two things are ==
2514 $amountleft = $data->{'amountoutstanding'} - $amount; # Um, isn't this the same as ZERO? We just tested those two things are ==
2516 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2517 WHERE (accountlines_id = ?)");
2518 $usth->execute($data->{'accountlines_id'}); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in.
2519 #check if any credit is left if so writeoff other accounts
2520 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2521 $amountleft *= -1 if ($amountleft < 0);
2522 if ($amountleft > 0) {
2523 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2524 AND (amountoutstanding >0) ORDER BY date"); # might want to order by amountoustanding ASC (pay smallest first)
2525 $msth->execute($data->{'borrowernumber'});
2526 # offset transactions
2529 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2530 if ($accdata->{'amountoutstanding'} < $amountleft) {
2532 $amountleft -= $accdata->{'amountoutstanding'};
2534 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2537 my $thisacct = $accdata->{'accountlines_id'};
2538 # FIXME: move prepares outside while loop!
2539 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2540 WHERE (accountlines_id = ?)");
2541 $usth->execute($newamtos,$thisacct);
2542 $usth = $dbh->prepare("INSERT INTO accountoffsets
2543 (borrowernumber, accountno, offsetaccount, offsetamount)
2546 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2549 $amountleft *= -1 if ($amountleft > 0);
2550 my $desc = "Item Returned " . $item_id;
2551 $usth = $dbh->prepare("INSERT INTO accountlines
2552 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2553 VALUES (?,?,now(),?,?,'CR',?)");
2554 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2555 if ($borrowernumber) {
2556 # FIXME: same as query above. use 1 sth for both
2557 $usth = $dbh->prepare("INSERT INTO accountoffsets
2558 (borrowernumber, accountno, offsetaccount, offsetamount)
2560 $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2562 ModItem({ paidfor => '' }, undef, $itemnumber);
2566 =head2 _GetCircControlBranch
2568 my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2572 Return the library code to be used to determine which circulation
2573 policy applies to a transaction. Looks up the CircControl and
2574 HomeOrHoldingBranch system preferences.
2576 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2578 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2582 sub _GetCircControlBranch {
2583 my ($item, $borrower) = @_;
2584 my $circcontrol = C4::Context->preference('CircControl');
2587 if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2588 $branch= C4::Context->userenv->{'branch'};
2589 } elsif ($circcontrol eq 'PatronLibrary') {
2590 $branch=$borrower->{branchcode};
2592 my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2593 $branch = $item->{$branchfield};
2594 # default to item home branch if holdingbranch is used
2595 # and is not defined
2596 if (!defined($branch) && $branchfield eq 'holdingbranch') {
2597 $branch = $item->{homebranch};
2610 $issue = &GetItemIssue($itemnumber);
2612 Returns patron currently having a book, or undef if not checked out.
2614 C<$itemnumber> is the itemnumber.
2616 C<$issue> is a hashref of the row from the issues table.
2621 my ($itemnumber) = @_;
2622 return unless $itemnumber;
2623 my $sth = C4::Context->dbh->prepare(
2624 "SELECT items.*, issues.*
2626 LEFT JOIN items ON issues.itemnumber=items.itemnumber
2627 WHERE issues.itemnumber=?");
2628 $sth->execute($itemnumber);
2629 my $data = $sth->fetchrow_hashref;
2630 return unless $data;
2631 $data->{issuedate_sql} = $data->{issuedate};
2632 $data->{date_due_sql} = $data->{date_due};
2633 $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2634 $data->{issuedate}->truncate(to => 'minute');
2635 $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2636 $data->{date_due}->truncate(to => 'minute');
2637 my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2638 $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2644 $issue = GetOpenIssue( $itemnumber );
2646 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2648 C<$itemnumber> is the item's itemnumber
2655 my ( $itemnumber ) = @_;
2656 return unless $itemnumber;
2657 my $dbh = C4::Context->dbh;
2658 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2659 $sth->execute( $itemnumber );
2660 return $sth->fetchrow_hashref();
2666 $issues = GetIssues({}); # return all issues!
2667 $issues = GetIssues({ borrowernumber => $borrowernumber, biblionumber => $biblionumber });
2669 Returns all pending issues that match given criteria.
2670 Returns a arrayref or undef if an error occurs.
2672 Allowed criteria are:
2676 =item * borrowernumber
2678 =item * biblionumber
2687 my ($criteria) = @_;
2691 my @allowed = qw(borrowernumber biblionumber itemnumber);
2692 foreach (@allowed) {
2693 if (defined $criteria->{$_}) {
2696 value => $criteria->{$_},
2701 # Do we need to join other tables ?
2703 if (defined $criteria->{biblionumber}) {
2710 $where = "WHERE " . join(' AND ', map { "$_->{field} = ?" } @filters);
2716 if (defined $join{items}) {
2718 LEFT JOIN items ON (issues.itemnumber = items.itemnumber)
2724 my $dbh = C4::Context->dbh;
2725 my $sth = $dbh->prepare($query);
2726 my $rv = $sth->execute(map { $_->{value} } @filters);
2728 return $rv ? $sth->fetchall_arrayref({}) : undef;
2731 =head2 GetItemIssues
2733 $issues = &GetItemIssues($itemnumber, $history);
2735 Returns patrons that have issued a book
2737 C<$itemnumber> is the itemnumber
2738 C<$history> is false if you just want the current "issuer" (if any)
2739 and true if you want issues history from old_issues also.
2741 Returns reference to an array of hashes
2746 my ( $itemnumber, $history ) = @_;
2748 my $today = DateTime->now( time_zome => C4::Context->tz); # get today date
2749 $today->truncate( to => 'minute' );
2750 my $sql = "SELECT * FROM issues
2751 JOIN borrowers USING (borrowernumber)
2752 JOIN items USING (itemnumber)
2753 WHERE issues.itemnumber = ? ";
2756 SELECT * FROM old_issues
2757 LEFT JOIN borrowers USING (borrowernumber)
2758 JOIN items USING (itemnumber)
2759 WHERE old_issues.itemnumber = ? ";
2761 $sql .= "ORDER BY date_due DESC";
2762 my $sth = C4::Context->dbh->prepare($sql);
2764 $sth->execute($itemnumber, $itemnumber);
2766 $sth->execute($itemnumber);
2768 my $results = $sth->fetchall_arrayref({});
2769 foreach (@$results) {
2770 my $date_due = dt_from_string($_->{date_due},'sql');
2771 $date_due->truncate( to => 'minute' );
2773 $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2778 =head2 GetBiblioIssues
2780 $issues = GetBiblioIssues($biblionumber);
2782 this function get all issues from a biblionumber.
2785 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2786 tables issues and the firstname,surname & cardnumber from borrowers.
2790 sub GetBiblioIssues {
2791 my $biblionumber = shift;
2792 return unless $biblionumber;
2793 my $dbh = C4::Context->dbh;
2795 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2797 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2798 LEFT JOIN items ON issues.itemnumber = items.itemnumber
2799 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2800 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2801 WHERE biblio.biblionumber = ?
2803 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2805 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2806 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2807 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2808 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2809 WHERE biblio.biblionumber = ?
2812 my $sth = $dbh->prepare($query);
2813 $sth->execute($biblionumber, $biblionumber);
2816 while ( my $data = $sth->fetchrow_hashref ) {
2817 push @issues, $data;
2822 =head2 GetUpcomingDueIssues
2824 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2828 sub GetUpcomingDueIssues {
2831 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2832 my $dbh = C4::Context->dbh;
2834 my $statement = <<END_SQL;
2835 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2837 LEFT JOIN items USING (itemnumber)
2838 LEFT OUTER JOIN branches USING (branchcode)
2839 WHERE returndate is NULL
2840 HAVING days_until_due >= 0 AND days_until_due <= ?
2843 my @bind_parameters = ( $params->{'days_in_advance'} );
2845 my $sth = $dbh->prepare( $statement );
2846 $sth->execute( @bind_parameters );
2847 my $upcoming_dues = $sth->fetchall_arrayref({});
2849 return $upcoming_dues;
2852 =head2 CanBookBeRenewed
2854 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2856 Find out whether a borrowed item may be renewed.
2858 C<$borrowernumber> is the borrower number of the patron who currently
2859 has the item on loan.
2861 C<$itemnumber> is the number of the item to renew.
2863 C<$override_limit>, if supplied with a true value, causes
2864 the limit on the number of times that the loan can be renewed
2865 (as controlled by the item type) to be ignored. Overriding also allows
2866 to renew sooner than "No renewal before" and to manually renew loans
2867 that are automatically renewed.
2869 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2870 item must currently be on loan to the specified borrower; renewals
2871 must be allowed for the item's type; and the borrower must not have
2872 already renewed the loan. $error will contain the reason the renewal can not proceed
2876 sub CanBookBeRenewed {
2877 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2879 my $dbh = C4::Context->dbh;
2882 my $item = GetItem($itemnumber) or return ( 0, 'no_item' );
2883 my $itemissue = GetItemIssue($itemnumber) or return ( 0, 'no_checkout' );
2884 return ( 0, 'onsite_checkout' ) if $itemissue->{onsite_checkout};
2886 $borrowernumber ||= $itemissue->{borrowernumber};
2887 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
2890 my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2892 # This item can fill one or more unfilled reserve, can those unfilled reserves
2893 # all be filled by other available items?
2895 && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2897 my $schema = Koha::Database->new()->schema();
2899 my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2901 # There is an item level hold on this item, no other item can fill the hold
2906 # Get all other items that could possibly fill reserves
2907 my @itemnumbers = $schema->resultset('Item')->search(
2909 biblionumber => $resrec->{biblionumber},
2912 -not => { itemnumber => $itemnumber }
2914 { columns => 'itemnumber' }
2915 )->get_column('itemnumber')->all();
2917 # Get all other reserves that could have been filled by this item
2918 my @borrowernumbers;
2920 my ( $reserve_found, $reserve, undef ) =
2921 C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2923 if ($reserve_found) {
2924 push( @borrowernumbers, $reserve->{borrowernumber} );
2931 # If the count of the union of the lists of reservable items for each borrower
2932 # is equal or greater than the number of borrowers, we know that all reserves
2933 # can be filled with available items. We can get the union of the sets simply
2934 # by pushing all the elements onto an array and removing the duplicates.
2936 foreach my $b (@borrowernumbers) {
2937 my ($borr) = C4::Members::GetMemberDetails($b);
2938 foreach my $i (@itemnumbers) {
2939 my $item = GetItem($i);
2940 if ( IsAvailableForItemLevelRequest( $item, $borr )
2941 && CanItemBeReserved( $b, $i )
2942 && !IsItemOnHoldAndFound($i) )
2944 push( @reservable, $i );
2949 @reservable = uniq(@reservable);
2951 if ( @reservable >= @borrowernumbers ) {
2956 return ( 0, "on_reserve" ) if $resfound; # '' when no hold was found
2958 return ( 1, undef ) if $override_limit;
2960 my $branchcode = _GetCircControlBranch( $item, $borrower );
2962 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2964 return ( 0, "too_many" )
2965 if $issuingrule->{renewalsallowed} <= $itemissue->{renewals};
2967 my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2968 my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2969 my $restricted = Koha::Patron::Debarments::IsDebarred($borrowernumber);
2970 my $hasoverdues = C4::Members::HasOverdues($borrowernumber);
2972 if ( $restricted and $restrictionblockrenewing ) {
2973 return ( 0, 'restriction');
2974 } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($itemissue->{overdue} and $overduesblockrenewing eq 'blockitem') ) {
2975 return ( 0, 'overdue');
2978 if ( defined $issuingrule->{norenewalbefore}
2979 and $issuingrule->{norenewalbefore} ne "" )
2982 # Calculate soonest renewal by subtracting 'No renewal before' from due date
2983 my $soonestrenewal =
2984 $itemissue->{date_due}->clone()
2986 $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
2988 # Depending on syspref reset the exact time, only check the date
2989 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2990 and $issuingrule->{lengthunit} eq 'days' )
2992 $soonestrenewal->truncate( to => 'day' );
2995 if ( $soonestrenewal > DateTime->now( time_zone => C4::Context->tz() ) )
2997 return ( 0, "auto_too_soon" ) if $itemissue->{auto_renew};
2998 return ( 0, "too_soon" );
3000 elsif ( $itemissue->{auto_renew} ) {
3001 return ( 0, "auto_renew" );
3005 # Fallback for automatic renewals:
3006 # If norenewalbefore is undef, don't renew before due date.
3007 elsif ( $itemissue->{auto_renew} ) {
3008 my $now = dt_from_string;
3009 return ( 0, "auto_renew" )
3010 if $now >= $itemissue->{date_due};
3011 return ( 0, "auto_too_soon" );
3014 return ( 1, undef );
3019 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
3023 C<$borrowernumber> is the borrower number of the patron who currently
3026 C<$itemnumber> is the number of the item to renew.
3028 C<$branch> is the library where the renewal took place (if any).
3029 The library that controls the circ policies for the renewal is retrieved from the issues record.
3031 C<$datedue> can be a DateTime object used to set the due date.
3033 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
3034 this parameter is not supplied, lastreneweddate is set to the current date.
3036 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
3037 from the book's item type.
3042 my $borrowernumber = shift;
3043 my $itemnumber = shift or return;
3045 my $datedue = shift;
3046 my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
3048 my $item = GetItem($itemnumber) or return;
3049 my $biblio = GetBiblioFromItemNumber($itemnumber) or return;
3051 my $dbh = C4::Context->dbh;
3053 # Find the issues record for this book
3055 $dbh->prepare("SELECT * FROM issues WHERE itemnumber = ?");
3056 $sth->execute( $itemnumber );
3057 my $issuedata = $sth->fetchrow_hashref;
3059 return unless ( $issuedata );
3061 $borrowernumber ||= $issuedata->{borrowernumber};
3063 if ( defined $datedue && ref $datedue ne 'DateTime' ) {
3064 carp 'Invalid date passed to AddRenewal.';
3068 # If the due date wasn't specified, calculate it by adding the
3069 # book's loan length to today's date or the current due date
3070 # based on the value of the RenewalPeriodBase syspref.
3073 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return;
3074 my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
3076 $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
3077 dt_from_string( $issuedata->{date_due} ) :
3078 DateTime->now( time_zone => C4::Context->tz());
3079 $datedue = CalcDateDue($datedue, $itemtype, $issuedata->{'branchcode'}, $borrower, 'is a renewal');
3082 # Update the issues record to have the new due date, and a new count
3083 # of how many times it has been renewed.
3084 my $renews = $issuedata->{'renewals'} + 1;
3085 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
3086 WHERE borrowernumber=?
3090 $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
3092 # Update the renewal count on the item, and tell zebra to reindex
3093 $renews = $biblio->{'renewals'} + 1;
3094 ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
3096 # Charge a new rental fee, if applicable?
3097 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
3098 if ( $charge > 0 ) {
3099 my $accountno = getnextacctno( $borrowernumber );
3100 my $item = GetBiblioFromItemNumber($itemnumber);
3102 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3103 $sth = $dbh->prepare(
3104 "INSERT INTO accountlines
3105 (date, borrowernumber, accountno, amount, manager_id,
3106 description,accounttype, amountoutstanding, itemnumber)
3107 VALUES (now(),?,?,?,?,?,?,?,?)"
3109 $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
3110 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
3111 'Rent', $charge, $itemnumber );
3114 # Send a renewal slip according to checkout alert preferencei
3115 if ( C4::Context->preference('RenewalSendNotice') eq '1') {
3116 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
3117 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
3119 branchcode => $branch,
3120 categorycode => $borrower->{categorycode},
3121 item_type => $item->{itype},
3122 notification => 'CHECKOUT',
3124 if ($circulation_alert->is_enabled_for(\%conditions)) {
3125 SendCirculationAlert({
3128 borrower => $borrower,
3134 # Remove any OVERDUES related debarment if the borrower has no overdues
3135 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
3136 if ( $borrowernumber
3137 && $borrower->{'debarred'}
3138 && !C4::Members::HasOverdues( $borrowernumber )
3139 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
3141 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
3145 UpdateStats({branch => $branch,
3148 itemnumber => $itemnumber,
3149 itemtype => $item->{itype},
3150 borrowernumber => $borrowernumber,
3151 ccode => $item->{'ccode'}}
3157 # check renewal status
3158 my ( $bornum, $itemno ) = @_;
3159 my $dbh = C4::Context->dbh;
3161 my $renewsallowed = 0;
3164 my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
3165 my $item = GetItem($itemno);
3167 # Look in the issues table for this item, lent to this borrower,
3168 # and not yet returned.
3170 # FIXME - I think this function could be redone to use only one SQL call.
3171 my $sth = $dbh->prepare(
3172 "select * from issues
3173 where (borrowernumber = ?)
3174 and (itemnumber = ?)"
3176 $sth->execute( $bornum, $itemno );
3177 my $data = $sth->fetchrow_hashref;
3178 $renewcount = $data->{'renewals'} if $data->{'renewals'};
3179 # $item and $borrower should be calculated
3180 my $branchcode = _GetCircControlBranch($item, $borrower);
3182 my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
3184 $renewsallowed = $issuingrule->{'renewalsallowed'};
3185 $renewsleft = $renewsallowed - $renewcount;
3186 if($renewsleft < 0){ $renewsleft = 0; }
3187 return ( $renewcount, $renewsallowed, $renewsleft );
3190 =head2 GetSoonestRenewDate
3192 $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
3194 Find out the soonest possible renew date of a borrowed item.
3196 C<$borrowernumber> is the borrower number of the patron who currently
3197 has the item on loan.
3199 C<$itemnumber> is the number of the item to renew.
3201 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3202 renew date, based on the value "No renewal before" of the applicable
3203 issuing rule. Returns the current date if the item can already be
3204 renewed, and returns undefined if the borrower, loan, or item
3209 sub GetSoonestRenewDate {
3210 my ( $borrowernumber, $itemnumber ) = @_;
3212 my $dbh = C4::Context->dbh;
3214 my $item = GetItem($itemnumber) or return;
3215 my $itemissue = GetItemIssue($itemnumber) or return;
3217 $borrowernumber ||= $itemissue->{borrowernumber};
3218 my $borrower = C4::Members::GetMemberDetails($borrowernumber)
3221 my $branchcode = _GetCircControlBranch( $item, $borrower );
3223 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
3225 my $now = dt_from_string;
3227 if ( defined $issuingrule->{norenewalbefore}
3228 and $issuingrule->{norenewalbefore} ne "" )
3230 my $soonestrenewal =
3231 $itemissue->{date_due}->clone()
3233 $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
3235 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3236 and $issuingrule->{lengthunit} eq 'days' )
3238 $soonestrenewal->truncate( to => 'day' );
3240 return $soonestrenewal if $now < $soonestrenewal;
3245 =head2 GetIssuingCharges
3247 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3249 Calculate how much it would cost for a given patron to borrow a given
3250 item, including any applicable discounts.
3252 C<$itemnumber> is the item number of item the patron wishes to borrow.
3254 C<$borrowernumber> is the patron's borrower number.
3256 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3257 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3262 sub GetIssuingCharges {
3264 # calculate charges due
3265 my ( $itemnumber, $borrowernumber ) = @_;
3267 my $dbh = C4::Context->dbh;
3270 # Get the book's item type and rental charge (via its biblioitem).
3271 my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3272 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3273 $charge_query .= (C4::Context->preference('item-level_itypes'))
3274 ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3275 : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3277 $charge_query .= ' WHERE items.itemnumber =?';
3279 my $sth = $dbh->prepare($charge_query);
3280 $sth->execute($itemnumber);
3281 if ( my $item_data = $sth->fetchrow_hashref ) {
3282 $item_type = $item_data->{itemtype};
3283 $charge = $item_data->{rentalcharge};
3284 my $branch = C4::Branch::mybranch();
3285 my $discount_query = q|SELECT rentaldiscount,
3286 issuingrules.itemtype, issuingrules.branchcode
3288 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3289 WHERE borrowers.borrowernumber = ?
3290 AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3291 AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3292 my $discount_sth = $dbh->prepare($discount_query);
3293 $discount_sth->execute( $borrowernumber, $item_type, $branch );
3294 my $discount_rules = $discount_sth->fetchall_arrayref({});
3295 if (@{$discount_rules}) {
3296 # We may have multiple rules so get the most specific
3297 my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3298 $charge = ( $charge * ( 100 - $discount ) ) / 100;
3302 return ( $charge, $item_type );
3305 # Select most appropriate discount rule from those returned
3306 sub _get_discount_from_rule {
3307 my ($rules_ref, $branch, $itemtype) = @_;
3310 if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3311 $discount = $rules_ref->[0]->{rentaldiscount};
3312 return (defined $discount) ? $discount : 0;
3314 # could have up to 4 does one match $branch and $itemtype
3315 my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3317 $discount = $d[0]->{rentaldiscount};
3318 return (defined $discount) ? $discount : 0;
3320 # do we have item type + all branches
3321 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3323 $discount = $d[0]->{rentaldiscount};
3324 return (defined $discount) ? $discount : 0;
3326 # do we all item types + this branch
3327 @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3329 $discount = $d[0]->{rentaldiscount};
3330 return (defined $discount) ? $discount : 0;
3332 # so all and all (surely we wont get here)
3333 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3335 $discount = $d[0]->{rentaldiscount};
3336 return (defined $discount) ? $discount : 0;
3342 =head2 AddIssuingCharge
3344 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3348 sub AddIssuingCharge {
3349 my ( $itemnumber, $borrowernumber, $charge ) = @_;
3350 my $dbh = C4::Context->dbh;
3351 my $nextaccntno = getnextacctno( $borrowernumber );
3353 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3355 INSERT INTO accountlines
3356 (borrowernumber, itemnumber, accountno,
3357 date, amount, description, accounttype,
3358 amountoutstanding, manager_id)
3359 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
3361 my $sth = $dbh->prepare($query);
3362 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
3367 GetTransfers($itemnumber);
3372 my ($itemnumber) = @_;
3374 my $dbh = C4::Context->dbh;
3380 FROM branchtransfers
3381 WHERE itemnumber = ?
3382 AND datearrived IS NULL
3384 my $sth = $dbh->prepare($query);
3385 $sth->execute($itemnumber);
3386 my @row = $sth->fetchrow_array();
3390 =head2 GetTransfersFromTo
3392 @results = GetTransfersFromTo($frombranch,$tobranch);
3394 Returns the list of pending transfers between $from and $to branch
3398 sub GetTransfersFromTo {
3399 my ( $frombranch, $tobranch ) = @_;
3400 return unless ( $frombranch && $tobranch );
3401 my $dbh = C4::Context->dbh;
3403 SELECT itemnumber,datesent,frombranch
3404 FROM branchtransfers
3407 AND datearrived IS NULL
3409 my $sth = $dbh->prepare($query);
3410 $sth->execute( $frombranch, $tobranch );
3413 while ( my $data = $sth->fetchrow_hashref ) {
3414 push @gettransfers, $data;
3416 return (@gettransfers);
3419 =head2 DeleteTransfer
3421 &DeleteTransfer($itemnumber);
3425 sub DeleteTransfer {
3426 my ($itemnumber) = @_;
3427 return unless $itemnumber;
3428 my $dbh = C4::Context->dbh;
3429 my $sth = $dbh->prepare(
3430 "DELETE FROM branchtransfers
3432 AND datearrived IS NULL "
3434 return $sth->execute($itemnumber);
3437 =head2 AnonymiseIssueHistory
3439 ($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)
3441 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
3442 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
3444 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
3445 setting (force delete).
3447 return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.
3451 sub AnonymiseIssueHistory {
3453 my $borrowernumber = shift;
3454 my $dbh = C4::Context->dbh;
3457 SET borrowernumber = ?
3458 WHERE returndate < ?
3459 AND borrowernumber IS NOT NULL
3462 # The default of 0 does not work due to foreign key constraints
3463 # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
3464 # Set it to undef (NULL)
3465 my $anonymouspatron = C4::Context->preference('AnonymousPatron') || undef;
3466 my @bind_params = ($anonymouspatron, $date);
3467 if (defined $borrowernumber) {
3468 $query .= " AND borrowernumber = ?";
3469 push @bind_params, $borrowernumber;
3471 $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
3473 my $sth = $dbh->prepare($query);
3474 $sth->execute(@bind_params);
3475 my $anonymisation_err = $dbh->err;
3476 my $rows_affected = $sth->rows; ### doublecheck row count return function
3477 return ($rows_affected, $anonymisation_err);
3480 =head2 SendCirculationAlert
3482 Send out a C<check-in> or C<checkout> alert using the messaging system.
3490 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3494 Hashref of information about the item being checked in or out.
3498 Hashref of information about the borrower of the item.
3502 The branchcode from where the checkout or check-in took place.
3508 SendCirculationAlert({
3511 borrower => $borrower,
3517 sub SendCirculationAlert {
3519 my ($type, $item, $borrower, $branch) =
3520 ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3521 my %message_name = (
3522 CHECKIN => 'Item_Check_in',
3523 CHECKOUT => 'Item_Checkout',
3524 RENEWAL => 'Item_Checkout',
3526 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3527 borrowernumber => $borrower->{borrowernumber},
3528 message_name => $message_name{$type},
3530 my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3532 my @transports = keys %{ $borrower_preferences->{transports} };
3533 # warn "no transports" unless @transports;
3535 # warn "transport: $_";
3536 my $message = C4::Message->find_last_message($borrower, $type, $_);
3538 #warn "create new message";
3539 my $letter = C4::Letters::GetPreparedLetter (
3540 module => 'circulation',
3541 letter_code => $type,
3542 branchcode => $branch,
3543 message_transport_type => $_,
3545 $issues_table => $item->{itemnumber},
3546 'items' => $item->{itemnumber},
3547 'biblio' => $item->{biblionumber},
3548 'biblioitems' => $item->{biblionumber},
3549 'borrowers' => $borrower,
3550 'branches' => $branch,
3553 C4::Message->enqueue($letter, $borrower, $_);
3555 #warn "append to old message";
3556 my $letter = C4::Letters::GetPreparedLetter (
3557 module => 'circulation',
3558 letter_code => $type,
3559 branchcode => $branch,
3560 message_transport_type => $_,
3562 $issues_table => $item->{itemnumber},
3563 'items' => $item->{itemnumber},
3564 'biblio' => $item->{biblionumber},
3565 'biblioitems' => $item->{biblionumber},
3566 'borrowers' => $borrower,
3567 'branches' => $branch,
3570 $message->append($letter);
3578 =head2 updateWrongTransfer
3580 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3582 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
3586 sub updateWrongTransfer {
3587 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3588 my $dbh = C4::Context->dbh;
3589 # first step validate the actual line of transfert .
3592 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3594 $sth->execute($FromLibrary,$itemNumber);
3596 # second step create a new line of branchtransfer to the right location .
3597 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3599 #third step changing holdingbranch of item
3600 UpdateHoldingbranch($FromLibrary,$itemNumber);
3603 =head2 UpdateHoldingbranch
3605 $items = UpdateHoldingbranch($branch,$itmenumber);
3607 Simple methode for updating hodlingbranch in items BDD line
3611 sub UpdateHoldingbranch {
3612 my ( $branch,$itemnumber ) = @_;
3613 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3618 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3620 this function calculates the due date given the start date and configured circulation rules,
3621 checking against the holidays calendar as per the 'useDaysMode' syspref.
3622 C<$startdate> = DateTime object representing start date of loan period (assumed to be today)
3623 C<$itemtype> = itemtype code of item in question
3624 C<$branch> = location whose calendar to use
3625 C<$borrower> = Borrower object
3626 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3631 my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3635 # loanlength now a href
3637 GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3639 my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3645 if (ref $startdate ne 'DateTime' ) {
3646 $datedue = dt_from_string($datedue);
3648 $datedue = $startdate->clone;
3652 DateTime->now( time_zone => C4::Context->tz() )
3653 ->truncate( to => 'minute' );
3657 # calculate the datedue as normal
3658 if ( C4::Context->preference('useDaysMode') eq 'Days' )
3659 { # ignoring calendar
3660 if ( $loanlength->{lengthunit} eq 'hours' ) {
3661 $datedue->add( hours => $loanlength->{$length_key} );
3663 $datedue->add( days => $loanlength->{$length_key} );
3664 $datedue->set_hour(23);
3665 $datedue->set_minute(59);
3669 if ($loanlength->{lengthunit} eq 'hours') {
3670 $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3673 $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3675 my $calendar = Koha::Calendar->new( branchcode => $branch );
3676 $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3677 if ($loanlength->{lengthunit} eq 'days') {
3678 $datedue->set_hour(23);
3679 $datedue->set_minute(59);
3683 # if Hard Due Dates are used, retrieve them and apply as necessary
3684 my ( $hardduedate, $hardduedatecompare ) =
3685 GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3686 if ($hardduedate) { # hardduedates are currently dates
3687 $hardduedate->truncate( to => 'minute' );
3688 $hardduedate->set_hour(23);
3689 $hardduedate->set_minute(59);
3690 my $cmp = DateTime->compare( $hardduedate, $datedue );
3692 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3693 # if the calculated date is before the 'after' Hard Due Date (floor), override
3694 # if the hard due date is set to 'exactly', overrride
3695 if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3696 $datedue = $hardduedate->clone;
3699 # in all other cases, keep the date due as it is
3703 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3704 if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3705 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3706 if( $expiry_dt ) { #skip empty expiry date..
3707 $expiry_dt->set( hour => 23, minute => 59);
3708 my $d1= $datedue->clone->set_time_zone('floating');
3709 if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3710 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3719 sub CheckValidBarcode{
3721 my $dbh = C4::Context->dbh;
3722 my $query=qq|SELECT count(*)
3726 my $sth = $dbh->prepare($query);
3727 $sth->execute($barcode);
3728 my $exist=$sth->fetchrow ;
3732 =head2 IsBranchTransferAllowed
3734 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3736 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3740 sub IsBranchTransferAllowed {
3741 my ( $toBranch, $fromBranch, $code ) = @_;
3743 if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3745 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3746 my $dbh = C4::Context->dbh;
3748 my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3749 $sth->execute( $toBranch, $fromBranch, $code );
3750 my $limit = $sth->fetchrow_hashref();
3752 ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3753 if ( $limit->{'limitId'} ) {
3760 =head2 CreateBranchTransferLimit
3762 CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3764 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3768 sub CreateBranchTransferLimit {
3769 my ( $toBranch, $fromBranch, $code ) = @_;
3770 return unless defined($toBranch) && defined($fromBranch);
3771 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3773 my $dbh = C4::Context->dbh;
3775 my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3776 return $sth->execute( $code, $toBranch, $fromBranch );
3779 =head2 DeleteBranchTransferLimits
3781 my $result = DeleteBranchTransferLimits($frombranch);
3783 Deletes all the library transfer limits for one library. Returns the
3784 number of limits deleted, 0e0 if no limits were deleted, or undef if
3785 no arguments are supplied.
3789 sub DeleteBranchTransferLimits {
3791 return unless defined $branch;
3792 my $dbh = C4::Context->dbh;
3793 my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3794 return $sth->execute($branch);
3798 my ( $borrowernumber, $itemnum ) = @_;
3800 MarkIssueReturned( $borrowernumber, $itemnum );
3801 my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3802 my $item = C4::Items::GetItem( $itemnum );
3803 my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3804 my @datearr = localtime(time);
3805 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3806 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3807 ModItem({ paidfor => $old_note."Paid for by $bor $date" }, undef, $itemnum);
3812 my ($itemnumber, $mark_returned) = @_;
3814 my $dbh = C4::Context->dbh();
3815 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3817 JOIN items USING (itemnumber)
3818 JOIN biblio USING (biblionumber)
3819 WHERE issues.itemnumber=?");
3820 $sth->execute($itemnumber);
3821 my $issues=$sth->fetchrow_hashref();
3823 # If a borrower lost the item, add a replacement cost to the their record
3824 if ( my $borrowernumber = $issues->{borrowernumber} ){
3825 my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3827 if (C4::Context->preference('WhenLostForgiveFine')){
3828 my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3829 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!"; # zero is OK, check defined
3831 if (C4::Context->preference('WhenLostChargeReplacementFee')){
3832 C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3833 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3834 #warn " $issues->{'borrowernumber'} / $itemnumber ";
3837 MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3841 sub GetOfflineOperations {
3842 my $dbh = C4::Context->dbh;
3843 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3844 $sth->execute(C4::Context->userenv->{'branch'});
3845 my $results = $sth->fetchall_arrayref({});
3849 sub GetOfflineOperation {
3850 my $operationid = shift;
3851 return unless $operationid;
3852 my $dbh = C4::Context->dbh;
3853 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3854 $sth->execute( $operationid );
3855 return $sth->fetchrow_hashref;
3858 sub AddOfflineOperation {
3859 my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3860 my $dbh = C4::Context->dbh;
3861 my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3862 $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3866 sub DeleteOfflineOperation {
3867 my $dbh = C4::Context->dbh;
3868 my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3869 $sth->execute( shift );
3873 sub ProcessOfflineOperation {
3874 my $operation = shift;
3877 if ( $operation->{action} eq 'return' ) {
3878 $report = ProcessOfflineReturn( $operation );
3879 } elsif ( $operation->{action} eq 'issue' ) {
3880 $report = ProcessOfflineIssue( $operation );
3881 } elsif ( $operation->{action} eq 'payment' ) {
3882 $report = ProcessOfflinePayment( $operation );
3885 DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3890 sub ProcessOfflineReturn {
3891 my $operation = shift;
3893 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3895 if ( $itemnumber ) {
3896 my $issue = GetOpenIssue( $itemnumber );
3899 $issue->{borrowernumber},
3902 $operation->{timestamp},
3905 { renewals => 0, onloan => undef },
3906 $issue->{'biblionumber'},
3911 return "Item not issued.";
3914 return "Item not found.";
3918 sub ProcessOfflineIssue {
3919 my $operation = shift;
3921 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3923 if ( $borrower->{borrowernumber} ) {
3924 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3925 unless ($itemnumber) {
3926 return "Barcode not found.";
3928 my $issue = GetOpenIssue( $itemnumber );
3930 if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3932 $issue->{borrowernumber},
3935 $operation->{timestamp},
3940 $operation->{'barcode'},
3943 $operation->{timestamp},
3948 return "Borrower not found.";
3952 sub ProcessOfflinePayment {
3953 my $operation = shift;
3955 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3956 my $amount = $operation->{amount};
3958 recordpayment( $borrower->{borrowernumber}, $amount );
3966 TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3968 Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3973 my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3975 my $item = GetItem( $itemnumber, $barcode )
3978 return C4::Letters::GetPreparedLetter (
3979 module => 'circulation',
3980 letter_code => 'TRANSFERSLIP',
3981 branchcode => $branch,
3983 'branches' => $to_branch,
3984 'biblio' => $item->{biblionumber},
3990 =head2 CheckIfIssuedToPatron
3992 CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3994 Return 1 if any record item is issued to patron, otherwise return 0
3998 sub CheckIfIssuedToPatron {
3999 my ($borrowernumber, $biblionumber) = @_;
4001 my $dbh = C4::Context->dbh;
4003 SELECT COUNT(*) FROM issues
4004 LEFT JOIN items ON items.itemnumber = issues.itemnumber
4005 WHERE items.biblionumber = ?
4006 AND issues.borrowernumber = ?
4008 my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
4009 return 1 if $is_issued;
4015 IsItemIssued( $itemnumber )
4017 Return 1 if the item is on loan, otherwise return 0
4022 my $itemnumber = shift;
4023 my $dbh = C4::Context->dbh;
4024 my $sth = $dbh->prepare(q{
4027 WHERE itemnumber = ?
4029 $sth->execute($itemnumber);
4030 return $sth->fetchrow;
4033 =head2 GetAgeRestriction
4035 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
4036 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
4038 if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }
4039 if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
4041 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
4042 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
4043 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
4044 Negative days mean the borrower has gone past the age restriction age.
4048 sub GetAgeRestriction {
4049 my ($record_restrictions, $borrower) = @_;
4050 my $markers = C4::Context->preference('AgeRestrictionMarker');
4052 # Split $record_restrictions to something like FSK 16 or PEGI 6
4053 my @values = split ' ', uc($record_restrictions);
4054 return unless @values;
4056 # Search first occurrence of one of the markers
4057 my @markers = split /\|/, uc($markers);
4058 return unless @markers;
4061 my $restriction_year = 0;
4062 for my $value (@values) {
4064 for my $marker (@markers) {
4065 $marker =~ s/^\s+//; #remove leading spaces
4066 $marker =~ s/\s+$//; #remove trailing spaces
4067 if ( $marker eq $value ) {
4068 if ( $index <= $#values ) {
4069 $restriction_year += $values[$index];
4073 elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
4075 # Perhaps it is something like "K16" (as in Finland)
4076 $restriction_year += $1;
4080 last if ( $restriction_year > 0 );
4083 #Check if the borrower is age restricted for this material and for how long.
4084 if ($restriction_year && $borrower) {
4085 if ( $borrower->{'dateofbirth'} ) {
4086 my @alloweddate = split /-/, $borrower->{'dateofbirth'};
4087 $alloweddate[0] += $restriction_year;
4089 #Prevent runime eror on leap year (invalid date)
4090 if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
4091 $alloweddate[2] = 28;
4094 #Get how many days the borrower has to reach the age restriction
4095 my @Today = split /-/, DateTime->today->ymd();
4096 my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
4097 #Negative days means the borrower went past the age restriction age
4098 return ($restriction_year, $daysToAgeRestriction);
4102 return ($restriction_year);
4106 =head2 GetPendingOnSiteCheckouts
4110 sub GetPendingOnSiteCheckouts {
4111 my $dbh = C4::Context->dbh;
4112 return $dbh->selectall_arrayref(q|
4118 items.itemcallnumber,
4122 issues.date_due < NOW() AS is_overdue,
4125 borrowers.firstname,
4127 borrowers.cardnumber,
4128 borrowers.borrowernumber
4130 LEFT JOIN issues ON items.itemnumber = issues.itemnumber
4131 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
4132 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
4133 WHERE issues.onsite_checkout = 1
4134 |, { Slice => {} } );
4140 my ($count, $branch, $itemtype, $ccode, $newness)
4141 = @$params{qw(count branch itemtype ccode newness)};
4143 my $dbh = C4::Context->dbh;
4145 SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4146 bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4147 i.ccode, SUM(i.issues) AS count
4149 LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
4150 LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
4153 my (@where_strs, @where_args);
4156 push @where_strs, 'i.homebranch = ?';
4157 push @where_args, $branch;
4160 if (C4::Context->preference('item-level_itypes')){
4161 push @where_strs, 'i.itype = ?';
4162 push @where_args, $itemtype;
4164 push @where_strs, 'bi.itemtype = ?';
4165 push @where_args, $itemtype;
4169 push @where_strs, 'i.ccode = ?';
4170 push @where_args, $ccode;
4173 push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4174 push @where_args, $newness;
4178 $query .= 'WHERE ' . join(' AND ', @where_strs);
4182 GROUP BY b.biblionumber
4187 $count = int($count);
4189 $query .= "LIMIT $count";
4192 my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4202 Koha Development Team <http://koha-community.org/>