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 under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
23 #use warnings; FIXME - Bug 2505
32 use C4::Dates qw(format_date);
34 use C4::ItemCirculationAlertPreference;
37 use C4::Branch; # GetBranches
38 use C4::Log; # logaction
40 GetAuthorisedValueByCode
42 GetKohaAuthorisedValueLib
44 use C4::Overdues qw(CalcFine UpdateFine get_chargeable_units);
45 use C4::RotatingCollections qw(GetCollectionItemBranches);
46 use Algorithm::CheckDigits;
51 use Koha::Borrower::Debarments;
54 use List::MoreUtils qw( uniq );
64 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
68 $VERSION = 3.07.00.049; # for version checking
71 # FIXME subs that should probably be elsewhere
76 &GetPendingOnSiteCheckouts
79 # subs to deal with issuing a book
91 &GetBranchBorrowerCircRule
95 &AnonymiseIssueHistory
96 &CheckIfIssuedToPatron
100 # subs to deal with returns
106 # subs to deal with transfers
113 &IsBranchTransferAllowed
114 &CreateBranchTransferLimit
115 &DeleteBranchTransferLimits
119 # subs to deal with offline circulation
121 &GetOfflineOperations
124 &DeleteOfflineOperation
125 &ProcessOfflineOperation
131 C4::Circulation - Koha circulation module
139 The functions in this module deal with circulation, issues, and
140 returns, as well as general information about the library.
141 Also deals with stocktaking.
147 $str = &barcodedecode($barcode, [$filter]);
149 Generic filter function for barcode string.
150 Called on every circ if the System Pref itemBarcodeInputFilter is set.
151 Will do some manipulation of the barcode for systems that deliver a barcode
152 to circulation.pl that differs from the barcode stored for the item.
153 For proper functioning of this filter, calling the function on the
154 correct barcode string (items.barcode) should return an unaltered barcode.
156 The optional $filter argument is to allow for testing or explicit
157 behavior that ignores the System Pref. Valid values are the same as the
162 # FIXME -- the &decode fcn below should be wrapped into this one.
163 # FIXME -- these plugins should be moved out of Circulation.pm
166 my ($barcode, $filter) = @_;
167 my $branch = C4::Branch::mybranch();
168 $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
169 $filter or return $barcode; # ensure filter is defined, else return untouched barcode
170 if ($filter eq 'whitespace') {
172 } elsif ($filter eq 'cuecat') {
174 my @fields = split( /\./, $barcode );
175 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
176 ($#results == 2) and return $results[2];
177 } elsif ($filter eq 'T-prefix') {
178 if ($barcode =~ /^[Tt](\d)/) {
179 (defined($1) and $1 eq '0') and return $barcode;
180 $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1)
182 return sprintf("T%07d", $barcode);
183 # FIXME: $barcode could be "T1", causing warning: substr outside of string
184 # Why drop the nonzero digit after the T?
185 # Why pass non-digits (or empty string) to "T%07d"?
186 } elsif ($filter eq 'libsuite8') {
187 unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it.
188 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
189 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
191 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
194 } elsif ($filter eq 'EAN13') {
195 my $ean = CheckDigits('ean');
196 if ( $ean->is_valid($barcode) ) {
197 #$barcode = sprintf('%013d',$barcode); # this doesn't work on 32-bit systems
198 $barcode = '0' x ( 13 - length($barcode) ) . $barcode;
200 warn "# [$barcode] not valid EAN-13/UPC-A\n";
203 return $barcode; # return barcode, modified or not
208 $str = &decode($chunk);
210 Decodes a segment of a string emitted by a CueCat barcode scanner and
213 FIXME: Should be replaced with Barcode::Cuecat from CPAN
214 or Javascript based decoding on the client side.
221 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
222 my @s = map { index( $seq, $_ ); } split( //, $encoded );
223 my $l = ( $#s + 1 ) % 4;
226 # warn "Error: Cuecat decode parsing failed!";
234 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
236 chr( ( $n >> 16 ) ^ 67 )
237 .chr( ( $n >> 8 & 255 ) ^ 67 )
238 .chr( ( $n & 255 ) ^ 67 );
241 $r = substr( $r, 0, length($r) - $l );
247 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
248 $barcode, $ignore_reserves);
250 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
252 C<$newbranch> is the code for the branch to which the item should be transferred.
254 C<$barcode> is the barcode of the item to be transferred.
256 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
257 Otherwise, if an item is reserved, the transfer fails.
259 Returns three values:
265 is true if the transfer was successful.
269 is a reference-to-hash which may have any of the following keys:
275 There is no item in the catalog with the given barcode. The value is C<$barcode>.
279 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.
281 =item C<DestinationEqualsHolding>
283 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.
287 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.
291 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>.
293 =item C<WasTransferred>
295 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
304 my ( $tbr, $barcode, $ignoreRs ) = @_;
307 my $branches = GetBranches();
308 my $itemnumber = GetItemnumberFromBarcode( $barcode );
309 my $issue = GetItemIssue($itemnumber);
310 my $biblio = GetBiblioFromItemNumber($itemnumber);
313 if ( not $itemnumber ) {
314 $messages->{'BadBarcode'} = $barcode;
318 # get branches of book...
319 my $hbr = $biblio->{'homebranch'};
320 my $fbr = $biblio->{'holdingbranch'};
322 # if using Branch Transfer Limits
323 if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
324 if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
325 if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
326 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
329 } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
330 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
336 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
337 $messages->{'IsPermanent'} = $hbr;
341 # can't transfer book if is already there....
342 if ( $fbr eq $tbr ) {
343 $messages->{'DestinationEqualsHolding'} = 1;
347 # check if it is still issued to someone, return it...
348 if ($issue->{borrowernumber}) {
349 AddReturn( $barcode, $fbr );
350 $messages->{'WasReturned'} = $issue->{borrowernumber};
354 # That'll save a database query.
355 my ( $resfound, $resrec, undef ) =
356 CheckReserves( $itemnumber );
357 if ( $resfound and not $ignoreRs ) {
358 $resrec->{'ResFound'} = $resfound;
360 # $messages->{'ResFound'} = $resrec;
364 #actually do the transfer....
366 ModItemTransfer( $itemnumber, $fbr, $tbr );
368 # don't need to update MARC anymore, we do it in batch now
369 $messages->{'WasTransfered'} = 1;
372 ModDateLastSeen( $itemnumber );
373 return ( $dotransfer, $messages, $biblio );
378 my $borrower = shift;
379 my $biblionumber = shift;
381 my $cat_borrower = $borrower->{'categorycode'};
382 my $dbh = C4::Context->dbh;
384 # Get which branchcode we need
385 $branch = _GetCircControlBranch($item,$borrower);
386 my $type = (C4::Context->preference('item-level_itypes'))
387 ? $item->{'itype'} # item-level
388 : $item->{'itemtype'}; # biblio-level
390 # given branch, patron category, and item type, determine
391 # applicable issuing rule
392 my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
394 # if a rule is found and has a loan limit set, count
395 # how many loans the patron already has that meet that
397 if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
399 my $count_query = "SELECT COUNT(*) FROM issues
400 JOIN items USING (itemnumber) ";
402 my $rule_itemtype = $issuing_rule->{itemtype};
403 if ($rule_itemtype eq "*") {
404 # matching rule has the default item type, so count only
405 # those existing loans that don't fall under a more
407 if (C4::Context->preference('item-level_itypes')) {
408 $count_query .= " WHERE items.itype NOT IN (
409 SELECT itemtype FROM issuingrules
411 AND (categorycode = ? OR categorycode = ?)
415 $count_query .= " JOIN biblioitems USING (biblionumber)
416 WHERE biblioitems.itemtype NOT IN (
417 SELECT itemtype FROM issuingrules
419 AND (categorycode = ? OR categorycode = ?)
423 push @bind_params, $issuing_rule->{branchcode};
424 push @bind_params, $issuing_rule->{categorycode};
425 push @bind_params, $cat_borrower;
427 # rule has specific item type, so count loans of that
429 if (C4::Context->preference('item-level_itypes')) {
430 $count_query .= " WHERE items.itype = ? ";
432 $count_query .= " JOIN biblioitems USING (biblionumber)
433 WHERE biblioitems.itemtype= ? ";
435 push @bind_params, $type;
438 $count_query .= " AND borrowernumber = ? ";
439 push @bind_params, $borrower->{'borrowernumber'};
440 my $rule_branch = $issuing_rule->{branchcode};
441 if ($rule_branch ne "*") {
442 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
443 $count_query .= " AND issues.branchcode = ? ";
444 push @bind_params, $branch;
445 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
446 ; # if branch is the patron's home branch, then count all loans by patron
448 $count_query .= " AND items.homebranch = ? ";
449 push @bind_params, $branch;
453 my $count_sth = $dbh->prepare($count_query);
454 $count_sth->execute(@bind_params);
455 my ($current_loan_count) = $count_sth->fetchrow_array;
457 my $max_loans_allowed = $issuing_rule->{'maxissueqty'};
458 if ($current_loan_count >= $max_loans_allowed) {
459 return ($current_loan_count, $max_loans_allowed);
463 # Now count total loans against the limit for the branch
464 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
465 if (defined($branch_borrower_circ_rule->{maxissueqty})) {
466 my @bind_params = ();
467 my $branch_count_query = "SELECT COUNT(*) FROM issues
468 JOIN items USING (itemnumber)
469 WHERE borrowernumber = ? ";
470 push @bind_params, $borrower->{borrowernumber};
472 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
473 $branch_count_query .= " AND issues.branchcode = ? ";
474 push @bind_params, $branch;
475 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
476 ; # if branch is the patron's home branch, then count all loans by patron
478 $branch_count_query .= " AND items.homebranch = ? ";
479 push @bind_params, $branch;
481 my $branch_count_sth = $dbh->prepare($branch_count_query);
482 $branch_count_sth->execute(@bind_params);
483 my ($current_loan_count) = $branch_count_sth->fetchrow_array;
485 my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty};
486 if ($current_loan_count >= $max_loans_allowed) {
487 return ($current_loan_count, $max_loans_allowed);
491 # OK, the patron can issue !!!
497 @issues = &itemissues($biblioitemnumber, $biblio);
499 Looks up information about who has borrowed the bookZ<>(s) with the
500 given biblioitemnumber.
502 C<$biblio> is ignored.
504 C<&itemissues> returns an array of references-to-hash. The keys
505 include the fields from the C<items> table in the Koha database.
506 Additional keys include:
512 If the item is currently on loan, this gives the due date.
514 If the item is not on loan, then this is either "Available" or
515 "Cancelled", if the item has been withdrawn.
519 If the item is currently on loan, this gives the card number of the
520 patron who currently has the item.
522 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
524 These give the timestamp for the last three times the item was
527 =item C<card0>, C<card1>, C<card2>
529 The card number of the last three patrons who borrowed this item.
531 =item C<borrower0>, C<borrower1>, C<borrower2>
533 The borrower number of the last three patrons who borrowed this item.
541 my ( $bibitem, $biblio ) = @_;
542 my $dbh = C4::Context->dbh;
544 $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
549 $sth->execute($bibitem) || die $sth->errstr;
551 while ( my $data = $sth->fetchrow_hashref ) {
553 # Find out who currently has this item.
554 # FIXME - Wouldn't it be better to do this as a left join of
555 # some sort? Currently, this code assumes that if
556 # fetchrow_hashref() fails, then the book is on the shelf.
557 # fetchrow_hashref() can fail for any number of reasons (e.g.,
558 # database server crash), not just because no items match the
560 my $sth2 = $dbh->prepare(
561 "SELECT * FROM issues
562 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
567 $sth2->execute( $data->{'itemnumber'} );
568 if ( my $data2 = $sth2->fetchrow_hashref ) {
569 $data->{'date_due'} = $data2->{'date_due'};
570 $data->{'card'} = $data2->{'cardnumber'};
571 $data->{'borrower'} = $data2->{'borrowernumber'};
574 $data->{'date_due'} = ($data->{'withdrawn'} eq '1') ? 'Cancelled' : 'Available';
578 # Find the last 3 people who borrowed this item.
579 $sth2 = $dbh->prepare(
580 "SELECT * FROM old_issues
581 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
583 ORDER BY returndate DESC,timestamp DESC"
586 $sth2->execute( $data->{'itemnumber'} );
587 for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
588 { # FIXME : error if there is less than 3 pple borrowing this item
589 if ( my $data2 = $sth2->fetchrow_hashref ) {
590 $data->{"timestamp$i2"} = $data2->{'timestamp'};
591 $data->{"card$i2"} = $data2->{'cardnumber'};
592 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
596 $results[$i] = $data;
603 =head2 CanBookBeIssued
605 ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower,
606 $barcode, $duedatespec, $inprocess, $ignore_reserves );
608 Check if a book can be issued.
610 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
614 =item C<$borrower> hash with borrower informations (from GetMember or GetMemberDetails)
616 =item C<$barcode> is the bar code of the book being issued.
618 =item C<$duedatespec> is a C4::Dates object.
620 =item C<$inprocess> boolean switch
621 =item C<$ignore_reserves> boolean switch
629 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
630 Possible values are :
636 sticky due date is invalid
640 borrower gone with no address
644 borrower declared it's card lost
650 =head3 UNKNOWN_BARCODE
664 item is restricted (set by ??)
666 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
667 could be prevented, but ones that can be overriden by the operator.
669 Possible values are :
677 renewing, not issuing
679 =head3 ISSUED_TO_ANOTHER
681 issued to someone else.
685 reserved for someone else.
689 sticky due date is invalid or due date in the past
693 if the borrower borrows to much things
697 sub CanBookBeIssued {
698 my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves ) = @_;
699 my %needsconfirmation; # filled with problems that needs confirmations
700 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
701 my %alerts; # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
703 my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
704 my $issue = GetItemIssue($item->{itemnumber});
705 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
706 $item->{'itemtype'}=$item->{'itype'};
707 my $dbh = C4::Context->dbh;
709 # MANDATORY CHECKS - unless item exists, nothing else matters
710 unless ( $item->{barcode} ) {
711 $issuingimpossible{UNKNOWN_BARCODE} = 1;
713 return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
716 # DUE DATE is OK ? -- should already have checked.
718 if ($duedate && ref $duedate ne 'DateTime') {
719 $duedate = dt_from_string($duedate);
721 my $now = DateTime->now( time_zone => C4::Context->tz() );
722 unless ( $duedate ) {
723 my $issuedate = $now->clone();
725 my $branch = _GetCircControlBranch($item,$borrower);
726 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
727 $duedate = CalcDateDue( $issuedate, $itype, $branch, $borrower );
729 # Offline circ calls AddIssue directly, doesn't run through here
730 # So issuingimpossible should be ok.
733 my $today = $now->clone();
734 $today->truncate( to => 'minute');
735 if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
736 $needsconfirmation{INVALID_DATE} = output_pref($duedate);
739 $issuingimpossible{INVALID_DATE} = output_pref($duedate);
745 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
746 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
748 branch => C4::Context->userenv->{'branch'},
750 itemnumber => $item->{'itemnumber'},
751 itemtype => $item->{'itemtype'},
752 borrowernumber => $borrower->{'borrowernumber'},
753 ccode => $item->{'ccode'}}
755 ModDateLastSeen( $item->{'itemnumber'} );
756 return( { STATS => 1 }, {});
758 if ( $borrower->{flags}->{GNA} ) {
759 $issuingimpossible{GNA} = 1;
761 if ( $borrower->{flags}->{'LOST'} ) {
762 $issuingimpossible{CARD_LOST} = 1;
764 if ( $borrower->{flags}->{'DBARRED'} ) {
765 $issuingimpossible{DEBARRED} = 1;
767 if ( !defined $borrower->{dateexpiry} || $borrower->{'dateexpiry'} eq '0000-00-00') {
768 $issuingimpossible{EXPIRED} = 1;
770 my ($y, $m, $d) = split /-/,$borrower->{'dateexpiry'};
771 if ($y && $m && $d) { # are we really writing oinvalid dates to borrs
772 my $expiry_dt = DateTime->new(
776 time_zone => C4::Context->tz,
778 $expiry_dt->truncate( to => 'day');
779 my $today = $now->clone()->truncate(to => 'day');
780 if (DateTime->compare($today, $expiry_dt) == 1) {
781 $issuingimpossible{EXPIRED} = 1;
784 carp("Invalid expity date in borr");
785 $issuingimpossible{EXPIRED} = 1;
793 my ($balance, $non_issue_charges, $other_charges) =
794 C4::Members::GetMemberAccountBalance( $borrower->{'borrowernumber'} );
795 my $amountlimit = C4::Context->preference("noissuescharge");
796 my $allowfineoverride = C4::Context->preference("AllowFineOverride");
797 my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
798 if ( C4::Context->preference("IssuingInProcess") ) {
799 if ( $non_issue_charges > $amountlimit && !$inprocess && !$allowfineoverride) {
800 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
801 } elsif ( $non_issue_charges > $amountlimit && !$inprocess && $allowfineoverride) {
802 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
803 } elsif ( $allfinesneedoverride && $non_issue_charges > 0 && $non_issue_charges <= $amountlimit && !$inprocess ) {
804 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
808 if ( $non_issue_charges > $amountlimit && $allowfineoverride ) {
809 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
810 } elsif ( $non_issue_charges > $amountlimit && !$allowfineoverride) {
811 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
812 } elsif ( $non_issue_charges > 0 && $allfinesneedoverride ) {
813 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
816 if ($balance > 0 && $other_charges > 0) {
817 $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges );
820 my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'});
821 if ($blocktype == -1) {
822 ## patron has outstanding overdue loans
823 if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
824 $issuingimpossible{USERBLOCKEDOVERDUE} = $count;
826 elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
827 $needsconfirmation{USERBLOCKEDOVERDUE} = $count;
829 } elsif($blocktype == 1) {
830 # patron has accrued fine days or has a restriction. $count is a date
831 if ($count eq '9999-12-31') {
832 $issuingimpossible{USERBLOCKEDNOENDDATE} = $count;
835 $issuingimpossible{USERBLOCKEDWITHENDDATE} = $count;
840 # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
842 my ($current_loan_count, $max_loans_allowed) = TooMany( $borrower, $item->{biblionumber}, $item );
843 # if TooMany max_loans_allowed returns 0 the user doesn't have permission to check out this book
844 if (defined $max_loans_allowed && $max_loans_allowed == 0) {
845 $needsconfirmation{PATRON_CANT} = 1;
847 if($max_loans_allowed){
848 if ( C4::Context->preference("AllowTooManyOverride") ) {
849 $needsconfirmation{TOO_MANY} = 1;
850 $needsconfirmation{current_loan_count} = $current_loan_count;
851 $needsconfirmation{max_loans_allowed} = $max_loans_allowed;
853 $issuingimpossible{TOO_MANY} = 1;
854 $issuingimpossible{current_loan_count} = $current_loan_count;
855 $issuingimpossible{max_loans_allowed} = $max_loans_allowed;
863 if ( $item->{'notforloan'} )
865 if(!C4::Context->preference("AllowNotForLoanOverride")){
866 $issuingimpossible{NOT_FOR_LOAN} = 1;
867 $issuingimpossible{item_notforloan} = $item->{'notforloan'};
869 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
870 $needsconfirmation{item_notforloan} = $item->{'notforloan'};
874 # we have to check itemtypes.notforloan also
875 if (C4::Context->preference('item-level_itypes')){
876 # this should probably be a subroutine
877 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
878 $sth->execute($item->{'itemtype'});
879 my $notforloan=$sth->fetchrow_hashref();
880 if ($notforloan->{'notforloan'}) {
881 if (!C4::Context->preference("AllowNotForLoanOverride")) {
882 $issuingimpossible{NOT_FOR_LOAN} = 1;
883 $issuingimpossible{itemtype_notforloan} = $item->{'itype'};
885 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
886 $needsconfirmation{itemtype_notforloan} = $item->{'itype'};
890 elsif ($biblioitem->{'notforloan'} == 1){
891 if (!C4::Context->preference("AllowNotForLoanOverride")) {
892 $issuingimpossible{NOT_FOR_LOAN} = 1;
893 $issuingimpossible{itemtype_notforloan} = $biblioitem->{'itemtype'};
895 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
896 $needsconfirmation{itemtype_notforloan} = $biblioitem->{'itemtype'};
900 if ( $item->{'withdrawn'} && $item->{'withdrawn'} > 0 )
902 $issuingimpossible{WTHDRAWN} = 1;
904 if ( $item->{'restricted'}
905 && $item->{'restricted'} == 1 )
907 $issuingimpossible{RESTRICTED} = 1;
909 if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
910 my $code = GetAuthorisedValueByCode( 'LOST', $item->{'itemlost'} );
911 $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
912 $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
914 if ( C4::Context->preference("IndependentBranches") ) {
915 my $userenv = C4::Context->userenv;
916 unless ( C4::Context->IsSuperLibrarian() ) {
917 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ){
918 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
919 $issuingimpossible{'itemhomebranch'} = $item->{C4::Context->preference("HomeOrHoldingBranch")};
921 $needsconfirmation{BORRNOTSAMEBRANCH} = GetBranchName( $borrower->{'branchcode'} )
922 if ( $borrower->{'branchcode'} ne $userenv->{branch} );
926 # CHECK IF THERE IS RENTAL CHARGES. RENTAL MUST BE CONFIRMED BY THE BORROWER
928 my $rentalConfirmation = C4::Context->preference("RentalFeesCheckoutConfirmation");
930 if ( $rentalConfirmation ){
931 my ($rentalCharge) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
932 if ( $rentalCharge > 0 ){
933 $rentalCharge = sprintf("%.02f", $rentalCharge);
934 $needsconfirmation{RENTALCHARGE} = $rentalCharge;
939 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
941 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} ){
943 # Already issued to current borrower. Ask whether the loan should
945 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
946 $borrower->{'borrowernumber'},
947 $item->{'itemnumber'}
949 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
950 $issuingimpossible{NO_MORE_RENEWALS} = 1;
953 $needsconfirmation{RENEW_ISSUE} = 1;
956 elsif ($issue->{borrowernumber}) {
958 # issued to someone else
959 my $currborinfo = C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} );
961 # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
962 $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
963 $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
964 $needsconfirmation{issued_surname} = $currborinfo->{'surname'};
965 $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
966 $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
969 unless ( $ignore_reserves ) {
970 # See if the item is on reserve.
971 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
973 my $resbor = $res->{'borrowernumber'};
974 if ( $resbor ne $borrower->{'borrowernumber'} ) {
975 my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor );
976 my $branchname = GetBranchName( $res->{'branchcode'} );
977 if ( $restype eq "Waiting" )
979 # The item is on reserve and waiting, but has been
980 # reserved by some other patron.
981 $needsconfirmation{RESERVE_WAITING} = 1;
982 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
983 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
984 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
985 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
986 $needsconfirmation{'resbranchname'} = $branchname;
987 $needsconfirmation{'reswaitingdate'} = format_date($res->{'waitingdate'});
989 elsif ( $restype eq "Reserved" ) {
990 # The item is on reserve for someone else.
991 $needsconfirmation{RESERVED} = 1;
992 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
993 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
994 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
995 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
996 $needsconfirmation{'resbranchname'} = $branchname;
997 $needsconfirmation{'resreservedate'} = format_date($res->{'reservedate'});
1003 ## CHECK AGE RESTRICTION
1004 my $agerestriction = $biblioitem->{'agerestriction'};
1005 my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $borrower );
1006 if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1007 if ( C4::Context->preference('AgeRestrictionOverride') ) {
1008 $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1011 $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1015 ## check for high holds decreasing loan period
1016 my $decrease_loan = C4::Context->preference('decreaseLoanHighHolds');
1017 if ( $decrease_loan && $decrease_loan == 1 ) {
1018 my ( $reserved, $num, $duration, $returndate ) =
1019 checkHighHolds( $item, $borrower );
1021 if ( $num >= C4::Context->preference('decreaseLoanHighHoldsValue') ) {
1022 $needsconfirmation{HIGHHOLDS} = {
1024 duration => $duration,
1025 returndate => output_pref($returndate),
1031 !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1032 # don't do the multiple loans per bib check if we've
1033 # already determined that we've got a loan on the same item
1034 !$issuingimpossible{NO_MORE_RENEWALS} &&
1035 !$needsconfirmation{RENEW_ISSUE}
1037 # Check if borrower has already issued an item from the same biblio
1038 # Only if it's not a subscription
1039 my $biblionumber = $item->{biblionumber};
1040 require C4::Serials;
1041 my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1042 unless ($is_a_subscription) {
1043 my $issues = GetIssues( {
1044 borrowernumber => $borrower->{borrowernumber},
1045 biblionumber => $biblionumber,
1047 my @issues = $issues ? @$issues : ();
1048 # if we get here, we don't already have a loan on this item,
1049 # so if there are any loans on this bib, ask for confirmation
1050 if (scalar @issues > 0) {
1051 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1056 return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
1059 =head2 CanBookBeReturned
1061 ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1063 Check whether the item can be returned to the provided branch
1067 =item C<$item> is a hash of item information as returned from GetItem
1069 =item C<$branch> is the branchcode where the return is taking place
1077 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1079 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1085 sub CanBookBeReturned {
1086 my ($item, $branch) = @_;
1087 my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1089 # assume return is allowed to start
1093 # identify all cases where return is forbidden
1094 if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1096 $message = $item->{'homebranch'};
1097 } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1099 $message = $item->{'holdingbranch'};
1100 } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1102 $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1105 return ($allowed, $message);
1108 =head2 CheckHighHolds
1110 used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1111 decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1112 has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1116 sub checkHighHolds {
1117 my ( $item, $borrower ) = @_;
1118 my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1119 my $branch = _GetCircControlBranch( $item, $borrower );
1120 my $dbh = C4::Context->dbh;
1121 my $sth = $dbh->prepare(
1122 'select count(borrowernumber) as num_holds from reserves where biblionumber=?'
1124 $sth->execute( $item->{'biblionumber'} );
1125 my ($holds) = $sth->fetchrow_array;
1127 my $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1129 my $calendar = Koha::Calendar->new( branchcode => $branch );
1132 ( C4::Context->preference('item-level_itypes') )
1133 ? $biblio->{'itype'}
1134 : $biblio->{'itemtype'};
1136 C4::Circulation::CalcDateDue( $issuedate, $itype, $branch,
1139 my $reduced_datedue =
1140 $calendar->addDate( $issuedate,
1141 C4::Context->preference('decreaseLoanHighHoldsDuration') );
1143 if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1145 C4::Context->preference('decreaseLoanHighHoldsDuration'),
1149 return ( 0, 0, 0, undef );
1154 &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1156 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1160 =item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails).
1162 =item C<$barcode> is the barcode of the item being issued.
1164 =item C<$datedue> is a C4::Dates object for the max date of return, i.e. the date due (optional).
1165 Calculated if empty.
1167 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1169 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1170 Defaults to today. Unlike C<$datedue>, NOT a C4::Dates object, unfortunately.
1172 AddIssue does the following things :
1174 - step 01: check that there is a borrowernumber & a barcode provided
1175 - check for RENEWAL (book issued & being issued to the same patron)
1176 - renewal YES = Calculate Charge & renew
1178 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1180 - fill reserve if reserve to this patron
1181 - cancel reserve or not, otherwise
1182 * TRANSFERT PENDING ?
1183 - complete the transfert
1191 my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1192 my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1193 my $auto_renew = $params && $params->{auto_renew};
1194 my $dbh = C4::Context->dbh;
1195 my $barcodecheck=CheckValidBarcode($barcode);
1197 if ($datedue && ref $datedue ne 'DateTime') {
1198 $datedue = dt_from_string($datedue);
1200 # $issuedate defaults to today.
1201 if ( ! defined $issuedate ) {
1202 $issuedate = DateTime->now(time_zone => C4::Context->tz());
1205 if ( ref $issuedate ne 'DateTime') {
1206 $issuedate = dt_from_string($issuedate);
1210 if ($borrower and $barcode and $barcodecheck ne '0'){#??? wtf
1211 # find which item we issue
1212 my $item = GetItem('', $barcode) or return; # if we don't get an Item, abort.
1213 my $branch = _GetCircControlBranch($item,$borrower);
1215 # get actual issuing if there is one
1216 my $actualissue = GetItemIssue( $item->{itemnumber});
1218 # get biblioinformation for this item
1219 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
1222 # check if we just renew the issue.
1224 if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
1225 $datedue = AddRenewal(
1226 $borrower->{'borrowernumber'},
1227 $item->{'itemnumber'},
1230 $issuedate, # here interpreted as the renewal date
1234 # it's NOT a renewal
1235 if ( $actualissue->{borrowernumber}) {
1236 # This book is currently on loan, but not to the person
1237 # who wants to borrow it now. mark it returned before issuing to the new borrower
1240 C4::Context->userenv->{'branch'}
1244 MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1245 # Starting process for transfer job (checking transfert and validate it if we have one)
1246 my ($datesent) = GetTransfers($item->{'itemnumber'});
1248 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1251 "UPDATE branchtransfers
1252 SET datearrived = now(),
1254 comments = 'Forced branchtransfer'
1255 WHERE itemnumber= ? AND datearrived IS NULL"
1257 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
1260 # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1261 unless ($auto_renew) {
1262 my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branch);
1263 $auto_renew = $issuingrule->{auto_renew};
1266 # Record in the database the fact that the book was issued.
1270 (borrowernumber, itemnumber,issuedate, date_due, branchcode, onsite_checkout, auto_renew)
1271 VALUES (?,?,?,?,?,?,?)"
1274 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
1275 $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1278 $datedue->truncate( to => 'minute');
1281 $borrower->{'borrowernumber'}, # borrowernumber
1282 $item->{'itemnumber'}, # itemnumber
1283 $issuedate->strftime('%Y-%m-%d %H:%M:%S'), # issuedate
1284 $datedue->strftime('%Y-%m-%d %H:%M:%S'), # date_due
1285 C4::Context->userenv->{'branch'}, # branchcode
1287 $auto_renew ? 1 : 0 # automatic renewal
1289 if ( C4::Context->preference('ReturnToShelvingCart') ) { ## ReturnToShelvingCart is on, anything issued should be taken off the cart.
1290 CartToShelf( $item->{'itemnumber'} );
1292 $item->{'issues'}++;
1293 if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1294 UpdateTotalIssues($item->{'biblionumber'}, 1);
1297 ## If item was lost, it has now been found, reverse any list item charges if neccessary.
1298 if ( $item->{'itemlost'} ) {
1299 if ( C4::Context->preference('RefundLostItemFeeOnReturn' ) ) {
1300 _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef, $item->{'barcode'} );
1304 ModItem({ issues => $item->{'issues'},
1305 holdingbranch => C4::Context->userenv->{'branch'},
1307 datelastborrowed => DateTime->now(time_zone => C4::Context->tz())->ymd(),
1308 onloan => $datedue->ymd(),
1309 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1310 ModDateLastSeen( $item->{'itemnumber'} );
1312 # If it costs to borrow this book, charge it to the patron's account.
1313 my ( $charge, $itemtype ) = GetIssuingCharges(
1314 $item->{'itemnumber'},
1315 $borrower->{'borrowernumber'}
1317 if ( $charge > 0 ) {
1319 $item->{'itemnumber'},
1320 $borrower->{'borrowernumber'}, $charge
1322 $item->{'charge'} = $charge;
1325 # Record the fact that this book was issued.
1327 branch => C4::Context->userenv->{'branch'},
1328 type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1330 other => ($sipmode ? "SIP-$sipmode" : ''),
1331 itemnumber => $item->{'itemnumber'},
1332 itemtype => $item->{'itype'},
1333 borrowernumber => $borrower->{'borrowernumber'},
1334 ccode => $item->{'ccode'}}
1337 # Send a checkout slip.
1338 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1340 branchcode => $branch,
1341 categorycode => $borrower->{categorycode},
1342 item_type => $item->{itype},
1343 notification => 'CHECKOUT',
1345 if ($circulation_alert->is_enabled_for(\%conditions)) {
1346 SendCirculationAlert({
1349 borrower => $borrower,
1355 logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'itemnumber'})
1356 if C4::Context->preference("IssueLog");
1358 return ($datedue); # not necessarily the same as when it came in!
1361 =head2 GetLoanLength
1363 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1365 Get loan length for an itemtype, a borrower type and a branch
1370 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1371 my $dbh = C4::Context->dbh;
1372 my $sth = $dbh->prepare(qq{
1373 SELECT issuelength, lengthunit, renewalperiod
1375 WHERE categorycode=?
1378 AND issuelength IS NOT NULL
1381 # try to find issuelength & return the 1st available.
1382 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1383 $sth->execute( $borrowertype, $itemtype, $branchcode );
1384 my $loanlength = $sth->fetchrow_hashref;
1387 if defined($loanlength) && $loanlength->{issuelength};
1389 $sth->execute( $borrowertype, '*', $branchcode );
1390 $loanlength = $sth->fetchrow_hashref;
1392 if defined($loanlength) && $loanlength->{issuelength};
1394 $sth->execute( '*', $itemtype, $branchcode );
1395 $loanlength = $sth->fetchrow_hashref;
1397 if defined($loanlength) && $loanlength->{issuelength};
1399 $sth->execute( '*', '*', $branchcode );
1400 $loanlength = $sth->fetchrow_hashref;
1402 if defined($loanlength) && $loanlength->{issuelength};
1404 $sth->execute( $borrowertype, $itemtype, '*' );
1405 $loanlength = $sth->fetchrow_hashref;
1407 if defined($loanlength) && $loanlength->{issuelength};
1409 $sth->execute( $borrowertype, '*', '*' );
1410 $loanlength = $sth->fetchrow_hashref;
1412 if defined($loanlength) && $loanlength->{issuelength};
1414 $sth->execute( '*', $itemtype, '*' );
1415 $loanlength = $sth->fetchrow_hashref;
1417 if defined($loanlength) && $loanlength->{issuelength};
1419 $sth->execute( '*', '*', '*' );
1420 $loanlength = $sth->fetchrow_hashref;
1422 if defined($loanlength) && $loanlength->{issuelength};
1424 # if no rule is set => 21 days (hardcoded)
1427 renewalperiod => 21,
1428 lengthunit => 'days',
1434 =head2 GetHardDueDate
1436 my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1438 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1442 sub GetHardDueDate {
1443 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1445 my $rule = GetIssuingRule( $borrowertype, $itemtype, $branchcode );
1447 if ( defined( $rule ) ) {
1448 if ( $rule->{hardduedate} ) {
1449 return (dt_from_string($rule->{hardduedate}, 'iso'),$rule->{hardduedatecompare});
1451 return (undef, undef);
1456 =head2 GetIssuingRule
1458 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1460 FIXME - This is a copy-paste of GetLoanLength
1461 as a stop-gap. Do not wish to change API for GetLoanLength
1462 this close to release.
1464 Get the issuing rule for an itemtype, a borrower type and a branch
1465 Returns a hashref from the issuingrules table.
1469 sub GetIssuingRule {
1470 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1471 my $dbh = C4::Context->dbh;
1472 my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=?" );
1475 $sth->execute( $borrowertype, $itemtype, $branchcode );
1476 $irule = $sth->fetchrow_hashref;
1477 return $irule if defined($irule) ;
1479 $sth->execute( $borrowertype, "*", $branchcode );
1480 $irule = $sth->fetchrow_hashref;
1481 return $irule if defined($irule) ;
1483 $sth->execute( "*", $itemtype, $branchcode );
1484 $irule = $sth->fetchrow_hashref;
1485 return $irule if defined($irule) ;
1487 $sth->execute( "*", "*", $branchcode );
1488 $irule = $sth->fetchrow_hashref;
1489 return $irule if defined($irule) ;
1491 $sth->execute( $borrowertype, $itemtype, "*" );
1492 $irule = $sth->fetchrow_hashref;
1493 return $irule if defined($irule) ;
1495 $sth->execute( $borrowertype, "*", "*" );
1496 $irule = $sth->fetchrow_hashref;
1497 return $irule if defined($irule) ;
1499 $sth->execute( "*", $itemtype, "*" );
1500 $irule = $sth->fetchrow_hashref;
1501 return $irule if defined($irule) ;
1503 $sth->execute( "*", "*", "*" );
1504 $irule = $sth->fetchrow_hashref;
1505 return $irule if defined($irule) ;
1507 # if no rule matches,
1511 =head2 GetBranchBorrowerCircRule
1513 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1515 Retrieves circulation rule attributes that apply to the given
1516 branch and patron category, regardless of item type.
1517 The return value is a hashref containing the following key:
1519 maxissueqty - maximum number of loans that a
1520 patron of the given category can have at the given
1521 branch. If the value is undef, no limit.
1523 This will first check for a specific branch and
1524 category match from branch_borrower_circ_rules.
1526 If no rule is found, it will then check default_branch_circ_rules
1527 (same branch, default category). If no rule is found,
1528 it will then check default_borrower_circ_rules (default
1529 branch, same category), then failing that, default_circ_rules
1530 (default branch, default category).
1532 If no rule has been found in the database, it will default to
1537 C<$branchcode> and C<$categorycode> should contain the
1538 literal branch code and patron category code, respectively - no
1543 sub GetBranchBorrowerCircRule {
1544 my $branchcode = shift;
1545 my $categorycode = shift;
1547 my $branch_cat_query = "SELECT maxissueqty
1548 FROM branch_borrower_circ_rules
1549 WHERE branchcode = ?
1550 AND categorycode = ?";
1551 my $dbh = C4::Context->dbh();
1552 my $sth = $dbh->prepare($branch_cat_query);
1553 $sth->execute($branchcode, $categorycode);
1555 if ($result = $sth->fetchrow_hashref()) {
1559 # try same branch, default borrower category
1560 my $branch_query = "SELECT maxissueqty
1561 FROM default_branch_circ_rules
1562 WHERE branchcode = ?";
1563 $sth = $dbh->prepare($branch_query);
1564 $sth->execute($branchcode);
1565 if ($result = $sth->fetchrow_hashref()) {
1569 # try default branch, same borrower category
1570 my $category_query = "SELECT maxissueqty
1571 FROM default_borrower_circ_rules
1572 WHERE categorycode = ?";
1573 $sth = $dbh->prepare($category_query);
1574 $sth->execute($categorycode);
1575 if ($result = $sth->fetchrow_hashref()) {
1579 # try default branch, default borrower category
1580 my $default_query = "SELECT maxissueqty
1581 FROM default_circ_rules";
1582 $sth = $dbh->prepare($default_query);
1584 if ($result = $sth->fetchrow_hashref()) {
1588 # built-in default circulation rule
1590 maxissueqty => undef,
1594 =head2 GetBranchItemRule
1596 my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1598 Retrieves circulation rule attributes that apply to the given
1599 branch and item type, regardless of patron category.
1601 The return value is a hashref containing the following keys:
1603 holdallowed => Hold policy for this branch and itemtype. Possible values:
1604 0: No holds allowed.
1605 1: Holds allowed only by patrons that have the same homebranch as the item.
1606 2: Holds allowed from any patron.
1608 returnbranch => branch to which to return item. Possible values:
1609 noreturn: do not return, let item remain where checked in (floating collections)
1610 homebranch: return to item's home branch
1612 This searches branchitemrules in the following order:
1614 * Same branchcode and itemtype
1615 * Same branchcode, itemtype '*'
1616 * branchcode '*', same itemtype
1617 * branchcode and itemtype '*'
1619 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1623 sub GetBranchItemRule {
1624 my ( $branchcode, $itemtype ) = @_;
1625 my $dbh = C4::Context->dbh();
1629 ['SELECT holdallowed, returnbranch
1630 FROM branch_item_rules
1631 WHERE branchcode = ?
1632 AND itemtype = ?', $branchcode, $itemtype],
1633 ['SELECT holdallowed, returnbranch
1634 FROM default_branch_circ_rules
1635 WHERE branchcode = ?', $branchcode],
1636 ['SELECT holdallowed, returnbranch
1637 FROM default_branch_item_rules
1638 WHERE itemtype = ?', $itemtype],
1639 ['SELECT holdallowed, returnbranch
1640 FROM default_circ_rules'],
1643 foreach my $attempt (@attempts) {
1644 my ($query, @bind_params) = @{$attempt};
1645 my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1648 # Since branch/category and branch/itemtype use the same per-branch
1649 # defaults tables, we have to check that the key we want is set, not
1650 # just that a row was returned
1651 $result->{'holdallowed'} = $search_result->{'holdallowed'} unless ( defined $result->{'holdallowed'} );
1652 $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1655 # built-in default circulation rule
1656 $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1657 $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1664 ($doreturn, $messages, $iteminformation, $borrower) =
1665 &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
1671 =item C<$barcode> is the bar code of the book being returned.
1673 =item C<$branch> is the code of the branch where the book is being returned.
1675 =item C<$exemptfine> indicates that overdue charges for the item will be
1678 =item C<$dropbox> indicates that the check-in date is assumed to be
1679 yesterday, or the last non-holiday as defined in C4::Calendar . If
1680 overdue charges are applied and C<$dropbox> is true, the last charge
1681 will be removed. This assumes that the fines accrual script has run
1682 for _today_. Optional.
1684 =item C<$return_date> allows the default return date to be overridden
1685 by the given return date. Optional.
1689 C<&AddReturn> returns a list of four items:
1691 C<$doreturn> is true iff the return succeeded.
1693 C<$messages> is a reference-to-hash giving feedback on the operation.
1694 The keys of the hash are:
1700 No item with this barcode exists. The value is C<$barcode>.
1704 The book is not currently on loan. The value is C<$barcode>.
1706 =item C<IsPermanent>
1708 The book's home branch is a permanent collection. If you have borrowed
1709 this book, you are not allowed to return it. The value is the code for
1710 the book's home branch.
1714 This book has been withdrawn/cancelled. The value should be ignored.
1716 =item C<Wrongbranch>
1718 This book has was returned to the wrong branch. The value is a hashref
1719 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1720 contain the branchcode of the incorrect and correct return library, respectively.
1724 The item was reserved. The value is a reference-to-hash whose keys are
1725 fields from the reserves table of the Koha database, and
1726 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1727 either C<Waiting>, C<Reserved>, or 0.
1731 C<$iteminformation> is a reference-to-hash, giving information about the
1732 returned item from the issues table.
1734 C<$borrower> is a reference-to-hash, giving information about the
1735 patron who last borrowed the book.
1740 my ( $barcode, $branch, $exemptfine, $dropbox, $return_date, $dropboxdate ) = @_;
1742 if ($branch and not GetBranchDetail($branch)) {
1743 warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
1746 $branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
1751 my $validTransfert = 0;
1752 my $stat_type = 'return';
1754 # get information on item
1755 my $itemnumber = GetItemnumberFromBarcode( $barcode );
1756 unless ($itemnumber) {
1757 return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower. bail out.
1759 my $issue = GetItemIssue($itemnumber);
1760 # warn Dumper($iteminformation);
1761 if ($issue and $issue->{borrowernumber}) {
1762 $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1763 or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existant borrowernumber '$issue->{borrowernumber}'\n"
1764 . Dumper($issue) . "\n";
1766 $messages->{'NotIssued'} = $barcode;
1767 # even though item is not on loan, it may still be transferred; therefore, get current branch info
1769 # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later.
1770 # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1771 if (C4::Context->preference("RecordLocalUseOnReturn")) {
1772 $messages->{'LocalUse'} = 1;
1773 $stat_type = 'localuse';
1777 my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1779 if ( $item->{'location'} eq 'PROC' ) {
1780 if ( C4::Context->preference("InProcessingToShelvingCart") ) {
1781 $item->{'location'} = 'CART';
1784 $item->{location} = $item->{permanent_location};
1787 ModItem( $item, $item->{'biblionumber'}, $item->{'itemnumber'} );
1790 # full item data, but no borrowernumber or checkout info (no issue)
1791 # we know GetItem should work because GetItemnumberFromBarcode worked
1792 my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1793 # get the proper branch to which to return the item
1794 $hbr = $item->{$hbr} || $branch ;
1795 # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1797 my $borrowernumber = $borrower->{'borrowernumber'} || undef; # we don't know if we had a borrower or not
1799 my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
1801 $yaml = "$yaml\n\n"; # YAML is anal on ending \n. Surplus does not hurt
1803 eval { $rules = YAML::Load($yaml); };
1805 warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
1808 foreach my $key ( keys %$rules ) {
1809 if ( $item->{notforloan} eq $key ) {
1810 $messages->{'NotForLoanStatusUpdated'} = { from => $item->{notforloan}, to => $rules->{$key} };
1811 ModItem( { notforloan => $rules->{$key} }, undef, $itemnumber );
1819 # check if the book is in a permanent collection....
1820 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1822 my $branches = GetBranches(); # a potentially expensive call for a non-feature.
1823 $branches->{$hbr}->{PE} and $messages->{'IsPermanent'} = $hbr;
1826 # check if the return is allowed at this branch
1827 my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
1828 unless ($returnallowed){
1829 $messages->{'Wrongbranch'} = {
1830 Wrongbranch => $branch,
1831 Rightbranch => $message
1834 return ( $doreturn, $messages, $issue, $borrower );
1837 if ( $item->{'withdrawn'} ) { # book has been cancelled
1838 $messages->{'withdrawn'} = 1;
1839 $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
1842 # case of a return of document (deal with issues and holdingbranch)
1843 my $today = DateTime->now( time_zone => C4::Context->tz() );
1846 my $datedue = $issue->{date_due};
1847 $borrower or warn "AddReturn without current borrower";
1848 my $circControlBranch;
1850 # define circControlBranch only if dropbox mode is set
1851 # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1852 # FIXME: check issuedate > returndate, factoring in holidays
1853 #$circControlBranch = _GetCircControlBranch($item,$borrower) unless ( $item->{'issuedate'} eq C4::Dates->today('iso') );;
1854 $circControlBranch = _GetCircControlBranch($item,$borrower);
1855 $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $dropboxdate ) == -1 ? 1 : 0;
1858 if ($borrowernumber) {
1859 if ( ( C4::Context->preference('CalculateFinesOnReturn') && $issue->{'overdue'} ) || $return_date ) {
1860 # we only need to calculate and change the fines if we want to do that on return
1861 # Should be on for hourly loans
1862 my $control = C4::Context->preference('CircControl');
1863 my $control_branchcode =
1864 ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
1865 : ( $control eq 'PatronLibrary' ) ? $borrower->{branchcode}
1866 : $issue->{branchcode};
1869 $return_date ? dt_from_string($return_date) : $today;
1871 my ( $amount, $type, $unitcounttotal ) =
1872 C4::Overdues::CalcFine( $item, $borrower->{categorycode},
1873 $control_branchcode, $datedue, $date_returned );
1877 if ( C4::Context->preference('finesMode') eq 'production' ) {
1878 if ( $amount > 0 ) {
1879 C4::Overdues::UpdateFine( $issue->{itemnumber},
1880 $issue->{borrowernumber},
1881 $amount, $type, output_pref($datedue) );
1883 elsif ($return_date) {
1885 # Backdated returns may have fines that shouldn't exist,
1886 # so in this case, we need to drop those fines to 0
1888 C4::Overdues::UpdateFine( $issue->{itemnumber},
1889 $issue->{borrowernumber},
1890 0, $type, output_pref($datedue) );
1895 MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
1896 $circControlBranch, $return_date, $borrower->{'privacy'} );
1898 # FIXME is the "= 1" right? This could be the borrower hash.
1899 $messages->{'WasReturned'} = 1;
1903 ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1906 # the holdingbranch is updated if the document is returned to another location.
1907 # this is always done regardless of whether the item was on loan or not
1908 if ($item->{'holdingbranch'} ne $branch) {
1909 UpdateHoldingbranch($branch, $item->{'itemnumber'});
1910 $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1912 ModDateLastSeen( $item->{'itemnumber'} );
1914 # check if we have a transfer for this document
1915 my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1917 # if we have a transfer to do, we update the line of transfers with the datearrived
1918 my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->{'itemnumber'} );
1920 if ( $tobranch eq $branch ) {
1921 my $sth = C4::Context->dbh->prepare(
1922 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1924 $sth->execute( $item->{'itemnumber'} );
1925 # if we have a reservation with valid transfer, we can set it's status to 'W'
1926 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1927 C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1929 $messages->{'WrongTransfer'} = $tobranch;
1930 $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1932 $validTransfert = 1;
1934 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1937 # fix up the accounts.....
1938 if ( $item->{'itemlost'} ) {
1939 $messages->{'WasLost'} = 1;
1941 if ( C4::Context->preference('RefundLostItemFeeOnReturn' ) ) {
1942 _FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode); # can tolerate undef $borrowernumber
1943 $messages->{'LostItemFeeRefunded'} = 1;
1947 # fix up the overdues in accounts...
1948 if ($borrowernumber) {
1949 my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
1950 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
1952 if ( $issue->{overdue} && $issue->{date_due} ) {
1954 $today = $dropboxdate if $dropbox;
1955 my ($debardate,$reminder) = _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today );
1957 $messages->{'PrevDebarred'} = $debardate;
1959 $messages->{'Debarred'} = $debardate if $debardate;
1961 # there's no overdue on the item but borrower had been previously debarred
1962 } elsif ( $issue->{date_due} and $borrower->{'debarred'} ) {
1963 if ( $borrower->{debarred} eq "9999-12-31") {
1964 $messages->{'ForeverDebarred'} = $borrower->{'debarred'};
1966 my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
1967 $borrower_debar_dt->truncate(to => 'day');
1968 my $today_dt = $today->clone()->truncate(to => 'day');
1969 if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
1970 $messages->{'PrevDebarred'} = $borrower->{'debarred'};
1976 # find reserves.....
1977 # if we don't have a reserve with the status W, we launch the Checkreserves routine
1978 my ($resfound, $resrec);
1979 my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
1980 ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'}, undef, $lookahead ) unless ( $item->{'withdrawn'} );
1982 $resrec->{'ResFound'} = $resfound;
1983 $messages->{'ResFound'} = $resrec;
1986 # Record the fact that this book was returned.
1987 # FIXME itemtype should record item level type, not bibliolevel type
1991 itemnumber => $item->{'itemnumber'},
1992 itemtype => $biblio->{'itemtype'},
1993 borrowernumber => $borrowernumber,
1994 ccode => $item->{'ccode'}}
1997 # Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then.
1998 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2000 branchcode => $branch,
2001 categorycode => $borrower->{categorycode},
2002 item_type => $item->{itype},
2003 notification => 'CHECKIN',
2005 if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2006 SendCirculationAlert({
2009 borrower => $borrower,
2014 logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
2015 if C4::Context->preference("ReturnLog");
2017 # Remove any OVERDUES related debarment if the borrower has no overdues
2018 if ( $borrowernumber
2019 && $borrower->{'debarred'}
2020 && C4::Context->preference('AutoRemoveOverduesRestrictions')
2021 && !C4::Members::HasOverdues( $borrowernumber )
2022 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2024 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2027 # FIXME: make this comment intelligible.
2028 #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
2029 #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
2031 if ( !$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $hbr) and not $messages->{'WrongTransfer'}){
2032 if ( C4::Context->preference("AutomaticItemReturn" ) or
2033 (C4::Context->preference("UseBranchTransferLimits") and
2034 ! IsBranchTransferAllowed($branch, $hbr, $item->{C4::Context->preference("BranchTransferLimitsType")} )
2036 $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $hbr;
2037 $debug and warn "item: " . Dumper($item);
2038 ModItemTransfer($item->{'itemnumber'}, $branch, $hbr);
2039 $messages->{'WasTransfered'} = 1;
2041 $messages->{'NeedsTransfer'} = 1; # TODO: instead of 1, specify branchcode that the transfer SHOULD go to, $item->{homebranch}
2045 return ( $doreturn, $messages, $issue, $borrower );
2048 =head2 MarkIssueReturned
2050 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
2052 Unconditionally marks an issue as being returned by
2053 moving the C<issues> row to C<old_issues> and
2054 setting C<returndate> to the current date, or
2055 the last non-holiday date of the branccode specified in
2056 C<dropbox_branch> . Assumes you've already checked that
2057 it's safe to do this, i.e. last non-holiday > issuedate.
2059 if C<$returndate> is specified (in iso format), it is used as the date
2060 of the return. It is ignored when a dropbox_branch is passed in.
2062 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2063 the old_issue is immediately anonymised
2065 Ideally, this function would be internal to C<C4::Circulation>,
2066 not exported, but it is currently needed by one
2067 routine in C<C4::Accounts>.
2071 sub MarkIssueReturned {
2072 my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
2074 my $dbh = C4::Context->dbh;
2075 my $query = 'UPDATE issues SET returndate=';
2077 if ($dropbox_branch) {
2078 my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
2079 my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
2081 push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2082 } elsif ($returndate) {
2084 push @bind, $returndate;
2086 $query .= ' now() ';
2088 $query .= ' WHERE borrowernumber = ? AND itemnumber = ?';
2089 push @bind, $borrowernumber, $itemnumber;
2091 my $sth_upd = $dbh->prepare($query);
2092 $sth_upd->execute(@bind);
2093 my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
2094 WHERE borrowernumber = ?
2095 AND itemnumber = ?');
2096 $sth_copy->execute($borrowernumber, $itemnumber);
2097 # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2098 if ( $privacy == 2) {
2099 # The default of 0 does not work due to foreign key constraints
2100 # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
2101 # FIXME the above is unacceptable - bug 9942 relates
2102 my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
2103 my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
2104 WHERE borrowernumber = ?
2105 AND itemnumber = ?");
2106 $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
2108 my $sth_del = $dbh->prepare("DELETE FROM issues
2109 WHERE borrowernumber = ?
2110 AND itemnumber = ?");
2111 $sth_del->execute($borrowernumber, $itemnumber);
2113 ModItem( { 'onloan' => undef }, undef, $itemnumber );
2116 =head2 _debar_user_on_return
2118 _debar_user_on_return($borrower, $item, $datedue, today);
2120 C<$borrower> borrower hashref
2122 C<$item> item hashref
2124 C<$datedue> date due DateTime object
2126 C<$today> DateTime object representing the return time
2128 Internal function, called only by AddReturn that calculates and updates
2129 the user fine days, and debars him if necessary.
2131 Should only be called for overdue returns
2135 sub _debar_user_on_return {
2136 my ( $borrower, $item, $dt_due, $dt_today ) = @_;
2138 my $branchcode = _GetCircControlBranch( $item, $borrower );
2140 my $circcontrol = C4::Context->preference('CircControl');
2142 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2143 my $finedays = $issuingrule->{finedays};
2144 my $unit = $issuingrule->{lengthunit};
2145 my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $dt_today, $branchcode);
2149 # finedays is in days, so hourly loans must multiply by 24
2150 # thus 1 hour late equals 1 day suspension * finedays rate
2151 $finedays = $finedays * 24 if ( $unit eq 'hours' );
2153 # grace period is measured in the same units as the loan
2155 DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
2157 my $deltadays = DateTime::Duration->new(
2158 days => $chargeable_units
2160 if ( $deltadays->subtract($grace)->is_positive() ) {
2161 my $suspension_days = $deltadays * $finedays;
2163 # If the max suspension days is < than the suspension days
2164 # the suspension days is limited to this maximum period.
2165 my $max_sd = $issuingrule->{maxsuspensiondays};
2166 if ( defined $max_sd ) {
2167 $max_sd = DateTime::Duration->new( days => $max_sd );
2168 $suspension_days = $max_sd
2169 if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2173 $dt_today->clone()->add_duration( $suspension_days );
2175 Koha::Borrower::Debarments::AddUniqueDebarment({
2176 borrowernumber => $borrower->{borrowernumber},
2177 expiration => $new_debar_dt->ymd(),
2178 type => 'SUSPENSION',
2180 # if borrower was already debarred but does not get an extra debarment
2181 if ( $borrower->{debarred} eq Koha::Borrower::Debarments::IsDebarred($borrower->{borrowernumber}) ) {
2182 return ($borrower->{debarred},1);
2184 return $new_debar_dt->ymd();
2190 =head2 _FixOverduesOnReturn
2192 &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2194 C<$brn> borrowernumber
2198 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2199 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2201 Internal function, called only by AddReturn
2205 sub _FixOverduesOnReturn {
2206 my ($borrowernumber, $item);
2207 unless ($borrowernumber = shift) {
2208 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2211 unless ($item = shift) {
2212 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2215 my ($exemptfine, $dropbox) = @_;
2216 my $dbh = C4::Context->dbh;
2218 # check for overdue fine
2219 my $sth = $dbh->prepare(
2220 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
2222 $sth->execute( $borrowernumber, $item );
2224 # alter fine to show that the book has been returned
2225 my $data = $sth->fetchrow_hashref;
2226 return 0 unless $data; # no warning, there's just nothing to fix
2229 my @bind = ($data->{'accountlines_id'});
2231 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2232 if (C4::Context->preference("FinesLog")) {
2233 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2235 } elsif ($dropbox && $data->{lastincrement}) {
2236 my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2237 my $amt = $data->{amount} - $data->{lastincrement} ;
2238 if (C4::Context->preference("FinesLog")) {
2239 &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2241 $uquery = "update accountlines set accounttype='F' ";
2242 if($outstanding >= 0 && $amt >=0) {
2243 $uquery .= ", amount = ? , amountoutstanding=? ";
2244 unshift @bind, ($amt, $outstanding) ;
2247 $uquery = "update accountlines set accounttype='F' ";
2249 $uquery .= " where (accountlines_id = ?)";
2250 my $usth = $dbh->prepare($uquery);
2251 return $usth->execute(@bind);
2254 =head2 _FixAccountForLostAndReturned
2256 &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2258 Calculates the charge for a book lost and returned.
2260 Internal function, not exported, called only by AddReturn.
2262 FIXME: This function reflects how inscrutable fines logic is. Fix both.
2263 FIXME: Give a positive return value on success. It might be the $borrowernumber who received credit, or the amount forgiven.
2267 sub _FixAccountForLostAndReturned {
2268 my $itemnumber = shift or return;
2269 my $borrowernumber = @_ ? shift : undef;
2270 my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
2271 my $dbh = C4::Context->dbh;
2272 # check for charge made for lost book
2273 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2274 $sth->execute($itemnumber);
2275 my $data = $sth->fetchrow_hashref;
2276 $data or return; # bail if there is nothing to do
2277 $data->{accounttype} eq 'W' and return; # Written off
2279 # writeoff this amount
2281 my $amount = $data->{'amount'};
2282 my $acctno = $data->{'accountno'};
2283 my $amountleft; # Starts off undef/zero.
2284 if ($data->{'amountoutstanding'} == $amount) {
2285 $offset = $data->{'amount'};
2286 $amountleft = 0; # Hey, it's zero here, too.
2288 $offset = $amount - $data->{'amountoutstanding'}; # Um, isn't this the same as ZERO? We just tested those two things are ==
2289 $amountleft = $data->{'amountoutstanding'} - $amount; # Um, isn't this the same as ZERO? We just tested those two things are ==
2291 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2292 WHERE (accountlines_id = ?)");
2293 $usth->execute($data->{'accountlines_id'}); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in.
2294 #check if any credit is left if so writeoff other accounts
2295 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2296 $amountleft *= -1 if ($amountleft < 0);
2297 if ($amountleft > 0) {
2298 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2299 AND (amountoutstanding >0) ORDER BY date"); # might want to order by amountoustanding ASC (pay smallest first)
2300 $msth->execute($data->{'borrowernumber'});
2301 # offset transactions
2304 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2305 if ($accdata->{'amountoutstanding'} < $amountleft) {
2307 $amountleft -= $accdata->{'amountoutstanding'};
2309 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2312 my $thisacct = $accdata->{'accountlines_id'};
2313 # FIXME: move prepares outside while loop!
2314 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2315 WHERE (accountlines_id = ?)");
2316 $usth->execute($newamtos,$thisacct);
2317 $usth = $dbh->prepare("INSERT INTO accountoffsets
2318 (borrowernumber, accountno, offsetaccount, offsetamount)
2321 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2324 $amountleft *= -1 if ($amountleft > 0);
2325 my $desc = "Item Returned " . $item_id;
2326 $usth = $dbh->prepare("INSERT INTO accountlines
2327 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2328 VALUES (?,?,now(),?,?,'CR',?)");
2329 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2330 if ($borrowernumber) {
2331 # FIXME: same as query above. use 1 sth for both
2332 $usth = $dbh->prepare("INSERT INTO accountoffsets
2333 (borrowernumber, accountno, offsetaccount, offsetamount)
2335 $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2337 ModItem({ paidfor => '' }, undef, $itemnumber);
2341 =head2 _GetCircControlBranch
2343 my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2347 Return the library code to be used to determine which circulation
2348 policy applies to a transaction. Looks up the CircControl and
2349 HomeOrHoldingBranch system preferences.
2351 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2353 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2357 sub _GetCircControlBranch {
2358 my ($item, $borrower) = @_;
2359 my $circcontrol = C4::Context->preference('CircControl');
2362 if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2363 $branch= C4::Context->userenv->{'branch'};
2364 } elsif ($circcontrol eq 'PatronLibrary') {
2365 $branch=$borrower->{branchcode};
2367 my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2368 $branch = $item->{$branchfield};
2369 # default to item home branch if holdingbranch is used
2370 # and is not defined
2371 if (!defined($branch) && $branchfield eq 'holdingbranch') {
2372 $branch = $item->{homebranch};
2385 $issue = &GetItemIssue($itemnumber);
2387 Returns patron currently having a book, or undef if not checked out.
2389 C<$itemnumber> is the itemnumber.
2391 C<$issue> is a hashref of the row from the issues table.
2396 my ($itemnumber) = @_;
2397 return unless $itemnumber;
2398 my $sth = C4::Context->dbh->prepare(
2399 "SELECT items.*, issues.*
2401 LEFT JOIN items ON issues.itemnumber=items.itemnumber
2402 WHERE issues.itemnumber=?");
2403 $sth->execute($itemnumber);
2404 my $data = $sth->fetchrow_hashref;
2405 return unless $data;
2406 $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2407 $data->{issuedate}->truncate(to => 'minute');
2408 $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2409 $data->{date_due}->truncate(to => 'minute');
2410 my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2411 $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2417 $issue = GetOpenIssue( $itemnumber );
2419 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2421 C<$itemnumber> is the item's itemnumber
2428 my ( $itemnumber ) = @_;
2429 return unless $itemnumber;
2430 my $dbh = C4::Context->dbh;
2431 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2432 $sth->execute( $itemnumber );
2433 return $sth->fetchrow_hashref();
2439 $issues = GetIssues({}); # return all issues!
2440 $issues = GetIssues({ borrowernumber => $borrowernumber, biblionumber => $biblionumber });
2442 Returns all pending issues that match given criteria.
2443 Returns a arrayref or undef if an error occurs.
2445 Allowed criteria are:
2449 =item * borrowernumber
2451 =item * biblionumber
2460 my ($criteria) = @_;
2464 my @allowed = qw(borrowernumber biblionumber itemnumber);
2465 foreach (@allowed) {
2466 if (defined $criteria->{$_}) {
2469 value => $criteria->{$_},
2474 # Do we need to join other tables ?
2476 if (defined $criteria->{biblionumber}) {
2483 $where = "WHERE " . join(' AND ', map { "$_->{field} = ?" } @filters);
2489 if (defined $join{items}) {
2491 LEFT JOIN items ON (issues.itemnumber = items.itemnumber)
2497 my $dbh = C4::Context->dbh;
2498 my $sth = $dbh->prepare($query);
2499 my $rv = $sth->execute(map { $_->{value} } @filters);
2501 return $rv ? $sth->fetchall_arrayref({}) : undef;
2504 =head2 GetItemIssues
2506 $issues = &GetItemIssues($itemnumber, $history);
2508 Returns patrons that have issued a book
2510 C<$itemnumber> is the itemnumber
2511 C<$history> is false if you just want the current "issuer" (if any)
2512 and true if you want issues history from old_issues also.
2514 Returns reference to an array of hashes
2519 my ( $itemnumber, $history ) = @_;
2521 my $today = DateTime->now( time_zome => C4::Context->tz); # get today date
2522 $today->truncate( to => 'minute' );
2523 my $sql = "SELECT * FROM issues
2524 JOIN borrowers USING (borrowernumber)
2525 JOIN items USING (itemnumber)
2526 WHERE issues.itemnumber = ? ";
2529 SELECT * FROM old_issues
2530 LEFT JOIN borrowers USING (borrowernumber)
2531 JOIN items USING (itemnumber)
2532 WHERE old_issues.itemnumber = ? ";
2534 $sql .= "ORDER BY date_due DESC";
2535 my $sth = C4::Context->dbh->prepare($sql);
2537 $sth->execute($itemnumber, $itemnumber);
2539 $sth->execute($itemnumber);
2541 my $results = $sth->fetchall_arrayref({});
2542 foreach (@$results) {
2543 my $date_due = dt_from_string($_->{date_due},'sql');
2544 $date_due->truncate( to => 'minute' );
2546 $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2551 =head2 GetBiblioIssues
2553 $issues = GetBiblioIssues($biblionumber);
2555 this function get all issues from a biblionumber.
2558 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2559 tables issues and the firstname,surname & cardnumber from borrowers.
2563 sub GetBiblioIssues {
2564 my $biblionumber = shift;
2565 return unless $biblionumber;
2566 my $dbh = C4::Context->dbh;
2568 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2570 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2571 LEFT JOIN items ON issues.itemnumber = items.itemnumber
2572 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2573 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2574 WHERE biblio.biblionumber = ?
2576 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2578 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2579 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2580 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2581 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2582 WHERE biblio.biblionumber = ?
2585 my $sth = $dbh->prepare($query);
2586 $sth->execute($biblionumber, $biblionumber);
2589 while ( my $data = $sth->fetchrow_hashref ) {
2590 push @issues, $data;
2595 =head2 GetUpcomingDueIssues
2597 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2601 sub GetUpcomingDueIssues {
2604 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2605 my $dbh = C4::Context->dbh;
2607 my $statement = <<END_SQL;
2608 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2610 LEFT JOIN items USING (itemnumber)
2611 LEFT OUTER JOIN branches USING (branchcode)
2612 WHERE returndate is NULL
2613 HAVING days_until_due >= 0 AND days_until_due <= ?
2616 my @bind_parameters = ( $params->{'days_in_advance'} );
2618 my $sth = $dbh->prepare( $statement );
2619 $sth->execute( @bind_parameters );
2620 my $upcoming_dues = $sth->fetchall_arrayref({});
2622 return $upcoming_dues;
2625 =head2 CanBookBeRenewed
2627 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2629 Find out whether a borrowed item may be renewed.
2631 C<$borrowernumber> is the borrower number of the patron who currently
2632 has the item on loan.
2634 C<$itemnumber> is the number of the item to renew.
2636 C<$override_limit>, if supplied with a true value, causes
2637 the limit on the number of times that the loan can be renewed
2638 (as controlled by the item type) to be ignored. Overriding also allows
2639 to renew sooner than "No renewal before" and to manually renew loans
2640 that are automatically renewed.
2642 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2643 item must currently be on loan to the specified borrower; renewals
2644 must be allowed for the item's type; and the borrower must not have
2645 already renewed the loan. $error will contain the reason the renewal can not proceed
2649 sub CanBookBeRenewed {
2650 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2652 my $dbh = C4::Context->dbh;
2655 my $item = GetItem($itemnumber) or return ( 0, 'no_item' );
2656 my $itemissue = GetItemIssue($itemnumber) or return ( 0, 'no_checkout' );
2658 $borrowernumber ||= $itemissue->{borrowernumber};
2659 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
2662 my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2664 # This item can fill one or more unfilled reserve, can those unfilled reserves
2665 # all be filled by other available items?
2667 && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2669 my $schema = Koha::Database->new()->schema();
2671 # Get all other items that could possibly fill reserves
2672 my @itemnumbers = $schema->resultset('Item')->search(
2674 biblionumber => $resrec->{biblionumber},
2676 -not => { itemnumber => $itemnumber }
2678 { columns => 'itemnumber' }
2679 )->get_column('itemnumber')->all();
2681 # Get all other reserves that could have been filled by this item
2682 my @borrowernumbers;
2684 my ( $reserve_found, $reserve, undef ) =
2685 C4::Reserves::CheckReserves( $itemnumber, undef, undef,
2686 \@borrowernumbers );
2688 if ($reserve_found) {
2689 push( @borrowernumbers, $reserve->{borrowernumber} );
2696 # If the count of the union of the lists of reservable items for each borrower
2697 # is equal or greater than the number of borrowers, we know that all reserves
2698 # can be filled with available items. We can get the union of the sets simply
2699 # by pushing all the elements onto an array and removing the duplicates.
2701 foreach my $b (@borrowernumbers) {
2702 my ( $borr ) = C4::Members::GetMemberDetails( $b );
2703 foreach my $i (@itemnumbers) {
2704 my $item = GetItem($i);
2705 if ( IsAvailableForItemLevelRequest($item, $borr)
2706 && CanItemBeReserved( $b, $i )
2707 && !IsItemOnHoldAndFound($i) )
2709 push( @reservable, $i );
2714 @reservable = uniq(@reservable);
2716 if ( @reservable >= @borrowernumbers ) {
2721 return ( 0, "on_reserve" ) if $resfound; # '' when no hold was found
2723 return ( 1, undef ) if $override_limit;
2725 my $branchcode = _GetCircControlBranch( $item, $borrower );
2727 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2729 return ( 0, "too_many" )
2730 if $issuingrule->{renewalsallowed} <= $itemissue->{renewals};
2732 if ( $issuingrule->{norenewalbefore} ) {
2734 # Get current time and add norenewalbefore.
2735 # If this is smaller than date_due, it's too soon for renewal.
2737 DateTime->now( time_zone => C4::Context->tz() )->add(
2738 $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore}
2739 ) < $itemissue->{date_due}
2742 return ( 0, "auto_too_soon" ) if $itemissue->{auto_renew};
2743 return ( 0, "too_soon" );
2747 return ( 0, "auto_renew" ) if $itemissue->{auto_renew};
2748 return ( 1, undef );
2753 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2757 C<$borrowernumber> is the borrower number of the patron who currently
2760 C<$itemnumber> is the number of the item to renew.
2762 C<$branch> is the library where the renewal took place (if any).
2763 The library that controls the circ policies for the renewal is retrieved from the issues record.
2765 C<$datedue> can be a C4::Dates object used to set the due date.
2767 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
2768 this parameter is not supplied, lastreneweddate is set to the current date.
2770 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2771 from the book's item type.
2776 my $borrowernumber = shift;
2777 my $itemnumber = shift or return;
2779 my $datedue = shift;
2780 my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2782 my $item = GetItem($itemnumber) or return;
2783 my $biblio = GetBiblioFromItemNumber($itemnumber) or return;
2785 my $dbh = C4::Context->dbh;
2787 # Find the issues record for this book
2789 $dbh->prepare("SELECT * FROM issues WHERE itemnumber = ?");
2790 $sth->execute( $itemnumber );
2791 my $issuedata = $sth->fetchrow_hashref;
2793 return unless ( $issuedata );
2795 $borrowernumber ||= $issuedata->{borrowernumber};
2797 if ( defined $datedue && ref $datedue ne 'DateTime' ) {
2798 carp 'Invalid date passed to AddRenewal.';
2802 # If the due date wasn't specified, calculate it by adding the
2803 # book's loan length to today's date or the current due date
2804 # based on the value of the RenewalPeriodBase syspref.
2807 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return;
2808 my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2810 $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2811 dt_from_string( $issuedata->{date_due} ) :
2812 DateTime->now( time_zone => C4::Context->tz());
2813 $datedue = CalcDateDue($datedue, $itemtype, $issuedata->{'branchcode'}, $borrower, 'is a renewal');
2816 # Update the issues record to have the new due date, and a new count
2817 # of how many times it has been renewed.
2818 my $renews = $issuedata->{'renewals'} + 1;
2819 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2820 WHERE borrowernumber=?
2824 $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2826 # Update the renewal count on the item, and tell zebra to reindex
2827 $renews = $biblio->{'renewals'} + 1;
2828 ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
2830 # Charge a new rental fee, if applicable?
2831 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2832 if ( $charge > 0 ) {
2833 my $accountno = getnextacctno( $borrowernumber );
2834 my $item = GetBiblioFromItemNumber($itemnumber);
2836 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2837 $sth = $dbh->prepare(
2838 "INSERT INTO accountlines
2839 (date, borrowernumber, accountno, amount, manager_id,
2840 description,accounttype, amountoutstanding, itemnumber)
2841 VALUES (now(),?,?,?,?,?,?,?,?)"
2843 $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2844 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2845 'Rent', $charge, $itemnumber );
2848 # Send a renewal slip according to checkout alert preferencei
2849 if ( C4::Context->preference('RenewalSendNotice') eq '1') {
2850 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
2851 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2853 branchcode => $branch,
2854 categorycode => $borrower->{categorycode},
2855 item_type => $item->{itype},
2856 notification => 'CHECKOUT',
2858 if ($circulation_alert->is_enabled_for(\%conditions)) {
2859 SendCirculationAlert({
2862 borrower => $borrower,
2868 # Remove any OVERDUES related debarment if the borrower has no overdues
2869 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
2870 if ( $borrowernumber
2871 && $borrower->{'debarred'}
2872 && !C4::Members::HasOverdues( $borrowernumber )
2873 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2875 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2879 UpdateStats({branch => $branch,
2882 itemnumber => $itemnumber,
2883 itemtype => $item->{itype},
2884 borrowernumber => $borrowernumber,
2885 ccode => $item->{'ccode'}}
2891 # check renewal status
2892 my ( $bornum, $itemno ) = @_;
2893 my $dbh = C4::Context->dbh;
2895 my $renewsallowed = 0;
2898 my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
2899 my $item = GetItem($itemno);
2901 # Look in the issues table for this item, lent to this borrower,
2902 # and not yet returned.
2904 # FIXME - I think this function could be redone to use only one SQL call.
2905 my $sth = $dbh->prepare(
2906 "select * from issues
2907 where (borrowernumber = ?)
2908 and (itemnumber = ?)"
2910 $sth->execute( $bornum, $itemno );
2911 my $data = $sth->fetchrow_hashref;
2912 $renewcount = $data->{'renewals'} if $data->{'renewals'};
2913 # $item and $borrower should be calculated
2914 my $branchcode = _GetCircControlBranch($item, $borrower);
2916 my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
2918 $renewsallowed = $issuingrule->{'renewalsallowed'};
2919 $renewsleft = $renewsallowed - $renewcount;
2920 if($renewsleft < 0){ $renewsleft = 0; }
2921 return ( $renewcount, $renewsallowed, $renewsleft );
2924 =head2 GetSoonestRenewDate
2926 $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
2928 Find out the soonest possible renew date of a borrowed item.
2930 C<$borrowernumber> is the borrower number of the patron who currently
2931 has the item on loan.
2933 C<$itemnumber> is the number of the item to renew.
2935 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
2936 renew date, based on the value "No renewal before" of the applicable
2937 issuing rule. Returns the current date if the item can already be
2938 renewed, and returns undefined if the borrower, loan, or item
2943 sub GetSoonestRenewDate {
2944 my ( $borrowernumber, $itemnumber ) = @_;
2946 my $dbh = C4::Context->dbh;
2948 my $item = GetItem($itemnumber) or return;
2949 my $itemissue = GetItemIssue($itemnumber) or return;
2951 $borrowernumber ||= $itemissue->{borrowernumber};
2952 my $borrower = C4::Members::GetMemberDetails($borrowernumber)
2955 my $branchcode = _GetCircControlBranch( $item, $borrower );
2957 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2959 my $now = DateTime->now( time_zone => C4::Context->tz() );
2961 if ( $issuingrule->{norenewalbefore} ) {
2962 my $soonestrenewal =
2963 $itemissue->{date_due}->subtract(
2964 $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
2966 $soonestrenewal = $now > $soonestrenewal ? $now : $soonestrenewal;
2967 return $soonestrenewal;
2972 =head2 GetIssuingCharges
2974 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2976 Calculate how much it would cost for a given patron to borrow a given
2977 item, including any applicable discounts.
2979 C<$itemnumber> is the item number of item the patron wishes to borrow.
2981 C<$borrowernumber> is the patron's borrower number.
2983 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2984 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2989 sub GetIssuingCharges {
2991 # calculate charges due
2992 my ( $itemnumber, $borrowernumber ) = @_;
2994 my $dbh = C4::Context->dbh;
2997 # Get the book's item type and rental charge (via its biblioitem).
2998 my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
2999 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3000 $charge_query .= (C4::Context->preference('item-level_itypes'))
3001 ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3002 : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3004 $charge_query .= ' WHERE items.itemnumber =?';
3006 my $sth = $dbh->prepare($charge_query);
3007 $sth->execute($itemnumber);
3008 if ( my $item_data = $sth->fetchrow_hashref ) {
3009 $item_type = $item_data->{itemtype};
3010 $charge = $item_data->{rentalcharge};
3011 my $branch = C4::Branch::mybranch();
3012 my $discount_query = q|SELECT rentaldiscount,
3013 issuingrules.itemtype, issuingrules.branchcode
3015 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3016 WHERE borrowers.borrowernumber = ?
3017 AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3018 AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3019 my $discount_sth = $dbh->prepare($discount_query);
3020 $discount_sth->execute( $borrowernumber, $item_type, $branch );
3021 my $discount_rules = $discount_sth->fetchall_arrayref({});
3022 if (@{$discount_rules}) {
3023 # We may have multiple rules so get the most specific
3024 my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3025 $charge = ( $charge * ( 100 - $discount ) ) / 100;
3029 return ( $charge, $item_type );
3032 # Select most appropriate discount rule from those returned
3033 sub _get_discount_from_rule {
3034 my ($rules_ref, $branch, $itemtype) = @_;
3037 if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3038 $discount = $rules_ref->[0]->{rentaldiscount};
3039 return (defined $discount) ? $discount : 0;
3041 # could have up to 4 does one match $branch and $itemtype
3042 my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3044 $discount = $d[0]->{rentaldiscount};
3045 return (defined $discount) ? $discount : 0;
3047 # do we have item type + all branches
3048 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3050 $discount = $d[0]->{rentaldiscount};
3051 return (defined $discount) ? $discount : 0;
3053 # do we all item types + this branch
3054 @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3056 $discount = $d[0]->{rentaldiscount};
3057 return (defined $discount) ? $discount : 0;
3059 # so all and all (surely we wont get here)
3060 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3062 $discount = $d[0]->{rentaldiscount};
3063 return (defined $discount) ? $discount : 0;
3069 =head2 AddIssuingCharge
3071 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3075 sub AddIssuingCharge {
3076 my ( $itemnumber, $borrowernumber, $charge ) = @_;
3077 my $dbh = C4::Context->dbh;
3078 my $nextaccntno = getnextacctno( $borrowernumber );
3080 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3082 INSERT INTO accountlines
3083 (borrowernumber, itemnumber, accountno,
3084 date, amount, description, accounttype,
3085 amountoutstanding, manager_id)
3086 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
3088 my $sth = $dbh->prepare($query);
3089 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
3094 GetTransfers($itemnumber);
3099 my ($itemnumber) = @_;
3101 my $dbh = C4::Context->dbh;
3107 FROM branchtransfers
3108 WHERE itemnumber = ?
3109 AND datearrived IS NULL
3111 my $sth = $dbh->prepare($query);
3112 $sth->execute($itemnumber);
3113 my @row = $sth->fetchrow_array();
3117 =head2 GetTransfersFromTo
3119 @results = GetTransfersFromTo($frombranch,$tobranch);
3121 Returns the list of pending transfers between $from and $to branch
3125 sub GetTransfersFromTo {
3126 my ( $frombranch, $tobranch ) = @_;
3127 return unless ( $frombranch && $tobranch );
3128 my $dbh = C4::Context->dbh;
3130 SELECT itemnumber,datesent,frombranch
3131 FROM branchtransfers
3134 AND datearrived IS NULL
3136 my $sth = $dbh->prepare($query);
3137 $sth->execute( $frombranch, $tobranch );
3140 while ( my $data = $sth->fetchrow_hashref ) {
3141 push @gettransfers, $data;
3143 return (@gettransfers);
3146 =head2 DeleteTransfer
3148 &DeleteTransfer($itemnumber);
3152 sub DeleteTransfer {
3153 my ($itemnumber) = @_;
3154 return unless $itemnumber;
3155 my $dbh = C4::Context->dbh;
3156 my $sth = $dbh->prepare(
3157 "DELETE FROM branchtransfers
3159 AND datearrived IS NULL "
3161 return $sth->execute($itemnumber);
3164 =head2 AnonymiseIssueHistory
3166 ($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)
3168 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
3169 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
3171 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
3172 setting (force delete).
3174 return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.
3178 sub AnonymiseIssueHistory {
3180 my $borrowernumber = shift;
3181 my $dbh = C4::Context->dbh;
3184 SET borrowernumber = ?
3185 WHERE returndate < ?
3186 AND borrowernumber IS NOT NULL
3189 # The default of 0 does not work due to foreign key constraints
3190 # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
3191 my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
3192 my @bind_params = ($anonymouspatron, $date);
3193 if (defined $borrowernumber) {
3194 $query .= " AND borrowernumber = ?";
3195 push @bind_params, $borrowernumber;
3197 $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
3199 my $sth = $dbh->prepare($query);
3200 $sth->execute(@bind_params);
3201 my $anonymisation_err = $dbh->err;
3202 my $rows_affected = $sth->rows; ### doublecheck row count return function
3203 return ($rows_affected, $anonymisation_err);
3206 =head2 SendCirculationAlert
3208 Send out a C<check-in> or C<checkout> alert using the messaging system.
3216 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3220 Hashref of information about the item being checked in or out.
3224 Hashref of information about the borrower of the item.
3228 The branchcode from where the checkout or check-in took place.
3234 SendCirculationAlert({
3237 borrower => $borrower,
3243 sub SendCirculationAlert {
3245 my ($type, $item, $borrower, $branch) =
3246 ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3247 my %message_name = (
3248 CHECKIN => 'Item_Check_in',
3249 CHECKOUT => 'Item_Checkout',
3250 RENEWAL => 'Item_Checkout',
3252 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3253 borrowernumber => $borrower->{borrowernumber},
3254 message_name => $message_name{$type},
3256 my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3258 my @transports = keys %{ $borrower_preferences->{transports} };
3259 # warn "no transports" unless @transports;
3261 # warn "transport: $_";
3262 my $message = C4::Message->find_last_message($borrower, $type, $_);
3264 #warn "create new message";
3265 my $letter = C4::Letters::GetPreparedLetter (
3266 module => 'circulation',
3267 letter_code => $type,
3268 branchcode => $branch,
3269 message_transport_type => $_,
3271 $issues_table => $item->{itemnumber},
3272 'items' => $item->{itemnumber},
3273 'biblio' => $item->{biblionumber},
3274 'biblioitems' => $item->{biblionumber},
3275 'borrowers' => $borrower,
3276 'branches' => $branch,
3279 C4::Message->enqueue($letter, $borrower, $_);
3281 #warn "append to old message";
3282 my $letter = C4::Letters::GetPreparedLetter (
3283 module => 'circulation',
3284 letter_code => $type,
3285 branchcode => $branch,
3286 message_transport_type => $_,
3288 $issues_table => $item->{itemnumber},
3289 'items' => $item->{itemnumber},
3290 'biblio' => $item->{biblionumber},
3291 'biblioitems' => $item->{biblionumber},
3292 'borrowers' => $borrower,
3293 'branches' => $branch,
3296 $message->append($letter);
3304 =head2 updateWrongTransfer
3306 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3308 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
3312 sub updateWrongTransfer {
3313 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3314 my $dbh = C4::Context->dbh;
3315 # first step validate the actual line of transfert .
3318 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3320 $sth->execute($FromLibrary,$itemNumber);
3322 # second step create a new line of branchtransfer to the right location .
3323 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3325 #third step changing holdingbranch of item
3326 UpdateHoldingbranch($FromLibrary,$itemNumber);
3329 =head2 UpdateHoldingbranch
3331 $items = UpdateHoldingbranch($branch,$itmenumber);
3333 Simple methode for updating hodlingbranch in items BDD line
3337 sub UpdateHoldingbranch {
3338 my ( $branch,$itemnumber ) = @_;
3339 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3344 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3346 this function calculates the due date given the start date and configured circulation rules,
3347 checking against the holidays calendar as per the 'useDaysMode' syspref.
3348 C<$startdate> = C4::Dates object representing start date of loan period (assumed to be today)
3349 C<$itemtype> = itemtype code of item in question
3350 C<$branch> = location whose calendar to use
3351 C<$borrower> = Borrower object
3352 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3357 my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3361 # loanlength now a href
3363 GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3365 my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3371 if (ref $startdate ne 'DateTime' ) {
3372 $datedue = dt_from_string($datedue);
3374 $datedue = $startdate->clone;
3378 DateTime->now( time_zone => C4::Context->tz() )
3379 ->truncate( to => 'minute' );
3383 # calculate the datedue as normal
3384 if ( C4::Context->preference('useDaysMode') eq 'Days' )
3385 { # ignoring calendar
3386 if ( $loanlength->{lengthunit} eq 'hours' ) {
3387 $datedue->add( hours => $loanlength->{$length_key} );
3389 $datedue->add( days => $loanlength->{$length_key} );
3390 $datedue->set_hour(23);
3391 $datedue->set_minute(59);
3395 if ($loanlength->{lengthunit} eq 'hours') {
3396 $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3399 $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3401 my $calendar = Koha::Calendar->new( branchcode => $branch );
3402 $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3403 if ($loanlength->{lengthunit} eq 'days') {
3404 $datedue->set_hour(23);
3405 $datedue->set_minute(59);
3409 # if Hard Due Dates are used, retreive them and apply as necessary
3410 my ( $hardduedate, $hardduedatecompare ) =
3411 GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3412 if ($hardduedate) { # hardduedates are currently dates
3413 $hardduedate->truncate( to => 'minute' );
3414 $hardduedate->set_hour(23);
3415 $hardduedate->set_minute(59);
3416 my $cmp = DateTime->compare( $hardduedate, $datedue );
3418 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3419 # if the calculated date is before the 'after' Hard Due Date (floor), override
3420 # if the hard due date is set to 'exactly', overrride
3421 if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3422 $datedue = $hardduedate->clone;
3425 # in all other cases, keep the date due as it is
3429 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3430 if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3431 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso' );
3432 $expiry_dt->set( hour => 23, minute => 59);
3433 if ( DateTime->compare( $datedue, $expiry_dt ) == 1 ) {
3434 $datedue = $expiry_dt->clone;
3442 =head2 CheckRepeatableHolidays
3444 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
3446 This function checks if the date due is a repeatable holiday
3448 C<$date_due> = returndate calculate with no day check
3449 C<$itemnumber> = itemnumber
3450 C<$branchcode> = localisation of issue
3454 sub CheckRepeatableHolidays{
3455 my($itemnumber,$week_day,$branchcode)=@_;
3456 my $dbh = C4::Context->dbh;
3457 my $query = qq|SELECT count(*)
3458 FROM repeatable_holidays
3461 my $sth = $dbh->prepare($query);
3462 $sth->execute($branchcode,$week_day);
3463 my $result=$sth->fetchrow;
3468 =head2 CheckSpecialHolidays
3470 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
3472 This function check if the date is a special holiday
3474 C<$years> = the years of datedue
3475 C<$month> = the month of datedue
3476 C<$day> = the day of datedue
3477 C<$itemnumber> = itemnumber
3478 C<$branchcode> = localisation of issue
3482 sub CheckSpecialHolidays{
3483 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
3484 my $dbh = C4::Context->dbh;
3485 my $query=qq|SELECT count(*)
3486 FROM `special_holidays`
3492 my $sth = $dbh->prepare($query);
3493 $sth->execute($years,$month,$day,$branchcode);
3494 my $countspecial=$sth->fetchrow ;
3495 return $countspecial;
3498 =head2 CheckRepeatableSpecialHolidays
3500 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
3502 This function check if the date is a repeatble special holidays
3504 C<$month> = the month of datedue
3505 C<$day> = the day of datedue
3506 C<$itemnumber> = itemnumber
3507 C<$branchcode> = localisation of issue
3511 sub CheckRepeatableSpecialHolidays{
3512 my ($month,$day,$itemnumber,$branchcode) = @_;
3513 my $dbh = C4::Context->dbh;
3514 my $query=qq|SELECT count(*)
3515 FROM `repeatable_holidays`
3520 my $sth = $dbh->prepare($query);
3521 $sth->execute($month,$day,$branchcode);
3522 my $countspecial=$sth->fetchrow ;
3523 return $countspecial;
3528 sub CheckValidBarcode{
3530 my $dbh = C4::Context->dbh;
3531 my $query=qq|SELECT count(*)
3535 my $sth = $dbh->prepare($query);
3536 $sth->execute($barcode);
3537 my $exist=$sth->fetchrow ;
3541 =head2 IsBranchTransferAllowed
3543 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3545 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3549 sub IsBranchTransferAllowed {
3550 my ( $toBranch, $fromBranch, $code ) = @_;
3552 if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3554 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3555 my $dbh = C4::Context->dbh;
3557 my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3558 $sth->execute( $toBranch, $fromBranch, $code );
3559 my $limit = $sth->fetchrow_hashref();
3561 ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3562 if ( $limit->{'limitId'} ) {
3569 =head2 CreateBranchTransferLimit
3571 CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3573 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3577 sub CreateBranchTransferLimit {
3578 my ( $toBranch, $fromBranch, $code ) = @_;
3579 return unless defined($toBranch) && defined($fromBranch);
3580 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3582 my $dbh = C4::Context->dbh;
3584 my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3585 return $sth->execute( $code, $toBranch, $fromBranch );
3588 =head2 DeleteBranchTransferLimits
3590 my $result = DeleteBranchTransferLimits($frombranch);
3592 Deletes all the library transfer limits for one library. Returns the
3593 number of limits deleted, 0e0 if no limits were deleted, or undef if
3594 no arguments are supplied.
3598 sub DeleteBranchTransferLimits {
3600 return unless defined $branch;
3601 my $dbh = C4::Context->dbh;
3602 my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3603 return $sth->execute($branch);
3607 my ( $borrowernumber, $itemnum ) = @_;
3609 MarkIssueReturned( $borrowernumber, $itemnum );
3610 my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3611 my $item = C4::Items::GetItem( $itemnum );
3612 my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3613 my @datearr = localtime(time);
3614 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3615 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3616 ModItem({ paidfor => $old_note."Paid for by $bor $date" }, undef, $itemnum);
3621 my ($itemnumber, $mark_returned) = @_;
3623 my $dbh = C4::Context->dbh();
3624 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3626 JOIN items USING (itemnumber)
3627 JOIN biblio USING (biblionumber)
3628 WHERE issues.itemnumber=?");
3629 $sth->execute($itemnumber);
3630 my $issues=$sth->fetchrow_hashref();
3632 # If a borrower lost the item, add a replacement cost to the their record
3633 if ( my $borrowernumber = $issues->{borrowernumber} ){
3634 my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3636 if (C4::Context->preference('WhenLostForgiveFine')){
3637 my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3638 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!"; # zero is OK, check defined
3640 if (C4::Context->preference('WhenLostChargeReplacementFee')){
3641 C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3642 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3643 #warn " $issues->{'borrowernumber'} / $itemnumber ";
3646 MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3650 sub GetOfflineOperations {
3651 my $dbh = C4::Context->dbh;
3652 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3653 $sth->execute(C4::Context->userenv->{'branch'});
3654 my $results = $sth->fetchall_arrayref({});
3658 sub GetOfflineOperation {
3659 my $operationid = shift;
3660 return unless $operationid;
3661 my $dbh = C4::Context->dbh;
3662 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3663 $sth->execute( $operationid );
3664 return $sth->fetchrow_hashref;
3667 sub AddOfflineOperation {
3668 my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3669 my $dbh = C4::Context->dbh;
3670 my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3671 $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3675 sub DeleteOfflineOperation {
3676 my $dbh = C4::Context->dbh;
3677 my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3678 $sth->execute( shift );
3682 sub ProcessOfflineOperation {
3683 my $operation = shift;
3686 if ( $operation->{action} eq 'return' ) {
3687 $report = ProcessOfflineReturn( $operation );
3688 } elsif ( $operation->{action} eq 'issue' ) {
3689 $report = ProcessOfflineIssue( $operation );
3690 } elsif ( $operation->{action} eq 'payment' ) {
3691 $report = ProcessOfflinePayment( $operation );
3694 DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3699 sub ProcessOfflineReturn {
3700 my $operation = shift;
3702 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3704 if ( $itemnumber ) {
3705 my $issue = GetOpenIssue( $itemnumber );
3708 $issue->{borrowernumber},
3711 $operation->{timestamp},
3714 { renewals => 0, onloan => undef },
3715 $issue->{'biblionumber'},
3720 return "Item not issued.";
3723 return "Item not found.";
3727 sub ProcessOfflineIssue {
3728 my $operation = shift;
3730 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3732 if ( $borrower->{borrowernumber} ) {
3733 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3734 unless ($itemnumber) {
3735 return "Barcode not found.";
3737 my $issue = GetOpenIssue( $itemnumber );
3739 if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3741 $issue->{borrowernumber},
3744 $operation->{timestamp},
3749 $operation->{'barcode'},
3752 $operation->{timestamp},
3757 return "Borrower not found.";
3761 sub ProcessOfflinePayment {
3762 my $operation = shift;
3764 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3765 my $amount = $operation->{amount};
3767 recordpayment( $borrower->{borrowernumber}, $amount );
3775 TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3777 Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3782 my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3784 my $item = GetItem( $itemnumber, $barcode )
3787 my $pulldate = C4::Dates->new();
3789 return C4::Letters::GetPreparedLetter (
3790 module => 'circulation',
3791 letter_code => 'TRANSFERSLIP',
3792 branchcode => $branch,
3794 'branches' => $to_branch,
3795 'biblio' => $item->{biblionumber},
3801 =head2 CheckIfIssuedToPatron
3803 CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3805 Return 1 if any record item is issued to patron, otherwise return 0
3809 sub CheckIfIssuedToPatron {
3810 my ($borrowernumber, $biblionumber) = @_;
3812 my $items = GetItemsByBiblioitemnumber($biblionumber);
3814 foreach my $item (@{$items}) {
3815 return 1 if ($item->{borrowernumber} && $item->{borrowernumber} eq $borrowernumber);
3823 IsItemIssued( $itemnumber )
3825 Return 1 if the item is on loan, otherwise return 0
3830 my $itemnumber = shift;
3831 my $dbh = C4::Context->dbh;
3832 my $sth = $dbh->prepare(q{
3835 WHERE itemnumber = ?
3837 $sth->execute($itemnumber);
3838 return $sth->fetchrow;
3841 =head2 GetAgeRestriction
3843 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3844 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3846 if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }
3847 if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3849 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3850 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3851 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3852 Negative days mean the borrower has gone past the age restriction age.
3856 sub GetAgeRestriction {
3857 my ($record_restrictions, $borrower) = @_;
3858 my $markers = C4::Context->preference('AgeRestrictionMarker');
3860 # Split $record_restrictions to something like FSK 16 or PEGI 6
3861 my @values = split ' ', uc($record_restrictions);
3862 return unless @values;
3864 # Search first occurence of one of the markers
3865 my @markers = split /\|/, uc($markers);
3866 return unless @markers;
3869 my $restriction_year = 0;
3870 for my $value (@values) {
3872 for my $marker (@markers) {
3873 $marker =~ s/^\s+//; #remove leading spaces
3874 $marker =~ s/\s+$//; #remove trailing spaces
3875 if ( $marker eq $value ) {
3876 if ( $index <= $#values ) {
3877 $restriction_year += $values[$index];
3881 elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
3883 # Perhaps it is something like "K16" (as in Finland)
3884 $restriction_year += $1;
3888 last if ( $restriction_year > 0 );
3891 #Check if the borrower is age restricted for this material and for how long.
3892 if ($restriction_year && $borrower) {
3893 if ( $borrower->{'dateofbirth'} ) {
3894 my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3895 $alloweddate[0] += $restriction_year;
3897 #Prevent runime eror on leap year (invalid date)
3898 if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3899 $alloweddate[2] = 28;
3902 #Get how many days the borrower has to reach the age restriction
3903 my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(Today);
3904 #Negative days means the borrower went past the age restriction age
3905 return ($restriction_year, $daysToAgeRestriction);
3909 return ($restriction_year);
3914 =head2 GetPendingOnSiteCheckouts
3918 sub GetPendingOnSiteCheckouts {
3919 my $dbh = C4::Context->dbh;
3920 return $dbh->selectall_arrayref(q|
3926 items.itemcallnumber,
3930 issues.date_due < NOW() AS is_overdue,
3933 borrowers.firstname,
3935 borrowers.cardnumber,
3936 borrowers.borrowernumber
3938 LEFT JOIN issues ON items.itemnumber = issues.itemnumber
3939 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
3940 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
3941 WHERE issues.onsite_checkout = 1
3942 |, { Slice => {} } );
3949 Koha Development Team <http://koha-community.org/>