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);
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
78 # subs to deal with issuing a book
90 &GetBranchBorrowerCircRule
94 &AnonymiseIssueHistory
95 &CheckIfIssuedToPatron
99 # subs to deal with returns
105 # subs to deal with transfers
112 &IsBranchTransferAllowed
113 &CreateBranchTransferLimit
114 &DeleteBranchTransferLimits
118 # subs to deal with offline circulation
120 &GetOfflineOperations
123 &DeleteOfflineOperation
124 &ProcessOfflineOperation
130 C4::Circulation - Koha circulation module
138 The functions in this module deal with circulation, issues, and
139 returns, as well as general information about the library.
140 Also deals with stocktaking.
146 $str = &barcodedecode($barcode, [$filter]);
148 Generic filter function for barcode string.
149 Called on every circ if the System Pref itemBarcodeInputFilter is set.
150 Will do some manipulation of the barcode for systems that deliver a barcode
151 to circulation.pl that differs from the barcode stored for the item.
152 For proper functioning of this filter, calling the function on the
153 correct barcode string (items.barcode) should return an unaltered barcode.
155 The optional $filter argument is to allow for testing or explicit
156 behavior that ignores the System Pref. Valid values are the same as the
161 # FIXME -- the &decode fcn below should be wrapped into this one.
162 # FIXME -- these plugins should be moved out of Circulation.pm
165 my ($barcode, $filter) = @_;
166 my $branch = C4::Branch::mybranch();
167 $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
168 $filter or return $barcode; # ensure filter is defined, else return untouched barcode
169 if ($filter eq 'whitespace') {
171 } elsif ($filter eq 'cuecat') {
173 my @fields = split( /\./, $barcode );
174 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
175 ($#results == 2) and return $results[2];
176 } elsif ($filter eq 'T-prefix') {
177 if ($barcode =~ /^[Tt](\d)/) {
178 (defined($1) and $1 eq '0') and return $barcode;
179 $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1)
181 return sprintf("T%07d", $barcode);
182 # FIXME: $barcode could be "T1", causing warning: substr outside of string
183 # Why drop the nonzero digit after the T?
184 # Why pass non-digits (or empty string) to "T%07d"?
185 } elsif ($filter eq 'libsuite8') {
186 unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it.
187 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
188 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
190 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
193 } elsif ($filter eq 'EAN13') {
194 my $ean = CheckDigits('ean');
195 if ( $ean->is_valid($barcode) ) {
196 #$barcode = sprintf('%013d',$barcode); # this doesn't work on 32-bit systems
197 $barcode = '0' x ( 13 - length($barcode) ) . $barcode;
199 warn "# [$barcode] not valid EAN-13/UPC-A\n";
202 return $barcode; # return barcode, modified or not
207 $str = &decode($chunk);
209 Decodes a segment of a string emitted by a CueCat barcode scanner and
212 FIXME: Should be replaced with Barcode::Cuecat from CPAN
213 or Javascript based decoding on the client side.
220 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
221 my @s = map { index( $seq, $_ ); } split( //, $encoded );
222 my $l = ( $#s + 1 ) % 4;
225 # warn "Error: Cuecat decode parsing failed!";
233 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
235 chr( ( $n >> 16 ) ^ 67 )
236 .chr( ( $n >> 8 & 255 ) ^ 67 )
237 .chr( ( $n & 255 ) ^ 67 );
240 $r = substr( $r, 0, length($r) - $l );
246 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
247 $barcode, $ignore_reserves);
249 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
251 C<$newbranch> is the code for the branch to which the item should be transferred.
253 C<$barcode> is the barcode of the item to be transferred.
255 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
256 Otherwise, if an item is reserved, the transfer fails.
258 Returns three values:
264 is true if the transfer was successful.
268 is a reference-to-hash which may have any of the following keys:
274 There is no item in the catalog with the given barcode. The value is C<$barcode>.
278 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.
280 =item C<DestinationEqualsHolding>
282 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.
286 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.
290 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>.
292 =item C<WasTransferred>
294 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
303 my ( $tbr, $barcode, $ignoreRs ) = @_;
306 my $branches = GetBranches();
307 my $itemnumber = GetItemnumberFromBarcode( $barcode );
308 my $issue = GetItemIssue($itemnumber);
309 my $biblio = GetBiblioFromItemNumber($itemnumber);
312 if ( not $itemnumber ) {
313 $messages->{'BadBarcode'} = $barcode;
317 # get branches of book...
318 my $hbr = $biblio->{'homebranch'};
319 my $fbr = $biblio->{'holdingbranch'};
321 # if using Branch Transfer Limits
322 if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
323 if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
324 if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
325 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
328 } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
329 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
335 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
336 $messages->{'IsPermanent'} = $hbr;
340 # can't transfer book if is already there....
341 if ( $fbr eq $tbr ) {
342 $messages->{'DestinationEqualsHolding'} = 1;
346 # check if it is still issued to someone, return it...
347 if ($issue->{borrowernumber}) {
348 AddReturn( $barcode, $fbr );
349 $messages->{'WasReturned'} = $issue->{borrowernumber};
353 # That'll save a database query.
354 my ( $resfound, $resrec, undef ) =
355 CheckReserves( $itemnumber );
356 if ( $resfound and not $ignoreRs ) {
357 $resrec->{'ResFound'} = $resfound;
359 # $messages->{'ResFound'} = $resrec;
363 #actually do the transfer....
365 ModItemTransfer( $itemnumber, $fbr, $tbr );
367 # don't need to update MARC anymore, we do it in batch now
368 $messages->{'WasTransfered'} = 1;
371 ModDateLastSeen( $itemnumber );
372 return ( $dotransfer, $messages, $biblio );
377 my $borrower = shift;
378 my $biblionumber = shift;
380 my $cat_borrower = $borrower->{'categorycode'};
381 my $dbh = C4::Context->dbh;
383 # Get which branchcode we need
384 $branch = _GetCircControlBranch($item,$borrower);
385 my $type = (C4::Context->preference('item-level_itypes'))
386 ? $item->{'itype'} # item-level
387 : $item->{'itemtype'}; # biblio-level
389 # given branch, patron category, and item type, determine
390 # applicable issuing rule
391 my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
393 # if a rule is found and has a loan limit set, count
394 # how many loans the patron already has that meet that
396 if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
398 my $count_query = "SELECT COUNT(*) FROM issues
399 JOIN items USING (itemnumber) ";
401 my $rule_itemtype = $issuing_rule->{itemtype};
402 if ($rule_itemtype eq "*") {
403 # matching rule has the default item type, so count only
404 # those existing loans that don't fall under a more
406 if (C4::Context->preference('item-level_itypes')) {
407 $count_query .= " WHERE items.itype NOT IN (
408 SELECT itemtype FROM issuingrules
410 AND (categorycode = ? OR categorycode = ?)
414 $count_query .= " JOIN biblioitems USING (biblionumber)
415 WHERE biblioitems.itemtype NOT IN (
416 SELECT itemtype FROM issuingrules
418 AND (categorycode = ? OR categorycode = ?)
422 push @bind_params, $issuing_rule->{branchcode};
423 push @bind_params, $issuing_rule->{categorycode};
424 push @bind_params, $cat_borrower;
426 # rule has specific item type, so count loans of that
428 if (C4::Context->preference('item-level_itypes')) {
429 $count_query .= " WHERE items.itype = ? ";
431 $count_query .= " JOIN biblioitems USING (biblionumber)
432 WHERE biblioitems.itemtype= ? ";
434 push @bind_params, $type;
437 $count_query .= " AND borrowernumber = ? ";
438 push @bind_params, $borrower->{'borrowernumber'};
439 my $rule_branch = $issuing_rule->{branchcode};
440 if ($rule_branch ne "*") {
441 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
442 $count_query .= " AND issues.branchcode = ? ";
443 push @bind_params, $branch;
444 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
445 ; # if branch is the patron's home branch, then count all loans by patron
447 $count_query .= " AND items.homebranch = ? ";
448 push @bind_params, $branch;
452 my $count_sth = $dbh->prepare($count_query);
453 $count_sth->execute(@bind_params);
454 my ($current_loan_count) = $count_sth->fetchrow_array;
456 my $max_loans_allowed = $issuing_rule->{'maxissueqty'};
457 if ($current_loan_count >= $max_loans_allowed) {
458 return ($current_loan_count, $max_loans_allowed);
462 # Now count total loans against the limit for the branch
463 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
464 if (defined($branch_borrower_circ_rule->{maxissueqty})) {
465 my @bind_params = ();
466 my $branch_count_query = "SELECT COUNT(*) FROM issues
467 JOIN items USING (itemnumber)
468 WHERE borrowernumber = ? ";
469 push @bind_params, $borrower->{borrowernumber};
471 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
472 $branch_count_query .= " AND issues.branchcode = ? ";
473 push @bind_params, $branch;
474 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
475 ; # if branch is the patron's home branch, then count all loans by patron
477 $branch_count_query .= " AND items.homebranch = ? ";
478 push @bind_params, $branch;
480 my $branch_count_sth = $dbh->prepare($branch_count_query);
481 $branch_count_sth->execute(@bind_params);
482 my ($current_loan_count) = $branch_count_sth->fetchrow_array;
484 my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty};
485 if ($current_loan_count >= $max_loans_allowed) {
486 return ($current_loan_count, $max_loans_allowed);
490 # OK, the patron can issue !!!
496 @issues = &itemissues($biblioitemnumber, $biblio);
498 Looks up information about who has borrowed the bookZ<>(s) with the
499 given biblioitemnumber.
501 C<$biblio> is ignored.
503 C<&itemissues> returns an array of references-to-hash. The keys
504 include the fields from the C<items> table in the Koha database.
505 Additional keys include:
511 If the item is currently on loan, this gives the due date.
513 If the item is not on loan, then this is either "Available" or
514 "Cancelled", if the item has been withdrawn.
518 If the item is currently on loan, this gives the card number of the
519 patron who currently has the item.
521 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
523 These give the timestamp for the last three times the item was
526 =item C<card0>, C<card1>, C<card2>
528 The card number of the last three patrons who borrowed this item.
530 =item C<borrower0>, C<borrower1>, C<borrower2>
532 The borrower number of the last three patrons who borrowed this item.
540 my ( $bibitem, $biblio ) = @_;
541 my $dbh = C4::Context->dbh;
543 $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
548 $sth->execute($bibitem) || die $sth->errstr;
550 while ( my $data = $sth->fetchrow_hashref ) {
552 # Find out who currently has this item.
553 # FIXME - Wouldn't it be better to do this as a left join of
554 # some sort? Currently, this code assumes that if
555 # fetchrow_hashref() fails, then the book is on the shelf.
556 # fetchrow_hashref() can fail for any number of reasons (e.g.,
557 # database server crash), not just because no items match the
559 my $sth2 = $dbh->prepare(
560 "SELECT * FROM issues
561 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
566 $sth2->execute( $data->{'itemnumber'} );
567 if ( my $data2 = $sth2->fetchrow_hashref ) {
568 $data->{'date_due'} = $data2->{'date_due'};
569 $data->{'card'} = $data2->{'cardnumber'};
570 $data->{'borrower'} = $data2->{'borrowernumber'};
573 $data->{'date_due'} = ($data->{'withdrawn'} eq '1') ? 'Cancelled' : 'Available';
577 # Find the last 3 people who borrowed this item.
578 $sth2 = $dbh->prepare(
579 "SELECT * FROM old_issues
580 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
582 ORDER BY returndate DESC,timestamp DESC"
585 $sth2->execute( $data->{'itemnumber'} );
586 for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
587 { # FIXME : error if there is less than 3 pple borrowing this item
588 if ( my $data2 = $sth2->fetchrow_hashref ) {
589 $data->{"timestamp$i2"} = $data2->{'timestamp'};
590 $data->{"card$i2"} = $data2->{'cardnumber'};
591 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
595 $results[$i] = $data;
602 =head2 CanBookBeIssued
604 ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower,
605 $barcode, $duedatespec, $inprocess, $ignore_reserves );
607 Check if a book can be issued.
609 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
613 =item C<$borrower> hash with borrower informations (from GetMember or GetMemberDetails)
615 =item C<$barcode> is the bar code of the book being issued.
617 =item C<$duedatespec> is a C4::Dates object.
619 =item C<$inprocess> boolean switch
620 =item C<$ignore_reserves> boolean switch
628 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
629 Possible values are :
635 sticky due date is invalid
639 borrower gone with no address
643 borrower declared it's card lost
649 =head3 UNKNOWN_BARCODE
663 item is restricted (set by ??)
665 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
666 could be prevented, but ones that can be overriden by the operator.
668 Possible values are :
676 renewing, not issuing
678 =head3 ISSUED_TO_ANOTHER
680 issued to someone else.
684 reserved for someone else.
688 sticky due date is invalid or due date in the past
692 if the borrower borrows to much things
696 sub CanBookBeIssued {
697 my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves ) = @_;
698 my %needsconfirmation; # filled with problems that needs confirmations
699 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
700 my %alerts; # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
702 my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
703 my $issue = GetItemIssue($item->{itemnumber});
704 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
705 $item->{'itemtype'}=$item->{'itype'};
706 my $dbh = C4::Context->dbh;
708 # MANDATORY CHECKS - unless item exists, nothing else matters
709 unless ( $item->{barcode} ) {
710 $issuingimpossible{UNKNOWN_BARCODE} = 1;
712 return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
715 # DUE DATE is OK ? -- should already have checked.
717 if ($duedate && ref $duedate ne 'DateTime') {
718 $duedate = dt_from_string($duedate);
720 my $now = DateTime->now( time_zone => C4::Context->tz() );
721 unless ( $duedate ) {
722 my $issuedate = $now->clone();
724 my $branch = _GetCircControlBranch($item,$borrower);
725 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
726 $duedate = CalcDateDue( $issuedate, $itype, $branch, $borrower );
728 # Offline circ calls AddIssue directly, doesn't run through here
729 # So issuingimpossible should be ok.
732 my $today = $now->clone();
733 $today->truncate( to => 'minute');
734 if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
735 $needsconfirmation{INVALID_DATE} = output_pref($duedate);
738 $issuingimpossible{INVALID_DATE} = output_pref($duedate);
744 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
745 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
747 branch => C4::Context->userenv->{'branch'},
749 itemnumber => $item->{'itemnumber'},
750 itemtype => $item->{'itemtype'},
751 borrowernumber => $borrower->{'borrowernumber'},
752 ccode => $item->{'ccode'}}
754 ModDateLastSeen( $item->{'itemnumber'} );
755 return( { STATS => 1 }, {});
757 if ( $borrower->{flags}->{GNA} ) {
758 $issuingimpossible{GNA} = 1;
760 if ( $borrower->{flags}->{'LOST'} ) {
761 $issuingimpossible{CARD_LOST} = 1;
763 if ( $borrower->{flags}->{'DBARRED'} ) {
764 $issuingimpossible{DEBARRED} = 1;
766 if ( !defined $borrower->{dateexpiry} || $borrower->{'dateexpiry'} eq '0000-00-00') {
767 $issuingimpossible{EXPIRED} = 1;
769 my ($y, $m, $d) = split /-/,$borrower->{'dateexpiry'};
770 if ($y && $m && $d) { # are we really writing oinvalid dates to borrs
771 my $expiry_dt = DateTime->new(
775 time_zone => C4::Context->tz,
777 $expiry_dt->truncate( to => 'day');
778 my $today = $now->clone()->truncate(to => 'day');
779 if (DateTime->compare($today, $expiry_dt) == 1) {
780 $issuingimpossible{EXPIRED} = 1;
783 carp("Invalid expity date in borr");
784 $issuingimpossible{EXPIRED} = 1;
792 my ($balance, $non_issue_charges, $other_charges) =
793 C4::Members::GetMemberAccountBalance( $borrower->{'borrowernumber'} );
794 my $amountlimit = C4::Context->preference("noissuescharge");
795 my $allowfineoverride = C4::Context->preference("AllowFineOverride");
796 my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
797 if ( C4::Context->preference("IssuingInProcess") ) {
798 if ( $non_issue_charges > $amountlimit && !$inprocess && !$allowfineoverride) {
799 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
800 } elsif ( $non_issue_charges > $amountlimit && !$inprocess && $allowfineoverride) {
801 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
802 } elsif ( $allfinesneedoverride && $non_issue_charges > 0 && $non_issue_charges <= $amountlimit && !$inprocess ) {
803 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
807 if ( $non_issue_charges > $amountlimit && $allowfineoverride ) {
808 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
809 } elsif ( $non_issue_charges > $amountlimit && !$allowfineoverride) {
810 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
811 } elsif ( $non_issue_charges > 0 && $allfinesneedoverride ) {
812 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
815 if ($balance > 0 && $other_charges > 0) {
816 $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges );
819 my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'});
820 if ($blocktype == -1) {
821 ## patron has outstanding overdue loans
822 if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
823 $issuingimpossible{USERBLOCKEDOVERDUE} = $count;
825 elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
826 $needsconfirmation{USERBLOCKEDOVERDUE} = $count;
828 } elsif($blocktype == 1) {
829 # patron has accrued fine days or has a restriction. $count is a date
830 if ($count eq '9999-12-31') {
831 $issuingimpossible{USERBLOCKEDNOENDDATE} = $count;
834 $issuingimpossible{USERBLOCKEDWITHENDDATE} = $count;
839 # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
841 my ($current_loan_count, $max_loans_allowed) = TooMany( $borrower, $item->{biblionumber}, $item );
842 # if TooMany max_loans_allowed returns 0 the user doesn't have permission to check out this book
843 if (defined $max_loans_allowed && $max_loans_allowed == 0) {
844 $needsconfirmation{PATRON_CANT} = 1;
846 if($max_loans_allowed){
847 if ( C4::Context->preference("AllowTooManyOverride") ) {
848 $needsconfirmation{TOO_MANY} = 1;
849 $needsconfirmation{current_loan_count} = $current_loan_count;
850 $needsconfirmation{max_loans_allowed} = $max_loans_allowed;
852 $issuingimpossible{TOO_MANY} = 1;
853 $issuingimpossible{current_loan_count} = $current_loan_count;
854 $issuingimpossible{max_loans_allowed} = $max_loans_allowed;
862 if ( $item->{'notforloan'} )
864 if(!C4::Context->preference("AllowNotForLoanOverride")){
865 $issuingimpossible{NOT_FOR_LOAN} = 1;
866 $issuingimpossible{item_notforloan} = $item->{'notforloan'};
868 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
869 $needsconfirmation{item_notforloan} = $item->{'notforloan'};
873 # we have to check itemtypes.notforloan also
874 if (C4::Context->preference('item-level_itypes')){
875 # this should probably be a subroutine
876 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
877 $sth->execute($item->{'itemtype'});
878 my $notforloan=$sth->fetchrow_hashref();
879 if ($notforloan->{'notforloan'}) {
880 if (!C4::Context->preference("AllowNotForLoanOverride")) {
881 $issuingimpossible{NOT_FOR_LOAN} = 1;
882 $issuingimpossible{itemtype_notforloan} = $item->{'itype'};
884 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
885 $needsconfirmation{itemtype_notforloan} = $item->{'itype'};
889 elsif ($biblioitem->{'notforloan'} == 1){
890 if (!C4::Context->preference("AllowNotForLoanOverride")) {
891 $issuingimpossible{NOT_FOR_LOAN} = 1;
892 $issuingimpossible{itemtype_notforloan} = $biblioitem->{'itemtype'};
894 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
895 $needsconfirmation{itemtype_notforloan} = $biblioitem->{'itemtype'};
899 if ( $item->{'withdrawn'} && $item->{'withdrawn'} > 0 )
901 $issuingimpossible{WTHDRAWN} = 1;
903 if ( $item->{'restricted'}
904 && $item->{'restricted'} == 1 )
906 $issuingimpossible{RESTRICTED} = 1;
908 if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
909 my $code = GetAuthorisedValueByCode( 'LOST', $item->{'itemlost'} );
910 $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
911 $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
913 if ( C4::Context->preference("IndependentBranches") ) {
914 my $userenv = C4::Context->userenv;
915 unless ( C4::Context->IsSuperLibrarian() ) {
916 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ){
917 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
918 $issuingimpossible{'itemhomebranch'} = $item->{C4::Context->preference("HomeOrHoldingBranch")};
920 $needsconfirmation{BORRNOTSAMEBRANCH} = GetBranchName( $borrower->{'branchcode'} )
921 if ( $borrower->{'branchcode'} ne $userenv->{branch} );
925 # CHECK IF THERE IS RENTAL CHARGES. RENTAL MUST BE CONFIRMED BY THE BORROWER
927 my $rentalConfirmation = C4::Context->preference("RentalFeesCheckoutConfirmation");
929 if ( $rentalConfirmation ){
930 my ($rentalCharge) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
931 if ( $rentalCharge ){
932 $rentalCharge = sprintf("%.02f", $rentalCharge);
933 $needsconfirmation{RENTALCHARGE} = $rentalCharge;
938 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
940 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} ){
942 # Already issued to current borrower. Ask whether the loan should
944 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
945 $borrower->{'borrowernumber'},
946 $item->{'itemnumber'}
948 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
949 $issuingimpossible{NO_MORE_RENEWALS} = 1;
952 $needsconfirmation{RENEW_ISSUE} = 1;
955 elsif ($issue->{borrowernumber}) {
957 # issued to someone else
958 my $currborinfo = C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} );
960 # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
961 $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
962 $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
963 $needsconfirmation{issued_surname} = $currborinfo->{'surname'};
964 $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
965 $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
968 unless ( $ignore_reserves ) {
969 # See if the item is on reserve.
970 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
972 my $resbor = $res->{'borrowernumber'};
973 if ( $resbor ne $borrower->{'borrowernumber'} ) {
974 my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor );
975 my $branchname = GetBranchName( $res->{'branchcode'} );
976 if ( $restype eq "Waiting" )
978 # The item is on reserve and waiting, but has been
979 # reserved by some other patron.
980 $needsconfirmation{RESERVE_WAITING} = 1;
981 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
982 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
983 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
984 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
985 $needsconfirmation{'resbranchname'} = $branchname;
986 $needsconfirmation{'reswaitingdate'} = format_date($res->{'waitingdate'});
988 elsif ( $restype eq "Reserved" ) {
989 # The item is on reserve for someone else.
990 $needsconfirmation{RESERVED} = 1;
991 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
992 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
993 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
994 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
995 $needsconfirmation{'resbranchname'} = $branchname;
996 $needsconfirmation{'resreservedate'} = format_date($res->{'reservedate'});
1002 ## CHECK AGE RESTRICTION
1003 my $agerestriction = $biblioitem->{'agerestriction'};
1004 my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $borrower );
1005 if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1006 if ( C4::Context->preference('AgeRestrictionOverride') ) {
1007 $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1010 $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1014 ## check for high holds decreasing loan period
1015 my $decrease_loan = C4::Context->preference('decreaseLoanHighHolds');
1016 if ( $decrease_loan && $decrease_loan == 1 ) {
1017 my ( $reserved, $num, $duration, $returndate ) =
1018 checkHighHolds( $item, $borrower );
1020 if ( $num >= C4::Context->preference('decreaseLoanHighHoldsValue') ) {
1021 $needsconfirmation{HIGHHOLDS} = {
1023 duration => $duration,
1024 returndate => output_pref($returndate),
1030 !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1031 # don't do the multiple loans per bib check if we've
1032 # already determined that we've got a loan on the same item
1033 !$issuingimpossible{NO_MORE_RENEWALS} &&
1034 !$needsconfirmation{RENEW_ISSUE}
1036 # Check if borrower has already issued an item from the same biblio
1037 # Only if it's not a subscription
1038 my $biblionumber = $item->{biblionumber};
1039 require C4::Serials;
1040 my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1041 unless ($is_a_subscription) {
1042 my $issues = GetIssues( {
1043 borrowernumber => $borrower->{borrowernumber},
1044 biblionumber => $biblionumber,
1046 my @issues = $issues ? @$issues : ();
1047 # if we get here, we don't already have a loan on this item,
1048 # so if there are any loans on this bib, ask for confirmation
1049 if (scalar @issues > 0) {
1050 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1055 return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
1058 =head2 CanBookBeReturned
1060 ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1062 Check whether the item can be returned to the provided branch
1066 =item C<$item> is a hash of item information as returned from GetItem
1068 =item C<$branch> is the branchcode where the return is taking place
1076 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1078 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1084 sub CanBookBeReturned {
1085 my ($item, $branch) = @_;
1086 my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1088 # assume return is allowed to start
1092 # identify all cases where return is forbidden
1093 if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1095 $message = $item->{'homebranch'};
1096 } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1098 $message = $item->{'holdingbranch'};
1099 } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1101 $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1104 return ($allowed, $message);
1107 =head2 CheckHighHolds
1109 used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1110 decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1111 has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1115 sub checkHighHolds {
1116 my ( $item, $borrower ) = @_;
1117 my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1118 my $branch = _GetCircControlBranch( $item, $borrower );
1119 my $dbh = C4::Context->dbh;
1120 my $sth = $dbh->prepare(
1121 'select count(borrowernumber) as num_holds from reserves where biblionumber=?'
1123 $sth->execute( $item->{'biblionumber'} );
1124 my ($holds) = $sth->fetchrow_array;
1126 my $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1128 my $calendar = Koha::Calendar->new( branchcode => $branch );
1131 ( C4::Context->preference('item-level_itypes') )
1132 ? $biblio->{'itype'}
1133 : $biblio->{'itemtype'};
1135 C4::Circulation::CalcDateDue( $issuedate, $itype, $branch,
1138 my $reduced_datedue =
1139 $calendar->addDate( $issuedate,
1140 C4::Context->preference('decreaseLoanHighHoldsDuration') );
1142 if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1144 C4::Context->preference('decreaseLoanHighHoldsDuration'),
1148 return ( 0, 0, 0, undef );
1153 &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1155 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1159 =item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails).
1161 =item C<$barcode> is the barcode of the item being issued.
1163 =item C<$datedue> is a C4::Dates object for the max date of return, i.e. the date due (optional).
1164 Calculated if empty.
1166 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1168 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1169 Defaults to today. Unlike C<$datedue>, NOT a C4::Dates object, unfortunately.
1171 AddIssue does the following things :
1173 - step 01: check that there is a borrowernumber & a barcode provided
1174 - check for RENEWAL (book issued & being issued to the same patron)
1175 - renewal YES = Calculate Charge & renew
1177 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1179 - fill reserve if reserve to this patron
1180 - cancel reserve or not, otherwise
1181 * TRANSFERT PENDING ?
1182 - complete the transfert
1190 my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1191 my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1192 my $auto_renew = $params && $params->{auto_renew};
1193 my $dbh = C4::Context->dbh;
1194 my $barcodecheck=CheckValidBarcode($barcode);
1196 if ($datedue && ref $datedue ne 'DateTime') {
1197 $datedue = dt_from_string($datedue);
1199 # $issuedate defaults to today.
1200 if ( ! defined $issuedate ) {
1201 $issuedate = DateTime->now(time_zone => C4::Context->tz());
1204 if ( ref $issuedate ne 'DateTime') {
1205 $issuedate = dt_from_string($issuedate);
1209 if ($borrower and $barcode and $barcodecheck ne '0'){#??? wtf
1210 # find which item we issue
1211 my $item = GetItem('', $barcode) or return; # if we don't get an Item, abort.
1212 my $branch = _GetCircControlBranch($item,$borrower);
1214 # get actual issuing if there is one
1215 my $actualissue = GetItemIssue( $item->{itemnumber});
1217 # get biblioinformation for this item
1218 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
1221 # check if we just renew the issue.
1223 if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
1224 $datedue = AddRenewal(
1225 $borrower->{'borrowernumber'},
1226 $item->{'itemnumber'},
1229 $issuedate, # here interpreted as the renewal date
1233 # it's NOT a renewal
1234 if ( $actualissue->{borrowernumber}) {
1235 # This book is currently on loan, but not to the person
1236 # who wants to borrow it now. mark it returned before issuing to the new borrower
1239 C4::Context->userenv->{'branch'}
1243 MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1244 # Starting process for transfer job (checking transfert and validate it if we have one)
1245 my ($datesent) = GetTransfers($item->{'itemnumber'});
1247 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1250 "UPDATE branchtransfers
1251 SET datearrived = now(),
1253 comments = 'Forced branchtransfer'
1254 WHERE itemnumber= ? AND datearrived IS NULL"
1256 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
1259 # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1260 unless ($auto_renew) {
1261 my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branch);
1262 $auto_renew = $issuingrule->{auto_renew};
1265 # Record in the database the fact that the book was issued.
1269 (borrowernumber, itemnumber,issuedate, date_due, branchcode, onsite_checkout, auto_renew)
1270 VALUES (?,?,?,?,?,?,?)"
1273 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
1274 $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1277 $datedue->truncate( to => 'minute');
1280 $borrower->{'borrowernumber'}, # borrowernumber
1281 $item->{'itemnumber'}, # itemnumber
1282 $issuedate->strftime('%Y-%m-%d %H:%M:00'), # issuedate
1283 $datedue->strftime('%Y-%m-%d %H:%M:00'), # date_due
1284 C4::Context->userenv->{'branch'}, # branchcode
1286 $auto_renew ? 1 : 0 # automatic renewal
1288 if ( C4::Context->preference('ReturnToShelvingCart') ) { ## ReturnToShelvingCart is on, anything issued should be taken off the cart.
1289 CartToShelf( $item->{'itemnumber'} );
1291 $item->{'issues'}++;
1292 if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1293 UpdateTotalIssues($item->{'biblionumber'}, 1);
1296 ## If item was lost, it has now been found, reverse any list item charges if neccessary.
1297 if ( $item->{'itemlost'} ) {
1298 if ( C4::Context->preference('RefundLostItemFeeOnReturn' ) ) {
1299 _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef, $item->{'barcode'} );
1303 ModItem({ issues => $item->{'issues'},
1304 holdingbranch => C4::Context->userenv->{'branch'},
1306 datelastborrowed => DateTime->now(time_zone => C4::Context->tz())->ymd(),
1307 onloan => $datedue->ymd(),
1308 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1309 ModDateLastSeen( $item->{'itemnumber'} );
1311 # If it costs to borrow this book, charge it to the patron's account.
1312 my ( $charge, $itemtype ) = GetIssuingCharges(
1313 $item->{'itemnumber'},
1314 $borrower->{'borrowernumber'}
1316 if ( $charge > 0 ) {
1318 $item->{'itemnumber'},
1319 $borrower->{'borrowernumber'}, $charge
1321 $item->{'charge'} = $charge;
1324 # Record the fact that this book was issued.
1326 branch => C4::Context->userenv->{'branch'},
1327 type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1329 other => ($sipmode ? "SIP-$sipmode" : ''),
1330 itemnumber => $item->{'itemnumber'},
1331 itemtype => $item->{'itype'},
1332 borrowernumber => $borrower->{'borrowernumber'},
1333 ccode => $item->{'ccode'}}
1336 # Send a checkout slip.
1337 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1339 branchcode => $branch,
1340 categorycode => $borrower->{categorycode},
1341 item_type => $item->{itype},
1342 notification => 'CHECKOUT',
1344 if ($circulation_alert->is_enabled_for(\%conditions)) {
1345 SendCirculationAlert({
1348 borrower => $borrower,
1354 logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'itemnumber'})
1355 if C4::Context->preference("IssueLog");
1357 return ($datedue); # not necessarily the same as when it came in!
1360 =head2 GetLoanLength
1362 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1364 Get loan length for an itemtype, a borrower type and a branch
1369 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1370 my $dbh = C4::Context->dbh;
1371 my $sth = $dbh->prepare(qq{
1372 SELECT issuelength, lengthunit, renewalperiod
1374 WHERE categorycode=?
1377 AND issuelength IS NOT NULL
1380 # try to find issuelength & return the 1st available.
1381 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1382 $sth->execute( $borrowertype, $itemtype, $branchcode );
1383 my $loanlength = $sth->fetchrow_hashref;
1386 if defined($loanlength) && $loanlength->{issuelength};
1388 $sth->execute( $borrowertype, '*', $branchcode );
1389 $loanlength = $sth->fetchrow_hashref;
1391 if defined($loanlength) && $loanlength->{issuelength};
1393 $sth->execute( '*', $itemtype, $branchcode );
1394 $loanlength = $sth->fetchrow_hashref;
1396 if defined($loanlength) && $loanlength->{issuelength};
1398 $sth->execute( '*', '*', $branchcode );
1399 $loanlength = $sth->fetchrow_hashref;
1401 if defined($loanlength) && $loanlength->{issuelength};
1403 $sth->execute( $borrowertype, $itemtype, '*' );
1404 $loanlength = $sth->fetchrow_hashref;
1406 if defined($loanlength) && $loanlength->{issuelength};
1408 $sth->execute( $borrowertype, '*', '*' );
1409 $loanlength = $sth->fetchrow_hashref;
1411 if defined($loanlength) && $loanlength->{issuelength};
1413 $sth->execute( '*', $itemtype, '*' );
1414 $loanlength = $sth->fetchrow_hashref;
1416 if defined($loanlength) && $loanlength->{issuelength};
1418 $sth->execute( '*', '*', '*' );
1419 $loanlength = $sth->fetchrow_hashref;
1421 if defined($loanlength) && $loanlength->{issuelength};
1423 # if no rule is set => 21 days (hardcoded)
1426 renewalperiod => 21,
1427 lengthunit => 'days',
1433 =head2 GetHardDueDate
1435 my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1437 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1441 sub GetHardDueDate {
1442 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1444 my $rule = GetIssuingRule( $borrowertype, $itemtype, $branchcode );
1446 if ( defined( $rule ) ) {
1447 if ( $rule->{hardduedate} ) {
1448 return (dt_from_string($rule->{hardduedate}, 'iso'),$rule->{hardduedatecompare});
1450 return (undef, undef);
1455 =head2 GetIssuingRule
1457 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1459 FIXME - This is a copy-paste of GetLoanLength
1460 as a stop-gap. Do not wish to change API for GetLoanLength
1461 this close to release.
1463 Get the issuing rule for an itemtype, a borrower type and a branch
1464 Returns a hashref from the issuingrules table.
1468 sub GetIssuingRule {
1469 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1470 my $dbh = C4::Context->dbh;
1471 my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null" );
1474 $sth->execute( $borrowertype, $itemtype, $branchcode );
1475 $irule = $sth->fetchrow_hashref;
1476 return $irule if defined($irule) ;
1478 $sth->execute( $borrowertype, "*", $branchcode );
1479 $irule = $sth->fetchrow_hashref;
1480 return $irule if defined($irule) ;
1482 $sth->execute( "*", $itemtype, $branchcode );
1483 $irule = $sth->fetchrow_hashref;
1484 return $irule if defined($irule) ;
1486 $sth->execute( "*", "*", $branchcode );
1487 $irule = $sth->fetchrow_hashref;
1488 return $irule if defined($irule) ;
1490 $sth->execute( $borrowertype, $itemtype, "*" );
1491 $irule = $sth->fetchrow_hashref;
1492 return $irule if defined($irule) ;
1494 $sth->execute( $borrowertype, "*", "*" );
1495 $irule = $sth->fetchrow_hashref;
1496 return $irule if defined($irule) ;
1498 $sth->execute( "*", $itemtype, "*" );
1499 $irule = $sth->fetchrow_hashref;
1500 return $irule if defined($irule) ;
1502 $sth->execute( "*", "*", "*" );
1503 $irule = $sth->fetchrow_hashref;
1504 return $irule if defined($irule) ;
1506 # if no rule matches,
1510 =head2 GetBranchBorrowerCircRule
1512 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1514 Retrieves circulation rule attributes that apply to the given
1515 branch and patron category, regardless of item type.
1516 The return value is a hashref containing the following key:
1518 maxissueqty - maximum number of loans that a
1519 patron of the given category can have at the given
1520 branch. If the value is undef, no limit.
1522 This will first check for a specific branch and
1523 category match from branch_borrower_circ_rules.
1525 If no rule is found, it will then check default_branch_circ_rules
1526 (same branch, default category). If no rule is found,
1527 it will then check default_borrower_circ_rules (default
1528 branch, same category), then failing that, default_circ_rules
1529 (default branch, default category).
1531 If no rule has been found in the database, it will default to
1536 C<$branchcode> and C<$categorycode> should contain the
1537 literal branch code and patron category code, respectively - no
1542 sub GetBranchBorrowerCircRule {
1543 my $branchcode = shift;
1544 my $categorycode = shift;
1546 my $branch_cat_query = "SELECT maxissueqty
1547 FROM branch_borrower_circ_rules
1548 WHERE branchcode = ?
1549 AND categorycode = ?";
1550 my $dbh = C4::Context->dbh();
1551 my $sth = $dbh->prepare($branch_cat_query);
1552 $sth->execute($branchcode, $categorycode);
1554 if ($result = $sth->fetchrow_hashref()) {
1558 # try same branch, default borrower category
1559 my $branch_query = "SELECT maxissueqty
1560 FROM default_branch_circ_rules
1561 WHERE branchcode = ?";
1562 $sth = $dbh->prepare($branch_query);
1563 $sth->execute($branchcode);
1564 if ($result = $sth->fetchrow_hashref()) {
1568 # try default branch, same borrower category
1569 my $category_query = "SELECT maxissueqty
1570 FROM default_borrower_circ_rules
1571 WHERE categorycode = ?";
1572 $sth = $dbh->prepare($category_query);
1573 $sth->execute($categorycode);
1574 if ($result = $sth->fetchrow_hashref()) {
1578 # try default branch, default borrower category
1579 my $default_query = "SELECT maxissueqty
1580 FROM default_circ_rules";
1581 $sth = $dbh->prepare($default_query);
1583 if ($result = $sth->fetchrow_hashref()) {
1587 # built-in default circulation rule
1589 maxissueqty => undef,
1593 =head2 GetBranchItemRule
1595 my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1597 Retrieves circulation rule attributes that apply to the given
1598 branch and item type, regardless of patron category.
1600 The return value is a hashref containing the following keys:
1602 holdallowed => Hold policy for this branch and itemtype. Possible values:
1603 0: No holds allowed.
1604 1: Holds allowed only by patrons that have the same homebranch as the item.
1605 2: Holds allowed from any patron.
1607 returnbranch => branch to which to return item. Possible values:
1608 noreturn: do not return, let item remain where checked in (floating collections)
1609 homebranch: return to item's home branch
1611 This searches branchitemrules in the following order:
1613 * Same branchcode and itemtype
1614 * Same branchcode, itemtype '*'
1615 * branchcode '*', same itemtype
1616 * branchcode and itemtype '*'
1618 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1622 sub GetBranchItemRule {
1623 my ( $branchcode, $itemtype ) = @_;
1624 my $dbh = C4::Context->dbh();
1628 ['SELECT holdallowed, returnbranch
1629 FROM branch_item_rules
1630 WHERE branchcode = ?
1631 AND itemtype = ?', $branchcode, $itemtype],
1632 ['SELECT holdallowed, returnbranch
1633 FROM default_branch_circ_rules
1634 WHERE branchcode = ?', $branchcode],
1635 ['SELECT holdallowed, returnbranch
1636 FROM default_branch_item_rules
1637 WHERE itemtype = ?', $itemtype],
1638 ['SELECT holdallowed, returnbranch
1639 FROM default_circ_rules'],
1642 foreach my $attempt (@attempts) {
1643 my ($query, @bind_params) = @{$attempt};
1644 my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1647 # Since branch/category and branch/itemtype use the same per-branch
1648 # defaults tables, we have to check that the key we want is set, not
1649 # just that a row was returned
1650 $result->{'holdallowed'} = $search_result->{'holdallowed'} unless ( defined $result->{'holdallowed'} );
1651 $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1654 # built-in default circulation rule
1655 $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1656 $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1663 ($doreturn, $messages, $iteminformation, $borrower) =
1664 &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
1670 =item C<$barcode> is the bar code of the book being returned.
1672 =item C<$branch> is the code of the branch where the book is being returned.
1674 =item C<$exemptfine> indicates that overdue charges for the item will be
1677 =item C<$dropbox> indicates that the check-in date is assumed to be
1678 yesterday, or the last non-holiday as defined in C4::Calendar . If
1679 overdue charges are applied and C<$dropbox> is true, the last charge
1680 will be removed. This assumes that the fines accrual script has run
1681 for _today_. Optional.
1683 =item C<$return_date> allows the default return date to be overridden
1684 by the given return date. Optional.
1688 C<&AddReturn> returns a list of four items:
1690 C<$doreturn> is true iff the return succeeded.
1692 C<$messages> is a reference-to-hash giving feedback on the operation.
1693 The keys of the hash are:
1699 No item with this barcode exists. The value is C<$barcode>.
1703 The book is not currently on loan. The value is C<$barcode>.
1705 =item C<IsPermanent>
1707 The book's home branch is a permanent collection. If you have borrowed
1708 this book, you are not allowed to return it. The value is the code for
1709 the book's home branch.
1713 This book has been withdrawn/cancelled. The value should be ignored.
1715 =item C<Wrongbranch>
1717 This book has was returned to the wrong branch. The value is a hashref
1718 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1719 contain the branchcode of the incorrect and correct return library, respectively.
1723 The item was reserved. The value is a reference-to-hash whose keys are
1724 fields from the reserves table of the Koha database, and
1725 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1726 either C<Waiting>, C<Reserved>, or 0.
1730 C<$iteminformation> is a reference-to-hash, giving information about the
1731 returned item from the issues table.
1733 C<$borrower> is a reference-to-hash, giving information about the
1734 patron who last borrowed the book.
1739 my ( $barcode, $branch, $exemptfine, $dropbox, $return_date ) = @_;
1741 if ($branch and not GetBranchDetail($branch)) {
1742 warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
1745 $branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
1750 my $validTransfert = 0;
1751 my $stat_type = 'return';
1753 # get information on item
1754 my $itemnumber = GetItemnumberFromBarcode( $barcode );
1755 unless ($itemnumber) {
1756 return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower. bail out.
1758 my $issue = GetItemIssue($itemnumber);
1759 # warn Dumper($iteminformation);
1760 if ($issue and $issue->{borrowernumber}) {
1761 $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1762 or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existant borrowernumber '$issue->{borrowernumber}'\n"
1763 . Dumper($issue) . "\n";
1765 $messages->{'NotIssued'} = $barcode;
1766 # even though item is not on loan, it may still be transferred; therefore, get current branch info
1768 # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later.
1769 # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1770 if (C4::Context->preference("RecordLocalUseOnReturn")) {
1771 $messages->{'LocalUse'} = 1;
1772 $stat_type = 'localuse';
1776 my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1777 # full item data, but no borrowernumber or checkout info (no issue)
1778 # we know GetItem should work because GetItemnumberFromBarcode worked
1779 my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1780 # get the proper branch to which to return the item
1781 $hbr = $item->{$hbr} || $branch ;
1782 # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1784 my $borrowernumber = $borrower->{'borrowernumber'} || undef; # we don't know if we had a borrower or not
1786 my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
1788 $yaml = "$yaml\n\n"; # YAML is anal on ending \n. Surplus does not hurt
1790 eval { $rules = YAML::Load($yaml); };
1792 warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
1795 foreach my $key ( keys %$rules ) {
1796 if ( $item->{notforloan} eq $key ) {
1797 $messages->{'NotForLoanStatusUpdated'} = { from => $item->{notforloan}, to => $rules->{$key} };
1798 ModItem( { notforloan => $rules->{$key} }, undef, $itemnumber );
1806 # check if the book is in a permanent collection....
1807 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1809 my $branches = GetBranches(); # a potentially expensive call for a non-feature.
1810 $branches->{$hbr}->{PE} and $messages->{'IsPermanent'} = $hbr;
1813 # check if the return is allowed at this branch
1814 my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
1815 unless ($returnallowed){
1816 $messages->{'Wrongbranch'} = {
1817 Wrongbranch => $branch,
1818 Rightbranch => $message
1821 return ( $doreturn, $messages, $issue, $borrower );
1824 if ( $item->{'withdrawn'} ) { # book has been cancelled
1825 $messages->{'withdrawn'} = 1;
1826 $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
1829 # case of a return of document (deal with issues and holdingbranch)
1830 my $today = DateTime->now( time_zone => C4::Context->tz() );
1833 my $datedue = $issue->{date_due};
1834 $borrower or warn "AddReturn without current borrower";
1835 my $circControlBranch;
1837 # define circControlBranch only if dropbox mode is set
1838 # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1839 # FIXME: check issuedate > returndate, factoring in holidays
1840 #$circControlBranch = _GetCircControlBranch($item,$borrower) unless ( $item->{'issuedate'} eq C4::Dates->today('iso') );;
1841 $circControlBranch = _GetCircControlBranch($item,$borrower);
1842 $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $today ) == -1 ? 1 : 0;
1845 if ($borrowernumber) {
1846 if ( ( C4::Context->preference('CalculateFinesOnReturn') && $issue->{'overdue'} ) || $return_date ) {
1847 # we only need to calculate and change the fines if we want to do that on return
1848 # Should be on for hourly loans
1849 my $control = C4::Context->preference('CircControl');
1850 my $control_branchcode =
1851 ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
1852 : ( $control eq 'PatronLibrary' ) ? $borrower->{branchcode}
1853 : $issue->{branchcode};
1856 $return_date ? dt_from_string($return_date) : $today;
1858 my ( $amount, $type, $unitcounttotal ) =
1859 C4::Overdues::CalcFine( $item, $borrower->{categorycode},
1860 $control_branchcode, $datedue, $date_returned );
1864 if ( C4::Context->preference('finesMode') eq 'production' ) {
1865 if ( $amount > 0 ) {
1866 C4::Overdues::UpdateFine( $issue->{itemnumber},
1867 $issue->{borrowernumber},
1868 $amount, $type, output_pref($datedue) );
1870 elsif ($return_date) {
1872 # Backdated returns may have fines that shouldn't exist,
1873 # so in this case, we need to drop those fines to 0
1875 C4::Overdues::UpdateFine( $issue->{itemnumber},
1876 $issue->{borrowernumber},
1877 0, $type, output_pref($datedue) );
1882 MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
1883 $circControlBranch, $return_date, $borrower->{'privacy'} );
1885 # FIXME is the "= 1" right? This could be the borrower hash.
1886 $messages->{'WasReturned'} = 1;
1890 ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1893 # the holdingbranch is updated if the document is returned to another location.
1894 # this is always done regardless of whether the item was on loan or not
1895 if ($item->{'holdingbranch'} ne $branch) {
1896 UpdateHoldingbranch($branch, $item->{'itemnumber'});
1897 $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1899 ModDateLastSeen( $item->{'itemnumber'} );
1901 # check if we have a transfer for this document
1902 my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1904 # if we have a transfer to do, we update the line of transfers with the datearrived
1905 my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->{'itemnumber'} );
1907 if ( $tobranch eq $branch ) {
1908 my $sth = C4::Context->dbh->prepare(
1909 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1911 $sth->execute( $item->{'itemnumber'} );
1912 # if we have a reservation with valid transfer, we can set it's status to 'W'
1913 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1914 C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1916 $messages->{'WrongTransfer'} = $tobranch;
1917 $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1919 $validTransfert = 1;
1921 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
1924 # fix up the accounts.....
1925 if ( $item->{'itemlost'} ) {
1926 $messages->{'WasLost'} = 1;
1928 if ( C4::Context->preference('RefundLostItemFeeOnReturn' ) ) {
1929 _FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode); # can tolerate undef $borrowernumber
1930 $messages->{'LostItemFeeRefunded'} = 1;
1934 # fix up the overdues in accounts...
1935 if ($borrowernumber) {
1936 my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
1937 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
1939 if ( $issue->{overdue} && $issue->{date_due} ) {
1941 my ($debardate,$reminder) = _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today );
1943 $messages->{'PrevDebarred'} = $debardate;
1945 $messages->{'Debarred'} = $debardate if $debardate;
1947 # there's no overdue on the item but borrower had been previously debarred
1948 } elsif ( $issue->{date_due} and $borrower->{'debarred'} ) {
1949 my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
1950 $borrower_debar_dt->truncate(to => 'day');
1951 my $today_dt = $today->clone()->truncate(to => 'day');
1952 if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
1953 $messages->{'PrevDebarred'} = $borrower->{'debarred'};
1958 # find reserves.....
1959 # if we don't have a reserve with the status W, we launch the Checkreserves routine
1960 my ($resfound, $resrec);
1961 my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
1962 ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'}, undef, $lookahead ) unless ( $item->{'withdrawn'} );
1964 $resrec->{'ResFound'} = $resfound;
1965 $messages->{'ResFound'} = $resrec;
1968 # Record the fact that this book was returned.
1969 # FIXME itemtype should record item level type, not bibliolevel type
1973 itemnumber => $item->{'itemnumber'},
1974 itemtype => $biblio->{'itemtype'},
1975 borrowernumber => $borrowernumber,
1976 ccode => $item->{'ccode'}}
1979 # Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then.
1980 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1982 branchcode => $branch,
1983 categorycode => $borrower->{categorycode},
1984 item_type => $item->{itype},
1985 notification => 'CHECKIN',
1987 if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
1988 SendCirculationAlert({
1991 borrower => $borrower,
1996 logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
1997 if C4::Context->preference("ReturnLog");
1999 # Remove any OVERDUES related debarment if the borrower has no overdues
2000 if ( $borrowernumber
2001 && $borrower->{'debarred'}
2002 && C4::Context->preference('AutoRemoveOverduesRestrictions')
2003 && !HasOverdues( $borrowernumber )
2004 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2006 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2009 # FIXME: make this comment intelligible.
2010 #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
2011 #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
2013 if ( !$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $hbr) and not $messages->{'WrongTransfer'}){
2014 if ( C4::Context->preference("AutomaticItemReturn" ) or
2015 (C4::Context->preference("UseBranchTransferLimits") and
2016 ! IsBranchTransferAllowed($branch, $hbr, $item->{C4::Context->preference("BranchTransferLimitsType")} )
2018 $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $hbr;
2019 $debug and warn "item: " . Dumper($item);
2020 ModItemTransfer($item->{'itemnumber'}, $branch, $hbr);
2021 $messages->{'WasTransfered'} = 1;
2023 $messages->{'NeedsTransfer'} = 1; # TODO: instead of 1, specify branchcode that the transfer SHOULD go to, $item->{homebranch}
2027 return ( $doreturn, $messages, $issue, $borrower );
2030 =head2 MarkIssueReturned
2032 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
2034 Unconditionally marks an issue as being returned by
2035 moving the C<issues> row to C<old_issues> and
2036 setting C<returndate> to the current date, or
2037 the last non-holiday date of the branccode specified in
2038 C<dropbox_branch> . Assumes you've already checked that
2039 it's safe to do this, i.e. last non-holiday > issuedate.
2041 if C<$returndate> is specified (in iso format), it is used as the date
2042 of the return. It is ignored when a dropbox_branch is passed in.
2044 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2045 the old_issue is immediately anonymised
2047 Ideally, this function would be internal to C<C4::Circulation>,
2048 not exported, but it is currently needed by one
2049 routine in C<C4::Accounts>.
2053 sub MarkIssueReturned {
2054 my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
2056 my $dbh = C4::Context->dbh;
2057 my $query = 'UPDATE issues SET returndate=';
2059 if ($dropbox_branch) {
2060 my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
2061 my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
2063 push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2064 } elsif ($returndate) {
2066 push @bind, $returndate;
2068 $query .= ' now() ';
2070 $query .= ' WHERE borrowernumber = ? AND itemnumber = ?';
2071 push @bind, $borrowernumber, $itemnumber;
2073 my $sth_upd = $dbh->prepare($query);
2074 $sth_upd->execute(@bind);
2075 my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
2076 WHERE borrowernumber = ?
2077 AND itemnumber = ?');
2078 $sth_copy->execute($borrowernumber, $itemnumber);
2079 # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2080 if ( $privacy == 2) {
2081 # The default of 0 does not work due to foreign key constraints
2082 # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
2083 # FIXME the above is unacceptable - bug 9942 relates
2084 my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
2085 my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
2086 WHERE borrowernumber = ?
2087 AND itemnumber = ?");
2088 $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
2090 my $sth_del = $dbh->prepare("DELETE FROM issues
2091 WHERE borrowernumber = ?
2092 AND itemnumber = ?");
2093 $sth_del->execute($borrowernumber, $itemnumber);
2095 ModItem( { 'onloan' => undef }, undef, $itemnumber );
2098 =head2 _debar_user_on_return
2100 _debar_user_on_return($borrower, $item, $datedue, today);
2102 C<$borrower> borrower hashref
2104 C<$item> item hashref
2106 C<$datedue> date due DateTime object
2108 C<$today> DateTime object representing the return time
2110 Internal function, called only by AddReturn that calculates and updates
2111 the user fine days, and debars him if necessary.
2113 Should only be called for overdue returns
2117 sub _debar_user_on_return {
2118 my ( $borrower, $item, $dt_due, $dt_today ) = @_;
2120 my $branchcode = _GetCircControlBranch( $item, $borrower );
2121 my $calendar = Koha::Calendar->new( branchcode => $branchcode );
2123 # $deltadays is a DateTime::Duration object
2124 my $deltadays = $calendar->days_between( $dt_due, $dt_today );
2126 my $circcontrol = C4::Context->preference('CircControl');
2128 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2129 my $finedays = $issuingrule->{finedays};
2130 my $unit = $issuingrule->{lengthunit};
2134 # finedays is in days, so hourly loans must multiply by 24
2135 # thus 1 hour late equals 1 day suspension * finedays rate
2136 $finedays = $finedays * 24 if ( $unit eq 'hours' );
2138 # grace period is measured in the same units as the loan
2140 DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
2142 if ( $deltadays->subtract($grace)->is_positive() ) {
2143 my $suspension_days = $deltadays * $finedays;
2145 # If the max suspension days is < than the suspension days
2146 # the suspension days is limited to this maximum period.
2147 my $max_sd = $issuingrule->{maxsuspensiondays};
2148 if ( defined $max_sd ) {
2149 $max_sd = DateTime::Duration->new( days => $max_sd );
2150 $suspension_days = $max_sd
2151 if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2155 $dt_today->clone()->add_duration( $suspension_days );
2157 Koha::Borrower::Debarments::AddUniqueDebarment({
2158 borrowernumber => $borrower->{borrowernumber},
2159 expiration => $new_debar_dt->ymd(),
2160 type => 'SUSPENSION',
2162 # if borrower was already debarred but does not get an extra debarment
2163 if ( $borrower->{debarred} eq Koha::Borrower::Debarments::IsDebarred($borrower->{borrowernumber}) ) {
2164 return ($borrower->{debarred},1);
2166 return $new_debar_dt->ymd();
2172 =head2 _FixOverduesOnReturn
2174 &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2176 C<$brn> borrowernumber
2180 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2181 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2183 Internal function, called only by AddReturn
2187 sub _FixOverduesOnReturn {
2188 my ($borrowernumber, $item);
2189 unless ($borrowernumber = shift) {
2190 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2193 unless ($item = shift) {
2194 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2197 my ($exemptfine, $dropbox) = @_;
2198 my $dbh = C4::Context->dbh;
2200 # check for overdue fine
2201 my $sth = $dbh->prepare(
2202 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
2204 $sth->execute( $borrowernumber, $item );
2206 # alter fine to show that the book has been returned
2207 my $data = $sth->fetchrow_hashref;
2208 return 0 unless $data; # no warning, there's just nothing to fix
2211 my @bind = ($data->{'accountlines_id'});
2213 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2214 if (C4::Context->preference("FinesLog")) {
2215 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2217 } elsif ($dropbox && $data->{lastincrement}) {
2218 my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2219 my $amt = $data->{amount} - $data->{lastincrement} ;
2220 if (C4::Context->preference("FinesLog")) {
2221 &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2223 $uquery = "update accountlines set accounttype='F' ";
2224 if($outstanding >= 0 && $amt >=0) {
2225 $uquery .= ", amount = ? , amountoutstanding=? ";
2226 unshift @bind, ($amt, $outstanding) ;
2229 $uquery = "update accountlines set accounttype='F' ";
2231 $uquery .= " where (accountlines_id = ?)";
2232 my $usth = $dbh->prepare($uquery);
2233 return $usth->execute(@bind);
2236 =head2 _FixAccountForLostAndReturned
2238 &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2240 Calculates the charge for a book lost and returned.
2242 Internal function, not exported, called only by AddReturn.
2244 FIXME: This function reflects how inscrutable fines logic is. Fix both.
2245 FIXME: Give a positive return value on success. It might be the $borrowernumber who received credit, or the amount forgiven.
2249 sub _FixAccountForLostAndReturned {
2250 my $itemnumber = shift or return;
2251 my $borrowernumber = @_ ? shift : undef;
2252 my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
2253 my $dbh = C4::Context->dbh;
2254 # check for charge made for lost book
2255 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2256 $sth->execute($itemnumber);
2257 my $data = $sth->fetchrow_hashref;
2258 $data or return; # bail if there is nothing to do
2259 $data->{accounttype} eq 'W' and return; # Written off
2261 # writeoff this amount
2263 my $amount = $data->{'amount'};
2264 my $acctno = $data->{'accountno'};
2265 my $amountleft; # Starts off undef/zero.
2266 if ($data->{'amountoutstanding'} == $amount) {
2267 $offset = $data->{'amount'};
2268 $amountleft = 0; # Hey, it's zero here, too.
2270 $offset = $amount - $data->{'amountoutstanding'}; # Um, isn't this the same as ZERO? We just tested those two things are ==
2271 $amountleft = $data->{'amountoutstanding'} - $amount; # Um, isn't this the same as ZERO? We just tested those two things are ==
2273 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2274 WHERE (accountlines_id = ?)");
2275 $usth->execute($data->{'accountlines_id'}); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in.
2276 #check if any credit is left if so writeoff other accounts
2277 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2278 $amountleft *= -1 if ($amountleft < 0);
2279 if ($amountleft > 0) {
2280 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2281 AND (amountoutstanding >0) ORDER BY date"); # might want to order by amountoustanding ASC (pay smallest first)
2282 $msth->execute($data->{'borrowernumber'});
2283 # offset transactions
2286 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2287 if ($accdata->{'amountoutstanding'} < $amountleft) {
2289 $amountleft -= $accdata->{'amountoutstanding'};
2291 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2294 my $thisacct = $accdata->{'accountlines_id'};
2295 # FIXME: move prepares outside while loop!
2296 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2297 WHERE (accountlines_id = ?)");
2298 $usth->execute($newamtos,$thisacct);
2299 $usth = $dbh->prepare("INSERT INTO accountoffsets
2300 (borrowernumber, accountno, offsetaccount, offsetamount)
2303 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2306 $amountleft *= -1 if ($amountleft > 0);
2307 my $desc = "Item Returned " . $item_id;
2308 $usth = $dbh->prepare("INSERT INTO accountlines
2309 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2310 VALUES (?,?,now(),?,?,'CR',?)");
2311 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2312 if ($borrowernumber) {
2313 # FIXME: same as query above. use 1 sth for both
2314 $usth = $dbh->prepare("INSERT INTO accountoffsets
2315 (borrowernumber, accountno, offsetaccount, offsetamount)
2317 $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2319 ModItem({ paidfor => '' }, undef, $itemnumber);
2323 =head2 _GetCircControlBranch
2325 my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2329 Return the library code to be used to determine which circulation
2330 policy applies to a transaction. Looks up the CircControl and
2331 HomeOrHoldingBranch system preferences.
2333 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2335 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2339 sub _GetCircControlBranch {
2340 my ($item, $borrower) = @_;
2341 my $circcontrol = C4::Context->preference('CircControl');
2344 if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2345 $branch= C4::Context->userenv->{'branch'};
2346 } elsif ($circcontrol eq 'PatronLibrary') {
2347 $branch=$borrower->{branchcode};
2349 my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2350 $branch = $item->{$branchfield};
2351 # default to item home branch if holdingbranch is used
2352 # and is not defined
2353 if (!defined($branch) && $branchfield eq 'holdingbranch') {
2354 $branch = $item->{homebranch};
2367 $issue = &GetItemIssue($itemnumber);
2369 Returns patron currently having a book, or undef if not checked out.
2371 C<$itemnumber> is the itemnumber.
2373 C<$issue> is a hashref of the row from the issues table.
2378 my ($itemnumber) = @_;
2379 return unless $itemnumber;
2380 my $sth = C4::Context->dbh->prepare(
2381 "SELECT items.*, issues.*
2383 LEFT JOIN items ON issues.itemnumber=items.itemnumber
2384 WHERE issues.itemnumber=?");
2385 $sth->execute($itemnumber);
2386 my $data = $sth->fetchrow_hashref;
2387 return unless $data;
2388 $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2389 $data->{issuedate}->truncate(to => 'minute');
2390 $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2391 $data->{date_due}->truncate(to => 'minute');
2392 my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2393 $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2399 $issue = GetOpenIssue( $itemnumber );
2401 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2403 C<$itemnumber> is the item's itemnumber
2410 my ( $itemnumber ) = @_;
2411 return unless $itemnumber;
2412 my $dbh = C4::Context->dbh;
2413 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2414 $sth->execute( $itemnumber );
2415 return $sth->fetchrow_hashref();
2421 $issues = GetIssues({}); # return all issues!
2422 $issues = GetIssues({ borrowernumber => $borrowernumber, biblionumber => $biblionumber });
2424 Returns all pending issues that match given criteria.
2425 Returns a arrayref or undef if an error occurs.
2427 Allowed criteria are:
2431 =item * borrowernumber
2433 =item * biblionumber
2442 my ($criteria) = @_;
2446 my @allowed = qw(borrowernumber biblionumber itemnumber);
2447 foreach (@allowed) {
2448 if (defined $criteria->{$_}) {
2451 value => $criteria->{$_},
2456 # Do we need to join other tables ?
2458 if (defined $criteria->{biblionumber}) {
2465 $where = "WHERE " . join(' AND ', map { "$_->{field} = ?" } @filters);
2471 if (defined $join{items}) {
2473 LEFT JOIN items ON (issues.itemnumber = items.itemnumber)
2479 my $dbh = C4::Context->dbh;
2480 my $sth = $dbh->prepare($query);
2481 my $rv = $sth->execute(map { $_->{value} } @filters);
2483 return $rv ? $sth->fetchall_arrayref({}) : undef;
2486 =head2 GetItemIssues
2488 $issues = &GetItemIssues($itemnumber, $history);
2490 Returns patrons that have issued a book
2492 C<$itemnumber> is the itemnumber
2493 C<$history> is false if you just want the current "issuer" (if any)
2494 and true if you want issues history from old_issues also.
2496 Returns reference to an array of hashes
2501 my ( $itemnumber, $history ) = @_;
2503 my $today = DateTime->now( time_zome => C4::Context->tz); # get today date
2504 $today->truncate( to => 'minute' );
2505 my $sql = "SELECT * FROM issues
2506 JOIN borrowers USING (borrowernumber)
2507 JOIN items USING (itemnumber)
2508 WHERE issues.itemnumber = ? ";
2511 SELECT * FROM old_issues
2512 LEFT JOIN borrowers USING (borrowernumber)
2513 JOIN items USING (itemnumber)
2514 WHERE old_issues.itemnumber = ? ";
2516 $sql .= "ORDER BY date_due DESC";
2517 my $sth = C4::Context->dbh->prepare($sql);
2519 $sth->execute($itemnumber, $itemnumber);
2521 $sth->execute($itemnumber);
2523 my $results = $sth->fetchall_arrayref({});
2524 foreach (@$results) {
2525 my $date_due = dt_from_string($_->{date_due},'sql');
2526 $date_due->truncate( to => 'minute' );
2528 $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2533 =head2 GetBiblioIssues
2535 $issues = GetBiblioIssues($biblionumber);
2537 this function get all issues from a biblionumber.
2540 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2541 tables issues and the firstname,surname & cardnumber from borrowers.
2545 sub GetBiblioIssues {
2546 my $biblionumber = shift;
2547 return unless $biblionumber;
2548 my $dbh = C4::Context->dbh;
2550 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2552 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2553 LEFT JOIN items ON issues.itemnumber = items.itemnumber
2554 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2555 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2556 WHERE biblio.biblionumber = ?
2558 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2560 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2561 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2562 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2563 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2564 WHERE biblio.biblionumber = ?
2567 my $sth = $dbh->prepare($query);
2568 $sth->execute($biblionumber, $biblionumber);
2571 while ( my $data = $sth->fetchrow_hashref ) {
2572 push @issues, $data;
2577 =head2 GetUpcomingDueIssues
2579 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2583 sub GetUpcomingDueIssues {
2586 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2587 my $dbh = C4::Context->dbh;
2589 my $statement = <<END_SQL;
2590 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2592 LEFT JOIN items USING (itemnumber)
2593 LEFT OUTER JOIN branches USING (branchcode)
2594 WHERE returndate is NULL
2595 HAVING days_until_due >= 0 AND days_until_due <= ?
2598 my @bind_parameters = ( $params->{'days_in_advance'} );
2600 my $sth = $dbh->prepare( $statement );
2601 $sth->execute( @bind_parameters );
2602 my $upcoming_dues = $sth->fetchall_arrayref({});
2604 return $upcoming_dues;
2607 =head2 CanBookBeRenewed
2609 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2611 Find out whether a borrowed item may be renewed.
2613 C<$borrowernumber> is the borrower number of the patron who currently
2614 has the item on loan.
2616 C<$itemnumber> is the number of the item to renew.
2618 C<$override_limit>, if supplied with a true value, causes
2619 the limit on the number of times that the loan can be renewed
2620 (as controlled by the item type) to be ignored. Overriding also allows
2621 to renew sooner than "No renewal before" and to manually renew loans
2622 that are automatically renewed.
2624 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2625 item must currently be on loan to the specified borrower; renewals
2626 must be allowed for the item's type; and the borrower must not have
2627 already renewed the loan. $error will contain the reason the renewal can not proceed
2631 sub CanBookBeRenewed {
2632 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2634 my $dbh = C4::Context->dbh;
2637 my $item = GetItem($itemnumber) or return ( 0, 'no_item' );
2638 my $itemissue = GetItemIssue($itemnumber) or return ( 0, 'no_checkout' );
2640 $borrowernumber ||= $itemissue->{borrowernumber};
2641 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
2644 my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2646 # This item can fill one or more unfilled reserve, can those unfilled reserves
2647 # all be filled by other available items?
2649 && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2651 my $schema = Koha::Database->new()->schema();
2653 # Get all other items that could possibly fill reserves
2654 my @itemnumbers = $schema->resultset('Item')->search(
2656 biblionumber => $resrec->{biblionumber},
2658 -not => { itemnumber => $itemnumber }
2660 { columns => 'itemnumber' }
2661 )->get_column('itemnumber')->all();
2663 # Get all other reserves that could have been filled by this item
2664 my @borrowernumbers;
2666 my ( $reserve_found, $reserve, undef ) =
2667 C4::Reserves::CheckReserves( $itemnumber, undef, undef,
2668 \@borrowernumbers );
2670 if ($reserve_found) {
2671 push( @borrowernumbers, $reserve->{borrowernumber} );
2678 # If the count of the union of the lists of reservable items for each borrower
2679 # is equal or greater than the number of borrowers, we know that all reserves
2680 # can be filled with available items. We can get the union of the sets simply
2681 # by pushing all the elements onto an array and removing the duplicates.
2683 foreach my $b (@borrowernumbers) {
2684 foreach my $i (@itemnumbers) {
2685 if ( IsAvailableForItemLevelRequest($i)
2686 && CanItemBeReserved( $b, $i ) )
2688 push( @reservable, $i );
2693 @reservable = uniq(@reservable);
2695 if ( @reservable >= @borrowernumbers ) {
2700 return ( 0, "on_reserve" ) if $resfound; # '' when no hold was found
2702 return ( 1, undef ) if $override_limit;
2704 my $branchcode = _GetCircControlBranch( $item, $borrower );
2706 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2708 return ( 0, "too_many" )
2709 if $issuingrule->{renewalsallowed} <= $itemissue->{renewals};
2711 if ( $issuingrule->{norenewalbefore} ) {
2713 # Get current time and add norenewalbefore.
2714 # If this is smaller than date_due, it's too soon for renewal.
2716 DateTime->now( time_zone => C4::Context->tz() )->add(
2717 $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore}
2718 ) < $itemissue->{date_due}
2721 return ( 0, "auto_too_soon" ) if $itemissue->{auto_renew};
2722 return ( 0, "too_soon" );
2726 return ( 0, "auto_renew" ) if $itemissue->{auto_renew};
2727 return ( 1, undef );
2732 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2736 C<$borrowernumber> is the borrower number of the patron who currently
2739 C<$itemnumber> is the number of the item to renew.
2741 C<$branch> is the library where the renewal took place (if any).
2742 The library that controls the circ policies for the renewal is retrieved from the issues record.
2744 C<$datedue> can be a C4::Dates object used to set the due date.
2746 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
2747 this parameter is not supplied, lastreneweddate is set to the current date.
2749 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2750 from the book's item type.
2755 my $borrowernumber = shift;
2756 my $itemnumber = shift or return;
2758 my $datedue = shift;
2759 my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
2761 my $item = GetItem($itemnumber) or return;
2762 my $biblio = GetBiblioFromItemNumber($itemnumber) or return;
2764 my $dbh = C4::Context->dbh;
2766 # Find the issues record for this book
2768 $dbh->prepare("SELECT * FROM issues WHERE itemnumber = ?");
2769 $sth->execute( $itemnumber );
2770 my $issuedata = $sth->fetchrow_hashref;
2772 return unless ( $issuedata );
2774 $borrowernumber ||= $issuedata->{borrowernumber};
2776 if ( defined $datedue && ref $datedue ne 'DateTime' ) {
2777 carp 'Invalid date passed to AddRenewal.';
2781 # If the due date wasn't specified, calculate it by adding the
2782 # book's loan length to today's date or the current due date
2783 # based on the value of the RenewalPeriodBase syspref.
2786 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return;
2787 my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
2789 $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2790 dt_from_string( $issuedata->{date_due} ) :
2791 DateTime->now( time_zone => C4::Context->tz());
2792 $datedue = CalcDateDue($datedue, $itemtype, $issuedata->{'branchcode'}, $borrower, 'is a renewal');
2795 # Update the issues record to have the new due date, and a new count
2796 # of how many times it has been renewed.
2797 my $renews = $issuedata->{'renewals'} + 1;
2798 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2799 WHERE borrowernumber=?
2803 $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2805 # Update the renewal count on the item, and tell zebra to reindex
2806 $renews = $biblio->{'renewals'} + 1;
2807 ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
2809 # Charge a new rental fee, if applicable?
2810 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2811 if ( $charge > 0 ) {
2812 my $accountno = getnextacctno( $borrowernumber );
2813 my $item = GetBiblioFromItemNumber($itemnumber);
2815 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
2816 $sth = $dbh->prepare(
2817 "INSERT INTO accountlines
2818 (date, borrowernumber, accountno, amount, manager_id,
2819 description,accounttype, amountoutstanding, itemnumber)
2820 VALUES (now(),?,?,?,?,?,?,?,?)"
2822 $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
2823 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2824 'Rent', $charge, $itemnumber );
2827 # Send a renewal slip according to checkout alert preferencei
2828 if ( C4::Context->preference('RenewalSendNotice') eq '1') {
2829 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
2830 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2832 branchcode => $branch,
2833 categorycode => $borrower->{categorycode},
2834 item_type => $item->{itype},
2835 notification => 'CHECKOUT',
2837 if ($circulation_alert->is_enabled_for(\%conditions)) {
2838 SendCirculationAlert({
2841 borrower => $borrower,
2847 # Remove any OVERDUES related debarment if the borrower has no overdues
2848 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
2849 if ( $borrowernumber
2850 && $borrower->{'debarred'}
2851 && !HasOverdues( $borrowernumber )
2852 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2854 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2858 UpdateStats({branch => $branch,
2861 itemnumber => $itemnumber,
2862 itemtype => $item->{itype},
2863 borrowernumber => $borrowernumber,
2864 ccode => $item->{'ccode'}}
2870 # check renewal status
2871 my ( $bornum, $itemno ) = @_;
2872 my $dbh = C4::Context->dbh;
2874 my $renewsallowed = 0;
2877 my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
2878 my $item = GetItem($itemno);
2880 # Look in the issues table for this item, lent to this borrower,
2881 # and not yet returned.
2883 # FIXME - I think this function could be redone to use only one SQL call.
2884 my $sth = $dbh->prepare(
2885 "select * from issues
2886 where (borrowernumber = ?)
2887 and (itemnumber = ?)"
2889 $sth->execute( $bornum, $itemno );
2890 my $data = $sth->fetchrow_hashref;
2891 $renewcount = $data->{'renewals'} if $data->{'renewals'};
2892 # $item and $borrower should be calculated
2893 my $branchcode = _GetCircControlBranch($item, $borrower);
2895 my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
2897 $renewsallowed = $issuingrule->{'renewalsallowed'};
2898 $renewsleft = $renewsallowed - $renewcount;
2899 if($renewsleft < 0){ $renewsleft = 0; }
2900 return ( $renewcount, $renewsallowed, $renewsleft );
2903 =head2 GetSoonestRenewDate
2905 $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
2907 Find out the soonest possible renew date of a borrowed item.
2909 C<$borrowernumber> is the borrower number of the patron who currently
2910 has the item on loan.
2912 C<$itemnumber> is the number of the item to renew.
2914 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
2915 renew date, based on the value "No renewal before" of the applicable
2916 issuing rule. Returns the current date if the item can already be
2917 renewed, and returns undefined if the borrower, loan, or item
2922 sub GetSoonestRenewDate {
2923 my ( $borrowernumber, $itemnumber ) = @_;
2925 my $dbh = C4::Context->dbh;
2927 my $item = GetItem($itemnumber) or return;
2928 my $itemissue = GetItemIssue($itemnumber) or return;
2930 $borrowernumber ||= $itemissue->{borrowernumber};
2931 my $borrower = C4::Members::GetMemberDetails($borrowernumber)
2934 my $branchcode = _GetCircControlBranch( $item, $borrower );
2936 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2938 my $now = DateTime->now( time_zone => C4::Context->tz() );
2940 if ( $issuingrule->{norenewalbefore} ) {
2941 my $soonestrenewal =
2942 $itemissue->{date_due}->subtract(
2943 $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
2945 $soonestrenewal = $now > $soonestrenewal ? $now : $soonestrenewal;
2946 return $soonestrenewal;
2951 =head2 GetIssuingCharges
2953 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2955 Calculate how much it would cost for a given patron to borrow a given
2956 item, including any applicable discounts.
2958 C<$itemnumber> is the item number of item the patron wishes to borrow.
2960 C<$borrowernumber> is the patron's borrower number.
2962 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2963 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2968 sub GetIssuingCharges {
2970 # calculate charges due
2971 my ( $itemnumber, $borrowernumber ) = @_;
2973 my $dbh = C4::Context->dbh;
2976 # Get the book's item type and rental charge (via its biblioitem).
2977 my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
2978 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
2979 $charge_query .= (C4::Context->preference('item-level_itypes'))
2980 ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
2981 : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
2983 $charge_query .= ' WHERE items.itemnumber =?';
2985 my $sth = $dbh->prepare($charge_query);
2986 $sth->execute($itemnumber);
2987 if ( my $item_data = $sth->fetchrow_hashref ) {
2988 $item_type = $item_data->{itemtype};
2989 $charge = $item_data->{rentalcharge};
2990 my $branch = C4::Branch::mybranch();
2991 my $discount_query = q|SELECT rentaldiscount,
2992 issuingrules.itemtype, issuingrules.branchcode
2994 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2995 WHERE borrowers.borrowernumber = ?
2996 AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
2997 AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
2998 my $discount_sth = $dbh->prepare($discount_query);
2999 $discount_sth->execute( $borrowernumber, $item_type, $branch );
3000 my $discount_rules = $discount_sth->fetchall_arrayref({});
3001 if (@{$discount_rules}) {
3002 # We may have multiple rules so get the most specific
3003 my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3004 $charge = ( $charge * ( 100 - $discount ) ) / 100;
3008 return ( $charge, $item_type );
3011 # Select most appropriate discount rule from those returned
3012 sub _get_discount_from_rule {
3013 my ($rules_ref, $branch, $itemtype) = @_;
3016 if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3017 $discount = $rules_ref->[0]->{rentaldiscount};
3018 return (defined $discount) ? $discount : 0;
3020 # could have up to 4 does one match $branch and $itemtype
3021 my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3023 $discount = $d[0]->{rentaldiscount};
3024 return (defined $discount) ? $discount : 0;
3026 # do we have item type + all branches
3027 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3029 $discount = $d[0]->{rentaldiscount};
3030 return (defined $discount) ? $discount : 0;
3032 # do we all item types + this branch
3033 @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3035 $discount = $d[0]->{rentaldiscount};
3036 return (defined $discount) ? $discount : 0;
3038 # so all and all (surely we wont get here)
3039 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3041 $discount = $d[0]->{rentaldiscount};
3042 return (defined $discount) ? $discount : 0;
3048 =head2 AddIssuingCharge
3050 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3054 sub AddIssuingCharge {
3055 my ( $itemnumber, $borrowernumber, $charge ) = @_;
3056 my $dbh = C4::Context->dbh;
3057 my $nextaccntno = getnextacctno( $borrowernumber );
3059 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3061 INSERT INTO accountlines
3062 (borrowernumber, itemnumber, accountno,
3063 date, amount, description, accounttype,
3064 amountoutstanding, manager_id)
3065 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
3067 my $sth = $dbh->prepare($query);
3068 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
3073 GetTransfers($itemnumber);
3078 my ($itemnumber) = @_;
3080 my $dbh = C4::Context->dbh;
3086 FROM branchtransfers
3087 WHERE itemnumber = ?
3088 AND datearrived IS NULL
3090 my $sth = $dbh->prepare($query);
3091 $sth->execute($itemnumber);
3092 my @row = $sth->fetchrow_array();
3096 =head2 GetTransfersFromTo
3098 @results = GetTransfersFromTo($frombranch,$tobranch);
3100 Returns the list of pending transfers between $from and $to branch
3104 sub GetTransfersFromTo {
3105 my ( $frombranch, $tobranch ) = @_;
3106 return unless ( $frombranch && $tobranch );
3107 my $dbh = C4::Context->dbh;
3109 SELECT itemnumber,datesent,frombranch
3110 FROM branchtransfers
3113 AND datearrived IS NULL
3115 my $sth = $dbh->prepare($query);
3116 $sth->execute( $frombranch, $tobranch );
3119 while ( my $data = $sth->fetchrow_hashref ) {
3120 push @gettransfers, $data;
3122 return (@gettransfers);
3125 =head2 DeleteTransfer
3127 &DeleteTransfer($itemnumber);
3131 sub DeleteTransfer {
3132 my ($itemnumber) = @_;
3133 return unless $itemnumber;
3134 my $dbh = C4::Context->dbh;
3135 my $sth = $dbh->prepare(
3136 "DELETE FROM branchtransfers
3138 AND datearrived IS NULL "
3140 return $sth->execute($itemnumber);
3143 =head2 AnonymiseIssueHistory
3145 ($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)
3147 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
3148 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
3150 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
3151 setting (force delete).
3153 return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.
3157 sub AnonymiseIssueHistory {
3159 my $borrowernumber = shift;
3160 my $dbh = C4::Context->dbh;
3163 SET borrowernumber = ?
3164 WHERE returndate < ?
3165 AND borrowernumber IS NOT NULL
3168 # The default of 0 does not work due to foreign key constraints
3169 # The anonymisation will fail quietly if AnonymousPatron is not a valid entry
3170 my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0;
3171 my @bind_params = ($anonymouspatron, $date);
3172 if (defined $borrowernumber) {
3173 $query .= " AND borrowernumber = ?";
3174 push @bind_params, $borrowernumber;
3176 $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
3178 my $sth = $dbh->prepare($query);
3179 $sth->execute(@bind_params);
3180 my $anonymisation_err = $dbh->err;
3181 my $rows_affected = $sth->rows; ### doublecheck row count return function
3182 return ($rows_affected, $anonymisation_err);
3185 =head2 SendCirculationAlert
3187 Send out a C<check-in> or C<checkout> alert using the messaging system.
3195 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3199 Hashref of information about the item being checked in or out.
3203 Hashref of information about the borrower of the item.
3207 The branchcode from where the checkout or check-in took place.
3213 SendCirculationAlert({
3216 borrower => $borrower,
3222 sub SendCirculationAlert {
3224 my ($type, $item, $borrower, $branch) =
3225 ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3226 my %message_name = (
3227 CHECKIN => 'Item_Check_in',
3228 CHECKOUT => 'Item_Checkout',
3229 RENEWAL => 'Item_Checkout',
3231 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3232 borrowernumber => $borrower->{borrowernumber},
3233 message_name => $message_name{$type},
3235 my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3236 my $letter = C4::Letters::GetPreparedLetter (
3237 module => 'circulation',
3238 letter_code => $type,
3239 branchcode => $branch,
3241 $issues_table => $item->{itemnumber},
3242 'items' => $item->{itemnumber},
3243 'biblio' => $item->{biblionumber},
3244 'biblioitems' => $item->{biblionumber},
3245 'borrowers' => $borrower,
3246 'branches' => $branch,
3250 my @transports = keys %{ $borrower_preferences->{transports} };
3251 # warn "no transports" unless @transports;
3253 # warn "transport: $_";
3254 my $message = C4::Message->find_last_message($borrower, $type, $_);
3256 #warn "create new message";
3257 C4::Message->enqueue($letter, $borrower, $_);
3259 #warn "append to old message";
3260 $message->append($letter);
3268 =head2 updateWrongTransfer
3270 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3272 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
3276 sub updateWrongTransfer {
3277 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3278 my $dbh = C4::Context->dbh;
3279 # first step validate the actual line of transfert .
3282 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3284 $sth->execute($FromLibrary,$itemNumber);
3286 # second step create a new line of branchtransfer to the right location .
3287 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3289 #third step changing holdingbranch of item
3290 UpdateHoldingbranch($FromLibrary,$itemNumber);
3293 =head2 UpdateHoldingbranch
3295 $items = UpdateHoldingbranch($branch,$itmenumber);
3297 Simple methode for updating hodlingbranch in items BDD line
3301 sub UpdateHoldingbranch {
3302 my ( $branch,$itemnumber ) = @_;
3303 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3308 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3310 this function calculates the due date given the start date and configured circulation rules,
3311 checking against the holidays calendar as per the 'useDaysMode' syspref.
3312 C<$startdate> = C4::Dates object representing start date of loan period (assumed to be today)
3313 C<$itemtype> = itemtype code of item in question
3314 C<$branch> = location whose calendar to use
3315 C<$borrower> = Borrower object
3316 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3321 my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3325 # loanlength now a href
3327 GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3329 my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3335 if (ref $startdate ne 'DateTime' ) {
3336 $datedue = dt_from_string($datedue);
3338 $datedue = $startdate->clone;
3342 DateTime->now( time_zone => C4::Context->tz() )
3343 ->truncate( to => 'minute' );
3347 # calculate the datedue as normal
3348 if ( C4::Context->preference('useDaysMode') eq 'Days' )
3349 { # ignoring calendar
3350 if ( $loanlength->{lengthunit} eq 'hours' ) {
3351 $datedue->add( hours => $loanlength->{$length_key} );
3353 $datedue->add( days => $loanlength->{$length_key} );
3354 $datedue->set_hour(23);
3355 $datedue->set_minute(59);
3359 if ($loanlength->{lengthunit} eq 'hours') {
3360 $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3363 $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3365 my $calendar = Koha::Calendar->new( branchcode => $branch );
3366 $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3367 if ($loanlength->{lengthunit} eq 'days') {
3368 $datedue->set_hour(23);
3369 $datedue->set_minute(59);
3373 # if Hard Due Dates are used, retreive them and apply as necessary
3374 my ( $hardduedate, $hardduedatecompare ) =
3375 GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3376 if ($hardduedate) { # hardduedates are currently dates
3377 $hardduedate->truncate( to => 'minute' );
3378 $hardduedate->set_hour(23);
3379 $hardduedate->set_minute(59);
3380 my $cmp = DateTime->compare( $hardduedate, $datedue );
3382 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3383 # if the calculated date is before the 'after' Hard Due Date (floor), override
3384 # if the hard due date is set to 'exactly', overrride
3385 if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3386 $datedue = $hardduedate->clone;
3389 # in all other cases, keep the date due as it is
3393 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3394 if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3395 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso' );
3396 $expiry_dt->set( hour => 23, minute => 59);
3397 if ( DateTime->compare( $datedue, $expiry_dt ) == 1 ) {
3398 $datedue = $expiry_dt->clone;
3406 =head2 CheckRepeatableHolidays
3408 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
3410 This function checks if the date due is a repeatable holiday
3412 C<$date_due> = returndate calculate with no day check
3413 C<$itemnumber> = itemnumber
3414 C<$branchcode> = localisation of issue
3418 sub CheckRepeatableHolidays{
3419 my($itemnumber,$week_day,$branchcode)=@_;
3420 my $dbh = C4::Context->dbh;
3421 my $query = qq|SELECT count(*)
3422 FROM repeatable_holidays
3425 my $sth = $dbh->prepare($query);
3426 $sth->execute($branchcode,$week_day);
3427 my $result=$sth->fetchrow;
3432 =head2 CheckSpecialHolidays
3434 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
3436 This function check if the date is a special holiday
3438 C<$years> = the years of datedue
3439 C<$month> = the month of datedue
3440 C<$day> = the day of datedue
3441 C<$itemnumber> = itemnumber
3442 C<$branchcode> = localisation of issue
3446 sub CheckSpecialHolidays{
3447 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
3448 my $dbh = C4::Context->dbh;
3449 my $query=qq|SELECT count(*)
3450 FROM `special_holidays`
3456 my $sth = $dbh->prepare($query);
3457 $sth->execute($years,$month,$day,$branchcode);
3458 my $countspecial=$sth->fetchrow ;
3459 return $countspecial;
3462 =head2 CheckRepeatableSpecialHolidays
3464 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
3466 This function check if the date is a repeatble special holidays
3468 C<$month> = the month of datedue
3469 C<$day> = the day of datedue
3470 C<$itemnumber> = itemnumber
3471 C<$branchcode> = localisation of issue
3475 sub CheckRepeatableSpecialHolidays{
3476 my ($month,$day,$itemnumber,$branchcode) = @_;
3477 my $dbh = C4::Context->dbh;
3478 my $query=qq|SELECT count(*)
3479 FROM `repeatable_holidays`
3484 my $sth = $dbh->prepare($query);
3485 $sth->execute($month,$day,$branchcode);
3486 my $countspecial=$sth->fetchrow ;
3487 return $countspecial;
3492 sub CheckValidBarcode{
3494 my $dbh = C4::Context->dbh;
3495 my $query=qq|SELECT count(*)
3499 my $sth = $dbh->prepare($query);
3500 $sth->execute($barcode);
3501 my $exist=$sth->fetchrow ;
3505 =head2 IsBranchTransferAllowed
3507 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3509 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3513 sub IsBranchTransferAllowed {
3514 my ( $toBranch, $fromBranch, $code ) = @_;
3516 if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3518 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3519 my $dbh = C4::Context->dbh;
3521 my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3522 $sth->execute( $toBranch, $fromBranch, $code );
3523 my $limit = $sth->fetchrow_hashref();
3525 ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3526 if ( $limit->{'limitId'} ) {
3533 =head2 CreateBranchTransferLimit
3535 CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3537 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3541 sub CreateBranchTransferLimit {
3542 my ( $toBranch, $fromBranch, $code ) = @_;
3543 return unless defined($toBranch) && defined($fromBranch);
3544 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3546 my $dbh = C4::Context->dbh;
3548 my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3549 return $sth->execute( $code, $toBranch, $fromBranch );
3552 =head2 DeleteBranchTransferLimits
3554 my $result = DeleteBranchTransferLimits($frombranch);
3556 Deletes all the library transfer limits for one library. Returns the
3557 number of limits deleted, 0e0 if no limits were deleted, or undef if
3558 no arguments are supplied.
3562 sub DeleteBranchTransferLimits {
3564 return unless defined $branch;
3565 my $dbh = C4::Context->dbh;
3566 my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3567 return $sth->execute($branch);
3571 my ( $borrowernumber, $itemnum ) = @_;
3573 MarkIssueReturned( $borrowernumber, $itemnum );
3574 my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3575 my $item = C4::Items::GetItem( $itemnum );
3576 my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3577 my @datearr = localtime(time);
3578 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3579 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3580 ModItem({ paidfor => $old_note."Paid for by $bor $date" }, undef, $itemnum);
3585 my ($itemnumber, $mark_returned) = @_;
3587 my $dbh = C4::Context->dbh();
3588 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3590 JOIN items USING (itemnumber)
3591 JOIN biblio USING (biblionumber)
3592 WHERE issues.itemnumber=?");
3593 $sth->execute($itemnumber);
3594 my $issues=$sth->fetchrow_hashref();
3596 # If a borrower lost the item, add a replacement cost to the their record
3597 if ( my $borrowernumber = $issues->{borrowernumber} ){
3598 my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3600 if (C4::Context->preference('WhenLostForgiveFine')){
3601 my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3602 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!"; # zero is OK, check defined
3604 if (C4::Context->preference('WhenLostChargeReplacementFee')){
3605 C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3606 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3607 #warn " $issues->{'borrowernumber'} / $itemnumber ";
3610 MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3614 sub GetOfflineOperations {
3615 my $dbh = C4::Context->dbh;
3616 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3617 $sth->execute(C4::Context->userenv->{'branch'});
3618 my $results = $sth->fetchall_arrayref({});
3622 sub GetOfflineOperation {
3623 my $operationid = shift;
3624 return unless $operationid;
3625 my $dbh = C4::Context->dbh;
3626 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3627 $sth->execute( $operationid );
3628 return $sth->fetchrow_hashref;
3631 sub AddOfflineOperation {
3632 my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3633 my $dbh = C4::Context->dbh;
3634 my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3635 $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3639 sub DeleteOfflineOperation {
3640 my $dbh = C4::Context->dbh;
3641 my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3642 $sth->execute( shift );
3646 sub ProcessOfflineOperation {
3647 my $operation = shift;
3650 if ( $operation->{action} eq 'return' ) {
3651 $report = ProcessOfflineReturn( $operation );
3652 } elsif ( $operation->{action} eq 'issue' ) {
3653 $report = ProcessOfflineIssue( $operation );
3654 } elsif ( $operation->{action} eq 'payment' ) {
3655 $report = ProcessOfflinePayment( $operation );
3658 DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3663 sub ProcessOfflineReturn {
3664 my $operation = shift;
3666 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3668 if ( $itemnumber ) {
3669 my $issue = GetOpenIssue( $itemnumber );
3672 $issue->{borrowernumber},
3675 $operation->{timestamp},
3678 { renewals => 0, onloan => undef },
3679 $issue->{'biblionumber'},
3684 return "Item not issued.";
3687 return "Item not found.";
3691 sub ProcessOfflineIssue {
3692 my $operation = shift;
3694 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3696 if ( $borrower->{borrowernumber} ) {
3697 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3698 unless ($itemnumber) {
3699 return "Barcode not found.";
3701 my $issue = GetOpenIssue( $itemnumber );
3703 if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3705 $issue->{borrowernumber},
3708 $operation->{timestamp},
3713 $operation->{'barcode'},
3716 $operation->{timestamp},
3721 return "Borrower not found.";
3725 sub ProcessOfflinePayment {
3726 my $operation = shift;
3728 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3729 my $amount = $operation->{amount};
3731 recordpayment( $borrower->{borrowernumber}, $amount );
3739 TransferSlip($user_branch, $itemnumber, $to_branch)
3741 Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3746 my ($branch, $itemnumber, $to_branch) = @_;
3748 my $item = GetItem( $itemnumber )
3751 my $pulldate = C4::Dates->new();
3753 return C4::Letters::GetPreparedLetter (
3754 module => 'circulation',
3755 letter_code => 'TRANSFERSLIP',
3756 branchcode => $branch,
3758 'branches' => $to_branch,
3759 'biblio' => $item->{biblionumber},
3765 =head2 CheckIfIssuedToPatron
3767 CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3769 Return 1 if any record item is issued to patron, otherwise return 0
3773 sub CheckIfIssuedToPatron {
3774 my ($borrowernumber, $biblionumber) = @_;
3776 my $items = GetItemsByBiblioitemnumber($biblionumber);
3778 foreach my $item (@{$items}) {
3779 return 1 if ($item->{borrowernumber} && $item->{borrowernumber} eq $borrowernumber);
3787 IsItemIssued( $itemnumber )
3789 Return 1 if the item is on loan, otherwise return 0
3794 my $itemnumber = shift;
3795 my $dbh = C4::Context->dbh;
3796 my $sth = $dbh->prepare(q{
3799 WHERE itemnumber = ?
3801 $sth->execute($itemnumber);
3802 return $sth->fetchrow;
3805 =head2 GetAgeRestriction
3807 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3808 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3810 if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }
3811 if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3813 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3814 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3815 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
3816 Negative days mean the borrower has gone past the age restriction age.
3820 sub GetAgeRestriction {
3821 my ($record_restrictions, $borrower) = @_;
3822 my $markers = C4::Context->preference('AgeRestrictionMarker');
3824 # Split $record_restrictions to something like FSK 16 or PEGI 6
3825 my @values = split ' ', uc($record_restrictions);
3826 return unless @values;
3828 # Search first occurence of one of the markers
3829 my @markers = split /\|/, uc($markers);
3830 return unless @markers;
3833 my $restriction_year = 0;
3834 for my $value (@values) {
3836 for my $marker (@markers) {
3837 $marker =~ s/^\s+//; #remove leading spaces
3838 $marker =~ s/\s+$//; #remove trailing spaces
3839 if ( $marker eq $value ) {
3840 if ( $index <= $#values ) {
3841 $restriction_year += $values[$index];
3845 elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
3847 # Perhaps it is something like "K16" (as in Finland)
3848 $restriction_year += $1;
3852 last if ( $restriction_year > 0 );
3855 #Check if the borrower is age restricted for this material and for how long.
3856 if ($restriction_year && $borrower) {
3857 if ( $borrower->{'dateofbirth'} ) {
3858 my @alloweddate = split /-/, $borrower->{'dateofbirth'};
3859 $alloweddate[0] += $restriction_year;
3861 #Prevent runime eror on leap year (invalid date)
3862 if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
3863 $alloweddate[2] = 28;
3866 #Get how many days the borrower has to reach the age restriction
3867 my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(Today);
3868 #Negative days means the borrower went past the age restriction age
3869 return ($restriction_year, $daysToAgeRestriction);
3873 return ($restriction_year);
3882 Koha Development Team <http://koha-community.org/>