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::Borrower::Debarments;
56 use List::MoreUtils qw( uniq );
66 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
70 $VERSION = 3.07.00.049; # for version checking
73 # FIXME subs that should probably be elsewhere
78 &GetPendingOnSiteCheckouts
81 # subs to deal with issuing a book
93 &GetBranchBorrowerCircRule
97 &AnonymiseIssueHistory
98 &CheckIfIssuedToPatron
103 # subs to deal with returns
109 # subs to deal with transfers
116 &IsBranchTransferAllowed
117 &CreateBranchTransferLimit
118 &DeleteBranchTransferLimits
122 # subs to deal with offline circulation
124 &GetOfflineOperations
127 &DeleteOfflineOperation
128 &ProcessOfflineOperation
134 C4::Circulation - Koha circulation module
142 The functions in this module deal with circulation, issues, and
143 returns, as well as general information about the library.
144 Also deals with stocktaking.
150 $str = &barcodedecode($barcode, [$filter]);
152 Generic filter function for barcode string.
153 Called on every circ if the System Pref itemBarcodeInputFilter is set.
154 Will do some manipulation of the barcode for systems that deliver a barcode
155 to circulation.pl that differs from the barcode stored for the item.
156 For proper functioning of this filter, calling the function on the
157 correct barcode string (items.barcode) should return an unaltered barcode.
159 The optional $filter argument is to allow for testing or explicit
160 behavior that ignores the System Pref. Valid values are the same as the
165 # FIXME -- the &decode fcn below should be wrapped into this one.
166 # FIXME -- these plugins should be moved out of Circulation.pm
169 my ($barcode, $filter) = @_;
170 my $branch = C4::Branch::mybranch();
171 $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
172 $filter or return $barcode; # ensure filter is defined, else return untouched barcode
173 if ($filter eq 'whitespace') {
175 } elsif ($filter eq 'cuecat') {
177 my @fields = split( /\./, $barcode );
178 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
179 ($#results == 2) and return $results[2];
180 } elsif ($filter eq 'T-prefix') {
181 if ($barcode =~ /^[Tt](\d)/) {
182 (defined($1) and $1 eq '0') and return $barcode;
183 $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1)
185 return sprintf("T%07d", $barcode);
186 # FIXME: $barcode could be "T1", causing warning: substr outside of string
187 # Why drop the nonzero digit after the T?
188 # Why pass non-digits (or empty string) to "T%07d"?
189 } elsif ($filter eq 'libsuite8') {
190 unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it.
191 if($barcode =~ m/^(\d)/i){ #Some barcodes even start with 0's & numbers and are assumed to have b as the item type in the libsuite8 software
192 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
194 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
197 } elsif ($filter eq 'EAN13') {
198 my $ean = CheckDigits('ean');
199 if ( $ean->is_valid($barcode) ) {
200 #$barcode = sprintf('%013d',$barcode); # this doesn't work on 32-bit systems
201 $barcode = '0' x ( 13 - length($barcode) ) . $barcode;
203 warn "# [$barcode] not valid EAN-13/UPC-A\n";
206 return $barcode; # return barcode, modified or not
211 $str = &decode($chunk);
213 Decodes a segment of a string emitted by a CueCat barcode scanner and
216 FIXME: Should be replaced with Barcode::Cuecat from CPAN
217 or Javascript based decoding on the client side.
224 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
225 my @s = map { index( $seq, $_ ); } split( //, $encoded );
226 my $l = ( $#s + 1 ) % 4;
229 # warn "Error: Cuecat decode parsing failed!";
237 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
239 chr( ( $n >> 16 ) ^ 67 )
240 .chr( ( $n >> 8 & 255 ) ^ 67 )
241 .chr( ( $n & 255 ) ^ 67 );
244 $r = substr( $r, 0, length($r) - $l );
250 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
251 $barcode, $ignore_reserves);
253 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
255 C<$newbranch> is the code for the branch to which the item should be transferred.
257 C<$barcode> is the barcode of the item to be transferred.
259 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
260 Otherwise, if an item is reserved, the transfer fails.
262 Returns three values:
268 is true if the transfer was successful.
272 is a reference-to-hash which may have any of the following keys:
278 There is no item in the catalog with the given barcode. The value is C<$barcode>.
282 The item's home branch is permanent. This doesn't prevent the item from being transferred, though. The value is the code of the item's home branch.
284 =item C<DestinationEqualsHolding>
286 The item is already at the branch to which it is being transferred. The transfer is nonetheless considered to have failed. The value should be ignored.
290 The item was on loan, and C<&transferbook> automatically returned it before transferring it. The value is the borrower number of the patron who had the item.
294 The item was reserved. The value is a reference-to-hash whose keys are fields from the reserves table of the Koha database, and C<biblioitemnumber>. It also has the key C<ResFound>, whose value is either C<Waiting> or C<Reserved>.
296 =item C<WasTransferred>
298 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
307 my ( $tbr, $barcode, $ignoreRs ) = @_;
310 my $branches = GetBranches();
311 my $itemnumber = GetItemnumberFromBarcode( $barcode );
312 my $issue = GetItemIssue($itemnumber);
313 my $biblio = GetBiblioFromItemNumber($itemnumber);
316 if ( not $itemnumber ) {
317 $messages->{'BadBarcode'} = $barcode;
321 # get branches of book...
322 my $hbr = $biblio->{'homebranch'};
323 my $fbr = $biblio->{'holdingbranch'};
325 # if using Branch Transfer Limits
326 if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
327 if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
328 if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
329 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
332 } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
333 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
339 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
340 $messages->{'IsPermanent'} = $hbr;
344 # can't transfer book if is already there....
345 if ( $fbr eq $tbr ) {
346 $messages->{'DestinationEqualsHolding'} = 1;
350 # check if it is still issued to someone, return it...
351 if ($issue->{borrowernumber}) {
352 AddReturn( $barcode, $fbr );
353 $messages->{'WasReturned'} = $issue->{borrowernumber};
357 # That'll save a database query.
358 my ( $resfound, $resrec, undef ) =
359 CheckReserves( $itemnumber );
360 if ( $resfound and not $ignoreRs ) {
361 $resrec->{'ResFound'} = $resfound;
363 # $messages->{'ResFound'} = $resrec;
367 #actually do the transfer....
369 ModItemTransfer( $itemnumber, $fbr, $tbr );
371 # don't need to update MARC anymore, we do it in batch now
372 $messages->{'WasTransfered'} = 1;
375 ModDateLastSeen( $itemnumber );
376 return ( $dotransfer, $messages, $biblio );
381 my $borrower = shift;
382 my $biblionumber = shift;
385 my $onsite_checkout = $params->{onsite_checkout} || 0;
386 my $cat_borrower = $borrower->{'categorycode'};
387 my $dbh = C4::Context->dbh;
389 # Get which branchcode we need
390 $branch = _GetCircControlBranch($item,$borrower);
391 my $type = (C4::Context->preference('item-level_itypes'))
392 ? $item->{'itype'} # item-level
393 : $item->{'itemtype'}; # biblio-level
395 # given branch, patron category, and item type, determine
396 # applicable issuing rule
397 my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
399 # if a rule is found and has a loan limit set, count
400 # how many loans the patron already has that meet that
402 if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
405 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
407 JOIN items USING (itemnumber)
410 my $rule_itemtype = $issuing_rule->{itemtype};
411 if ($rule_itemtype eq "*") {
412 # matching rule has the default item type, so count only
413 # those existing loans that don't fall under a more
415 if (C4::Context->preference('item-level_itypes')) {
416 $count_query .= " WHERE items.itype NOT IN (
417 SELECT itemtype FROM issuingrules
419 AND (categorycode = ? OR categorycode = ?)
423 $count_query .= " JOIN biblioitems USING (biblionumber)
424 WHERE biblioitems.itemtype NOT IN (
425 SELECT itemtype FROM issuingrules
427 AND (categorycode = ? OR categorycode = ?)
431 push @bind_params, $issuing_rule->{branchcode};
432 push @bind_params, $issuing_rule->{categorycode};
433 push @bind_params, $cat_borrower;
435 # rule has specific item type, so count loans of that
437 if (C4::Context->preference('item-level_itypes')) {
438 $count_query .= " WHERE items.itype = ? ";
440 $count_query .= " JOIN biblioitems USING (biblionumber)
441 WHERE biblioitems.itemtype= ? ";
443 push @bind_params, $type;
446 $count_query .= " AND borrowernumber = ? ";
447 push @bind_params, $borrower->{'borrowernumber'};
448 my $rule_branch = $issuing_rule->{branchcode};
449 if ($rule_branch ne "*") {
450 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
451 $count_query .= " AND issues.branchcode = ? ";
452 push @bind_params, $branch;
453 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
454 ; # if branch is the patron's home branch, then count all loans by patron
456 $count_query .= " AND items.homebranch = ? ";
457 push @bind_params, $branch;
461 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $count_query, {}, @bind_params );
463 my $max_checkouts_allowed = $issuing_rule->{maxissueqty};
464 my $max_onsite_checkouts_allowed = $issuing_rule->{maxonsiteissueqty};
466 if ( $onsite_checkout ) {
467 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
469 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
470 count => $onsite_checkout_count,
471 max_allowed => $max_onsite_checkouts_allowed,
475 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
476 if ( $checkout_count >= $max_checkouts_allowed ) {
478 reason => 'TOO_MANY_CHECKOUTS',
479 count => $checkout_count,
480 max_allowed => $max_checkouts_allowed,
483 } elsif ( not $onsite_checkout ) {
484 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
486 reason => 'TOO_MANY_CHECKOUTS',
487 count => $checkout_count - $onsite_checkout_count,
488 max_allowed => $max_checkouts_allowed,
494 # Now count total loans against the limit for the branch
495 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
496 if (defined($branch_borrower_circ_rule->{maxissueqty})) {
497 my @bind_params = ();
498 my $branch_count_query = q|
499 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
501 JOIN items USING (itemnumber)
502 WHERE borrowernumber = ?
504 push @bind_params, $borrower->{borrowernumber};
506 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
507 $branch_count_query .= " AND issues.branchcode = ? ";
508 push @bind_params, $branch;
509 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
510 ; # if branch is the patron's home branch, then count all loans by patron
512 $branch_count_query .= " AND items.homebranch = ? ";
513 push @bind_params, $branch;
515 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $branch_count_query, {}, @bind_params );
516 my $max_checkouts_allowed = $branch_borrower_circ_rule->{maxissueqty};
517 my $max_onsite_checkouts_allowed = $branch_borrower_circ_rule->{maxonsiteissueqty};
519 if ( $onsite_checkout ) {
520 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
522 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
523 count => $onsite_checkout_count,
524 max_allowed => $max_onsite_checkouts_allowed,
528 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
529 if ( $checkout_count >= $max_checkouts_allowed ) {
531 reason => 'TOO_MANY_CHECKOUTS',
532 count => $checkout_count,
533 max_allowed => $max_checkouts_allowed,
536 } elsif ( not $onsite_checkout ) {
537 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
539 reason => 'TOO_MANY_CHECKOUTS',
540 count => $checkout_count - $onsite_checkout_count,
541 max_allowed => $max_checkouts_allowed,
547 # OK, the patron can issue !!!
553 @issues = &itemissues($biblioitemnumber, $biblio);
555 Looks up information about who has borrowed the bookZ<>(s) with the
556 given biblioitemnumber.
558 C<$biblio> is ignored.
560 C<&itemissues> returns an array of references-to-hash. The keys
561 include the fields from the C<items> table in the Koha database.
562 Additional keys include:
568 If the item is currently on loan, this gives the due date.
570 If the item is not on loan, then this is either "Available" or
571 "Cancelled", if the item has been withdrawn.
575 If the item is currently on loan, this gives the card number of the
576 patron who currently has the item.
578 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
580 These give the timestamp for the last three times the item was
583 =item C<card0>, C<card1>, C<card2>
585 The card number of the last three patrons who borrowed this item.
587 =item C<borrower0>, C<borrower1>, C<borrower2>
589 The borrower number of the last three patrons who borrowed this item.
597 my ( $bibitem, $biblio ) = @_;
598 my $dbh = C4::Context->dbh;
600 $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
605 $sth->execute($bibitem) || die $sth->errstr;
607 while ( my $data = $sth->fetchrow_hashref ) {
609 # Find out who currently has this item.
610 # FIXME - Wouldn't it be better to do this as a left join of
611 # some sort? Currently, this code assumes that if
612 # fetchrow_hashref() fails, then the book is on the shelf.
613 # fetchrow_hashref() can fail for any number of reasons (e.g.,
614 # database server crash), not just because no items match the
616 my $sth2 = $dbh->prepare(
617 "SELECT * FROM issues
618 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
623 $sth2->execute( $data->{'itemnumber'} );
624 if ( my $data2 = $sth2->fetchrow_hashref ) {
625 $data->{'date_due'} = $data2->{'date_due'};
626 $data->{'card'} = $data2->{'cardnumber'};
627 $data->{'borrower'} = $data2->{'borrowernumber'};
630 $data->{'date_due'} = ($data->{'withdrawn'} eq '1') ? 'Cancelled' : 'Available';
634 # Find the last 3 people who borrowed this item.
635 $sth2 = $dbh->prepare(
636 "SELECT * FROM old_issues
637 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
639 ORDER BY returndate DESC,timestamp DESC"
642 $sth2->execute( $data->{'itemnumber'} );
643 for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
644 { # FIXME : error if there is less than 3 pple borrowing this item
645 if ( my $data2 = $sth2->fetchrow_hashref ) {
646 $data->{"timestamp$i2"} = $data2->{'timestamp'};
647 $data->{"card$i2"} = $data2->{'cardnumber'};
648 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
652 $results[$i] = $data;
659 =head2 CanBookBeIssued
661 ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower,
662 $barcode, $duedate, $inprocess, $ignore_reserves );
664 Check if a book can be issued.
666 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
670 =item C<$borrower> hash with borrower informations (from GetMember or GetMemberDetails)
672 =item C<$barcode> is the bar code of the book being issued.
674 =item C<$duedates> is a DateTime object.
676 =item C<$inprocess> boolean switch
677 =item C<$ignore_reserves> boolean switch
685 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
686 Possible values are :
692 sticky due date is invalid
696 borrower gone with no address
700 borrower declared it's card lost
706 =head3 UNKNOWN_BARCODE
720 item is restricted (set by ??)
722 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
723 could be prevented, but ones that can be overriden by the operator.
725 Possible values are :
733 renewing, not issuing
735 =head3 ISSUED_TO_ANOTHER
737 issued to someone else.
741 reserved for someone else.
745 sticky due date is invalid or due date in the past
749 if the borrower borrows to much things
753 sub CanBookBeIssued {
754 my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves, $params ) = @_;
755 my %needsconfirmation; # filled with problems that needs confirmations
756 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
757 my %alerts; # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
759 my $onsite_checkout = $params->{onsite_checkout} || 0;
761 my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
762 my $issue = GetItemIssue($item->{itemnumber});
763 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
764 $item->{'itemtype'}=$item->{'itype'};
765 my $dbh = C4::Context->dbh;
767 # MANDATORY CHECKS - unless item exists, nothing else matters
768 unless ( $item->{barcode} ) {
769 $issuingimpossible{UNKNOWN_BARCODE} = 1;
771 return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
774 # DUE DATE is OK ? -- should already have checked.
776 if ($duedate && ref $duedate ne 'DateTime') {
777 $duedate = dt_from_string($duedate);
779 my $now = DateTime->now( time_zone => C4::Context->tz() );
780 unless ( $duedate ) {
781 my $issuedate = $now->clone();
783 my $branch = _GetCircControlBranch($item,$borrower);
784 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
785 $duedate = CalcDateDue( $issuedate, $itype, $branch, $borrower );
787 # Offline circ calls AddIssue directly, doesn't run through here
788 # So issuingimpossible should be ok.
791 my $today = $now->clone();
792 $today->truncate( to => 'minute');
793 if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
794 $needsconfirmation{INVALID_DATE} = output_pref($duedate);
797 $issuingimpossible{INVALID_DATE} = output_pref($duedate);
803 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
804 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
806 branch => C4::Context->userenv->{'branch'},
808 itemnumber => $item->{'itemnumber'},
809 itemtype => $item->{'itemtype'},
810 borrowernumber => $borrower->{'borrowernumber'},
811 ccode => $item->{'ccode'}}
813 ModDateLastSeen( $item->{'itemnumber'} );
814 return( { STATS => 1 }, {});
816 if ( ref $borrower->{flags} ) {
817 if ( $borrower->{flags}->{GNA} ) {
818 $issuingimpossible{GNA} = 1;
820 if ( $borrower->{flags}->{'LOST'} ) {
821 $issuingimpossible{CARD_LOST} = 1;
823 if ( $borrower->{flags}->{'DBARRED'} ) {
824 $issuingimpossible{DEBARRED} = 1;
827 if ( !defined $borrower->{dateexpiry} || $borrower->{'dateexpiry'} eq '0000-00-00') {
828 $issuingimpossible{EXPIRED} = 1;
830 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'sql', 'floating' );
831 $expiry_dt->truncate( to => 'day');
832 my $today = $now->clone()->truncate(to => 'day');
833 $today->set_time_zone( 'floating' );
834 if ( DateTime->compare($today, $expiry_dt) == 1 ) {
835 $issuingimpossible{EXPIRED} = 1;
844 my ($balance, $non_issue_charges, $other_charges) =
845 C4::Members::GetMemberAccountBalance( $borrower->{'borrowernumber'} );
846 my $amountlimit = C4::Context->preference("noissuescharge");
847 my $allowfineoverride = C4::Context->preference("AllowFineOverride");
848 my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
849 if ( C4::Context->preference("IssuingInProcess") ) {
850 if ( $non_issue_charges > $amountlimit && !$inprocess && !$allowfineoverride) {
851 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
852 } elsif ( $non_issue_charges > $amountlimit && !$inprocess && $allowfineoverride) {
853 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
854 } elsif ( $allfinesneedoverride && $non_issue_charges > 0 && $non_issue_charges <= $amountlimit && !$inprocess ) {
855 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
859 if ( $non_issue_charges > $amountlimit && $allowfineoverride ) {
860 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
861 } elsif ( $non_issue_charges > $amountlimit && !$allowfineoverride) {
862 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
863 } elsif ( $non_issue_charges > 0 && $allfinesneedoverride ) {
864 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
867 if ($balance > 0 && $other_charges > 0) {
868 $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges );
871 my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'});
872 if ($blocktype == -1) {
873 ## patron has outstanding overdue loans
874 if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
875 $issuingimpossible{USERBLOCKEDOVERDUE} = $count;
877 elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
878 $needsconfirmation{USERBLOCKEDOVERDUE} = $count;
880 } elsif($blocktype == 1) {
881 # patron has accrued fine days or has a restriction. $count is a date
882 if ($count eq '9999-12-31') {
883 $issuingimpossible{USERBLOCKEDNOENDDATE} = $count;
886 $issuingimpossible{USERBLOCKEDWITHENDDATE} = $count;
891 # JB34 CHECKS IF BORROWERS DON'T HAVE ISSUE TOO MANY BOOKS
893 my $toomany = TooMany( $borrower, $item->{biblionumber}, $item, { onsite_checkout => $onsite_checkout } );
894 # if TooMany max_allowed returns 0 the user doesn't have permission to check out this book
896 if ( $toomany->{max_allowed} == 0 ) {
897 $needsconfirmation{PATRON_CANT} = 1;
899 if ( C4::Context->preference("AllowTooManyOverride") ) {
900 $needsconfirmation{TOO_MANY} = $toomany->{reason};
901 $needsconfirmation{current_loan_count} = $toomany->{count};
902 $needsconfirmation{max_loans_allowed} = $toomany->{max_allowed};
904 $needsconfirmation{TOO_MANY} = $toomany->{reason};
905 $issuingimpossible{current_loan_count} = $toomany->{count};
906 $issuingimpossible{max_loans_allowed} = $toomany->{max_allowed};
913 if ( $item->{'notforloan'} )
915 if(!C4::Context->preference("AllowNotForLoanOverride")){
916 $issuingimpossible{NOT_FOR_LOAN} = 1;
917 $issuingimpossible{item_notforloan} = $item->{'notforloan'};
919 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
920 $needsconfirmation{item_notforloan} = $item->{'notforloan'};
924 # we have to check itemtypes.notforloan also
925 if (C4::Context->preference('item-level_itypes')){
926 # this should probably be a subroutine
927 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
928 $sth->execute($item->{'itemtype'});
929 my $notforloan=$sth->fetchrow_hashref();
930 if ($notforloan->{'notforloan'}) {
931 if (!C4::Context->preference("AllowNotForLoanOverride")) {
932 $issuingimpossible{NOT_FOR_LOAN} = 1;
933 $issuingimpossible{itemtype_notforloan} = $item->{'itype'};
935 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
936 $needsconfirmation{itemtype_notforloan} = $item->{'itype'};
940 elsif ($biblioitem->{'notforloan'} == 1){
941 if (!C4::Context->preference("AllowNotForLoanOverride")) {
942 $issuingimpossible{NOT_FOR_LOAN} = 1;
943 $issuingimpossible{itemtype_notforloan} = $biblioitem->{'itemtype'};
945 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
946 $needsconfirmation{itemtype_notforloan} = $biblioitem->{'itemtype'};
950 if ( $item->{'withdrawn'} && $item->{'withdrawn'} > 0 )
952 $issuingimpossible{WTHDRAWN} = 1;
954 if ( $item->{'restricted'}
955 && $item->{'restricted'} == 1 )
957 $issuingimpossible{RESTRICTED} = 1;
959 if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
960 my $code = GetAuthorisedValueByCode( 'LOST', $item->{'itemlost'} );
961 $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
962 $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
964 if ( C4::Context->preference("IndependentBranches") ) {
965 my $userenv = C4::Context->userenv;
966 unless ( C4::Context->IsSuperLibrarian() ) {
967 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ){
968 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
969 $issuingimpossible{'itemhomebranch'} = $item->{C4::Context->preference("HomeOrHoldingBranch")};
971 $needsconfirmation{BORRNOTSAMEBRANCH} = GetBranchName( $borrower->{'branchcode'} )
972 if ( $borrower->{'branchcode'} ne $userenv->{branch} );
976 # CHECK IF THERE IS RENTAL CHARGES. RENTAL MUST BE CONFIRMED BY THE BORROWER
978 my $rentalConfirmation = C4::Context->preference("RentalFeesCheckoutConfirmation");
980 if ( $rentalConfirmation ){
981 my ($rentalCharge) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
982 if ( $rentalCharge > 0 ){
983 $rentalCharge = sprintf("%.02f", $rentalCharge);
984 $needsconfirmation{RENTALCHARGE} = $rentalCharge;
989 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
991 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} ){
993 # Already issued to current borrower. Ask whether the loan should
995 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
996 $borrower->{'borrowernumber'},
997 $item->{'itemnumber'}
999 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
1000 if ( $renewerror eq 'onsite_checkout' ) {
1001 $issuingimpossible{NO_RENEWAL_FOR_ONSITE_CHECKOUTS} = 1;
1004 $issuingimpossible{NO_MORE_RENEWALS} = 1;
1008 $needsconfirmation{RENEW_ISSUE} = 1;
1011 elsif ($issue->{borrowernumber}) {
1013 # issued to someone else
1014 my $currborinfo = C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} );
1016 # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
1017 $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
1018 $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
1019 $needsconfirmation{issued_surname} = $currborinfo->{'surname'};
1020 $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
1021 $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
1024 unless ( $ignore_reserves ) {
1025 # See if the item is on reserve.
1026 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
1028 my $resbor = $res->{'borrowernumber'};
1029 if ( $resbor ne $borrower->{'borrowernumber'} ) {
1030 my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor );
1031 my $branchname = GetBranchName( $res->{'branchcode'} );
1032 if ( $restype eq "Waiting" )
1034 # The item is on reserve and waiting, but has been
1035 # reserved by some other patron.
1036 $needsconfirmation{RESERVE_WAITING} = 1;
1037 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
1038 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
1039 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
1040 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
1041 $needsconfirmation{'resbranchname'} = $branchname;
1042 $needsconfirmation{'reswaitingdate'} = $res->{'waitingdate'};
1044 elsif ( $restype eq "Reserved" ) {
1045 # The item is on reserve for someone else.
1046 $needsconfirmation{RESERVED} = 1;
1047 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
1048 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
1049 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
1050 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
1051 $needsconfirmation{'resbranchname'} = $branchname;
1052 $needsconfirmation{'resreservedate'} = $res->{'reservedate'};
1058 ## CHECK AGE RESTRICTION
1059 my $agerestriction = $biblioitem->{'agerestriction'};
1060 my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $borrower );
1061 if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1062 if ( C4::Context->preference('AgeRestrictionOverride') ) {
1063 $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1066 $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1070 ## check for high holds decreasing loan period
1071 my $decrease_loan = C4::Context->preference('decreaseLoanHighHolds');
1072 if ( $decrease_loan && $decrease_loan == 1 ) {
1073 my ( $reserved, $num, $duration, $returndate ) =
1074 checkHighHolds( $item, $borrower );
1076 if ( $num >= C4::Context->preference('decreaseLoanHighHoldsValue') ) {
1077 $needsconfirmation{HIGHHOLDS} = {
1079 duration => $duration,
1080 returndate => output_pref($returndate),
1086 !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1087 # don't do the multiple loans per bib check if we've
1088 # already determined that we've got a loan on the same item
1089 !$issuingimpossible{NO_MORE_RENEWALS} &&
1090 !$needsconfirmation{RENEW_ISSUE}
1092 # Check if borrower has already issued an item from the same biblio
1093 # Only if it's not a subscription
1094 my $biblionumber = $item->{biblionumber};
1095 require C4::Serials;
1096 my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1097 unless ($is_a_subscription) {
1098 my $issues = GetIssues( {
1099 borrowernumber => $borrower->{borrowernumber},
1100 biblionumber => $biblionumber,
1102 my @issues = $issues ? @$issues : ();
1103 # if we get here, we don't already have a loan on this item,
1104 # so if there are any loans on this bib, ask for confirmation
1105 if (scalar @issues > 0) {
1106 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1111 return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
1114 =head2 CanBookBeReturned
1116 ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1118 Check whether the item can be returned to the provided branch
1122 =item C<$item> is a hash of item information as returned from GetItem
1124 =item C<$branch> is the branchcode where the return is taking place
1132 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1134 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1140 sub CanBookBeReturned {
1141 my ($item, $branch) = @_;
1142 my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1144 # assume return is allowed to start
1148 # identify all cases where return is forbidden
1149 if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1151 $message = $item->{'homebranch'};
1152 } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1154 $message = $item->{'holdingbranch'};
1155 } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1157 $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1160 return ($allowed, $message);
1163 =head2 CheckHighHolds
1165 used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1166 decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1167 has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1171 sub checkHighHolds {
1172 my ( $item, $borrower ) = @_;
1173 my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1174 my $branch = _GetCircControlBranch( $item, $borrower );
1175 my $dbh = C4::Context->dbh;
1176 my $sth = $dbh->prepare(
1177 'select count(borrowernumber) as num_holds from reserves where biblionumber=?'
1179 $sth->execute( $item->{'biblionumber'} );
1180 my ($holds) = $sth->fetchrow_array;
1182 my $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1184 my $calendar = Koha::Calendar->new( branchcode => $branch );
1187 ( C4::Context->preference('item-level_itypes') )
1188 ? $biblio->{'itype'}
1189 : $biblio->{'itemtype'};
1191 C4::Circulation::CalcDateDue( $issuedate, $itype, $branch,
1194 my $reduced_datedue =
1195 $calendar->addDate( $issuedate,
1196 C4::Context->preference('decreaseLoanHighHoldsDuration') );
1198 if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1200 C4::Context->preference('decreaseLoanHighHoldsDuration'),
1204 return ( 0, 0, 0, undef );
1209 &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1211 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1215 =item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails).
1217 =item C<$barcode> is the barcode of the item being issued.
1219 =item C<$datedue> is a DateTime object for the max date of return, i.e. the date due (optional).
1220 Calculated if empty.
1222 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1224 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1225 Defaults to today. Unlike C<$datedue>, NOT a DateTime object, unfortunately.
1227 AddIssue does the following things :
1229 - step 01: check that there is a borrowernumber & a barcode provided
1230 - check for RENEWAL (book issued & being issued to the same patron)
1231 - renewal YES = Calculate Charge & renew
1233 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1235 - fill reserve if reserve to this patron
1236 - cancel reserve or not, otherwise
1237 * TRANSFERT PENDING ?
1238 - complete the transfert
1246 my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1247 my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1248 my $auto_renew = $params && $params->{auto_renew};
1249 my $dbh = C4::Context->dbh;
1250 my $barcodecheck=CheckValidBarcode($barcode);
1254 if ($datedue && ref $datedue ne 'DateTime') {
1255 $datedue = dt_from_string($datedue);
1257 # $issuedate defaults to today.
1258 if ( ! defined $issuedate ) {
1259 $issuedate = DateTime->now(time_zone => C4::Context->tz());
1262 if ( ref $issuedate ne 'DateTime') {
1263 $issuedate = dt_from_string($issuedate);
1267 if ($borrower and $barcode and $barcodecheck ne '0'){#??? wtf
1268 # find which item we issue
1269 my $item = GetItem('', $barcode) or return; # if we don't get an Item, abort.
1270 my $branch = _GetCircControlBranch($item,$borrower);
1272 # get actual issuing if there is one
1273 my $actualissue = GetItemIssue( $item->{itemnumber});
1275 # get biblioinformation for this item
1276 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
1279 # check if we just renew the issue.
1281 if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
1282 $datedue = AddRenewal(
1283 $borrower->{'borrowernumber'},
1284 $item->{'itemnumber'},
1287 $issuedate, # here interpreted as the renewal date
1291 # it's NOT a renewal
1292 if ( $actualissue->{borrowernumber}) {
1293 # This book is currently on loan, but not to the person
1294 # who wants to borrow it now. mark it returned before issuing to the new borrower
1297 C4::Context->userenv->{'branch'}
1301 MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1302 # Starting process for transfer job (checking transfert and validate it if we have one)
1303 my ($datesent) = GetTransfers($item->{'itemnumber'});
1305 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1308 "UPDATE branchtransfers
1309 SET datearrived = now(),
1311 comments = 'Forced branchtransfer'
1312 WHERE itemnumber= ? AND datearrived IS NULL"
1314 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
1317 # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1318 unless ($auto_renew) {
1319 my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branch);
1320 $auto_renew = $issuingrule->{auto_renew};
1323 # Record in the database the fact that the book was issued.
1325 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
1326 $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1329 $datedue->truncate( to => 'minute');
1331 $issue = Koha::Database->new()->schema()->resultset('Issue')->create(
1333 borrowernumber => $borrower->{'borrowernumber'},
1334 itemnumber => $item->{'itemnumber'},
1335 issuedate => $issuedate->strftime('%Y-%m-%d %H:%M:%S'),
1336 date_due => $datedue->strftime('%Y-%m-%d %H:%M:%S'),
1337 branchcode => C4::Context->userenv->{'branch'},
1338 onsite_checkout => $onsite_checkout,
1339 auto_renew => $auto_renew ? 1 : 0
1343 if ( C4::Context->preference('ReturnToShelvingCart') ) { ## ReturnToShelvingCart is on, anything issued should be taken off the cart.
1344 CartToShelf( $item->{'itemnumber'} );
1346 $item->{'issues'}++;
1347 if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1348 UpdateTotalIssues($item->{'biblionumber'}, 1);
1351 ## If item was lost, it has now been found, reverse any list item charges if necessary.
1352 if ( $item->{'itemlost'} ) {
1353 if ( C4::Context->preference('RefundLostItemFeeOnReturn' ) ) {
1354 _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef, $item->{'barcode'} );
1358 ModItem({ issues => $item->{'issues'},
1359 holdingbranch => C4::Context->userenv->{'branch'},
1361 datelastborrowed => DateTime->now(time_zone => C4::Context->tz())->ymd(),
1362 onloan => $datedue->ymd(),
1363 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1364 ModDateLastSeen( $item->{'itemnumber'} );
1366 # If it costs to borrow this book, charge it to the patron's account.
1367 my ( $charge, $itemtype ) = GetIssuingCharges(
1368 $item->{'itemnumber'},
1369 $borrower->{'borrowernumber'}
1371 if ( $charge > 0 ) {
1373 $item->{'itemnumber'},
1374 $borrower->{'borrowernumber'}, $charge
1376 $item->{'charge'} = $charge;
1379 # Record the fact that this book was issued.
1381 branch => C4::Context->userenv->{'branch'},
1382 type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1384 other => ($sipmode ? "SIP-$sipmode" : ''),
1385 itemnumber => $item->{'itemnumber'},
1386 itemtype => $item->{'itype'},
1387 borrowernumber => $borrower->{'borrowernumber'},
1388 ccode => $item->{'ccode'}}
1391 # Send a checkout slip.
1392 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1394 branchcode => $branch,
1395 categorycode => $borrower->{categorycode},
1396 item_type => $item->{itype},
1397 notification => 'CHECKOUT',
1399 if ($circulation_alert->is_enabled_for(\%conditions)) {
1400 SendCirculationAlert({
1403 borrower => $borrower,
1409 logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'itemnumber'})
1410 if C4::Context->preference("IssueLog");
1415 =head2 GetLoanLength
1417 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1419 Get loan length for an itemtype, a borrower type and a branch
1424 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1425 my $dbh = C4::Context->dbh;
1426 my $sth = $dbh->prepare(qq{
1427 SELECT issuelength, lengthunit, renewalperiod
1429 WHERE categorycode=?
1432 AND issuelength IS NOT NULL
1435 # try to find issuelength & return the 1st available.
1436 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1437 $sth->execute( $borrowertype, $itemtype, $branchcode );
1438 my $loanlength = $sth->fetchrow_hashref;
1441 if defined($loanlength) && $loanlength->{issuelength};
1443 $sth->execute( $borrowertype, '*', $branchcode );
1444 $loanlength = $sth->fetchrow_hashref;
1446 if defined($loanlength) && $loanlength->{issuelength};
1448 $sth->execute( '*', $itemtype, $branchcode );
1449 $loanlength = $sth->fetchrow_hashref;
1451 if defined($loanlength) && $loanlength->{issuelength};
1453 $sth->execute( '*', '*', $branchcode );
1454 $loanlength = $sth->fetchrow_hashref;
1456 if defined($loanlength) && $loanlength->{issuelength};
1458 $sth->execute( $borrowertype, $itemtype, '*' );
1459 $loanlength = $sth->fetchrow_hashref;
1461 if defined($loanlength) && $loanlength->{issuelength};
1463 $sth->execute( $borrowertype, '*', '*' );
1464 $loanlength = $sth->fetchrow_hashref;
1466 if defined($loanlength) && $loanlength->{issuelength};
1468 $sth->execute( '*', $itemtype, '*' );
1469 $loanlength = $sth->fetchrow_hashref;
1471 if defined($loanlength) && $loanlength->{issuelength};
1473 $sth->execute( '*', '*', '*' );
1474 $loanlength = $sth->fetchrow_hashref;
1476 if defined($loanlength) && $loanlength->{issuelength};
1478 # if no rule is set => 21 days (hardcoded)
1481 renewalperiod => 21,
1482 lengthunit => 'days',
1488 =head2 GetHardDueDate
1490 my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1492 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1496 sub GetHardDueDate {
1497 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1499 my $rule = GetIssuingRule( $borrowertype, $itemtype, $branchcode );
1501 if ( defined( $rule ) ) {
1502 if ( $rule->{hardduedate} ) {
1503 return (dt_from_string($rule->{hardduedate}, 'iso'),$rule->{hardduedatecompare});
1505 return (undef, undef);
1510 =head2 GetIssuingRule
1512 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1514 FIXME - This is a copy-paste of GetLoanLength
1515 as a stop-gap. Do not wish to change API for GetLoanLength
1516 this close to release.
1518 Get the issuing rule for an itemtype, a borrower type and a branch
1519 Returns a hashref from the issuingrules table.
1523 sub GetIssuingRule {
1524 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1525 my $dbh = C4::Context->dbh;
1526 my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=?" );
1529 $sth->execute( $borrowertype, $itemtype, $branchcode );
1530 $irule = $sth->fetchrow_hashref;
1531 return $irule if defined($irule) ;
1533 $sth->execute( $borrowertype, "*", $branchcode );
1534 $irule = $sth->fetchrow_hashref;
1535 return $irule if defined($irule) ;
1537 $sth->execute( "*", $itemtype, $branchcode );
1538 $irule = $sth->fetchrow_hashref;
1539 return $irule if defined($irule) ;
1541 $sth->execute( "*", "*", $branchcode );
1542 $irule = $sth->fetchrow_hashref;
1543 return $irule if defined($irule) ;
1545 $sth->execute( $borrowertype, $itemtype, "*" );
1546 $irule = $sth->fetchrow_hashref;
1547 return $irule if defined($irule) ;
1549 $sth->execute( $borrowertype, "*", "*" );
1550 $irule = $sth->fetchrow_hashref;
1551 return $irule if defined($irule) ;
1553 $sth->execute( "*", $itemtype, "*" );
1554 $irule = $sth->fetchrow_hashref;
1555 return $irule if defined($irule) ;
1557 $sth->execute( "*", "*", "*" );
1558 $irule = $sth->fetchrow_hashref;
1559 return $irule if defined($irule) ;
1561 # if no rule matches,
1565 =head2 GetBranchBorrowerCircRule
1567 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1569 Retrieves circulation rule attributes that apply to the given
1570 branch and patron category, regardless of item type.
1571 The return value is a hashref containing the following key:
1573 maxissueqty - maximum number of loans that a
1574 patron of the given category can have at the given
1575 branch. If the value is undef, no limit.
1577 maxonsiteissueqty - maximum of on-site checkouts that a
1578 patron of the given category can have at the given
1579 branch. If the value is undef, no limit.
1581 This will first check for a specific branch and
1582 category match from branch_borrower_circ_rules.
1584 If no rule is found, it will then check default_branch_circ_rules
1585 (same branch, default category). If no rule is found,
1586 it will then check default_borrower_circ_rules (default
1587 branch, same category), then failing that, default_circ_rules
1588 (default branch, default category).
1590 If no rule has been found in the database, it will default to
1594 maxonsiteissueqty - undef
1596 C<$branchcode> and C<$categorycode> should contain the
1597 literal branch code and patron category code, respectively - no
1602 sub GetBranchBorrowerCircRule {
1603 my ( $branchcode, $categorycode ) = @_;
1606 my $dbh = C4::Context->dbh();
1607 $rules = $dbh->selectrow_hashref( q|
1608 SELECT maxissueqty, maxonsiteissueqty
1609 FROM branch_borrower_circ_rules
1610 WHERE branchcode = ?
1611 AND categorycode = ?
1612 |, {}, $branchcode, $categorycode ) ;
1613 return $rules if $rules;
1615 # try same branch, default borrower category
1616 $rules = $dbh->selectrow_hashref( q|
1617 SELECT maxissueqty, maxonsiteissueqty
1618 FROM default_branch_circ_rules
1619 WHERE branchcode = ?
1620 |, {}, $branchcode ) ;
1621 return $rules if $rules;
1623 # try default branch, same borrower category
1624 $rules = $dbh->selectrow_hashref( q|
1625 SELECT maxissueqty, maxonsiteissueqty
1626 FROM default_borrower_circ_rules
1627 WHERE categorycode = ?
1628 |, {}, $categorycode ) ;
1629 return $rules if $rules;
1631 # try default branch, default borrower category
1632 $rules = $dbh->selectrow_hashref( q|
1633 SELECT maxissueqty, maxonsiteissueqty
1634 FROM default_circ_rules
1636 return $rules if $rules;
1638 # built-in default circulation rule
1640 maxissueqty => undef,
1641 maxonsiteissueqty => undef,
1645 =head2 GetBranchItemRule
1647 my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1649 Retrieves circulation rule attributes that apply to the given
1650 branch and item type, regardless of patron category.
1652 The return value is a hashref containing the following keys:
1654 holdallowed => Hold policy for this branch and itemtype. Possible values:
1655 0: No holds allowed.
1656 1: Holds allowed only by patrons that have the same homebranch as the item.
1657 2: Holds allowed from any patron.
1659 returnbranch => branch to which to return item. Possible values:
1660 noreturn: do not return, let item remain where checked in (floating collections)
1661 homebranch: return to item's home branch
1662 holdingbranch: return to issuer branch
1664 This searches branchitemrules in the following order:
1666 * Same branchcode and itemtype
1667 * Same branchcode, itemtype '*'
1668 * branchcode '*', same itemtype
1669 * branchcode and itemtype '*'
1671 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1675 sub GetBranchItemRule {
1676 my ( $branchcode, $itemtype ) = @_;
1677 my $dbh = C4::Context->dbh();
1681 ['SELECT holdallowed, returnbranch
1682 FROM branch_item_rules
1683 WHERE branchcode = ?
1684 AND itemtype = ?', $branchcode, $itemtype],
1685 ['SELECT holdallowed, returnbranch
1686 FROM default_branch_circ_rules
1687 WHERE branchcode = ?', $branchcode],
1688 ['SELECT holdallowed, returnbranch
1689 FROM default_branch_item_rules
1690 WHERE itemtype = ?', $itemtype],
1691 ['SELECT holdallowed, returnbranch
1692 FROM default_circ_rules'],
1695 foreach my $attempt (@attempts) {
1696 my ($query, @bind_params) = @{$attempt};
1697 my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1700 # Since branch/category and branch/itemtype use the same per-branch
1701 # defaults tables, we have to check that the key we want is set, not
1702 # just that a row was returned
1703 $result->{'holdallowed'} = $search_result->{'holdallowed'} unless ( defined $result->{'holdallowed'} );
1704 $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1707 # built-in default circulation rule
1708 $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1709 $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1716 ($doreturn, $messages, $iteminformation, $borrower) =
1717 &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
1723 =item C<$barcode> is the bar code of the book being returned.
1725 =item C<$branch> is the code of the branch where the book is being returned.
1727 =item C<$exemptfine> indicates that overdue charges for the item will be
1730 =item C<$dropbox> indicates that the check-in date is assumed to be
1731 yesterday, or the last non-holiday as defined in C4::Calendar . If
1732 overdue charges are applied and C<$dropbox> is true, the last charge
1733 will be removed. This assumes that the fines accrual script has run
1734 for _today_. Optional.
1736 =item C<$return_date> allows the default return date to be overridden
1737 by the given return date. Optional.
1741 C<&AddReturn> returns a list of four items:
1743 C<$doreturn> is true iff the return succeeded.
1745 C<$messages> is a reference-to-hash giving feedback on the operation.
1746 The keys of the hash are:
1752 No item with this barcode exists. The value is C<$barcode>.
1756 The book is not currently on loan. The value is C<$barcode>.
1758 =item C<IsPermanent>
1760 The book's home branch is a permanent collection. If you have borrowed
1761 this book, you are not allowed to return it. The value is the code for
1762 the book's home branch.
1766 This book has been withdrawn/cancelled. The value should be ignored.
1768 =item C<Wrongbranch>
1770 This book has was returned to the wrong branch. The value is a hashref
1771 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1772 contain the branchcode of the incorrect and correct return library, respectively.
1776 The item was reserved. The value is a reference-to-hash whose keys are
1777 fields from the reserves table of the Koha database, and
1778 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1779 either C<Waiting>, C<Reserved>, or 0.
1781 =item C<WasReturned>
1783 Value 1 if return is successful.
1785 =item C<NeedsTransfer>
1787 If AutomaticItemReturn is disabled, return branch is given as value of NeedsTransfer.
1791 C<$iteminformation> is a reference-to-hash, giving information about the
1792 returned item from the issues table.
1794 C<$borrower> is a reference-to-hash, giving information about the
1795 patron who last borrowed the book.
1800 my ( $barcode, $branch, $exemptfine, $dropbox, $return_date, $dropboxdate ) = @_;
1802 if ($branch and not Koha::Libraries->find($branch)) {
1803 warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
1806 $branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
1811 my $validTransfert = 0;
1812 my $stat_type = 'return';
1814 # get information on item
1815 my $itemnumber = GetItemnumberFromBarcode( $barcode );
1816 unless ($itemnumber) {
1817 return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower. bail out.
1819 my $issue = GetItemIssue($itemnumber);
1820 if ($issue and $issue->{borrowernumber}) {
1821 $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1822 or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existent borrowernumber '$issue->{borrowernumber}'\n"
1823 . Dumper($issue) . "\n";
1825 $messages->{'NotIssued'} = $barcode;
1826 # even though item is not on loan, it may still be transferred; therefore, get current branch info
1828 # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later.
1829 # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1830 if (C4::Context->preference("RecordLocalUseOnReturn")) {
1831 $messages->{'LocalUse'} = 1;
1832 $stat_type = 'localuse';
1836 my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1838 if ( $item->{'location'} eq 'PROC' ) {
1839 if ( C4::Context->preference("InProcessingToShelvingCart") ) {
1840 $item->{'location'} = 'CART';
1843 $item->{location} = $item->{permanent_location};
1846 ModItem( $item, $item->{'biblionumber'}, $item->{'itemnumber'} );
1849 # full item data, but no borrowernumber or checkout info (no issue)
1850 # we know GetItem should work because GetItemnumberFromBarcode worked
1851 my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1852 # get the proper branch to which to return the item
1853 my $returnbranch = $item->{$hbr} || $branch ;
1854 # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1856 my $borrowernumber = $borrower->{'borrowernumber'} || undef; # we don't know if we had a borrower or not
1858 my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
1860 $yaml = "$yaml\n\n"; # YAML is anal on ending \n. Surplus does not hurt
1862 eval { $rules = YAML::Load($yaml); };
1864 warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
1867 foreach my $key ( keys %$rules ) {
1868 if ( $item->{notforloan} eq $key ) {
1869 $messages->{'NotForLoanStatusUpdated'} = { from => $item->{notforloan}, to => $rules->{$key} };
1870 ModItem( { notforloan => $rules->{$key} }, undef, $itemnumber );
1878 # check if the book is in a permanent collection....
1879 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1880 if ( $returnbranch ) {
1881 my $branches = GetBranches(); # a potentially expensive call for a non-feature.
1882 $branches->{$returnbranch}->{PE} and $messages->{'IsPermanent'} = $returnbranch;
1885 # check if the return is allowed at this branch
1886 my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
1887 unless ($returnallowed){
1888 $messages->{'Wrongbranch'} = {
1889 Wrongbranch => $branch,
1890 Rightbranch => $message
1893 return ( $doreturn, $messages, $issue, $borrower );
1896 if ( $item->{'withdrawn'} ) { # book has been cancelled
1897 $messages->{'withdrawn'} = 1;
1898 $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
1901 # case of a return of document (deal with issues and holdingbranch)
1902 my $today = DateTime->now( time_zone => C4::Context->tz() );
1905 my $datedue = $issue->{date_due};
1906 $borrower or warn "AddReturn without current borrower";
1907 my $circControlBranch;
1909 # define circControlBranch only if dropbox mode is set
1910 # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1911 # FIXME: check issuedate > returndate, factoring in holidays
1913 $circControlBranch = _GetCircControlBranch($item,$borrower);
1914 $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $dropboxdate ) == -1 ? 1 : 0;
1917 if ($borrowernumber) {
1918 if ( ( C4::Context->preference('CalculateFinesOnReturn') && $issue->{'overdue'} ) || $return_date ) {
1919 # we only need to calculate and change the fines if we want to do that on return
1920 # Should be on for hourly loans
1921 my $control = C4::Context->preference('CircControl');
1922 my $control_branchcode =
1923 ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
1924 : ( $control eq 'PatronLibrary' ) ? $borrower->{branchcode}
1925 : $issue->{branchcode};
1928 $return_date ? dt_from_string($return_date) : $today;
1930 my ( $amount, $type, $unitcounttotal ) =
1931 C4::Overdues::CalcFine( $item, $borrower->{categorycode},
1932 $control_branchcode, $datedue, $date_returned );
1936 if ( C4::Context->preference('finesMode') eq 'production' ) {
1937 if ( $amount > 0 ) {
1938 C4::Overdues::UpdateFine( $issue->{itemnumber},
1939 $issue->{borrowernumber},
1940 $amount, $type, output_pref($datedue) );
1942 elsif ($return_date) {
1944 # Backdated returns may have fines that shouldn't exist,
1945 # so in this case, we need to drop those fines to 0
1947 C4::Overdues::UpdateFine( $issue->{itemnumber},
1948 $issue->{borrowernumber},
1949 0, $type, output_pref($datedue) );
1955 MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
1956 $circControlBranch, $return_date, $borrower->{'privacy'} );
1959 $messages->{'Wrongbranch'} = {
1960 Wrongbranch => $branch,
1961 Rightbranch => $message
1964 return ( 0, { WasReturned => 0 }, $issue, $borrower );
1967 # FIXME is the "= 1" right? This could be the borrower hash.
1968 $messages->{'WasReturned'} = 1;
1972 ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1975 # the holdingbranch is updated if the document is returned to another location.
1976 # this is always done regardless of whether the item was on loan or not
1977 if ($item->{'holdingbranch'} ne $branch) {
1978 UpdateHoldingbranch($branch, $item->{'itemnumber'});
1979 $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1981 ModDateLastSeen( $item->{'itemnumber'} );
1983 # check if we have a transfer for this document
1984 my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1986 # if we have a transfer to do, we update the line of transfers with the datearrived
1987 my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->{'itemnumber'} );
1989 if ( $tobranch eq $branch ) {
1990 my $sth = C4::Context->dbh->prepare(
1991 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1993 $sth->execute( $item->{'itemnumber'} );
1994 # if we have a reservation with valid transfer, we can set it's status to 'W'
1995 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1996 C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1998 $messages->{'WrongTransfer'} = $tobranch;
1999 $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
2001 $validTransfert = 1;
2003 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
2006 # fix up the accounts.....
2007 if ( $item->{'itemlost'} ) {
2008 $messages->{'WasLost'} = 1;
2010 if ( C4::Context->preference('RefundLostItemFeeOnReturn' ) ) {
2011 _FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode); # can tolerate undef $borrowernumber
2012 $messages->{'LostItemFeeRefunded'} = 1;
2016 # fix up the overdues in accounts...
2017 if ($borrowernumber) {
2018 my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
2019 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
2021 if ( $issue->{overdue} && $issue->{date_due} ) {
2023 $today = $dropboxdate if $dropbox;
2024 my ($debardate,$reminder) = _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today );
2026 $messages->{'PrevDebarred'} = $debardate;
2028 $messages->{'Debarred'} = $debardate if $debardate;
2030 # there's no overdue on the item but borrower had been previously debarred
2031 } elsif ( $issue->{date_due} and $borrower->{'debarred'} ) {
2032 if ( $borrower->{debarred} eq "9999-12-31") {
2033 $messages->{'ForeverDebarred'} = $borrower->{'debarred'};
2035 my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
2036 $borrower_debar_dt->truncate(to => 'day');
2037 my $today_dt = $today->clone()->truncate(to => 'day');
2038 if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2039 $messages->{'PrevDebarred'} = $borrower->{'debarred'};
2045 # find reserves.....
2046 # if we don't have a reserve with the status W, we launch the Checkreserves routine
2047 my ($resfound, $resrec);
2048 my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2049 ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'}, undef, $lookahead ) unless ( $item->{'withdrawn'} );
2051 $resrec->{'ResFound'} = $resfound;
2052 $messages->{'ResFound'} = $resrec;
2055 # Record the fact that this book was returned.
2056 # FIXME itemtype should record item level type, not bibliolevel type
2060 itemnumber => $item->{'itemnumber'},
2061 itemtype => $biblio->{'itemtype'},
2062 borrowernumber => $borrowernumber,
2063 ccode => $item->{'ccode'}}
2066 # Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then.
2067 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2069 branchcode => $branch,
2070 categorycode => $borrower->{categorycode},
2071 item_type => $item->{itype},
2072 notification => 'CHECKIN',
2074 if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2075 SendCirculationAlert({
2078 borrower => $borrower,
2083 logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
2084 if C4::Context->preference("ReturnLog");
2086 # Remove any OVERDUES related debarment if the borrower has no overdues
2087 if ( $borrowernumber
2088 && $borrower->{'debarred'}
2089 && C4::Context->preference('AutoRemoveOverduesRestrictions')
2090 && !C4::Members::HasOverdues( $borrowernumber )
2091 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2093 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2096 # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2097 if (!$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) and not $messages->{'WrongTransfer'}){
2098 if (C4::Context->preference("AutomaticItemReturn" ) or
2099 (C4::Context->preference("UseBranchTransferLimits") and
2100 ! IsBranchTransferAllowed($branch, $returnbranch, $item->{C4::Context->preference("BranchTransferLimitsType")} )
2102 $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $returnbranch;
2103 $debug and warn "item: " . Dumper($item);
2104 ModItemTransfer($item->{'itemnumber'}, $branch, $returnbranch);
2105 $messages->{'WasTransfered'} = 1;
2107 $messages->{'NeedsTransfer'} = $returnbranch;
2111 return ( $doreturn, $messages, $issue, $borrower );
2114 =head2 MarkIssueReturned
2116 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
2118 Unconditionally marks an issue as being returned by
2119 moving the C<issues> row to C<old_issues> and
2120 setting C<returndate> to the current date, or
2121 the last non-holiday date of the branccode specified in
2122 C<dropbox_branch> . Assumes you've already checked that
2123 it's safe to do this, i.e. last non-holiday > issuedate.
2125 if C<$returndate> is specified (in iso format), it is used as the date
2126 of the return. It is ignored when a dropbox_branch is passed in.
2128 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2129 the old_issue is immediately anonymised
2131 Ideally, this function would be internal to C<C4::Circulation>,
2132 not exported, but it is currently needed by one
2133 routine in C<C4::Accounts>.
2137 sub MarkIssueReturned {
2138 my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
2140 my $anonymouspatron;
2141 if ( $privacy == 2 ) {
2142 # The default of 0 will not work due to foreign key constraints
2143 # The anonymisation will fail if AnonymousPatron is not a valid entry
2144 # We need to check if the anonymous patron exist, Koha will fail loudly if it does not
2145 # Note that a warning should appear on the about page (System information tab).
2146 $anonymouspatron = C4::Context->preference('AnonymousPatron');
2147 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."
2148 unless C4::Members::GetMember( borrowernumber => $anonymouspatron );
2150 my $dbh = C4::Context->dbh;
2151 my $query = 'UPDATE issues SET returndate=';
2153 if ($dropbox_branch) {
2154 my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
2155 my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
2157 push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2158 } elsif ($returndate) {
2160 push @bind, $returndate;
2162 $query .= ' now() ';
2164 $query .= ' WHERE borrowernumber = ? AND itemnumber = ?';
2165 push @bind, $borrowernumber, $itemnumber;
2167 my $sth_upd = $dbh->prepare($query);
2168 $sth_upd->execute(@bind);
2169 my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
2170 WHERE borrowernumber = ?
2171 AND itemnumber = ?');
2172 $sth_copy->execute($borrowernumber, $itemnumber);
2173 # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2174 if ( $privacy == 2) {
2175 my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
2176 WHERE borrowernumber = ?
2177 AND itemnumber = ?");
2178 $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
2180 my $sth_del = $dbh->prepare("DELETE FROM issues
2181 WHERE borrowernumber = ?
2182 AND itemnumber = ?");
2183 $sth_del->execute($borrowernumber, $itemnumber);
2185 ModItem( { 'onloan' => undef }, undef, $itemnumber );
2187 if ( C4::Context->preference('StoreLastBorrower') ) {
2188 my $item = Koha::Items->find( $itemnumber );
2189 my $patron = Koha::Borrowers->find( $borrowernumber );
2190 $item->last_returned_by( $patron );
2194 =head2 _debar_user_on_return
2196 _debar_user_on_return($borrower, $item, $datedue, today);
2198 C<$borrower> borrower hashref
2200 C<$item> item hashref
2202 C<$datedue> date due DateTime object
2204 C<$today> DateTime object representing the return time
2206 Internal function, called only by AddReturn that calculates and updates
2207 the user fine days, and debars him if necessary.
2209 Should only be called for overdue returns
2213 sub _debar_user_on_return {
2214 my ( $borrower, $item, $dt_due, $dt_today ) = @_;
2216 my $branchcode = _GetCircControlBranch( $item, $borrower );
2218 my $circcontrol = C4::Context->preference('CircControl');
2220 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2221 my $finedays = $issuingrule->{finedays};
2222 my $unit = $issuingrule->{lengthunit};
2223 my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $dt_today, $branchcode);
2227 # finedays is in days, so hourly loans must multiply by 24
2228 # thus 1 hour late equals 1 day suspension * finedays rate
2229 $finedays = $finedays * 24 if ( $unit eq 'hours' );
2231 # grace period is measured in the same units as the loan
2233 DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
2235 my $deltadays = DateTime::Duration->new(
2236 days => $chargeable_units
2238 if ( $deltadays->subtract($grace)->is_positive() ) {
2239 my $suspension_days = $deltadays * $finedays;
2241 # If the max suspension days is < than the suspension days
2242 # the suspension days is limited to this maximum period.
2243 my $max_sd = $issuingrule->{maxsuspensiondays};
2244 if ( defined $max_sd ) {
2245 $max_sd = DateTime::Duration->new( days => $max_sd );
2246 $suspension_days = $max_sd
2247 if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2251 $dt_today->clone()->add_duration( $suspension_days );
2253 Koha::Borrower::Debarments::AddUniqueDebarment({
2254 borrowernumber => $borrower->{borrowernumber},
2255 expiration => $new_debar_dt->ymd(),
2256 type => 'SUSPENSION',
2258 # if borrower was already debarred but does not get an extra debarment
2259 if ( $borrower->{debarred} eq Koha::Borrower::Debarments::IsDebarred($borrower->{borrowernumber}) ) {
2260 return ($borrower->{debarred},1);
2262 return $new_debar_dt->ymd();
2268 =head2 _FixOverduesOnReturn
2270 &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2272 C<$brn> borrowernumber
2276 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2277 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2279 Internal function, called only by AddReturn
2283 sub _FixOverduesOnReturn {
2284 my ($borrowernumber, $item);
2285 unless ($borrowernumber = shift) {
2286 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2289 unless ($item = shift) {
2290 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2293 my ($exemptfine, $dropbox) = @_;
2294 my $dbh = C4::Context->dbh;
2296 # check for overdue fine
2297 my $sth = $dbh->prepare(
2298 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
2300 $sth->execute( $borrowernumber, $item );
2302 # alter fine to show that the book has been returned
2303 my $data = $sth->fetchrow_hashref;
2304 return 0 unless $data; # no warning, there's just nothing to fix
2307 my @bind = ($data->{'accountlines_id'});
2309 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2310 if (C4::Context->preference("FinesLog")) {
2311 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2313 } elsif ($dropbox && $data->{lastincrement}) {
2314 my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2315 my $amt = $data->{amount} - $data->{lastincrement} ;
2316 if (C4::Context->preference("FinesLog")) {
2317 &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2319 $uquery = "update accountlines set accounttype='F' ";
2320 if($outstanding >= 0 && $amt >=0) {
2321 $uquery .= ", amount = ? , amountoutstanding=? ";
2322 unshift @bind, ($amt, $outstanding) ;
2325 $uquery = "update accountlines set accounttype='F' ";
2327 $uquery .= " where (accountlines_id = ?)";
2328 my $usth = $dbh->prepare($uquery);
2329 return $usth->execute(@bind);
2332 =head2 _FixAccountForLostAndReturned
2334 &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2336 Calculates the charge for a book lost and returned.
2338 Internal function, not exported, called only by AddReturn.
2340 FIXME: This function reflects how inscrutable fines logic is. Fix both.
2341 FIXME: Give a positive return value on success. It might be the $borrowernumber who received credit, or the amount forgiven.
2345 sub _FixAccountForLostAndReturned {
2346 my $itemnumber = shift or return;
2347 my $borrowernumber = @_ ? shift : undef;
2348 my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
2349 my $dbh = C4::Context->dbh;
2350 # check for charge made for lost book
2351 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2352 $sth->execute($itemnumber);
2353 my $data = $sth->fetchrow_hashref;
2354 $data or return; # bail if there is nothing to do
2355 $data->{accounttype} eq 'W' and return; # Written off
2357 # writeoff this amount
2359 my $amount = $data->{'amount'};
2360 my $acctno = $data->{'accountno'};
2361 my $amountleft; # Starts off undef/zero.
2362 if ($data->{'amountoutstanding'} == $amount) {
2363 $offset = $data->{'amount'};
2364 $amountleft = 0; # Hey, it's zero here, too.
2366 $offset = $amount - $data->{'amountoutstanding'}; # Um, isn't this the same as ZERO? We just tested those two things are ==
2367 $amountleft = $data->{'amountoutstanding'} - $amount; # Um, isn't this the same as ZERO? We just tested those two things are ==
2369 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2370 WHERE (accountlines_id = ?)");
2371 $usth->execute($data->{'accountlines_id'}); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in.
2372 #check if any credit is left if so writeoff other accounts
2373 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2374 $amountleft *= -1 if ($amountleft < 0);
2375 if ($amountleft > 0) {
2376 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2377 AND (amountoutstanding >0) ORDER BY date"); # might want to order by amountoustanding ASC (pay smallest first)
2378 $msth->execute($data->{'borrowernumber'});
2379 # offset transactions
2382 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2383 if ($accdata->{'amountoutstanding'} < $amountleft) {
2385 $amountleft -= $accdata->{'amountoutstanding'};
2387 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2390 my $thisacct = $accdata->{'accountlines_id'};
2391 # FIXME: move prepares outside while loop!
2392 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2393 WHERE (accountlines_id = ?)");
2394 $usth->execute($newamtos,$thisacct);
2395 $usth = $dbh->prepare("INSERT INTO accountoffsets
2396 (borrowernumber, accountno, offsetaccount, offsetamount)
2399 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2402 $amountleft *= -1 if ($amountleft > 0);
2403 my $desc = "Item Returned " . $item_id;
2404 $usth = $dbh->prepare("INSERT INTO accountlines
2405 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2406 VALUES (?,?,now(),?,?,'CR',?)");
2407 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2408 if ($borrowernumber) {
2409 # FIXME: same as query above. use 1 sth for both
2410 $usth = $dbh->prepare("INSERT INTO accountoffsets
2411 (borrowernumber, accountno, offsetaccount, offsetamount)
2413 $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2415 ModItem({ paidfor => '' }, undef, $itemnumber);
2419 =head2 _GetCircControlBranch
2421 my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2425 Return the library code to be used to determine which circulation
2426 policy applies to a transaction. Looks up the CircControl and
2427 HomeOrHoldingBranch system preferences.
2429 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2431 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2435 sub _GetCircControlBranch {
2436 my ($item, $borrower) = @_;
2437 my $circcontrol = C4::Context->preference('CircControl');
2440 if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2441 $branch= C4::Context->userenv->{'branch'};
2442 } elsif ($circcontrol eq 'PatronLibrary') {
2443 $branch=$borrower->{branchcode};
2445 my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2446 $branch = $item->{$branchfield};
2447 # default to item home branch if holdingbranch is used
2448 # and is not defined
2449 if (!defined($branch) && $branchfield eq 'holdingbranch') {
2450 $branch = $item->{homebranch};
2463 $issue = &GetItemIssue($itemnumber);
2465 Returns patron currently having a book, or undef if not checked out.
2467 C<$itemnumber> is the itemnumber.
2469 C<$issue> is a hashref of the row from the issues table.
2474 my ($itemnumber) = @_;
2475 return unless $itemnumber;
2476 my $sth = C4::Context->dbh->prepare(
2477 "SELECT items.*, issues.*
2479 LEFT JOIN items ON issues.itemnumber=items.itemnumber
2480 WHERE issues.itemnumber=?");
2481 $sth->execute($itemnumber);
2482 my $data = $sth->fetchrow_hashref;
2483 return unless $data;
2484 $data->{issuedate_sql} = $data->{issuedate};
2485 $data->{date_due_sql} = $data->{date_due};
2486 $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2487 $data->{issuedate}->truncate(to => 'minute');
2488 $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2489 $data->{date_due}->truncate(to => 'minute');
2490 my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2491 $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2497 $issue = GetOpenIssue( $itemnumber );
2499 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2501 C<$itemnumber> is the item's itemnumber
2508 my ( $itemnumber ) = @_;
2509 return unless $itemnumber;
2510 my $dbh = C4::Context->dbh;
2511 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2512 $sth->execute( $itemnumber );
2513 return $sth->fetchrow_hashref();
2519 $issues = GetIssues({}); # return all issues!
2520 $issues = GetIssues({ borrowernumber => $borrowernumber, biblionumber => $biblionumber });
2522 Returns all pending issues that match given criteria.
2523 Returns a arrayref or undef if an error occurs.
2525 Allowed criteria are:
2529 =item * borrowernumber
2531 =item * biblionumber
2540 my ($criteria) = @_;
2544 my @allowed = qw(borrowernumber biblionumber itemnumber);
2545 foreach (@allowed) {
2546 if (defined $criteria->{$_}) {
2549 value => $criteria->{$_},
2554 # Do we need to join other tables ?
2556 if (defined $criteria->{biblionumber}) {
2563 $where = "WHERE " . join(' AND ', map { "$_->{field} = ?" } @filters);
2569 if (defined $join{items}) {
2571 LEFT JOIN items ON (issues.itemnumber = items.itemnumber)
2577 my $dbh = C4::Context->dbh;
2578 my $sth = $dbh->prepare($query);
2579 my $rv = $sth->execute(map { $_->{value} } @filters);
2581 return $rv ? $sth->fetchall_arrayref({}) : undef;
2584 =head2 GetItemIssues
2586 $issues = &GetItemIssues($itemnumber, $history);
2588 Returns patrons that have issued a book
2590 C<$itemnumber> is the itemnumber
2591 C<$history> is false if you just want the current "issuer" (if any)
2592 and true if you want issues history from old_issues also.
2594 Returns reference to an array of hashes
2599 my ( $itemnumber, $history ) = @_;
2601 my $today = DateTime->now( time_zome => C4::Context->tz); # get today date
2602 $today->truncate( to => 'minute' );
2603 my $sql = "SELECT * FROM issues
2604 JOIN borrowers USING (borrowernumber)
2605 JOIN items USING (itemnumber)
2606 WHERE issues.itemnumber = ? ";
2609 SELECT * FROM old_issues
2610 LEFT JOIN borrowers USING (borrowernumber)
2611 JOIN items USING (itemnumber)
2612 WHERE old_issues.itemnumber = ? ";
2614 $sql .= "ORDER BY date_due DESC";
2615 my $sth = C4::Context->dbh->prepare($sql);
2617 $sth->execute($itemnumber, $itemnumber);
2619 $sth->execute($itemnumber);
2621 my $results = $sth->fetchall_arrayref({});
2622 foreach (@$results) {
2623 my $date_due = dt_from_string($_->{date_due},'sql');
2624 $date_due->truncate( to => 'minute' );
2626 $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2631 =head2 GetBiblioIssues
2633 $issues = GetBiblioIssues($biblionumber);
2635 this function get all issues from a biblionumber.
2638 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2639 tables issues and the firstname,surname & cardnumber from borrowers.
2643 sub GetBiblioIssues {
2644 my $biblionumber = shift;
2645 return unless $biblionumber;
2646 my $dbh = C4::Context->dbh;
2648 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2650 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2651 LEFT JOIN items ON issues.itemnumber = items.itemnumber
2652 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2653 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2654 WHERE biblio.biblionumber = ?
2656 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2658 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2659 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2660 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2661 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2662 WHERE biblio.biblionumber = ?
2665 my $sth = $dbh->prepare($query);
2666 $sth->execute($biblionumber, $biblionumber);
2669 while ( my $data = $sth->fetchrow_hashref ) {
2670 push @issues, $data;
2675 =head2 GetUpcomingDueIssues
2677 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2681 sub GetUpcomingDueIssues {
2684 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2685 my $dbh = C4::Context->dbh;
2687 my $statement = <<END_SQL;
2688 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2690 LEFT JOIN items USING (itemnumber)
2691 LEFT OUTER JOIN branches USING (branchcode)
2692 WHERE returndate is NULL
2693 HAVING days_until_due >= 0 AND days_until_due <= ?
2696 my @bind_parameters = ( $params->{'days_in_advance'} );
2698 my $sth = $dbh->prepare( $statement );
2699 $sth->execute( @bind_parameters );
2700 my $upcoming_dues = $sth->fetchall_arrayref({});
2702 return $upcoming_dues;
2705 =head2 CanBookBeRenewed
2707 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2709 Find out whether a borrowed item may be renewed.
2711 C<$borrowernumber> is the borrower number of the patron who currently
2712 has the item on loan.
2714 C<$itemnumber> is the number of the item to renew.
2716 C<$override_limit>, if supplied with a true value, causes
2717 the limit on the number of times that the loan can be renewed
2718 (as controlled by the item type) to be ignored. Overriding also allows
2719 to renew sooner than "No renewal before" and to manually renew loans
2720 that are automatically renewed.
2722 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2723 item must currently be on loan to the specified borrower; renewals
2724 must be allowed for the item's type; and the borrower must not have
2725 already renewed the loan. $error will contain the reason the renewal can not proceed
2729 sub CanBookBeRenewed {
2730 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2732 my $dbh = C4::Context->dbh;
2735 my $item = GetItem($itemnumber) or return ( 0, 'no_item' );
2736 my $itemissue = GetItemIssue($itemnumber) or return ( 0, 'no_checkout' );
2737 return ( 0, 'onsite_checkout' ) if $itemissue->{onsite_checkout};
2739 $borrowernumber ||= $itemissue->{borrowernumber};
2740 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
2743 my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2745 # This item can fill one or more unfilled reserve, can those unfilled reserves
2746 # all be filled by other available items?
2748 && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2750 my $schema = Koha::Database->new()->schema();
2752 my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2754 # There is an item level hold on this item, no other item can fill the hold
2759 # Get all other items that could possibly fill reserves
2760 my @itemnumbers = $schema->resultset('Item')->search(
2762 biblionumber => $resrec->{biblionumber},
2765 -not => { itemnumber => $itemnumber }
2767 { columns => 'itemnumber' }
2768 )->get_column('itemnumber')->all();
2770 # Get all other reserves that could have been filled by this item
2771 my @borrowernumbers;
2773 my ( $reserve_found, $reserve, undef ) =
2774 C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2776 if ($reserve_found) {
2777 push( @borrowernumbers, $reserve->{borrowernumber} );
2784 # If the count of the union of the lists of reservable items for each borrower
2785 # is equal or greater than the number of borrowers, we know that all reserves
2786 # can be filled with available items. We can get the union of the sets simply
2787 # by pushing all the elements onto an array and removing the duplicates.
2789 foreach my $b (@borrowernumbers) {
2790 my ($borr) = C4::Members::GetMemberDetails($b);
2791 foreach my $i (@itemnumbers) {
2792 my $item = GetItem($i);
2793 if ( IsAvailableForItemLevelRequest( $item, $borr )
2794 && CanItemBeReserved( $b, $i )
2795 && !IsItemOnHoldAndFound($i) )
2797 push( @reservable, $i );
2802 @reservable = uniq(@reservable);
2804 if ( @reservable >= @borrowernumbers ) {
2809 return ( 0, "on_reserve" ) if $resfound; # '' when no hold was found
2811 return ( 1, undef ) if $override_limit;
2813 my $branchcode = _GetCircControlBranch( $item, $borrower );
2815 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2817 return ( 0, "too_many" )
2818 if $issuingrule->{renewalsallowed} <= $itemissue->{renewals};
2820 my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2821 my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2822 my $restricted = Koha::Borrower::Debarments::IsDebarred($borrowernumber);
2823 my $hasoverdues = C4::Members::HasOverdues($borrowernumber);
2825 if ( $restricted and $restrictionblockrenewing ) {
2826 return ( 0, 'restriction');
2827 } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($itemissue->{overdue} and $overduesblockrenewing eq 'blockitem') ) {
2828 return ( 0, 'overdue');
2831 if ( defined $issuingrule->{norenewalbefore}
2832 and $issuingrule->{norenewalbefore} ne "" )
2835 # Get current time and add norenewalbefore.
2836 # If this is smaller than date_due, it's too soon for renewal.
2837 my $now = dt_from_string;
2840 $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore}
2841 ) < $itemissue->{date_due}
2844 return ( 0, "auto_too_soon" ) if $itemissue->{auto_renew};
2845 return ( 0, "too_soon" );
2847 elsif ( $itemissue->{auto_renew} ) {
2848 return ( 0, "auto_renew" );
2852 # Fallback for automatic renewals:
2853 # If norenewalbefore is undef, don't renew before due date.
2854 elsif ( $itemissue->{auto_renew} ) {
2855 my $now = dt_from_string;
2856 return ( 0, "auto_renew" )
2857 if $now >= $itemissue->{date_due};
2858 return ( 0, "auto_too_soon" );
2861 return ( 1, undef );
2866 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2870 C<$borrowernumber> is the borrower number of the patron who currently
2873 C<$itemnumber> is the number of the item to renew.
2875 C<$branch> is the library where the renewal took place (if any).
2876 The library that controls the circ policies for the renewal is retrieved from the issues record.
2878 C<$datedue> can be a DateTime object used to set the due date.
2880 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
2881 this parameter is not supplied, lastreneweddate is set to the current date.
2883 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2884 from the book's item type.
2889 my $borrowernumber = shift;
2890 my $itemnumber = shift or return;
2892 my $datedue = shift;
2893 my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2895 my $item = GetItem($itemnumber) or return;
2896 my $biblio = GetBiblioFromItemNumber($itemnumber) or return;
2898 my $dbh = C4::Context->dbh;
2900 # Find the issues record for this book
2902 $dbh->prepare("SELECT * FROM issues WHERE itemnumber = ?");
2903 $sth->execute( $itemnumber );
2904 my $issuedata = $sth->fetchrow_hashref;
2906 return unless ( $issuedata );
2908 $borrowernumber ||= $issuedata->{borrowernumber};
2910 if ( defined $datedue && ref $datedue ne 'DateTime' ) {
2911 carp 'Invalid date passed to AddRenewal.';
2915 # If the due date wasn't specified, calculate it by adding the
2916 # book's loan length to today's date or the current due date
2917 # based on the value of the RenewalPeriodBase syspref.
2920 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return;
2921 my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2923 $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2924 dt_from_string( $issuedata->{date_due} ) :
2925 DateTime->now( time_zone => C4::Context->tz());
2926 $datedue = CalcDateDue($datedue, $itemtype, $issuedata->{'branchcode'}, $borrower, 'is a renewal');
2929 # Update the issues record to have the new due date, and a new count
2930 # of how many times it has been renewed.
2931 my $renews = $issuedata->{'renewals'} + 1;
2932 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2933 WHERE borrowernumber=?
2937 $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2939 # Update the renewal count on the item, and tell zebra to reindex
2940 $renews = $biblio->{'renewals'} + 1;
2941 ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
2943 # Charge a new rental fee, if applicable?
2944 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2945 if ( $charge > 0 ) {
2946 my $accountno = getnextacctno( $borrowernumber );
2947 my $item = GetBiblioFromItemNumber($itemnumber);
2949 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2950 $sth = $dbh->prepare(
2951 "INSERT INTO accountlines
2952 (date, borrowernumber, accountno, amount, manager_id,
2953 description,accounttype, amountoutstanding, itemnumber)
2954 VALUES (now(),?,?,?,?,?,?,?,?)"
2956 $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2957 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2958 'Rent', $charge, $itemnumber );
2961 # Send a renewal slip according to checkout alert preferencei
2962 if ( C4::Context->preference('RenewalSendNotice') eq '1') {
2963 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
2964 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2966 branchcode => $branch,
2967 categorycode => $borrower->{categorycode},
2968 item_type => $item->{itype},
2969 notification => 'CHECKOUT',
2971 if ($circulation_alert->is_enabled_for(\%conditions)) {
2972 SendCirculationAlert({
2975 borrower => $borrower,
2981 # Remove any OVERDUES related debarment if the borrower has no overdues
2982 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
2983 if ( $borrowernumber
2984 && $borrower->{'debarred'}
2985 && !C4::Members::HasOverdues( $borrowernumber )
2986 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2988 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2992 UpdateStats({branch => $branch,
2995 itemnumber => $itemnumber,
2996 itemtype => $item->{itype},
2997 borrowernumber => $borrowernumber,
2998 ccode => $item->{'ccode'}}
3004 # check renewal status
3005 my ( $bornum, $itemno ) = @_;
3006 my $dbh = C4::Context->dbh;
3008 my $renewsallowed = 0;
3011 my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
3012 my $item = GetItem($itemno);
3014 # Look in the issues table for this item, lent to this borrower,
3015 # and not yet returned.
3017 # FIXME - I think this function could be redone to use only one SQL call.
3018 my $sth = $dbh->prepare(
3019 "select * from issues
3020 where (borrowernumber = ?)
3021 and (itemnumber = ?)"
3023 $sth->execute( $bornum, $itemno );
3024 my $data = $sth->fetchrow_hashref;
3025 $renewcount = $data->{'renewals'} if $data->{'renewals'};
3026 # $item and $borrower should be calculated
3027 my $branchcode = _GetCircControlBranch($item, $borrower);
3029 my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
3031 $renewsallowed = $issuingrule->{'renewalsallowed'};
3032 $renewsleft = $renewsallowed - $renewcount;
3033 if($renewsleft < 0){ $renewsleft = 0; }
3034 return ( $renewcount, $renewsallowed, $renewsleft );
3037 =head2 GetSoonestRenewDate
3039 $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
3041 Find out the soonest possible renew date of a borrowed item.
3043 C<$borrowernumber> is the borrower number of the patron who currently
3044 has the item on loan.
3046 C<$itemnumber> is the number of the item to renew.
3048 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3049 renew date, based on the value "No renewal before" of the applicable
3050 issuing rule. Returns the current date if the item can already be
3051 renewed, and returns undefined if the borrower, loan, or item
3056 sub GetSoonestRenewDate {
3057 my ( $borrowernumber, $itemnumber ) = @_;
3059 my $dbh = C4::Context->dbh;
3061 my $item = GetItem($itemnumber) or return;
3062 my $itemissue = GetItemIssue($itemnumber) or return;
3064 $borrowernumber ||= $itemissue->{borrowernumber};
3065 my $borrower = C4::Members::GetMemberDetails($borrowernumber)
3068 my $branchcode = _GetCircControlBranch( $item, $borrower );
3070 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
3072 my $now = dt_from_string;
3074 if ( defined $issuingrule->{norenewalbefore}
3075 and $issuingrule->{norenewalbefore} ne "" )
3077 my $soonestrenewal =
3078 $itemissue->{date_due}->subtract(
3079 $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
3081 $soonestrenewal = $now > $soonestrenewal ? $now : $soonestrenewal;
3082 return $soonestrenewal;
3087 =head2 GetIssuingCharges
3089 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3091 Calculate how much it would cost for a given patron to borrow a given
3092 item, including any applicable discounts.
3094 C<$itemnumber> is the item number of item the patron wishes to borrow.
3096 C<$borrowernumber> is the patron's borrower number.
3098 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3099 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3104 sub GetIssuingCharges {
3106 # calculate charges due
3107 my ( $itemnumber, $borrowernumber ) = @_;
3109 my $dbh = C4::Context->dbh;
3112 # Get the book's item type and rental charge (via its biblioitem).
3113 my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3114 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3115 $charge_query .= (C4::Context->preference('item-level_itypes'))
3116 ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3117 : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3119 $charge_query .= ' WHERE items.itemnumber =?';
3121 my $sth = $dbh->prepare($charge_query);
3122 $sth->execute($itemnumber);
3123 if ( my $item_data = $sth->fetchrow_hashref ) {
3124 $item_type = $item_data->{itemtype};
3125 $charge = $item_data->{rentalcharge};
3126 my $branch = C4::Branch::mybranch();
3127 my $discount_query = q|SELECT rentaldiscount,
3128 issuingrules.itemtype, issuingrules.branchcode
3130 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3131 WHERE borrowers.borrowernumber = ?
3132 AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3133 AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3134 my $discount_sth = $dbh->prepare($discount_query);
3135 $discount_sth->execute( $borrowernumber, $item_type, $branch );
3136 my $discount_rules = $discount_sth->fetchall_arrayref({});
3137 if (@{$discount_rules}) {
3138 # We may have multiple rules so get the most specific
3139 my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3140 $charge = ( $charge * ( 100 - $discount ) ) / 100;
3144 return ( $charge, $item_type );
3147 # Select most appropriate discount rule from those returned
3148 sub _get_discount_from_rule {
3149 my ($rules_ref, $branch, $itemtype) = @_;
3152 if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3153 $discount = $rules_ref->[0]->{rentaldiscount};
3154 return (defined $discount) ? $discount : 0;
3156 # could have up to 4 does one match $branch and $itemtype
3157 my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3159 $discount = $d[0]->{rentaldiscount};
3160 return (defined $discount) ? $discount : 0;
3162 # do we have item type + all branches
3163 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3165 $discount = $d[0]->{rentaldiscount};
3166 return (defined $discount) ? $discount : 0;
3168 # do we all item types + this branch
3169 @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3171 $discount = $d[0]->{rentaldiscount};
3172 return (defined $discount) ? $discount : 0;
3174 # so all and all (surely we wont get here)
3175 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3177 $discount = $d[0]->{rentaldiscount};
3178 return (defined $discount) ? $discount : 0;
3184 =head2 AddIssuingCharge
3186 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3190 sub AddIssuingCharge {
3191 my ( $itemnumber, $borrowernumber, $charge ) = @_;
3192 my $dbh = C4::Context->dbh;
3193 my $nextaccntno = getnextacctno( $borrowernumber );
3195 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3197 INSERT INTO accountlines
3198 (borrowernumber, itemnumber, accountno,
3199 date, amount, description, accounttype,
3200 amountoutstanding, manager_id)
3201 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
3203 my $sth = $dbh->prepare($query);
3204 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
3209 GetTransfers($itemnumber);
3214 my ($itemnumber) = @_;
3216 my $dbh = C4::Context->dbh;
3222 FROM branchtransfers
3223 WHERE itemnumber = ?
3224 AND datearrived IS NULL
3226 my $sth = $dbh->prepare($query);
3227 $sth->execute($itemnumber);
3228 my @row = $sth->fetchrow_array();
3232 =head2 GetTransfersFromTo
3234 @results = GetTransfersFromTo($frombranch,$tobranch);
3236 Returns the list of pending transfers between $from and $to branch
3240 sub GetTransfersFromTo {
3241 my ( $frombranch, $tobranch ) = @_;
3242 return unless ( $frombranch && $tobranch );
3243 my $dbh = C4::Context->dbh;
3245 SELECT itemnumber,datesent,frombranch
3246 FROM branchtransfers
3249 AND datearrived IS NULL
3251 my $sth = $dbh->prepare($query);
3252 $sth->execute( $frombranch, $tobranch );
3255 while ( my $data = $sth->fetchrow_hashref ) {
3256 push @gettransfers, $data;
3258 return (@gettransfers);
3261 =head2 DeleteTransfer
3263 &DeleteTransfer($itemnumber);
3267 sub DeleteTransfer {
3268 my ($itemnumber) = @_;
3269 return unless $itemnumber;
3270 my $dbh = C4::Context->dbh;
3271 my $sth = $dbh->prepare(
3272 "DELETE FROM branchtransfers
3274 AND datearrived IS NULL "
3276 return $sth->execute($itemnumber);
3279 =head2 AnonymiseIssueHistory
3281 ($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)
3283 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
3284 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
3286 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
3287 setting (force delete).
3289 return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.
3293 sub AnonymiseIssueHistory {
3295 my $borrowernumber = shift;
3296 my $dbh = C4::Context->dbh;
3299 SET borrowernumber = ?
3300 WHERE returndate < ?
3301 AND borrowernumber IS NOT NULL
3304 # The default of 0 does not work due to foreign key constraints
3305 # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
3306 # Set it to undef (NULL)
3307 my $anonymouspatron = C4::Context->preference('AnonymousPatron') || undef;
3308 my @bind_params = ($anonymouspatron, $date);
3309 if (defined $borrowernumber) {
3310 $query .= " AND borrowernumber = ?";
3311 push @bind_params, $borrowernumber;
3313 $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
3315 my $sth = $dbh->prepare($query);
3316 $sth->execute(@bind_params);
3317 my $anonymisation_err = $dbh->err;
3318 my $rows_affected = $sth->rows; ### doublecheck row count return function
3319 return ($rows_affected, $anonymisation_err);
3322 =head2 SendCirculationAlert
3324 Send out a C<check-in> or C<checkout> alert using the messaging system.
3332 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3336 Hashref of information about the item being checked in or out.
3340 Hashref of information about the borrower of the item.
3344 The branchcode from where the checkout or check-in took place.
3350 SendCirculationAlert({
3353 borrower => $borrower,
3359 sub SendCirculationAlert {
3361 my ($type, $item, $borrower, $branch) =
3362 ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3363 my %message_name = (
3364 CHECKIN => 'Item_Check_in',
3365 CHECKOUT => 'Item_Checkout',
3366 RENEWAL => 'Item_Checkout',
3368 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3369 borrowernumber => $borrower->{borrowernumber},
3370 message_name => $message_name{$type},
3372 my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3374 my @transports = keys %{ $borrower_preferences->{transports} };
3375 # warn "no transports" unless @transports;
3377 # warn "transport: $_";
3378 my $message = C4::Message->find_last_message($borrower, $type, $_);
3380 #warn "create new message";
3381 my $letter = C4::Letters::GetPreparedLetter (
3382 module => 'circulation',
3383 letter_code => $type,
3384 branchcode => $branch,
3385 message_transport_type => $_,
3387 $issues_table => $item->{itemnumber},
3388 'items' => $item->{itemnumber},
3389 'biblio' => $item->{biblionumber},
3390 'biblioitems' => $item->{biblionumber},
3391 'borrowers' => $borrower,
3392 'branches' => $branch,
3395 C4::Message->enqueue($letter, $borrower, $_);
3397 #warn "append to old message";
3398 my $letter = C4::Letters::GetPreparedLetter (
3399 module => 'circulation',
3400 letter_code => $type,
3401 branchcode => $branch,
3402 message_transport_type => $_,
3404 $issues_table => $item->{itemnumber},
3405 'items' => $item->{itemnumber},
3406 'biblio' => $item->{biblionumber},
3407 'biblioitems' => $item->{biblionumber},
3408 'borrowers' => $borrower,
3409 'branches' => $branch,
3412 $message->append($letter);
3420 =head2 updateWrongTransfer
3422 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3424 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
3428 sub updateWrongTransfer {
3429 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3430 my $dbh = C4::Context->dbh;
3431 # first step validate the actual line of transfert .
3434 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3436 $sth->execute($FromLibrary,$itemNumber);
3438 # second step create a new line of branchtransfer to the right location .
3439 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3441 #third step changing holdingbranch of item
3442 UpdateHoldingbranch($FromLibrary,$itemNumber);
3445 =head2 UpdateHoldingbranch
3447 $items = UpdateHoldingbranch($branch,$itmenumber);
3449 Simple methode for updating hodlingbranch in items BDD line
3453 sub UpdateHoldingbranch {
3454 my ( $branch,$itemnumber ) = @_;
3455 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3460 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3462 this function calculates the due date given the start date and configured circulation rules,
3463 checking against the holidays calendar as per the 'useDaysMode' syspref.
3464 C<$startdate> = DateTime object representing start date of loan period (assumed to be today)
3465 C<$itemtype> = itemtype code of item in question
3466 C<$branch> = location whose calendar to use
3467 C<$borrower> = Borrower object
3468 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3473 my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3477 # loanlength now a href
3479 GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3481 my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3487 if (ref $startdate ne 'DateTime' ) {
3488 $datedue = dt_from_string($datedue);
3490 $datedue = $startdate->clone;
3494 DateTime->now( time_zone => C4::Context->tz() )
3495 ->truncate( to => 'minute' );
3499 # calculate the datedue as normal
3500 if ( C4::Context->preference('useDaysMode') eq 'Days' )
3501 { # ignoring calendar
3502 if ( $loanlength->{lengthunit} eq 'hours' ) {
3503 $datedue->add( hours => $loanlength->{$length_key} );
3505 $datedue->add( days => $loanlength->{$length_key} );
3506 $datedue->set_hour(23);
3507 $datedue->set_minute(59);
3511 if ($loanlength->{lengthunit} eq 'hours') {
3512 $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3515 $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3517 my $calendar = Koha::Calendar->new( branchcode => $branch );
3518 $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3519 if ($loanlength->{lengthunit} eq 'days') {
3520 $datedue->set_hour(23);
3521 $datedue->set_minute(59);
3525 # if Hard Due Dates are used, retrieve them and apply as necessary
3526 my ( $hardduedate, $hardduedatecompare ) =
3527 GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3528 if ($hardduedate) { # hardduedates are currently dates
3529 $hardduedate->truncate( to => 'minute' );
3530 $hardduedate->set_hour(23);
3531 $hardduedate->set_minute(59);
3532 my $cmp = DateTime->compare( $hardduedate, $datedue );
3534 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3535 # if the calculated date is before the 'after' Hard Due Date (floor), override
3536 # if the hard due date is set to 'exactly', overrride
3537 if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3538 $datedue = $hardduedate->clone;
3541 # in all other cases, keep the date due as it is
3545 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3546 if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3547 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3548 if( $expiry_dt ) { #skip empty expiry date..
3549 $expiry_dt->set( hour => 23, minute => 59);
3550 my $d1= $datedue->clone->set_time_zone('floating');
3551 if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3552 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3561 sub CheckValidBarcode{
3563 my $dbh = C4::Context->dbh;
3564 my $query=qq|SELECT count(*)
3568 my $sth = $dbh->prepare($query);
3569 $sth->execute($barcode);
3570 my $exist=$sth->fetchrow ;
3574 =head2 IsBranchTransferAllowed
3576 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3578 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3582 sub IsBranchTransferAllowed {
3583 my ( $toBranch, $fromBranch, $code ) = @_;
3585 if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3587 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3588 my $dbh = C4::Context->dbh;
3590 my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3591 $sth->execute( $toBranch, $fromBranch, $code );
3592 my $limit = $sth->fetchrow_hashref();
3594 ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3595 if ( $limit->{'limitId'} ) {
3602 =head2 CreateBranchTransferLimit
3604 CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3606 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3610 sub CreateBranchTransferLimit {
3611 my ( $toBranch, $fromBranch, $code ) = @_;
3612 return unless defined($toBranch) && defined($fromBranch);
3613 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3615 my $dbh = C4::Context->dbh;
3617 my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3618 return $sth->execute( $code, $toBranch, $fromBranch );
3621 =head2 DeleteBranchTransferLimits
3623 my $result = DeleteBranchTransferLimits($frombranch);
3625 Deletes all the library transfer limits for one library. Returns the
3626 number of limits deleted, 0e0 if no limits were deleted, or undef if
3627 no arguments are supplied.
3631 sub DeleteBranchTransferLimits {
3633 return unless defined $branch;
3634 my $dbh = C4::Context->dbh;
3635 my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3636 return $sth->execute($branch);
3640 my ( $borrowernumber, $itemnum ) = @_;
3642 MarkIssueReturned( $borrowernumber, $itemnum );
3643 my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3644 my $item = C4::Items::GetItem( $itemnum );
3645 my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3646 my @datearr = localtime(time);
3647 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3648 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3649 ModItem({ paidfor => $old_note."Paid for by $bor $date" }, undef, $itemnum);
3654 my ($itemnumber, $mark_returned) = @_;
3656 my $dbh = C4::Context->dbh();
3657 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3659 JOIN items USING (itemnumber)
3660 JOIN biblio USING (biblionumber)
3661 WHERE issues.itemnumber=?");
3662 $sth->execute($itemnumber);
3663 my $issues=$sth->fetchrow_hashref();
3665 # If a borrower lost the item, add a replacement cost to the their record
3666 if ( my $borrowernumber = $issues->{borrowernumber} ){
3667 my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3669 if (C4::Context->preference('WhenLostForgiveFine')){
3670 my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3671 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!"; # zero is OK, check defined
3673 if (C4::Context->preference('WhenLostChargeReplacementFee')){
3674 C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3675 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3676 #warn " $issues->{'borrowernumber'} / $itemnumber ";
3679 MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3683 sub GetOfflineOperations {
3684 my $dbh = C4::Context->dbh;
3685 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3686 $sth->execute(C4::Context->userenv->{'branch'});
3687 my $results = $sth->fetchall_arrayref({});
3691 sub GetOfflineOperation {
3692 my $operationid = shift;
3693 return unless $operationid;
3694 my $dbh = C4::Context->dbh;
3695 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3696 $sth->execute( $operationid );
3697 return $sth->fetchrow_hashref;
3700 sub AddOfflineOperation {
3701 my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3702 my $dbh = C4::Context->dbh;
3703 my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3704 $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3708 sub DeleteOfflineOperation {
3709 my $dbh = C4::Context->dbh;
3710 my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3711 $sth->execute( shift );
3715 sub ProcessOfflineOperation {
3716 my $operation = shift;
3719 if ( $operation->{action} eq 'return' ) {
3720 $report = ProcessOfflineReturn( $operation );
3721 } elsif ( $operation->{action} eq 'issue' ) {
3722 $report = ProcessOfflineIssue( $operation );
3723 } elsif ( $operation->{action} eq 'payment' ) {
3724 $report = ProcessOfflinePayment( $operation );
3727 DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3732 sub ProcessOfflineReturn {
3733 my $operation = shift;
3735 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3737 if ( $itemnumber ) {
3738 my $issue = GetOpenIssue( $itemnumber );
3741 $issue->{borrowernumber},
3744 $operation->{timestamp},
3747 { renewals => 0, onloan => undef },
3748 $issue->{'biblionumber'},
3753 return "Item not issued.";
3756 return "Item not found.";
3760 sub ProcessOfflineIssue {
3761 my $operation = shift;
3763 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3765 if ( $borrower->{borrowernumber} ) {
3766 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3767 unless ($itemnumber) {
3768 return "Barcode not found.";
3770 my $issue = GetOpenIssue( $itemnumber );
3772 if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3774 $issue->{borrowernumber},
3777 $operation->{timestamp},
3782 $operation->{'barcode'},
3785 $operation->{timestamp},
3790 return "Borrower not found.";
3794 sub ProcessOfflinePayment {
3795 my $operation = shift;
3797 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3798 my $amount = $operation->{amount};
3800 recordpayment( $borrower->{borrowernumber}, $amount );
3808 TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3810 Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3815 my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3817 my $item = GetItem( $itemnumber, $barcode )
3820 return C4::Letters::GetPreparedLetter (
3821 module => 'circulation',
3822 letter_code => 'TRANSFERSLIP',
3823 branchcode => $branch,
3825 'branches' => $to_branch,
3826 'biblio' => $item->{biblionumber},
3832 =head2 CheckIfIssuedToPatron
3834 CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3836 Return 1 if any record item is issued to patron, otherwise return 0
3840 sub CheckIfIssuedToPatron {
3841 my ($borrowernumber, $biblionumber) = @_;
3843 my $dbh = C4::Context->dbh;
3845 SELECT COUNT(*) FROM issues
3846 LEFT JOIN items ON items.itemnumber = issues.itemnumber
3847 WHERE items.biblionumber = ?
3848 AND issues.borrowernumber = ?
3850 my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
3851 return 1 if $is_issued;
3857 IsItemIssued( $itemnumber )
3859 Return 1 if the item is on loan, otherwise return 0
3864 my $itemnumber = shift;
3865 my $dbh = C4::Context->dbh;
3866 my $sth = $dbh->prepare(q{
3869 WHERE itemnumber = ?
3871 $sth->execute($itemnumber);
3872 return $sth->fetchrow;
3875 =head2 GetAgeRestriction
3877 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3878 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3880 if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }
3881 if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3883 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3884 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3885 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3886 Negative days mean the borrower has gone past the age restriction age.
3890 sub GetAgeRestriction {
3891 my ($record_restrictions, $borrower) = @_;
3892 my $markers = C4::Context->preference('AgeRestrictionMarker');
3894 # Split $record_restrictions to something like FSK 16 or PEGI 6
3895 my @values = split ' ', uc($record_restrictions);
3896 return unless @values;
3898 # Search first occurrence of one of the markers
3899 my @markers = split /\|/, uc($markers);
3900 return unless @markers;
3903 my $restriction_year = 0;
3904 for my $value (@values) {
3906 for my $marker (@markers) {
3907 $marker =~ s/^\s+//; #remove leading spaces
3908 $marker =~ s/\s+$//; #remove trailing spaces
3909 if ( $marker eq $value ) {
3910 if ( $index <= $#values ) {
3911 $restriction_year += $values[$index];
3915 elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
3917 # Perhaps it is something like "K16" (as in Finland)
3918 $restriction_year += $1;
3922 last if ( $restriction_year > 0 );
3925 #Check if the borrower is age restricted for this material and for how long.
3926 if ($restriction_year && $borrower) {
3927 if ( $borrower->{'dateofbirth'} ) {
3928 my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3929 $alloweddate[0] += $restriction_year;
3931 #Prevent runime eror on leap year (invalid date)
3932 if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3933 $alloweddate[2] = 28;
3936 #Get how many days the borrower has to reach the age restriction
3937 my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(Today);
3938 #Negative days means the borrower went past the age restriction age
3939 return ($restriction_year, $daysToAgeRestriction);
3943 return ($restriction_year);
3947 =head2 GetPendingOnSiteCheckouts
3951 sub GetPendingOnSiteCheckouts {
3952 my $dbh = C4::Context->dbh;
3953 return $dbh->selectall_arrayref(q|
3959 items.itemcallnumber,
3963 issues.date_due < NOW() AS is_overdue,
3966 borrowers.firstname,
3968 borrowers.cardnumber,
3969 borrowers.borrowernumber
3971 LEFT JOIN issues ON items.itemnumber = issues.itemnumber
3972 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
3973 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
3974 WHERE issues.onsite_checkout = 1
3975 |, { Slice => {} } );
3981 my ($count, $branch, $itemtype, $ccode, $newness)
3982 = @$params{qw(count branch itemtype ccode newness)};
3984 my $dbh = C4::Context->dbh;
3986 SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
3987 bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
3988 i.ccode, SUM(i.issues) AS count
3990 LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
3991 LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
3994 my (@where_strs, @where_args);
3997 push @where_strs, 'i.homebranch = ?';
3998 push @where_args, $branch;
4001 if (C4::Context->preference('item-level_itypes')){
4002 push @where_strs, 'i.itype = ?';
4003 push @where_args, $itemtype;
4005 push @where_strs, 'bi.itemtype = ?';
4006 push @where_args, $itemtype;
4010 push @where_strs, 'i.ccode = ?';
4011 push @where_args, $ccode;
4014 push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4015 push @where_args, $newness;
4019 $query .= 'WHERE ' . join(' AND ', @where_strs);
4023 GROUP BY b.biblionumber
4028 $count = int($count);
4030 $query .= "LIMIT $count";
4033 my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4043 Koha Development Team <http://koha-community.org/>