Translation updates for Koha 16.05.00 release
[koha.git] / C4 / Circulation.pm
blob913ec0b0893f344323a212abe273ddf39e24d4ea
1 package C4::Circulation;
3 # Copyright 2000-2002 Katipo Communications
4 # copyright 2010 BibLibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use strict;
23 #use warnings; FIXME - Bug 2505
24 use DateTime;
25 use Koha::DateUtils;
26 use C4::Context;
27 use C4::Stats;
28 use C4::Reserves;
29 use C4::Biblio;
30 use C4::Items;
31 use C4::Members;
32 use C4::Accounts;
33 use C4::ItemCirculationAlertPreference;
34 use C4::Message;
35 use C4::Debug;
36 use C4::Branch; # GetBranches
37 use C4::Log; # logaction
38 use C4::Koha qw(
39 GetAuthorisedValueByCode
40 GetAuthValCode
41 GetKohaAuthorisedValueLib
43 use C4::Overdues qw(CalcFine UpdateFine get_chargeable_units);
44 use C4::RotatingCollections qw(GetCollectionItemBranches);
45 use Algorithm::CheckDigits;
47 use Data::Dumper;
48 use Koha::DateUtils;
49 use Koha::Calendar;
50 use Koha::Items;
51 use Koha::Patrons;
52 use Koha::Patron::Debarments;
53 use Koha::Database;
54 use Koha::Libraries;
55 use Koha::Holds;
56 use Carp;
57 use List::MoreUtils qw( uniq );
58 use Scalar::Util qw( looks_like_number );
59 use Date::Calc qw(
60 Today
61 Today_and_Now
62 Add_Delta_YM
63 Add_Delta_DHMS
64 Date_to_Days
65 Day_of_Week
66 Add_Delta_Days
68 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
70 BEGIN {
71 require Exporter;
72 @ISA = qw(Exporter);
74 # FIXME subs that should probably be elsewhere
75 push @EXPORT, qw(
76 &barcodedecode
77 &LostItem
78 &ReturnLostItem
79 &GetPendingOnSiteCheckouts
82 # subs to deal with issuing a book
83 push @EXPORT, qw(
84 &CanBookBeIssued
85 &CanBookBeRenewed
86 &AddIssue
87 &AddRenewal
88 &GetRenewCount
89 &GetSoonestRenewDate
90 &GetItemIssue
91 &GetItemIssues
92 &GetIssuingCharges
93 &GetIssuingRule
94 &GetBranchBorrowerCircRule
95 &GetBranchItemRule
96 &GetBiblioIssues
97 &GetOpenIssue
98 &AnonymiseIssueHistory
99 &CheckIfIssuedToPatron
100 &IsItemIssued
101 GetTopIssues
104 # subs to deal with returns
105 push @EXPORT, qw(
106 &AddReturn
107 &MarkIssueReturned
110 # subs to deal with transfers
111 push @EXPORT, qw(
112 &transferbook
113 &GetTransfers
114 &GetTransfersFromTo
115 &updateWrongTransfer
116 &DeleteTransfer
117 &IsBranchTransferAllowed
118 &CreateBranchTransferLimit
119 &DeleteBranchTransferLimits
120 &TransferSlip
123 # subs to deal with offline circulation
124 push @EXPORT, qw(
125 &GetOfflineOperations
126 &GetOfflineOperation
127 &AddOfflineOperation
128 &DeleteOfflineOperation
129 &ProcessOfflineOperation
133 =head1 NAME
135 C4::Circulation - Koha circulation module
137 =head1 SYNOPSIS
139 use C4::Circulation;
141 =head1 DESCRIPTION
143 The functions in this module deal with circulation, issues, and
144 returns, as well as general information about the library.
145 Also deals with inventory.
147 =head1 FUNCTIONS
149 =head2 barcodedecode
151 $str = &barcodedecode($barcode, [$filter]);
153 Generic filter function for barcode string.
154 Called on every circ if the System Pref itemBarcodeInputFilter is set.
155 Will do some manipulation of the barcode for systems that deliver a barcode
156 to circulation.pl that differs from the barcode stored for the item.
157 For proper functioning of this filter, calling the function on the
158 correct barcode string (items.barcode) should return an unaltered barcode.
160 The optional $filter argument is to allow for testing or explicit
161 behavior that ignores the System Pref. Valid values are the same as the
162 System Pref options.
164 =cut
166 # FIXME -- the &decode fcn below should be wrapped into this one.
167 # FIXME -- these plugins should be moved out of Circulation.pm
169 sub barcodedecode {
170 my ($barcode, $filter) = @_;
171 my $branch = C4::Branch::mybranch();
172 $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
173 $filter or return $barcode; # ensure filter is defined, else return untouched barcode
174 if ($filter eq 'whitespace') {
175 $barcode =~ s/\s//g;
176 } elsif ($filter eq 'cuecat') {
177 chomp($barcode);
178 my @fields = split( /\./, $barcode );
179 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
180 ($#results == 2) and return $results[2];
181 } elsif ($filter eq 'T-prefix') {
182 if ($barcode =~ /^[Tt](\d)/) {
183 (defined($1) and $1 eq '0') and return $barcode;
184 $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1)
186 return sprintf("T%07d", $barcode);
187 # FIXME: $barcode could be "T1", causing warning: substr outside of string
188 # Why drop the nonzero digit after the T?
189 # Why pass non-digits (or empty string) to "T%07d"?
190 } elsif ($filter eq 'libsuite8') {
191 unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it.
192 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
193 $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i;
194 }else{
195 $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i;
198 } elsif ($filter eq 'EAN13') {
199 my $ean = CheckDigits('ean');
200 if ( $ean->is_valid($barcode) ) {
201 #$barcode = sprintf('%013d',$barcode); # this doesn't work on 32-bit systems
202 $barcode = '0' x ( 13 - length($barcode) ) . $barcode;
203 } else {
204 warn "# [$barcode] not valid EAN-13/UPC-A\n";
207 return $barcode; # return barcode, modified or not
210 =head2 decode
212 $str = &decode($chunk);
214 Decodes a segment of a string emitted by a CueCat barcode scanner and
215 returns it.
217 FIXME: Should be replaced with Barcode::Cuecat from CPAN
218 or Javascript based decoding on the client side.
220 =cut
222 sub decode {
223 my ($encoded) = @_;
224 my $seq =
225 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
226 my @s = map { index( $seq, $_ ); } split( //, $encoded );
227 my $l = ( $#s + 1 ) % 4;
228 if ($l) {
229 if ( $l == 1 ) {
230 # warn "Error: Cuecat decode parsing failed!";
231 return;
233 $l = 4 - $l;
234 $#s += $l;
236 my $r = '';
237 while ( $#s >= 0 ) {
238 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
239 $r .=
240 chr( ( $n >> 16 ) ^ 67 )
241 .chr( ( $n >> 8 & 255 ) ^ 67 )
242 .chr( ( $n & 255 ) ^ 67 );
243 @s = @s[ 4 .. $#s ];
245 $r = substr( $r, 0, length($r) - $l );
246 return $r;
249 =head2 transferbook
251 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
252 $barcode, $ignore_reserves);
254 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
256 C<$newbranch> is the code for the branch to which the item should be transferred.
258 C<$barcode> is the barcode of the item to be transferred.
260 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
261 Otherwise, if an item is reserved, the transfer fails.
263 Returns three values:
265 =over
267 =item $dotransfer
269 is true if the transfer was successful.
271 =item $messages
273 is a reference-to-hash which may have any of the following keys:
275 =over
277 =item C<BadBarcode>
279 There is no item in the catalog with the given barcode. The value is C<$barcode>.
281 =item C<IsPermanent>
283 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.
285 =item C<DestinationEqualsHolding>
287 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.
289 =item C<WasReturned>
291 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.
293 =item C<ResFound>
295 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>.
297 =item C<WasTransferred>
299 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
301 =back
303 =back
305 =cut
307 sub transferbook {
308 my ( $tbr, $barcode, $ignoreRs ) = @_;
309 my $messages;
310 my $dotransfer = 1;
311 my $branches = GetBranches();
312 my $itemnumber = GetItemnumberFromBarcode( $barcode );
313 my $issue = GetItemIssue($itemnumber);
314 my $biblio = GetBiblioFromItemNumber($itemnumber);
316 # bad barcode..
317 if ( not $itemnumber ) {
318 $messages->{'BadBarcode'} = $barcode;
319 $dotransfer = 0;
322 # get branches of book...
323 my $hbr = $biblio->{'homebranch'};
324 my $fbr = $biblio->{'holdingbranch'};
326 # if using Branch Transfer Limits
327 if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
328 if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
329 if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
330 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
331 $dotransfer = 0;
333 } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
334 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
335 $dotransfer = 0;
339 # if is permanent...
340 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
341 $messages->{'IsPermanent'} = $hbr;
342 $dotransfer = 0;
345 # can't transfer book if is already there....
346 if ( $fbr eq $tbr ) {
347 $messages->{'DestinationEqualsHolding'} = 1;
348 $dotransfer = 0;
351 # check if it is still issued to someone, return it...
352 if ($issue->{borrowernumber}) {
353 AddReturn( $barcode, $fbr );
354 $messages->{'WasReturned'} = $issue->{borrowernumber};
357 # find reserves.....
358 # That'll save a database query.
359 my ( $resfound, $resrec, undef ) =
360 CheckReserves( $itemnumber );
361 if ( $resfound and not $ignoreRs ) {
362 $resrec->{'ResFound'} = $resfound;
364 # $messages->{'ResFound'} = $resrec;
365 $dotransfer = 1;
368 #actually do the transfer....
369 if ($dotransfer) {
370 ModItemTransfer( $itemnumber, $fbr, $tbr );
372 # don't need to update MARC anymore, we do it in batch now
373 $messages->{'WasTransfered'} = 1;
376 ModDateLastSeen( $itemnumber );
377 return ( $dotransfer, $messages, $biblio );
381 sub TooMany {
382 my $borrower = shift;
383 my $biblionumber = shift;
384 my $item = shift;
385 my $params = shift;
386 my $onsite_checkout = $params->{onsite_checkout} || 0;
387 my $cat_borrower = $borrower->{'categorycode'};
388 my $dbh = C4::Context->dbh;
389 my $branch;
390 # Get which branchcode we need
391 $branch = _GetCircControlBranch($item,$borrower);
392 my $type = (C4::Context->preference('item-level_itypes'))
393 ? $item->{'itype'} # item-level
394 : $item->{'itemtype'}; # biblio-level
396 # given branch, patron category, and item type, determine
397 # applicable issuing rule
398 my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
400 # if a rule is found and has a loan limit set, count
401 # how many loans the patron already has that meet that
402 # rule
403 if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
404 my @bind_params;
405 my $count_query = q|
406 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
407 FROM issues
408 JOIN items USING (itemnumber)
411 my $rule_itemtype = $issuing_rule->{itemtype};
412 if ($rule_itemtype eq "*") {
413 # matching rule has the default item type, so count only
414 # those existing loans that don't fall under a more
415 # specific rule
416 if (C4::Context->preference('item-level_itypes')) {
417 $count_query .= " WHERE items.itype NOT IN (
418 SELECT itemtype FROM issuingrules
419 WHERE branchcode = ?
420 AND (categorycode = ? OR categorycode = ?)
421 AND itemtype <> '*'
422 ) ";
423 } else {
424 $count_query .= " JOIN biblioitems USING (biblionumber)
425 WHERE biblioitems.itemtype NOT IN (
426 SELECT itemtype FROM issuingrules
427 WHERE branchcode = ?
428 AND (categorycode = ? OR categorycode = ?)
429 AND itemtype <> '*'
430 ) ";
432 push @bind_params, $issuing_rule->{branchcode};
433 push @bind_params, $issuing_rule->{categorycode};
434 push @bind_params, $cat_borrower;
435 } else {
436 # rule has specific item type, so count loans of that
437 # specific item type
438 if (C4::Context->preference('item-level_itypes')) {
439 $count_query .= " WHERE items.itype = ? ";
440 } else {
441 $count_query .= " JOIN biblioitems USING (biblionumber)
442 WHERE biblioitems.itemtype= ? ";
444 push @bind_params, $type;
447 $count_query .= " AND borrowernumber = ? ";
448 push @bind_params, $borrower->{'borrowernumber'};
449 my $rule_branch = $issuing_rule->{branchcode};
450 if ($rule_branch ne "*") {
451 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
452 $count_query .= " AND issues.branchcode = ? ";
453 push @bind_params, $branch;
454 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
455 ; # if branch is the patron's home branch, then count all loans by patron
456 } else {
457 $count_query .= " AND items.homebranch = ? ";
458 push @bind_params, $branch;
462 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $count_query, {}, @bind_params );
464 my $max_checkouts_allowed = $issuing_rule->{maxissueqty};
465 my $max_onsite_checkouts_allowed = $issuing_rule->{maxonsiteissueqty};
467 if ( $onsite_checkout ) {
468 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
469 return {
470 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
471 count => $onsite_checkout_count,
472 max_allowed => $max_onsite_checkouts_allowed,
476 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
477 if ( $checkout_count >= $max_checkouts_allowed ) {
478 return {
479 reason => 'TOO_MANY_CHECKOUTS',
480 count => $checkout_count,
481 max_allowed => $max_checkouts_allowed,
484 } elsif ( not $onsite_checkout ) {
485 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
486 return {
487 reason => 'TOO_MANY_CHECKOUTS',
488 count => $checkout_count - $onsite_checkout_count,
489 max_allowed => $max_checkouts_allowed,
495 # Now count total loans against the limit for the branch
496 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
497 if (defined($branch_borrower_circ_rule->{maxissueqty})) {
498 my @bind_params = ();
499 my $branch_count_query = q|
500 SELECT COUNT(*) AS total, COALESCE(SUM(onsite_checkout), 0) AS onsite_checkouts
501 FROM issues
502 JOIN items USING (itemnumber)
503 WHERE borrowernumber = ?
505 push @bind_params, $borrower->{borrowernumber};
507 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
508 $branch_count_query .= " AND issues.branchcode = ? ";
509 push @bind_params, $branch;
510 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
511 ; # if branch is the patron's home branch, then count all loans by patron
512 } else {
513 $branch_count_query .= " AND items.homebranch = ? ";
514 push @bind_params, $branch;
516 my ( $checkout_count, $onsite_checkout_count ) = $dbh->selectrow_array( $branch_count_query, {}, @bind_params );
517 my $max_checkouts_allowed = $branch_borrower_circ_rule->{maxissueqty};
518 my $max_onsite_checkouts_allowed = $branch_borrower_circ_rule->{maxonsiteissueqty};
520 if ( $onsite_checkout ) {
521 if ( $onsite_checkout_count >= $max_onsite_checkouts_allowed ) {
522 return {
523 reason => 'TOO_MANY_ONSITE_CHECKOUTS',
524 count => $onsite_checkout_count,
525 max_allowed => $max_onsite_checkouts_allowed,
529 if ( C4::Context->preference('ConsiderOnSiteCheckoutsAsNormalCheckouts') ) {
530 if ( $checkout_count >= $max_checkouts_allowed ) {
531 return {
532 reason => 'TOO_MANY_CHECKOUTS',
533 count => $checkout_count,
534 max_allowed => $max_checkouts_allowed,
537 } elsif ( not $onsite_checkout ) {
538 if ( $checkout_count - $onsite_checkout_count >= $max_checkouts_allowed ) {
539 return {
540 reason => 'TOO_MANY_CHECKOUTS',
541 count => $checkout_count - $onsite_checkout_count,
542 max_allowed => $max_checkouts_allowed,
548 # OK, the patron can issue !!!
549 return;
552 =head2 itemissues
554 @issues = &itemissues($biblioitemnumber, $biblio);
556 Looks up information about who has borrowed the bookZ<>(s) with the
557 given biblioitemnumber.
559 C<$biblio> is ignored.
561 C<&itemissues> returns an array of references-to-hash. The keys
562 include the fields from the C<items> table in the Koha database.
563 Additional keys include:
565 =over 4
567 =item C<date_due>
569 If the item is currently on loan, this gives the due date.
571 If the item is not on loan, then this is either "Available" or
572 "Cancelled", if the item has been withdrawn.
574 =item C<card>
576 If the item is currently on loan, this gives the card number of the
577 patron who currently has the item.
579 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
581 These give the timestamp for the last three times the item was
582 borrowed.
584 =item C<card0>, C<card1>, C<card2>
586 The card number of the last three patrons who borrowed this item.
588 =item C<borrower0>, C<borrower1>, C<borrower2>
590 The borrower number of the last three patrons who borrowed this item.
592 =back
594 =cut
597 sub itemissues {
598 my ( $bibitem, $biblio ) = @_;
599 my $dbh = C4::Context->dbh;
600 my $sth =
601 $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
602 || die $dbh->errstr;
603 my $i = 0;
604 my @results;
606 $sth->execute($bibitem) || die $sth->errstr;
608 while ( my $data = $sth->fetchrow_hashref ) {
610 # Find out who currently has this item.
611 # FIXME - Wouldn't it be better to do this as a left join of
612 # some sort? Currently, this code assumes that if
613 # fetchrow_hashref() fails, then the book is on the shelf.
614 # fetchrow_hashref() can fail for any number of reasons (e.g.,
615 # database server crash), not just because no items match the
616 # search criteria.
617 my $sth2 = $dbh->prepare(
618 "SELECT * FROM issues
619 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
620 WHERE itemnumber = ?
624 $sth2->execute( $data->{'itemnumber'} );
625 if ( my $data2 = $sth2->fetchrow_hashref ) {
626 $data->{'date_due'} = $data2->{'date_due'};
627 $data->{'card'} = $data2->{'cardnumber'};
628 $data->{'borrower'} = $data2->{'borrowernumber'};
630 else {
631 $data->{'date_due'} = ($data->{'withdrawn'} eq '1') ? 'Cancelled' : 'Available';
635 # Find the last 3 people who borrowed this item.
636 $sth2 = $dbh->prepare(
637 "SELECT * FROM old_issues
638 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
639 WHERE itemnumber = ?
640 ORDER BY returndate DESC,timestamp DESC"
643 $sth2->execute( $data->{'itemnumber'} );
644 for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
645 { # FIXME : error if there is less than 3 pple borrowing this item
646 if ( my $data2 = $sth2->fetchrow_hashref ) {
647 $data->{"timestamp$i2"} = $data2->{'timestamp'};
648 $data->{"card$i2"} = $data2->{'cardnumber'};
649 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
650 } # if
651 } # for
653 $results[$i] = $data;
654 $i++;
657 return (@results);
660 =head2 CanBookBeIssued
662 ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower,
663 $barcode, $duedate, $inprocess, $ignore_reserves, $params );
665 Check if a book can be issued.
667 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
669 =over 4
671 =item C<$borrower> hash with borrower informations (from GetMember or GetMemberDetails)
673 =item C<$barcode> is the bar code of the book being issued.
675 =item C<$duedates> is a DateTime object.
677 =item C<$inprocess> boolean switch
679 =item C<$ignore_reserves> boolean switch
681 =item C<$params> Hashref of additional parameters
683 Available keys:
684 override_high_holds - Ignore high holds
685 onsite_checkout - Checkout is an onsite checkout that will not leave the library
687 =back
689 Returns :
691 =over 4
693 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
694 Possible values are :
696 =back
698 =head3 INVALID_DATE
700 sticky due date is invalid
702 =head3 GNA
704 borrower gone with no address
706 =head3 CARD_LOST
708 borrower declared it's card lost
710 =head3 DEBARRED
712 borrower debarred
714 =head3 UNKNOWN_BARCODE
716 barcode unknown
718 =head3 NOT_FOR_LOAN
720 item is not for loan
722 =head3 WTHDRAWN
724 item withdrawn.
726 =head3 RESTRICTED
728 item is restricted (set by ??)
730 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
731 could be prevented, but ones that can be overriden by the operator.
733 Possible values are :
735 =head3 DEBT
737 borrower has debts.
739 =head3 RENEW_ISSUE
741 renewing, not issuing
743 =head3 ISSUED_TO_ANOTHER
745 issued to someone else.
747 =head3 RESERVED
749 reserved for someone else.
751 =head3 INVALID_DATE
753 sticky due date is invalid or due date in the past
755 =head3 TOO_MANY
757 if the borrower borrows to much things
759 =cut
761 sub CanBookBeIssued {
762 my ( $borrower, $barcode, $duedate, $inprocess, $ignore_reserves, $params ) = @_;
763 my %needsconfirmation; # filled with problems that needs confirmations
764 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
765 my %alerts; # filled with messages that shouldn't stop issuing, but the librarian should be aware of.
767 my $onsite_checkout = $params->{onsite_checkout} || 0;
768 my $override_high_holds = $params->{override_high_holds} || 0;
770 my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
771 my $issue = GetItemIssue($item->{itemnumber});
772 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
773 $item->{'itemtype'}=$item->{'itype'};
774 my $dbh = C4::Context->dbh;
776 # MANDATORY CHECKS - unless item exists, nothing else matters
777 unless ( $item->{barcode} ) {
778 $issuingimpossible{UNKNOWN_BARCODE} = 1;
780 return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
783 # DUE DATE is OK ? -- should already have checked.
785 if ($duedate && ref $duedate ne 'DateTime') {
786 $duedate = dt_from_string($duedate);
788 my $now = DateTime->now( time_zone => C4::Context->tz() );
789 unless ( $duedate ) {
790 my $issuedate = $now->clone();
792 my $branch = _GetCircControlBranch($item,$borrower);
793 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
794 $duedate = CalcDateDue( $issuedate, $itype, $branch, $borrower );
796 # Offline circ calls AddIssue directly, doesn't run through here
797 # So issuingimpossible should be ok.
799 if ($duedate) {
800 my $today = $now->clone();
801 $today->truncate( to => 'minute');
802 if (DateTime->compare($duedate,$today) == -1 ) { # duedate cannot be before now
803 $needsconfirmation{INVALID_DATE} = output_pref($duedate);
805 } else {
806 $issuingimpossible{INVALID_DATE} = output_pref($duedate);
810 # BORROWER STATUS
812 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
813 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
814 &UpdateStats({
815 branch => C4::Context->userenv->{'branch'},
816 type => 'localuse',
817 itemnumber => $item->{'itemnumber'},
818 itemtype => $item->{'itemtype'},
819 borrowernumber => $borrower->{'borrowernumber'},
820 ccode => $item->{'ccode'}}
822 ModDateLastSeen( $item->{'itemnumber'} );
823 return( { STATS => 1 }, {});
825 if ( ref $borrower->{flags} ) {
826 if ( $borrower->{flags}->{GNA} ) {
827 $issuingimpossible{GNA} = 1;
829 if ( $borrower->{flags}->{'LOST'} ) {
830 $issuingimpossible{CARD_LOST} = 1;
832 if ( $borrower->{flags}->{'DBARRED'} ) {
833 $issuingimpossible{DEBARRED} = 1;
836 if ( !defined $borrower->{dateexpiry} || $borrower->{'dateexpiry'} eq '0000-00-00') {
837 $issuingimpossible{EXPIRED} = 1;
838 } else {
839 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'sql', 'floating' );
840 $expiry_dt->truncate( to => 'day');
841 my $today = $now->clone()->truncate(to => 'day');
842 $today->set_time_zone( 'floating' );
843 if ( DateTime->compare($today, $expiry_dt) == 1 ) {
844 $issuingimpossible{EXPIRED} = 1;
849 # BORROWER STATUS
852 # DEBTS
853 my ($balance, $non_issue_charges, $other_charges) =
854 C4::Members::GetMemberAccountBalance( $borrower->{'borrowernumber'} );
856 my $amountlimit = C4::Context->preference("noissuescharge");
857 my $allowfineoverride = C4::Context->preference("AllowFineOverride");
858 my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride");
860 # Check the debt of this patrons guarantees
861 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
862 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
863 if ( defined $no_issues_charge_guarantees ) {
864 my $p = Koha::Patrons->find( $borrower->{borrowernumber} );
865 my @guarantees = $p->guarantees();
866 my $guarantees_non_issues_charges;
867 foreach my $g ( @guarantees ) {
868 my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
869 $guarantees_non_issues_charges += $n;
872 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && !$allowfineoverride) {
873 $issuingimpossible{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
874 } elsif ( $guarantees_non_issues_charges > $no_issues_charge_guarantees && !$inprocess && $allowfineoverride) {
875 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
876 } elsif ( $allfinesneedoverride && $guarantees_non_issues_charges > 0 && $guarantees_non_issues_charges <= $no_issues_charge_guarantees && !$inprocess ) {
877 $needsconfirmation{DEBT_GUARANTEES} = $guarantees_non_issues_charges;
881 if ( C4::Context->preference("IssuingInProcess") ) {
882 if ( $non_issue_charges > $amountlimit && !$inprocess && !$allowfineoverride) {
883 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
884 } elsif ( $non_issue_charges > $amountlimit && !$inprocess && $allowfineoverride) {
885 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
886 } elsif ( $allfinesneedoverride && $non_issue_charges > 0 && $non_issue_charges <= $amountlimit && !$inprocess ) {
887 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
890 else {
891 if ( $non_issue_charges > $amountlimit && $allowfineoverride ) {
892 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
893 } elsif ( $non_issue_charges > $amountlimit && !$allowfineoverride) {
894 $issuingimpossible{DEBT} = sprintf( "%.2f", $non_issue_charges );
895 } elsif ( $non_issue_charges > 0 && $allfinesneedoverride ) {
896 $needsconfirmation{DEBT} = sprintf( "%.2f", $non_issue_charges );
900 if ($balance > 0 && $other_charges > 0) {
901 $alerts{OTHER_CHARGES} = sprintf( "%.2f", $other_charges );
904 my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'});
905 if ($blocktype == -1) {
906 ## patron has outstanding overdue loans
907 if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
908 $issuingimpossible{USERBLOCKEDOVERDUE} = $count;
910 elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
911 $needsconfirmation{USERBLOCKEDOVERDUE} = $count;
913 } elsif($blocktype == 1) {
914 # patron has accrued fine days or has a restriction. $count is a date
915 if ($count eq '9999-12-31') {
916 $issuingimpossible{USERBLOCKEDNOENDDATE} = $count;
918 else {
919 $issuingimpossible{USERBLOCKEDWITHENDDATE} = $count;
924 # JB34 CHECKS IF BORROWERS DON'T HAVE ISSUE TOO MANY BOOKS
926 my $toomany = TooMany( $borrower, $item->{biblionumber}, $item, { onsite_checkout => $onsite_checkout } );
927 # if TooMany max_allowed returns 0 the user doesn't have permission to check out this book
928 if ( $toomany ) {
929 if ( $toomany->{max_allowed} == 0 ) {
930 $needsconfirmation{PATRON_CANT} = 1;
932 if ( C4::Context->preference("AllowTooManyOverride") ) {
933 $needsconfirmation{TOO_MANY} = $toomany->{reason};
934 $needsconfirmation{current_loan_count} = $toomany->{count};
935 $needsconfirmation{max_loans_allowed} = $toomany->{max_allowed};
936 } else {
937 $needsconfirmation{TOO_MANY} = $toomany->{reason};
938 $issuingimpossible{current_loan_count} = $toomany->{count};
939 $issuingimpossible{max_loans_allowed} = $toomany->{max_allowed};
944 # ITEM CHECKING
946 if ( $item->{'notforloan'} )
948 if(!C4::Context->preference("AllowNotForLoanOverride")){
949 $issuingimpossible{NOT_FOR_LOAN} = 1;
950 $issuingimpossible{item_notforloan} = $item->{'notforloan'};
951 }else{
952 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
953 $needsconfirmation{item_notforloan} = $item->{'notforloan'};
956 else {
957 # we have to check itemtypes.notforloan also
958 if (C4::Context->preference('item-level_itypes')){
959 # this should probably be a subroutine
960 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
961 $sth->execute($item->{'itemtype'});
962 my $notforloan=$sth->fetchrow_hashref();
963 if ($notforloan->{'notforloan'}) {
964 if (!C4::Context->preference("AllowNotForLoanOverride")) {
965 $issuingimpossible{NOT_FOR_LOAN} = 1;
966 $issuingimpossible{itemtype_notforloan} = $item->{'itype'};
967 } else {
968 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
969 $needsconfirmation{itemtype_notforloan} = $item->{'itype'};
973 elsif ($biblioitem->{'notforloan'} == 1){
974 if (!C4::Context->preference("AllowNotForLoanOverride")) {
975 $issuingimpossible{NOT_FOR_LOAN} = 1;
976 $issuingimpossible{itemtype_notforloan} = $biblioitem->{'itemtype'};
977 } else {
978 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
979 $needsconfirmation{itemtype_notforloan} = $biblioitem->{'itemtype'};
983 if ( $item->{'withdrawn'} && $item->{'withdrawn'} > 0 )
985 $issuingimpossible{WTHDRAWN} = 1;
987 if ( $item->{'restricted'}
988 && $item->{'restricted'} == 1 )
990 $issuingimpossible{RESTRICTED} = 1;
992 if ( $item->{'itemlost'} && C4::Context->preference("IssueLostItem") ne 'nothing' ) {
993 my $code = GetAuthorisedValueByCode( 'LOST', $item->{'itemlost'} );
994 $needsconfirmation{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'confirm' );
995 $alerts{ITEM_LOST} = $code if ( C4::Context->preference("IssueLostItem") eq 'alert' );
997 if ( C4::Context->preference("IndependentBranches") ) {
998 my $userenv = C4::Context->userenv;
999 unless ( C4::Context->IsSuperLibrarian() ) {
1000 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ){
1001 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1;
1002 $issuingimpossible{'itemhomebranch'} = $item->{C4::Context->preference("HomeOrHoldingBranch")};
1004 $needsconfirmation{BORRNOTSAMEBRANCH} = GetBranchName( $borrower->{'branchcode'} )
1005 if ( $borrower->{'branchcode'} ne $userenv->{branch} );
1009 # CHECK IF THERE IS RENTAL CHARGES. RENTAL MUST BE CONFIRMED BY THE BORROWER
1011 my $rentalConfirmation = C4::Context->preference("RentalFeesCheckoutConfirmation");
1013 if ( $rentalConfirmation ){
1014 my ($rentalCharge) = GetIssuingCharges( $item->{'itemnumber'}, $borrower->{'borrowernumber'} );
1015 if ( $rentalCharge > 0 ){
1016 $rentalCharge = sprintf("%.02f", $rentalCharge);
1017 $needsconfirmation{RENTALCHARGE} = $rentalCharge;
1022 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
1024 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} ){
1026 # Already issued to current borrower. Ask whether the loan should
1027 # be renewed.
1028 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
1029 $borrower->{'borrowernumber'},
1030 $item->{'itemnumber'}
1032 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
1033 if ( $renewerror eq 'onsite_checkout' ) {
1034 $issuingimpossible{NO_RENEWAL_FOR_ONSITE_CHECKOUTS} = 1;
1036 else {
1037 $issuingimpossible{NO_MORE_RENEWALS} = 1;
1040 else {
1041 $needsconfirmation{RENEW_ISSUE} = 1;
1044 elsif ($issue->{borrowernumber}) {
1046 # issued to someone else
1047 my $currborinfo = C4::Members::GetMember( borrowernumber => $issue->{borrowernumber} );
1049 # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
1050 $needsconfirmation{ISSUED_TO_ANOTHER} = 1;
1051 $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'};
1052 $needsconfirmation{issued_surname} = $currborinfo->{'surname'};
1053 $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'};
1054 $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'};
1057 unless ( $ignore_reserves ) {
1058 # See if the item is on reserve.
1059 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
1060 if ($restype) {
1061 my $resbor = $res->{'borrowernumber'};
1062 if ( $resbor ne $borrower->{'borrowernumber'} ) {
1063 my ( $resborrower ) = C4::Members::GetMember( borrowernumber => $resbor );
1064 my $branchname = GetBranchName( $res->{'branchcode'} );
1065 if ( $restype eq "Waiting" )
1067 # The item is on reserve and waiting, but has been
1068 # reserved by some other patron.
1069 $needsconfirmation{RESERVE_WAITING} = 1;
1070 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
1071 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
1072 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
1073 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
1074 $needsconfirmation{'resbranchname'} = $branchname;
1075 $needsconfirmation{'reswaitingdate'} = $res->{'waitingdate'};
1077 elsif ( $restype eq "Reserved" ) {
1078 # The item is on reserve for someone else.
1079 $needsconfirmation{RESERVED} = 1;
1080 $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'};
1081 $needsconfirmation{'ressurname'} = $resborrower->{'surname'};
1082 $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'};
1083 $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'};
1084 $needsconfirmation{'resbranchname'} = $branchname;
1085 $needsconfirmation{'resreservedate'} = $res->{'reservedate'};
1091 ## CHECK AGE RESTRICTION
1092 my $agerestriction = $biblioitem->{'agerestriction'};
1093 my ($restriction_age, $daysToAgeRestriction) = GetAgeRestriction( $agerestriction, $borrower );
1094 if ( $daysToAgeRestriction && $daysToAgeRestriction > 0 ) {
1095 if ( C4::Context->preference('AgeRestrictionOverride') ) {
1096 $needsconfirmation{AGE_RESTRICTION} = "$agerestriction";
1098 else {
1099 $issuingimpossible{AGE_RESTRICTION} = "$agerestriction";
1103 ## check for high holds decreasing loan period
1104 if ( C4::Context->preference('decreaseLoanHighHolds') ) {
1105 my $check = checkHighHolds( $item, $borrower );
1107 if ( $check->{exceeded} ) {
1108 if ($override_high_holds) {
1109 $alerts{HIGHHOLDS} = {
1110 num_holds => $check->{outstanding},
1111 duration => $check->{duration},
1112 returndate => output_pref( $check->{due_date} ),
1115 else {
1116 $needsconfirmation{HIGHHOLDS} = {
1117 num_holds => $check->{outstanding},
1118 duration => $check->{duration},
1119 returndate => output_pref( $check->{due_date} ),
1125 if (
1126 !C4::Context->preference('AllowMultipleIssuesOnABiblio') &&
1127 # don't do the multiple loans per bib check if we've
1128 # already determined that we've got a loan on the same item
1129 !$issuingimpossible{NO_MORE_RENEWALS} &&
1130 !$needsconfirmation{RENEW_ISSUE}
1132 # Check if borrower has already issued an item from the same biblio
1133 # Only if it's not a subscription
1134 my $biblionumber = $item->{biblionumber};
1135 require C4::Serials;
1136 my $is_a_subscription = C4::Serials::CountSubscriptionFromBiblionumber($biblionumber);
1137 unless ($is_a_subscription) {
1138 my $issues = GetIssues( {
1139 borrowernumber => $borrower->{borrowernumber},
1140 biblionumber => $biblionumber,
1141 } );
1142 my @issues = $issues ? @$issues : ();
1143 # if we get here, we don't already have a loan on this item,
1144 # so if there are any loans on this bib, ask for confirmation
1145 if (scalar @issues > 0) {
1146 $needsconfirmation{BIBLIO_ALREADY_ISSUED} = 1;
1151 return ( \%issuingimpossible, \%needsconfirmation, \%alerts );
1154 =head2 CanBookBeReturned
1156 ($returnallowed, $message) = CanBookBeReturned($item, $branch)
1158 Check whether the item can be returned to the provided branch
1160 =over 4
1162 =item C<$item> is a hash of item information as returned from GetItem
1164 =item C<$branch> is the branchcode where the return is taking place
1166 =back
1168 Returns:
1170 =over 4
1172 =item C<$returnallowed> is 0 or 1, corresponding to whether the return is allowed (1) or not (0)
1174 =item C<$message> is the branchcode where the item SHOULD be returned, if the return is not allowed
1176 =back
1178 =cut
1180 sub CanBookBeReturned {
1181 my ($item, $branch) = @_;
1182 my $allowreturntobranch = C4::Context->preference("AllowReturnToBranch") || 'anywhere';
1184 # assume return is allowed to start
1185 my $allowed = 1;
1186 my $message;
1188 # identify all cases where return is forbidden
1189 if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1190 $allowed = 0;
1191 $message = $item->{'homebranch'};
1192 } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1193 $allowed = 0;
1194 $message = $item->{'holdingbranch'};
1195 } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
1196 $allowed = 0;
1197 $message = $item->{'homebranch'}; # FIXME: choice of homebranch is arbitrary
1200 return ($allowed, $message);
1203 =head2 CheckHighHolds
1205 used when syspref decreaseLoanHighHolds is active. Returns 1 or 0 to define whether the minimum value held in
1206 decreaseLoanHighHoldsValue is exceeded, the total number of outstanding holds, the number of days the loan
1207 has been decreased to (held in syspref decreaseLoanHighHoldsValue), and the new due date
1209 =cut
1211 sub checkHighHolds {
1212 my ( $item, $borrower ) = @_;
1213 my $biblio = GetBiblioFromItemNumber( $item->{itemnumber} );
1214 my $branch = _GetCircControlBranch( $item, $borrower );
1216 my $return_data = {
1217 exceeded => 0,
1218 outstanding => 0,
1219 duration => 0,
1220 due_date => undef,
1223 my $holds = Koha::Holds->search( { biblionumber => $item->{'biblionumber'} } );
1225 if ( $holds->count() ) {
1226 $return_data->{outstanding} = $holds->count();
1228 my $decreaseLoanHighHoldsControl = C4::Context->preference('decreaseLoanHighHoldsControl');
1229 my $decreaseLoanHighHoldsValue = C4::Context->preference('decreaseLoanHighHoldsValue');
1230 my $decreaseLoanHighHoldsIgnoreStatuses = C4::Context->preference('decreaseLoanHighHoldsIgnoreStatuses');
1232 my @decreaseLoanHighHoldsIgnoreStatuses = split( /,/, $decreaseLoanHighHoldsIgnoreStatuses );
1234 if ( $decreaseLoanHighHoldsControl eq 'static' ) {
1236 # static means just more than a given number of holds on the record
1238 # If the number of holds is less than the threshold, we can stop here
1239 if ( $holds->count() < $decreaseLoanHighHoldsValue ) {
1240 return $return_data;
1243 elsif ( $decreaseLoanHighHoldsControl eq 'dynamic' ) {
1245 # dynamic means X more than the number of holdable items on the record
1247 # let's get the items
1248 my @items = $holds->next()->biblio()->items();
1250 # Remove any items with status defined to be ignored even if the would not make item unholdable
1251 foreach my $status (@decreaseLoanHighHoldsIgnoreStatuses) {
1252 @items = grep { !$_->$status } @items;
1255 # Remove any items that are not holdable for this patron
1256 @items = grep { CanItemBeReserved( $borrower->{borrowernumber}, $_->itemnumber ) eq 'OK' } @items;
1258 my $items_count = scalar @items;
1260 my $threshold = $items_count + $decreaseLoanHighHoldsValue;
1262 # If the number of holds is less than the count of items we have
1263 # plus the number of holds allowed above that count, we can stop here
1264 if ( $holds->count() <= $threshold ) {
1265 return $return_data;
1269 my $issuedate = DateTime->now( time_zone => C4::Context->tz() );
1271 my $calendar = Koha::Calendar->new( branchcode => $branch );
1273 my $itype =
1274 ( C4::Context->preference('item-level_itypes') )
1275 ? $biblio->{'itype'}
1276 : $biblio->{'itemtype'};
1278 my $orig_due = C4::Circulation::CalcDateDue( $issuedate, $itype, $branch, $borrower );
1280 my $decreaseLoanHighHoldsDuration = C4::Context->preference('decreaseLoanHighHoldsDuration');
1282 my $reduced_datedue = $calendar->addDate( $issuedate, $decreaseLoanHighHoldsDuration );
1284 if ( DateTime->compare( $reduced_datedue, $orig_due ) == -1 ) {
1285 $return_data->{exceeded} = 1;
1286 $return_data->{duration} = $decreaseLoanHighHoldsDuration;
1287 $return_data->{due_date} = $reduced_datedue;
1291 return $return_data;
1294 =head2 AddIssue
1296 &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
1298 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
1300 =over 4
1302 =item C<$borrower> is a hash with borrower informations (from GetMember or GetMemberDetails).
1304 =item C<$barcode> is the barcode of the item being issued.
1306 =item C<$datedue> is a DateTime object for the max date of return, i.e. the date due (optional).
1307 Calculated if empty.
1309 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
1311 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
1312 Defaults to today. Unlike C<$datedue>, NOT a DateTime object, unfortunately.
1314 AddIssue does the following things :
1316 - step 01: check that there is a borrowernumber & a barcode provided
1317 - check for RENEWAL (book issued & being issued to the same patron)
1318 - renewal YES = Calculate Charge & renew
1319 - renewal NO =
1320 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1321 * RESERVE PLACED ?
1322 - fill reserve if reserve to this patron
1323 - cancel reserve or not, otherwise
1324 * TRANSFERT PENDING ?
1325 - complete the transfert
1326 * ISSUE THE BOOK
1328 =back
1330 =cut
1332 sub AddIssue {
1333 my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode, $params ) = @_;
1334 my $onsite_checkout = $params && $params->{onsite_checkout} ? 1 : 0;
1335 my $auto_renew = $params && $params->{auto_renew};
1336 my $dbh = C4::Context->dbh;
1337 my $barcodecheck=CheckValidBarcode($barcode);
1339 my $issue;
1341 if ($datedue && ref $datedue ne 'DateTime') {
1342 $datedue = dt_from_string($datedue);
1344 # $issuedate defaults to today.
1345 if ( ! defined $issuedate ) {
1346 $issuedate = DateTime->now(time_zone => C4::Context->tz());
1348 else {
1349 if ( ref $issuedate ne 'DateTime') {
1350 $issuedate = dt_from_string($issuedate);
1354 if ($borrower and $barcode and $barcodecheck ne '0'){#??? wtf
1355 # find which item we issue
1356 my $item = GetItem('', $barcode) or return; # if we don't get an Item, abort.
1357 my $branch = _GetCircControlBranch($item,$borrower);
1359 # get actual issuing if there is one
1360 my $actualissue = GetItemIssue( $item->{itemnumber});
1362 # get biblioinformation for this item
1363 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
1366 # check if we just renew the issue.
1368 if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
1369 $datedue = AddRenewal(
1370 $borrower->{'borrowernumber'},
1371 $item->{'itemnumber'},
1372 $branch,
1373 $datedue,
1374 $issuedate, # here interpreted as the renewal date
1377 else {
1378 # it's NOT a renewal
1379 if ( $actualissue->{borrowernumber}) {
1380 # This book is currently on loan, but not to the person
1381 # who wants to borrow it now. mark it returned before issuing to the new borrower
1382 AddReturn(
1383 $item->{'barcode'},
1384 C4::Context->userenv->{'branch'}
1388 MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve );
1389 # Starting process for transfer job (checking transfert and validate it if we have one)
1390 my ($datesent) = GetTransfers($item->{'itemnumber'});
1391 if ($datesent) {
1392 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
1393 my $sth =
1394 $dbh->prepare(
1395 "UPDATE branchtransfers
1396 SET datearrived = now(),
1397 tobranch = ?,
1398 comments = 'Forced branchtransfer'
1399 WHERE itemnumber= ? AND datearrived IS NULL"
1401 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
1404 # If automatic renewal wasn't selected while issuing, set the value according to the issuing rule.
1405 unless ($auto_renew) {
1406 my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branch);
1407 $auto_renew = $issuingrule->{auto_renew};
1410 # Record in the database the fact that the book was issued.
1411 unless ($datedue) {
1412 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
1413 $datedue = CalcDateDue( $issuedate, $itype, $branch, $borrower );
1416 $datedue->truncate( to => 'minute');
1418 $issue = Koha::Database->new()->schema()->resultset('Issue')->create(
1420 borrowernumber => $borrower->{'borrowernumber'},
1421 itemnumber => $item->{'itemnumber'},
1422 issuedate => $issuedate->strftime('%Y-%m-%d %H:%M:%S'),
1423 date_due => $datedue->strftime('%Y-%m-%d %H:%M:%S'),
1424 branchcode => C4::Context->userenv->{'branch'},
1425 onsite_checkout => $onsite_checkout,
1426 auto_renew => $auto_renew ? 1 : 0
1430 if ( C4::Context->preference('ReturnToShelvingCart') ) { ## ReturnToShelvingCart is on, anything issued should be taken off the cart.
1431 CartToShelf( $item->{'itemnumber'} );
1433 $item->{'issues'}++;
1434 if ( C4::Context->preference('UpdateTotalIssuesOnCirc') ) {
1435 UpdateTotalIssues($item->{'biblionumber'}, 1);
1438 ## If item was lost, it has now been found, reverse any list item charges if necessary.
1439 if ( $item->{'itemlost'} ) {
1440 if ( C4::Context->preference('RefundLostItemFeeOnReturn' ) ) {
1441 _FixAccountForLostAndReturned( $item->{'itemnumber'}, undef, $item->{'barcode'} );
1445 ModItem({ issues => $item->{'issues'},
1446 holdingbranch => C4::Context->userenv->{'branch'},
1447 itemlost => 0,
1448 datelastborrowed => DateTime->now(time_zone => C4::Context->tz())->ymd(),
1449 onloan => $datedue->ymd(),
1450 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1451 ModDateLastSeen( $item->{'itemnumber'} );
1453 # If it costs to borrow this book, charge it to the patron's account.
1454 my ( $charge, $itemtype ) = GetIssuingCharges(
1455 $item->{'itemnumber'},
1456 $borrower->{'borrowernumber'}
1458 if ( $charge > 0 ) {
1459 AddIssuingCharge(
1460 $item->{'itemnumber'},
1461 $borrower->{'borrowernumber'}, $charge
1463 $item->{'charge'} = $charge;
1466 # Record the fact that this book was issued.
1467 &UpdateStats({
1468 branch => C4::Context->userenv->{'branch'},
1469 type => ( $onsite_checkout ? 'onsite_checkout' : 'issue' ),
1470 amount => $charge,
1471 other => ($sipmode ? "SIP-$sipmode" : ''),
1472 itemnumber => $item->{'itemnumber'},
1473 itemtype => $item->{'itype'},
1474 borrowernumber => $borrower->{'borrowernumber'},
1475 ccode => $item->{'ccode'}}
1478 # Send a checkout slip.
1479 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1480 my %conditions = (
1481 branchcode => $branch,
1482 categorycode => $borrower->{categorycode},
1483 item_type => $item->{itype},
1484 notification => 'CHECKOUT',
1486 if ($circulation_alert->is_enabled_for(\%conditions)) {
1487 SendCirculationAlert({
1488 type => 'CHECKOUT',
1489 item => $item,
1490 borrower => $borrower,
1491 branch => $branch,
1496 logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'itemnumber'})
1497 if C4::Context->preference("IssueLog");
1499 return $issue;
1502 =head2 GetLoanLength
1504 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1506 Get loan length for an itemtype, a borrower type and a branch
1508 =cut
1510 sub GetLoanLength {
1511 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1512 my $dbh = C4::Context->dbh;
1513 my $sth = $dbh->prepare(qq{
1514 SELECT issuelength, lengthunit, renewalperiod
1515 FROM issuingrules
1516 WHERE categorycode=?
1517 AND itemtype=?
1518 AND branchcode=?
1519 AND issuelength IS NOT NULL
1522 # try to find issuelength & return the 1st available.
1523 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1524 $sth->execute( $borrowertype, $itemtype, $branchcode );
1525 my $loanlength = $sth->fetchrow_hashref;
1527 return $loanlength
1528 if defined($loanlength) && defined $loanlength->{issuelength};
1530 $sth->execute( $borrowertype, '*', $branchcode );
1531 $loanlength = $sth->fetchrow_hashref;
1532 return $loanlength
1533 if defined($loanlength) && defined $loanlength->{issuelength};
1535 $sth->execute( '*', $itemtype, $branchcode );
1536 $loanlength = $sth->fetchrow_hashref;
1537 return $loanlength
1538 if defined($loanlength) && defined $loanlength->{issuelength};
1540 $sth->execute( '*', '*', $branchcode );
1541 $loanlength = $sth->fetchrow_hashref;
1542 return $loanlength
1543 if defined($loanlength) && defined $loanlength->{issuelength};
1545 $sth->execute( $borrowertype, $itemtype, '*' );
1546 $loanlength = $sth->fetchrow_hashref;
1547 return $loanlength
1548 if defined($loanlength) && defined $loanlength->{issuelength};
1550 $sth->execute( $borrowertype, '*', '*' );
1551 $loanlength = $sth->fetchrow_hashref;
1552 return $loanlength
1553 if defined($loanlength) && defined $loanlength->{issuelength};
1555 $sth->execute( '*', $itemtype, '*' );
1556 $loanlength = $sth->fetchrow_hashref;
1557 return $loanlength
1558 if defined($loanlength) && defined $loanlength->{issuelength};
1560 $sth->execute( '*', '*', '*' );
1561 $loanlength = $sth->fetchrow_hashref;
1562 return $loanlength
1563 if defined($loanlength) && defined $loanlength->{issuelength};
1565 # if no rule is set => 0 day (hardcoded)
1566 return {
1567 issuelength => 0,
1568 renewalperiod => 0,
1569 lengthunit => 'days',
1575 =head2 GetHardDueDate
1577 my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode)
1579 Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch
1581 =cut
1583 sub GetHardDueDate {
1584 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1586 my $rule = GetIssuingRule( $borrowertype, $itemtype, $branchcode );
1588 if ( defined( $rule ) ) {
1589 if ( $rule->{hardduedate} ) {
1590 return (dt_from_string($rule->{hardduedate}, 'iso'),$rule->{hardduedatecompare});
1591 } else {
1592 return (undef, undef);
1597 =head2 GetIssuingRule
1599 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1601 FIXME - This is a copy-paste of GetLoanLength
1602 as a stop-gap. Do not wish to change API for GetLoanLength
1603 this close to release.
1605 Get the issuing rule for an itemtype, a borrower type and a branch
1606 Returns a hashref from the issuingrules table.
1608 =cut
1610 sub GetIssuingRule {
1611 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1612 my $dbh = C4::Context->dbh;
1613 my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=?" );
1614 my $irule;
1616 $sth->execute( $borrowertype, $itemtype, $branchcode );
1617 $irule = $sth->fetchrow_hashref;
1618 return $irule if defined($irule) ;
1620 $sth->execute( $borrowertype, "*", $branchcode );
1621 $irule = $sth->fetchrow_hashref;
1622 return $irule if defined($irule) ;
1624 $sth->execute( "*", $itemtype, $branchcode );
1625 $irule = $sth->fetchrow_hashref;
1626 return $irule if defined($irule) ;
1628 $sth->execute( "*", "*", $branchcode );
1629 $irule = $sth->fetchrow_hashref;
1630 return $irule if defined($irule) ;
1632 $sth->execute( $borrowertype, $itemtype, "*" );
1633 $irule = $sth->fetchrow_hashref;
1634 return $irule if defined($irule) ;
1636 $sth->execute( $borrowertype, "*", "*" );
1637 $irule = $sth->fetchrow_hashref;
1638 return $irule if defined($irule) ;
1640 $sth->execute( "*", $itemtype, "*" );
1641 $irule = $sth->fetchrow_hashref;
1642 return $irule if defined($irule) ;
1644 $sth->execute( "*", "*", "*" );
1645 $irule = $sth->fetchrow_hashref;
1646 return $irule if defined($irule) ;
1648 # if no rule matches,
1649 return;
1652 =head2 GetBranchBorrowerCircRule
1654 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1656 Retrieves circulation rule attributes that apply to the given
1657 branch and patron category, regardless of item type.
1658 The return value is a hashref containing the following key:
1660 maxissueqty - maximum number of loans that a
1661 patron of the given category can have at the given
1662 branch. If the value is undef, no limit.
1664 maxonsiteissueqty - maximum of on-site checkouts that a
1665 patron of the given category can have at the given
1666 branch. If the value is undef, no limit.
1668 This will first check for a specific branch and
1669 category match from branch_borrower_circ_rules.
1671 If no rule is found, it will then check default_branch_circ_rules
1672 (same branch, default category). If no rule is found,
1673 it will then check default_borrower_circ_rules (default
1674 branch, same category), then failing that, default_circ_rules
1675 (default branch, default category).
1677 If no rule has been found in the database, it will default to
1678 the buillt in rule:
1680 maxissueqty - undef
1681 maxonsiteissueqty - undef
1683 C<$branchcode> and C<$categorycode> should contain the
1684 literal branch code and patron category code, respectively - no
1685 wildcards.
1687 =cut
1689 sub GetBranchBorrowerCircRule {
1690 my ( $branchcode, $categorycode ) = @_;
1692 my $rules;
1693 my $dbh = C4::Context->dbh();
1694 $rules = $dbh->selectrow_hashref( q|
1695 SELECT maxissueqty, maxonsiteissueqty
1696 FROM branch_borrower_circ_rules
1697 WHERE branchcode = ?
1698 AND categorycode = ?
1699 |, {}, $branchcode, $categorycode ) ;
1700 return $rules if $rules;
1702 # try same branch, default borrower category
1703 $rules = $dbh->selectrow_hashref( q|
1704 SELECT maxissueqty, maxonsiteissueqty
1705 FROM default_branch_circ_rules
1706 WHERE branchcode = ?
1707 |, {}, $branchcode ) ;
1708 return $rules if $rules;
1710 # try default branch, same borrower category
1711 $rules = $dbh->selectrow_hashref( q|
1712 SELECT maxissueqty, maxonsiteissueqty
1713 FROM default_borrower_circ_rules
1714 WHERE categorycode = ?
1715 |, {}, $categorycode ) ;
1716 return $rules if $rules;
1718 # try default branch, default borrower category
1719 $rules = $dbh->selectrow_hashref( q|
1720 SELECT maxissueqty, maxonsiteissueqty
1721 FROM default_circ_rules
1722 |, {} );
1723 return $rules if $rules;
1725 # built-in default circulation rule
1726 return {
1727 maxissueqty => undef,
1728 maxonsiteissueqty => undef,
1732 =head2 GetBranchItemRule
1734 my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1736 Retrieves circulation rule attributes that apply to the given
1737 branch and item type, regardless of patron category.
1739 The return value is a hashref containing the following keys:
1741 holdallowed => Hold policy for this branch and itemtype. Possible values:
1742 0: No holds allowed.
1743 1: Holds allowed only by patrons that have the same homebranch as the item.
1744 2: Holds allowed from any patron.
1746 returnbranch => branch to which to return item. Possible values:
1747 noreturn: do not return, let item remain where checked in (floating collections)
1748 homebranch: return to item's home branch
1749 holdingbranch: return to issuer branch
1751 This searches branchitemrules in the following order:
1753 * Same branchcode and itemtype
1754 * Same branchcode, itemtype '*'
1755 * branchcode '*', same itemtype
1756 * branchcode and itemtype '*'
1758 Neither C<$branchcode> nor C<$itemtype> should be '*'.
1760 =cut
1762 sub GetBranchItemRule {
1763 my ( $branchcode, $itemtype ) = @_;
1764 my $dbh = C4::Context->dbh();
1765 my $result = {};
1767 my @attempts = (
1768 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1769 FROM branch_item_rules
1770 WHERE branchcode = ?
1771 AND itemtype = ?', $branchcode, $itemtype],
1772 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1773 FROM default_branch_circ_rules
1774 WHERE branchcode = ?', $branchcode],
1775 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1776 FROM default_branch_item_rules
1777 WHERE itemtype = ?', $itemtype],
1778 ['SELECT holdallowed, returnbranch, hold_fulfillment_policy
1779 FROM default_circ_rules'],
1782 foreach my $attempt (@attempts) {
1783 my ($query, @bind_params) = @{$attempt};
1784 my $search_result = $dbh->selectrow_hashref ( $query , {}, @bind_params )
1785 or next;
1787 # Since branch/category and branch/itemtype use the same per-branch
1788 # defaults tables, we have to check that the key we want is set, not
1789 # just that a row was returned
1790 $result->{'holdallowed'} = $search_result->{'holdallowed'} unless ( defined $result->{'holdallowed'} );
1791 $result->{'hold_fulfillment_policy'} = $search_result->{'hold_fulfillment_policy'} unless ( defined $result->{'hold_fulfillment_policy'} );
1792 $result->{'returnbranch'} = $search_result->{'returnbranch'} unless ( defined $result->{'returnbranch'} );
1795 # built-in default circulation rule
1796 $result->{'holdallowed'} = 2 unless ( defined $result->{'holdallowed'} );
1797 $result->{'hold_fulfillment_policy'} = 'any' unless ( defined $result->{'hold_fulfillment_policy'} );
1798 $result->{'returnbranch'} = 'homebranch' unless ( defined $result->{'returnbranch'} );
1800 return $result;
1803 =head2 AddReturn
1805 ($doreturn, $messages, $iteminformation, $borrower) =
1806 &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
1808 Returns a book.
1810 =over 4
1812 =item C<$barcode> is the bar code of the book being returned.
1814 =item C<$branch> is the code of the branch where the book is being returned.
1816 =item C<$exemptfine> indicates that overdue charges for the item will be
1817 removed. Optional.
1819 =item C<$dropbox> indicates that the check-in date is assumed to be
1820 yesterday, or the last non-holiday as defined in C4::Calendar . If
1821 overdue charges are applied and C<$dropbox> is true, the last charge
1822 will be removed. This assumes that the fines accrual script has run
1823 for _today_. Optional.
1825 =item C<$return_date> allows the default return date to be overridden
1826 by the given return date. Optional.
1828 =back
1830 C<&AddReturn> returns a list of four items:
1832 C<$doreturn> is true iff the return succeeded.
1834 C<$messages> is a reference-to-hash giving feedback on the operation.
1835 The keys of the hash are:
1837 =over 4
1839 =item C<BadBarcode>
1841 No item with this barcode exists. The value is C<$barcode>.
1843 =item C<NotIssued>
1845 The book is not currently on loan. The value is C<$barcode>.
1847 =item C<IsPermanent>
1849 The book's home branch is a permanent collection. If you have borrowed
1850 this book, you are not allowed to return it. The value is the code for
1851 the book's home branch.
1853 =item C<withdrawn>
1855 This book has been withdrawn/cancelled. The value should be ignored.
1857 =item C<Wrongbranch>
1859 This book has was returned to the wrong branch. The value is a hashref
1860 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1861 contain the branchcode of the incorrect and correct return library, respectively.
1863 =item C<ResFound>
1865 The item was reserved. The value is a reference-to-hash whose keys are
1866 fields from the reserves table of the Koha database, and
1867 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1868 either C<Waiting>, C<Reserved>, or 0.
1870 =item C<WasReturned>
1872 Value 1 if return is successful.
1874 =item C<NeedsTransfer>
1876 If AutomaticItemReturn is disabled, return branch is given as value of NeedsTransfer.
1878 =back
1880 C<$iteminformation> is a reference-to-hash, giving information about the
1881 returned item from the issues table.
1883 C<$borrower> is a reference-to-hash, giving information about the
1884 patron who last borrowed the book.
1886 =cut
1888 sub AddReturn {
1889 my ( $barcode, $branch, $exemptfine, $dropbox, $return_date, $dropboxdate ) = @_;
1891 if ($branch and not Koha::Libraries->find($branch)) {
1892 warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
1893 undef $branch;
1895 $branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
1896 my $messages;
1897 my $borrower;
1898 my $biblio;
1899 my $doreturn = 1;
1900 my $validTransfert = 0;
1901 my $stat_type = 'return';
1903 # get information on item
1904 my $itemnumber = GetItemnumberFromBarcode( $barcode );
1905 unless ($itemnumber) {
1906 return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower. bail out.
1908 my $issue = GetItemIssue($itemnumber);
1909 if ($issue and $issue->{borrowernumber}) {
1910 $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1911 or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existent borrowernumber '$issue->{borrowernumber}'\n"
1912 . Dumper($issue) . "\n";
1913 } else {
1914 $messages->{'NotIssued'} = $barcode;
1915 # even though item is not on loan, it may still be transferred; therefore, get current branch info
1916 $doreturn = 0;
1917 # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later.
1918 # Record this as a local use, instead of a return, if the RecordLocalUseOnReturn is on
1919 if (C4::Context->preference("RecordLocalUseOnReturn")) {
1920 $messages->{'LocalUse'} = 1;
1921 $stat_type = 'localuse';
1925 my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1927 if ( $item->{'location'} eq 'PROC' ) {
1928 if ( C4::Context->preference("InProcessingToShelvingCart") ) {
1929 $item->{'location'} = 'CART';
1931 else {
1932 $item->{location} = $item->{permanent_location};
1935 ModItem( $item, $item->{'biblionumber'}, $item->{'itemnumber'} );
1938 # full item data, but no borrowernumber or checkout info (no issue)
1939 # we know GetItem should work because GetItemnumberFromBarcode worked
1940 my $hbr = GetBranchItemRule($item->{'homebranch'}, $item->{'itype'})->{'returnbranch'} || "homebranch";
1941 # get the proper branch to which to return the item
1942 my $returnbranch = $item->{$hbr} || $branch ;
1943 # if $hbr was "noreturn" or any other non-item table value, then it should 'float' (i.e. stay at this branch)
1945 my $borrowernumber = $borrower->{'borrowernumber'} || undef; # we don't know if we had a borrower or not
1947 my $yaml = C4::Context->preference('UpdateNotForLoanStatusOnCheckin');
1948 if ($yaml) {
1949 $yaml = "$yaml\n\n"; # YAML is anal on ending \n. Surplus does not hurt
1950 my $rules;
1951 eval { $rules = YAML::Load($yaml); };
1952 if ($@) {
1953 warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
1955 else {
1956 foreach my $key ( keys %$rules ) {
1957 if ( $item->{notforloan} eq $key ) {
1958 $messages->{'NotForLoanStatusUpdated'} = { from => $item->{notforloan}, to => $rules->{$key} };
1959 ModItem( { notforloan => $rules->{$key} }, undef, $itemnumber );
1960 last;
1967 # check if the book is in a permanent collection....
1968 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1969 if ( $returnbranch ) {
1970 my $branches = GetBranches(); # a potentially expensive call for a non-feature.
1971 $branches->{$returnbranch}->{PE} and $messages->{'IsPermanent'} = $returnbranch;
1974 # check if the return is allowed at this branch
1975 my ($returnallowed, $message) = CanBookBeReturned($item, $branch);
1976 unless ($returnallowed){
1977 $messages->{'Wrongbranch'} = {
1978 Wrongbranch => $branch,
1979 Rightbranch => $message
1981 $doreturn = 0;
1982 return ( $doreturn, $messages, $issue, $borrower );
1985 if ( $item->{'withdrawn'} ) { # book has been cancelled
1986 $messages->{'withdrawn'} = 1;
1987 $doreturn = 0 if C4::Context->preference("BlockReturnOfWithdrawnItems");
1990 # case of a return of document (deal with issues and holdingbranch)
1991 my $today = DateTime->now( time_zone => C4::Context->tz() );
1993 if ($doreturn) {
1994 my $datedue = $issue->{date_due};
1995 $borrower or warn "AddReturn without current borrower";
1996 my $circControlBranch;
1997 if ($dropbox) {
1998 # define circControlBranch only if dropbox mode is set
1999 # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
2000 # FIXME: check issuedate > returndate, factoring in holidays
2002 $circControlBranch = _GetCircControlBranch($item,$borrower);
2003 $issue->{'overdue'} = DateTime->compare($issue->{'date_due'}, $dropboxdate ) == -1 ? 1 : 0;
2006 if ($borrowernumber) {
2007 if ( ( C4::Context->preference('CalculateFinesOnReturn') && $issue->{'overdue'} ) || $return_date ) {
2008 # we only need to calculate and change the fines if we want to do that on return
2009 # Should be on for hourly loans
2010 my $control = C4::Context->preference('CircControl');
2011 my $control_branchcode =
2012 ( $control eq 'ItemHomeLibrary' ) ? $item->{homebranch}
2013 : ( $control eq 'PatronLibrary' ) ? $borrower->{branchcode}
2014 : $issue->{branchcode};
2016 my $date_returned =
2017 $return_date ? dt_from_string($return_date) : $today;
2019 my ( $amount, $type, $unitcounttotal ) =
2020 C4::Overdues::CalcFine( $item, $borrower->{categorycode},
2021 $control_branchcode, $datedue, $date_returned );
2023 $type ||= q{};
2025 if ( C4::Context->preference('finesMode') eq 'production' ) {
2026 if ( $amount > 0 ) {
2027 C4::Overdues::UpdateFine(
2029 issue_id => $issue->{issue_id},
2030 itemnumber => $issue->{itemnumber},
2031 borrowernumber => $issue->{borrowernumber},
2032 amount => $amount,
2033 type => $type,
2034 due => output_pref($datedue),
2038 elsif ($return_date) {
2040 # Backdated returns may have fines that shouldn't exist,
2041 # so in this case, we need to drop those fines to 0
2043 C4::Overdues::UpdateFine(
2045 issue_id => $issue->{issue_id},
2046 itemnumber => $issue->{itemnumber},
2047 borrowernumber => $issue->{borrowernumber},
2048 amount => 0,
2049 type => $type,
2050 due => output_pref($datedue),
2057 eval {
2058 MarkIssueReturned( $borrowernumber, $item->{'itemnumber'},
2059 $circControlBranch, $return_date, $borrower->{'privacy'} );
2061 if ( $@ ) {
2062 $messages->{'Wrongbranch'} = {
2063 Wrongbranch => $branch,
2064 Rightbranch => $message
2066 carp $@;
2067 return ( 0, { WasReturned => 0 }, $issue, $borrower );
2070 # FIXME is the "= 1" right? This could be the borrower hash.
2071 $messages->{'WasReturned'} = 1;
2075 ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
2078 # the holdingbranch is updated if the document is returned to another location.
2079 # this is always done regardless of whether the item was on loan or not
2080 if ($item->{'holdingbranch'} ne $branch) {
2081 UpdateHoldingbranch($branch, $item->{'itemnumber'});
2082 $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
2084 ModDateLastSeen( $item->{'itemnumber'} );
2086 # check if we have a transfer for this document
2087 my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
2089 # if we have a transfer to do, we update the line of transfers with the datearrived
2090 my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->{'itemnumber'} );
2091 if ($datesent) {
2092 if ( $tobranch eq $branch ) {
2093 my $sth = C4::Context->dbh->prepare(
2094 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
2096 $sth->execute( $item->{'itemnumber'} );
2097 # if we have a reservation with valid transfer, we can set it's status to 'W'
2098 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
2099 C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
2100 } else {
2101 $messages->{'WrongTransfer'} = $tobranch;
2102 $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
2104 $validTransfert = 1;
2105 } else {
2106 ShelfToCart( $item->{'itemnumber'} ) if ( C4::Context->preference("ReturnToShelvingCart") );
2109 # fix up the accounts.....
2110 if ( $item->{'itemlost'} ) {
2111 $messages->{'WasLost'} = 1;
2113 if ( C4::Context->preference('RefundLostItemFeeOnReturn' ) ) {
2114 _FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode); # can tolerate undef $borrowernumber
2115 $messages->{'LostItemFeeRefunded'} = 1;
2119 # fix up the overdues in accounts...
2120 if ($borrowernumber) {
2121 my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
2122 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
2124 if ( $issue->{overdue} && $issue->{date_due} ) {
2125 # fix fine days
2126 $today = $dropboxdate if $dropbox;
2127 my ($debardate,$reminder) = _debar_user_on_return( $borrower, $item, $issue->{date_due}, $today );
2128 if ($reminder){
2129 $messages->{'PrevDebarred'} = $debardate;
2130 } else {
2131 $messages->{'Debarred'} = $debardate if $debardate;
2133 # there's no overdue on the item but borrower had been previously debarred
2134 } elsif ( $issue->{date_due} and $borrower->{'debarred'} ) {
2135 if ( $borrower->{debarred} eq "9999-12-31") {
2136 $messages->{'ForeverDebarred'} = $borrower->{'debarred'};
2137 } else {
2138 my $borrower_debar_dt = dt_from_string( $borrower->{debarred} );
2139 $borrower_debar_dt->truncate(to => 'day');
2140 my $today_dt = $today->clone()->truncate(to => 'day');
2141 if ( DateTime->compare( $borrower_debar_dt, $today_dt ) != -1 ) {
2142 $messages->{'PrevDebarred'} = $borrower->{'debarred'};
2148 # find reserves.....
2149 # if we don't have a reserve with the status W, we launch the Checkreserves routine
2150 my ($resfound, $resrec);
2151 my $lookahead= C4::Context->preference('ConfirmFutureHolds'); #number of days to look for future holds
2152 ($resfound, $resrec, undef) = C4::Reserves::CheckReserves( $item->{'itemnumber'}, undef, $lookahead ) unless ( $item->{'withdrawn'} );
2153 if ($resfound) {
2154 $resrec->{'ResFound'} = $resfound;
2155 $messages->{'ResFound'} = $resrec;
2158 # Record the fact that this book was returned.
2159 # FIXME itemtype should record item level type, not bibliolevel type
2160 UpdateStats({
2161 branch => $branch,
2162 type => $stat_type,
2163 itemnumber => $item->{'itemnumber'},
2164 itemtype => $biblio->{'itemtype'},
2165 borrowernumber => $borrowernumber,
2166 ccode => $item->{'ccode'}}
2169 # Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then.
2170 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
2171 my %conditions = (
2172 branchcode => $branch,
2173 categorycode => $borrower->{categorycode},
2174 item_type => $item->{itype},
2175 notification => 'CHECKIN',
2177 if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
2178 SendCirculationAlert({
2179 type => 'CHECKIN',
2180 item => $item,
2181 borrower => $borrower,
2182 branch => $branch,
2186 logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'itemnumber'})
2187 if C4::Context->preference("ReturnLog");
2189 # Remove any OVERDUES related debarment if the borrower has no overdues
2190 if ( $borrowernumber
2191 && $borrower->{'debarred'}
2192 && C4::Context->preference('AutoRemoveOverduesRestrictions')
2193 && !C4::Members::HasOverdues( $borrowernumber )
2194 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
2196 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
2199 # Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
2200 if (!$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) and not $messages->{'WrongTransfer'}){
2201 if (C4::Context->preference("AutomaticItemReturn" ) or
2202 (C4::Context->preference("UseBranchTransferLimits") and
2203 ! IsBranchTransferAllowed($branch, $returnbranch, $item->{C4::Context->preference("BranchTransferLimitsType")} )
2204 )) {
2205 $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $returnbranch;
2206 $debug and warn "item: " . Dumper($item);
2207 ModItemTransfer($item->{'itemnumber'}, $branch, $returnbranch);
2208 $messages->{'WasTransfered'} = 1;
2209 } else {
2210 $messages->{'NeedsTransfer'} = $returnbranch;
2214 return ( $doreturn, $messages, $issue, $borrower );
2217 =head2 MarkIssueReturned
2219 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy);
2221 Unconditionally marks an issue as being returned by
2222 moving the C<issues> row to C<old_issues> and
2223 setting C<returndate> to the current date, or
2224 the last non-holiday date of the branccode specified in
2225 C<dropbox_branch> . Assumes you've already checked that
2226 it's safe to do this, i.e. last non-holiday > issuedate.
2228 if C<$returndate> is specified (in iso format), it is used as the date
2229 of the return. It is ignored when a dropbox_branch is passed in.
2231 C<$privacy> contains the privacy parameter. If the patron has set privacy to 2,
2232 the old_issue is immediately anonymised
2234 Ideally, this function would be internal to C<C4::Circulation>,
2235 not exported, but it is currently needed by one
2236 routine in C<C4::Accounts>.
2238 =cut
2240 sub MarkIssueReturned {
2241 my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_;
2243 my $anonymouspatron;
2244 if ( $privacy == 2 ) {
2245 # The default of 0 will not work due to foreign key constraints
2246 # The anonymisation will fail if AnonymousPatron is not a valid entry
2247 # We need to check if the anonymous patron exist, Koha will fail loudly if it does not
2248 # Note that a warning should appear on the about page (System information tab).
2249 $anonymouspatron = C4::Context->preference('AnonymousPatron');
2250 die "Fatal error: the patron ($borrowernumber) has requested their circulation history be anonymized on check-in, but the AnonymousPatron system preference is empty or not set correctly."
2251 unless C4::Members::GetMember( borrowernumber => $anonymouspatron );
2253 my $dbh = C4::Context->dbh;
2254 my $query = 'UPDATE issues SET returndate=';
2255 my @bind;
2256 if ($dropbox_branch) {
2257 my $calendar = Koha::Calendar->new( branchcode => $dropbox_branch );
2258 my $dropboxdate = $calendar->addDate( DateTime->now( time_zone => C4::Context->tz), -1 );
2259 $query .= ' ? ';
2260 push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2261 } elsif ($returndate) {
2262 $query .= ' ? ';
2263 push @bind, $returndate;
2264 } else {
2265 $query .= ' now() ';
2267 $query .= ' WHERE borrowernumber = ? AND itemnumber = ?';
2268 push @bind, $borrowernumber, $itemnumber;
2269 # FIXME transaction
2270 my $sth_upd = $dbh->prepare($query);
2271 $sth_upd->execute(@bind);
2272 my $sth_copy = $dbh->prepare('INSERT INTO old_issues SELECT * FROM issues
2273 WHERE borrowernumber = ?
2274 AND itemnumber = ?');
2275 $sth_copy->execute($borrowernumber, $itemnumber);
2276 # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber
2277 if ( $privacy == 2) {
2278 my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=?
2279 WHERE borrowernumber = ?
2280 AND itemnumber = ?");
2281 $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber);
2283 my $sth_del = $dbh->prepare("DELETE FROM issues
2284 WHERE borrowernumber = ?
2285 AND itemnumber = ?");
2286 $sth_del->execute($borrowernumber, $itemnumber);
2288 ModItem( { 'onloan' => undef }, undef, $itemnumber );
2290 if ( C4::Context->preference('StoreLastBorrower') ) {
2291 my $item = Koha::Items->find( $itemnumber );
2292 my $patron = Koha::Patrons->find( $borrowernumber );
2293 $item->last_returned_by( $patron );
2297 =head2 _debar_user_on_return
2299 _debar_user_on_return($borrower, $item, $datedue, today);
2301 C<$borrower> borrower hashref
2303 C<$item> item hashref
2305 C<$datedue> date due DateTime object
2307 C<$today> DateTime object representing the return time
2309 Internal function, called only by AddReturn that calculates and updates
2310 the user fine days, and debars him if necessary.
2312 Should only be called for overdue returns
2314 =cut
2316 sub _debar_user_on_return {
2317 my ( $borrower, $item, $dt_due, $dt_today ) = @_;
2319 my $branchcode = _GetCircControlBranch( $item, $borrower );
2321 my $circcontrol = C4::Context->preference('CircControl');
2322 my $issuingrule =
2323 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2324 my $finedays = $issuingrule->{finedays};
2325 my $unit = $issuingrule->{lengthunit};
2326 my $chargeable_units = C4::Overdues::get_chargeable_units($unit, $dt_due, $dt_today, $branchcode);
2328 if ($finedays) {
2330 # finedays is in days, so hourly loans must multiply by 24
2331 # thus 1 hour late equals 1 day suspension * finedays rate
2332 $finedays = $finedays * 24 if ( $unit eq 'hours' );
2334 # grace period is measured in the same units as the loan
2335 my $grace =
2336 DateTime::Duration->new( $unit => $issuingrule->{firstremind} );
2338 my $deltadays = DateTime::Duration->new(
2339 days => $chargeable_units
2341 if ( $deltadays->subtract($grace)->is_positive() ) {
2342 my $suspension_days = $deltadays * $finedays;
2344 # If the max suspension days is < than the suspension days
2345 # the suspension days is limited to this maximum period.
2346 my $max_sd = $issuingrule->{maxsuspensiondays};
2347 if ( defined $max_sd ) {
2348 $max_sd = DateTime::Duration->new( days => $max_sd );
2349 $suspension_days = $max_sd
2350 if DateTime::Duration->compare( $max_sd, $suspension_days ) < 0;
2353 my $new_debar_dt =
2354 $dt_today->clone()->add_duration( $suspension_days );
2356 Koha::Patron::Debarments::AddUniqueDebarment({
2357 borrowernumber => $borrower->{borrowernumber},
2358 expiration => $new_debar_dt->ymd(),
2359 type => 'SUSPENSION',
2361 # if borrower was already debarred but does not get an extra debarment
2362 if ( $borrower->{debarred} eq Koha::Patron::Debarments::IsDebarred($borrower->{borrowernumber}) ) {
2363 return ($borrower->{debarred},1);
2365 return $new_debar_dt->ymd();
2368 return;
2371 =head2 _FixOverduesOnReturn
2373 &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2375 C<$brn> borrowernumber
2377 C<$itm> itemnumber
2379 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
2380 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
2382 Internal function, called only by AddReturn
2384 =cut
2386 sub _FixOverduesOnReturn {
2387 my ($borrowernumber, $item);
2388 unless ($borrowernumber = shift) {
2389 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2390 return;
2392 unless ($item = shift) {
2393 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
2394 return;
2396 my ($exemptfine, $dropbox) = @_;
2397 my $dbh = C4::Context->dbh;
2399 # check for overdue fine
2400 my $sth = $dbh->prepare(
2401 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
2403 $sth->execute( $borrowernumber, $item );
2405 # alter fine to show that the book has been returned
2406 my $data = $sth->fetchrow_hashref;
2407 return 0 unless $data; # no warning, there's just nothing to fix
2409 my $uquery;
2410 my @bind = ($data->{'accountlines_id'});
2411 if ($exemptfine) {
2412 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
2413 if (C4::Context->preference("FinesLog")) {
2414 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
2416 } elsif ($dropbox && $data->{lastincrement}) {
2417 my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
2418 my $amt = $data->{amount} - $data->{lastincrement} ;
2419 if (C4::Context->preference("FinesLog")) {
2420 &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
2422 $uquery = "update accountlines set accounttype='F' ";
2423 if($outstanding >= 0 && $amt >=0) {
2424 $uquery .= ", amount = ? , amountoutstanding=? ";
2425 unshift @bind, ($amt, $outstanding) ;
2427 } else {
2428 $uquery = "update accountlines set accounttype='F' ";
2430 $uquery .= " where (accountlines_id = ?)";
2431 my $usth = $dbh->prepare($uquery);
2432 return $usth->execute(@bind);
2435 =head2 _FixAccountForLostAndReturned
2437 &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
2439 Calculates the charge for a book lost and returned.
2441 Internal function, not exported, called only by AddReturn.
2443 FIXME: This function reflects how inscrutable fines logic is. Fix both.
2444 FIXME: Give a positive return value on success. It might be the $borrowernumber who received credit, or the amount forgiven.
2446 =cut
2448 sub _FixAccountForLostAndReturned {
2449 my $itemnumber = shift or return;
2450 my $borrowernumber = @_ ? shift : undef;
2451 my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
2452 my $dbh = C4::Context->dbh;
2453 # check for charge made for lost book
2454 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE itemnumber = ? AND accounttype IN ('L', 'Rep', 'W') ORDER BY date DESC, accountno DESC");
2455 $sth->execute($itemnumber);
2456 my $data = $sth->fetchrow_hashref;
2457 $data or return; # bail if there is nothing to do
2458 $data->{accounttype} eq 'W' and return; # Written off
2460 # writeoff this amount
2461 my $offset;
2462 my $amount = $data->{'amount'};
2463 my $acctno = $data->{'accountno'};
2464 my $amountleft; # Starts off undef/zero.
2465 if ($data->{'amountoutstanding'} == $amount) {
2466 $offset = $data->{'amount'};
2467 $amountleft = 0; # Hey, it's zero here, too.
2468 } else {
2469 $offset = $amount - $data->{'amountoutstanding'}; # Um, isn't this the same as ZERO? We just tested those two things are ==
2470 $amountleft = $data->{'amountoutstanding'} - $amount; # Um, isn't this the same as ZERO? We just tested those two things are ==
2472 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
2473 WHERE (accountlines_id = ?)");
2474 $usth->execute($data->{'accountlines_id'}); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in.
2475 #check if any credit is left if so writeoff other accounts
2476 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
2477 $amountleft *= -1 if ($amountleft < 0);
2478 if ($amountleft > 0) {
2479 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
2480 AND (amountoutstanding >0) ORDER BY date"); # might want to order by amountoustanding ASC (pay smallest first)
2481 $msth->execute($data->{'borrowernumber'});
2482 # offset transactions
2483 my $newamtos;
2484 my $accdata;
2485 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2486 if ($accdata->{'amountoutstanding'} < $amountleft) {
2487 $newamtos = 0;
2488 $amountleft -= $accdata->{'amountoutstanding'};
2489 } else {
2490 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
2491 $amountleft = 0;
2493 my $thisacct = $accdata->{'accountlines_id'};
2494 # FIXME: move prepares outside while loop!
2495 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
2496 WHERE (accountlines_id = ?)");
2497 $usth->execute($newamtos,$thisacct);
2498 $usth = $dbh->prepare("INSERT INTO accountoffsets
2499 (borrowernumber, accountno, offsetaccount, offsetamount)
2500 VALUES
2501 (?,?,?,?)");
2502 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
2505 $amountleft *= -1 if ($amountleft > 0);
2506 my $desc = "Item Returned " . $item_id;
2507 $usth = $dbh->prepare("INSERT INTO accountlines
2508 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
2509 VALUES (?,?,now(),?,?,'CR',?)");
2510 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
2511 if ($borrowernumber) {
2512 # FIXME: same as query above. use 1 sth for both
2513 $usth = $dbh->prepare("INSERT INTO accountoffsets
2514 (borrowernumber, accountno, offsetaccount, offsetamount)
2515 VALUES (?,?,?,?)");
2516 $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2518 ModItem({ paidfor => '' }, undef, $itemnumber);
2519 return;
2522 =head2 _GetCircControlBranch
2524 my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
2526 Internal function :
2528 Return the library code to be used to determine which circulation
2529 policy applies to a transaction. Looks up the CircControl and
2530 HomeOrHoldingBranch system preferences.
2532 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
2534 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
2536 =cut
2538 sub _GetCircControlBranch {
2539 my ($item, $borrower) = @_;
2540 my $circcontrol = C4::Context->preference('CircControl');
2541 my $branch;
2543 if ($circcontrol eq 'PickupLibrary' and (C4::Context->userenv and C4::Context->userenv->{'branch'}) ) {
2544 $branch= C4::Context->userenv->{'branch'};
2545 } elsif ($circcontrol eq 'PatronLibrary') {
2546 $branch=$borrower->{branchcode};
2547 } else {
2548 my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
2549 $branch = $item->{$branchfield};
2550 # default to item home branch if holdingbranch is used
2551 # and is not defined
2552 if (!defined($branch) && $branchfield eq 'holdingbranch') {
2553 $branch = $item->{homebranch};
2556 return $branch;
2564 =head2 GetItemIssue
2566 $issue = &GetItemIssue($itemnumber);
2568 Returns patron currently having a book, or undef if not checked out.
2570 C<$itemnumber> is the itemnumber.
2572 C<$issue> is a hashref of the row from the issues table.
2574 =cut
2576 sub GetItemIssue {
2577 my ($itemnumber) = @_;
2578 return unless $itemnumber;
2579 my $sth = C4::Context->dbh->prepare(
2580 "SELECT items.*, issues.*
2581 FROM issues
2582 LEFT JOIN items ON issues.itemnumber=items.itemnumber
2583 WHERE issues.itemnumber=?");
2584 $sth->execute($itemnumber);
2585 my $data = $sth->fetchrow_hashref;
2586 return unless $data;
2587 $data->{issuedate_sql} = $data->{issuedate};
2588 $data->{date_due_sql} = $data->{date_due};
2589 $data->{issuedate} = dt_from_string($data->{issuedate}, 'sql');
2590 $data->{issuedate}->truncate(to => 'minute');
2591 $data->{date_due} = dt_from_string($data->{date_due}, 'sql');
2592 $data->{date_due}->truncate(to => 'minute');
2593 my $dt = DateTime->now( time_zone => C4::Context->tz)->truncate( to => 'minute');
2594 $data->{'overdue'} = DateTime->compare($data->{'date_due'}, $dt ) == -1 ? 1 : 0;
2595 return $data;
2598 =head2 GetOpenIssue
2600 $issue = GetOpenIssue( $itemnumber );
2602 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
2604 C<$itemnumber> is the item's itemnumber
2606 Returns a hashref
2608 =cut
2610 sub GetOpenIssue {
2611 my ( $itemnumber ) = @_;
2612 return unless $itemnumber;
2613 my $dbh = C4::Context->dbh;
2614 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
2615 $sth->execute( $itemnumber );
2616 return $sth->fetchrow_hashref();
2620 =head2 GetIssues
2622 $issues = GetIssues({}); # return all issues!
2623 $issues = GetIssues({ borrowernumber => $borrowernumber, biblionumber => $biblionumber });
2625 Returns all pending issues that match given criteria.
2626 Returns a arrayref or undef if an error occurs.
2628 Allowed criteria are:
2630 =over 2
2632 =item * borrowernumber
2634 =item * biblionumber
2636 =item * itemnumber
2638 =back
2640 =cut
2642 sub GetIssues {
2643 my ($criteria) = @_;
2645 # Build filters
2646 my @filters;
2647 my @allowed = qw(borrowernumber biblionumber itemnumber);
2648 foreach (@allowed) {
2649 if (defined $criteria->{$_}) {
2650 push @filters, {
2651 field => $_,
2652 value => $criteria->{$_},
2657 # Do we need to join other tables ?
2658 my %join;
2659 if (defined $criteria->{biblionumber}) {
2660 $join{items} = 1;
2663 # Build SQL query
2664 my $where = '';
2665 if (@filters) {
2666 $where = "WHERE " . join(' AND ', map { "$_->{field} = ?" } @filters);
2668 my $query = q{
2669 SELECT issues.*
2670 FROM issues
2672 if (defined $join{items}) {
2673 $query .= q{
2674 LEFT JOIN items ON (issues.itemnumber = items.itemnumber)
2677 $query .= $where;
2679 # Execute SQL query
2680 my $dbh = C4::Context->dbh;
2681 my $sth = $dbh->prepare($query);
2682 my $rv = $sth->execute(map { $_->{value} } @filters);
2684 return $rv ? $sth->fetchall_arrayref({}) : undef;
2687 =head2 GetItemIssues
2689 $issues = &GetItemIssues($itemnumber, $history);
2691 Returns patrons that have issued a book
2693 C<$itemnumber> is the itemnumber
2694 C<$history> is false if you just want the current "issuer" (if any)
2695 and true if you want issues history from old_issues also.
2697 Returns reference to an array of hashes
2699 =cut
2701 sub GetItemIssues {
2702 my ( $itemnumber, $history ) = @_;
2704 my $today = DateTime->now( time_zome => C4::Context->tz); # get today date
2705 $today->truncate( to => 'minute' );
2706 my $sql = "SELECT * FROM issues
2707 JOIN borrowers USING (borrowernumber)
2708 JOIN items USING (itemnumber)
2709 WHERE issues.itemnumber = ? ";
2710 if ($history) {
2711 $sql .= "UNION ALL
2712 SELECT * FROM old_issues
2713 LEFT JOIN borrowers USING (borrowernumber)
2714 JOIN items USING (itemnumber)
2715 WHERE old_issues.itemnumber = ? ";
2717 $sql .= "ORDER BY date_due DESC";
2718 my $sth = C4::Context->dbh->prepare($sql);
2719 if ($history) {
2720 $sth->execute($itemnumber, $itemnumber);
2721 } else {
2722 $sth->execute($itemnumber);
2724 my $results = $sth->fetchall_arrayref({});
2725 foreach (@$results) {
2726 my $date_due = dt_from_string($_->{date_due},'sql');
2727 $date_due->truncate( to => 'minute' );
2729 $_->{overdue} = (DateTime->compare($date_due, $today) == -1) ? 1 : 0;
2731 return $results;
2734 =head2 GetBiblioIssues
2736 $issues = GetBiblioIssues($biblionumber);
2738 this function get all issues from a biblionumber.
2740 Return:
2741 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
2742 tables issues and the firstname,surname & cardnumber from borrowers.
2744 =cut
2746 sub GetBiblioIssues {
2747 my $biblionumber = shift;
2748 return unless $biblionumber;
2749 my $dbh = C4::Context->dbh;
2750 my $query = "
2751 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2752 FROM issues
2753 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
2754 LEFT JOIN items ON issues.itemnumber = items.itemnumber
2755 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2756 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2757 WHERE biblio.biblionumber = ?
2758 UNION ALL
2759 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
2760 FROM old_issues
2761 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
2762 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
2763 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
2764 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2765 WHERE biblio.biblionumber = ?
2766 ORDER BY timestamp
2768 my $sth = $dbh->prepare($query);
2769 $sth->execute($biblionumber, $biblionumber);
2771 my @issues;
2772 while ( my $data = $sth->fetchrow_hashref ) {
2773 push @issues, $data;
2775 return \@issues;
2778 =head2 GetUpcomingDueIssues
2780 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2782 =cut
2784 sub GetUpcomingDueIssues {
2785 my $params = shift;
2787 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
2788 my $dbh = C4::Context->dbh;
2790 my $statement = <<END_SQL;
2791 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due, branches.branchemail
2792 FROM issues
2793 LEFT JOIN items USING (itemnumber)
2794 LEFT OUTER JOIN branches USING (branchcode)
2795 WHERE returndate is NULL
2796 HAVING days_until_due >= 0 AND days_until_due <= ?
2797 END_SQL
2799 my @bind_parameters = ( $params->{'days_in_advance'} );
2801 my $sth = $dbh->prepare( $statement );
2802 $sth->execute( @bind_parameters );
2803 my $upcoming_dues = $sth->fetchall_arrayref({});
2805 return $upcoming_dues;
2808 =head2 CanBookBeRenewed
2810 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2812 Find out whether a borrowed item may be renewed.
2814 C<$borrowernumber> is the borrower number of the patron who currently
2815 has the item on loan.
2817 C<$itemnumber> is the number of the item to renew.
2819 C<$override_limit>, if supplied with a true value, causes
2820 the limit on the number of times that the loan can be renewed
2821 (as controlled by the item type) to be ignored. Overriding also allows
2822 to renew sooner than "No renewal before" and to manually renew loans
2823 that are automatically renewed.
2825 C<$CanBookBeRenewed> returns a true value if the item may be renewed. The
2826 item must currently be on loan to the specified borrower; renewals
2827 must be allowed for the item's type; and the borrower must not have
2828 already renewed the loan. $error will contain the reason the renewal can not proceed
2830 =cut
2832 sub CanBookBeRenewed {
2833 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2835 my $dbh = C4::Context->dbh;
2836 my $renews = 1;
2838 my $item = GetItem($itemnumber) or return ( 0, 'no_item' );
2839 my $itemissue = GetItemIssue($itemnumber) or return ( 0, 'no_checkout' );
2840 return ( 0, 'onsite_checkout' ) if $itemissue->{onsite_checkout};
2842 $borrowernumber ||= $itemissue->{borrowernumber};
2843 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber )
2844 or return;
2846 my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
2848 # This item can fill one or more unfilled reserve, can those unfilled reserves
2849 # all be filled by other available items?
2850 if ( $resfound
2851 && C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
2853 my $schema = Koha::Database->new()->schema();
2855 my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
2856 if ($item_holds) {
2857 # There is an item level hold on this item, no other item can fill the hold
2858 $resfound = 1;
2860 else {
2862 # Get all other items that could possibly fill reserves
2863 my @itemnumbers = $schema->resultset('Item')->search(
2865 biblionumber => $resrec->{biblionumber},
2866 onloan => undef,
2867 notforloan => 0,
2868 -not => { itemnumber => $itemnumber }
2870 { columns => 'itemnumber' }
2871 )->get_column('itemnumber')->all();
2873 # Get all other reserves that could have been filled by this item
2874 my @borrowernumbers;
2875 while (1) {
2876 my ( $reserve_found, $reserve, undef ) =
2877 C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2879 if ($reserve_found) {
2880 push( @borrowernumbers, $reserve->{borrowernumber} );
2882 else {
2883 last;
2887 # If the count of the union of the lists of reservable items for each borrower
2888 # is equal or greater than the number of borrowers, we know that all reserves
2889 # can be filled with available items. We can get the union of the sets simply
2890 # by pushing all the elements onto an array and removing the duplicates.
2891 my @reservable;
2892 foreach my $b (@borrowernumbers) {
2893 my ($borr) = C4::Members::GetMemberDetails($b);
2894 foreach my $i (@itemnumbers) {
2895 my $item = GetItem($i);
2896 if ( IsAvailableForItemLevelRequest( $item, $borr )
2897 && CanItemBeReserved( $b, $i )
2898 && !IsItemOnHoldAndFound($i) )
2900 push( @reservable, $i );
2905 @reservable = uniq(@reservable);
2907 if ( @reservable >= @borrowernumbers ) {
2908 $resfound = 0;
2912 return ( 0, "on_reserve" ) if $resfound; # '' when no hold was found
2914 return ( 1, undef ) if $override_limit;
2916 my $branchcode = _GetCircControlBranch( $item, $borrower );
2917 my $issuingrule =
2918 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
2920 return ( 0, "too_many" )
2921 if $issuingrule->{renewalsallowed} <= $itemissue->{renewals};
2923 my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
2924 my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
2925 my $restricted = Koha::Patron::Debarments::IsDebarred($borrowernumber);
2926 my $hasoverdues = C4::Members::HasOverdues($borrowernumber);
2928 if ( $restricted and $restrictionblockrenewing ) {
2929 return ( 0, 'restriction');
2930 } elsif ( ($hasoverdues and $overduesblockrenewing eq 'block') || ($itemissue->{overdue} and $overduesblockrenewing eq 'blockitem') ) {
2931 return ( 0, 'overdue');
2934 if ( defined $issuingrule->{norenewalbefore}
2935 and $issuingrule->{norenewalbefore} ne "" )
2938 # Calculate soonest renewal by subtracting 'No renewal before' from due date
2939 my $soonestrenewal =
2940 $itemissue->{date_due}->clone()
2941 ->subtract(
2942 $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
2944 # Depending on syspref reset the exact time, only check the date
2945 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
2946 and $issuingrule->{lengthunit} eq 'days' )
2948 $soonestrenewal->truncate( to => 'day' );
2951 if ( $soonestrenewal > DateTime->now( time_zone => C4::Context->tz() ) )
2953 return ( 0, "auto_too_soon" ) if $itemissue->{auto_renew};
2954 return ( 0, "too_soon" );
2956 elsif ( $itemissue->{auto_renew} ) {
2957 return ( 0, "auto_renew" );
2961 # Fallback for automatic renewals:
2962 # If norenewalbefore is undef, don't renew before due date.
2963 elsif ( $itemissue->{auto_renew} ) {
2964 my $now = dt_from_string;
2965 return ( 0, "auto_renew" )
2966 if $now >= $itemissue->{date_due};
2967 return ( 0, "auto_too_soon" );
2970 return ( 1, undef );
2973 =head2 AddRenewal
2975 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2977 Renews a loan.
2979 C<$borrowernumber> is the borrower number of the patron who currently
2980 has the item.
2982 C<$itemnumber> is the number of the item to renew.
2984 C<$branch> is the library where the renewal took place (if any).
2985 The library that controls the circ policies for the renewal is retrieved from the issues record.
2987 C<$datedue> can be a DateTime object used to set the due date.
2989 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
2990 this parameter is not supplied, lastreneweddate is set to the current date.
2992 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2993 from the book's item type.
2995 =cut
2997 sub AddRenewal {
2998 my $borrowernumber = shift;
2999 my $itemnumber = shift or return;
3000 my $branch = shift;
3001 my $datedue = shift;
3002 my $lastreneweddate = shift || DateTime->now(time_zone => C4::Context->tz)->ymd();
3004 my $item = GetItem($itemnumber) or return;
3005 my $biblio = GetBiblioFromItemNumber($itemnumber) or return;
3007 my $dbh = C4::Context->dbh;
3009 # Find the issues record for this book
3010 my $sth =
3011 $dbh->prepare("SELECT * FROM issues WHERE itemnumber = ?");
3012 $sth->execute( $itemnumber );
3013 my $issuedata = $sth->fetchrow_hashref;
3015 return unless ( $issuedata );
3017 $borrowernumber ||= $issuedata->{borrowernumber};
3019 if ( defined $datedue && ref $datedue ne 'DateTime' ) {
3020 carp 'Invalid date passed to AddRenewal.';
3021 return;
3024 # If the due date wasn't specified, calculate it by adding the
3025 # book's loan length to today's date or the current due date
3026 # based on the value of the RenewalPeriodBase syspref.
3027 unless ($datedue) {
3029 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber ) or return;
3030 my $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'};
3032 $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
3033 dt_from_string( $issuedata->{date_due} ) :
3034 DateTime->now( time_zone => C4::Context->tz());
3035 $datedue = CalcDateDue($datedue, $itemtype, $issuedata->{'branchcode'}, $borrower, 'is a renewal');
3038 # Update the issues record to have the new due date, and a new count
3039 # of how many times it has been renewed.
3040 my $renews = $issuedata->{'renewals'} + 1;
3041 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
3042 WHERE borrowernumber=?
3043 AND itemnumber=?"
3046 $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
3048 # Update the renewal count on the item, and tell zebra to reindex
3049 $renews = $biblio->{'renewals'} + 1;
3050 ModItem({ renewals => $renews, onloan => $datedue->strftime('%Y-%m-%d %H:%M')}, $biblio->{'biblionumber'}, $itemnumber);
3052 # Charge a new rental fee, if applicable?
3053 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
3054 if ( $charge > 0 ) {
3055 my $accountno = getnextacctno( $borrowernumber );
3056 my $item = GetBiblioFromItemNumber($itemnumber);
3057 my $manager_id = 0;
3058 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3059 $sth = $dbh->prepare(
3060 "INSERT INTO accountlines
3061 (date, borrowernumber, accountno, amount, manager_id,
3062 description,accounttype, amountoutstanding, itemnumber)
3063 VALUES (now(),?,?,?,?,?,?,?,?)"
3065 $sth->execute( $borrowernumber, $accountno, $charge, $manager_id,
3066 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
3067 'Rent', $charge, $itemnumber );
3070 # Send a renewal slip according to checkout alert preferencei
3071 if ( C4::Context->preference('RenewalSendNotice') eq '1') {
3072 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
3073 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
3074 my %conditions = (
3075 branchcode => $branch,
3076 categorycode => $borrower->{categorycode},
3077 item_type => $item->{itype},
3078 notification => 'CHECKOUT',
3080 if ($circulation_alert->is_enabled_for(\%conditions)) {
3081 SendCirculationAlert({
3082 type => 'RENEWAL',
3083 item => $item,
3084 borrower => $borrower,
3085 branch => $branch,
3090 # Remove any OVERDUES related debarment if the borrower has no overdues
3091 my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
3092 if ( $borrowernumber
3093 && $borrower->{'debarred'}
3094 && !C4::Members::HasOverdues( $borrowernumber )
3095 && @{ GetDebarments({ borrowernumber => $borrowernumber, type => 'OVERDUES' }) }
3097 DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
3100 # Log the renewal
3101 UpdateStats({branch => $branch,
3102 type => 'renew',
3103 amount => $charge,
3104 itemnumber => $itemnumber,
3105 itemtype => $item->{itype},
3106 borrowernumber => $borrowernumber,
3107 ccode => $item->{'ccode'}}
3109 return $datedue;
3112 sub GetRenewCount {
3113 # check renewal status
3114 my ( $bornum, $itemno ) = @_;
3115 my $dbh = C4::Context->dbh;
3116 my $renewcount = 0;
3117 my $renewsallowed = 0;
3118 my $renewsleft = 0;
3120 my $borrower = C4::Members::GetMember( borrowernumber => $bornum);
3121 my $item = GetItem($itemno);
3123 # Look in the issues table for this item, lent to this borrower,
3124 # and not yet returned.
3126 # FIXME - I think this function could be redone to use only one SQL call.
3127 my $sth = $dbh->prepare(
3128 "select * from issues
3129 where (borrowernumber = ?)
3130 and (itemnumber = ?)"
3132 $sth->execute( $bornum, $itemno );
3133 my $data = $sth->fetchrow_hashref;
3134 $renewcount = $data->{'renewals'} if $data->{'renewals'};
3135 # $item and $borrower should be calculated
3136 my $branchcode = _GetCircControlBranch($item, $borrower);
3138 my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
3140 $renewsallowed = $issuingrule->{'renewalsallowed'};
3141 $renewsleft = $renewsallowed - $renewcount;
3142 if($renewsleft < 0){ $renewsleft = 0; }
3143 return ( $renewcount, $renewsallowed, $renewsleft );
3146 =head2 GetSoonestRenewDate
3148 $NoRenewalBeforeThisDate = &GetSoonestRenewDate($borrowernumber, $itemnumber);
3150 Find out the soonest possible renew date of a borrowed item.
3152 C<$borrowernumber> is the borrower number of the patron who currently
3153 has the item on loan.
3155 C<$itemnumber> is the number of the item to renew.
3157 C<$GetSoonestRenewDate> returns the DateTime of the soonest possible
3158 renew date, based on the value "No renewal before" of the applicable
3159 issuing rule. Returns the current date if the item can already be
3160 renewed, and returns undefined if the borrower, loan, or item
3161 cannot be found.
3163 =cut
3165 sub GetSoonestRenewDate {
3166 my ( $borrowernumber, $itemnumber ) = @_;
3168 my $dbh = C4::Context->dbh;
3170 my $item = GetItem($itemnumber) or return;
3171 my $itemissue = GetItemIssue($itemnumber) or return;
3173 $borrowernumber ||= $itemissue->{borrowernumber};
3174 my $borrower = C4::Members::GetMemberDetails($borrowernumber)
3175 or return;
3177 my $branchcode = _GetCircControlBranch( $item, $borrower );
3178 my $issuingrule =
3179 GetIssuingRule( $borrower->{categorycode}, $item->{itype}, $branchcode );
3181 my $now = dt_from_string;
3183 if ( defined $issuingrule->{norenewalbefore}
3184 and $issuingrule->{norenewalbefore} ne "" )
3186 my $soonestrenewal =
3187 $itemissue->{date_due}->clone()
3188 ->subtract(
3189 $issuingrule->{lengthunit} => $issuingrule->{norenewalbefore} );
3191 if ( C4::Context->preference('NoRenewalBeforePrecision') eq 'date'
3192 and $issuingrule->{lengthunit} eq 'days' )
3194 $soonestrenewal->truncate( to => 'day' );
3196 return $soonestrenewal if $now < $soonestrenewal;
3198 return $now;
3201 =head2 GetIssuingCharges
3203 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
3205 Calculate how much it would cost for a given patron to borrow a given
3206 item, including any applicable discounts.
3208 C<$itemnumber> is the item number of item the patron wishes to borrow.
3210 C<$borrowernumber> is the patron's borrower number.
3212 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
3213 and C<$item_type> is the code for the item's item type (e.g., C<VID>
3214 if it's a video).
3216 =cut
3218 sub GetIssuingCharges {
3220 # calculate charges due
3221 my ( $itemnumber, $borrowernumber ) = @_;
3222 my $charge = 0;
3223 my $dbh = C4::Context->dbh;
3224 my $item_type;
3226 # Get the book's item type and rental charge (via its biblioitem).
3227 my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items
3228 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber';
3229 $charge_query .= (C4::Context->preference('item-level_itypes'))
3230 ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype'
3231 : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype';
3233 $charge_query .= ' WHERE items.itemnumber =?';
3235 my $sth = $dbh->prepare($charge_query);
3236 $sth->execute($itemnumber);
3237 if ( my $item_data = $sth->fetchrow_hashref ) {
3238 $item_type = $item_data->{itemtype};
3239 $charge = $item_data->{rentalcharge};
3240 my $branch = C4::Branch::mybranch();
3241 my $discount_query = q|SELECT rentaldiscount,
3242 issuingrules.itemtype, issuingrules.branchcode
3243 FROM borrowers
3244 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
3245 WHERE borrowers.borrowernumber = ?
3246 AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')
3247 AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|;
3248 my $discount_sth = $dbh->prepare($discount_query);
3249 $discount_sth->execute( $borrowernumber, $item_type, $branch );
3250 my $discount_rules = $discount_sth->fetchall_arrayref({});
3251 if (@{$discount_rules}) {
3252 # We may have multiple rules so get the most specific
3253 my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type);
3254 $charge = ( $charge * ( 100 - $discount ) ) / 100;
3258 return ( $charge, $item_type );
3261 # Select most appropriate discount rule from those returned
3262 sub _get_discount_from_rule {
3263 my ($rules_ref, $branch, $itemtype) = @_;
3264 my $discount;
3266 if (@{$rules_ref} == 1) { # only 1 applicable rule use it
3267 $discount = $rules_ref->[0]->{rentaldiscount};
3268 return (defined $discount) ? $discount : 0;
3270 # could have up to 4 does one match $branch and $itemtype
3271 my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref};
3272 if (@d) {
3273 $discount = $d[0]->{rentaldiscount};
3274 return (defined $discount) ? $discount : 0;
3276 # do we have item type + all branches
3277 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref};
3278 if (@d) {
3279 $discount = $d[0]->{rentaldiscount};
3280 return (defined $discount) ? $discount : 0;
3282 # do we all item types + this branch
3283 @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref};
3284 if (@d) {
3285 $discount = $d[0]->{rentaldiscount};
3286 return (defined $discount) ? $discount : 0;
3288 # so all and all (surely we wont get here)
3289 @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref};
3290 if (@d) {
3291 $discount = $d[0]->{rentaldiscount};
3292 return (defined $discount) ? $discount : 0;
3294 # none of the above
3295 return 0;
3298 =head2 AddIssuingCharge
3300 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3302 =cut
3304 sub AddIssuingCharge {
3305 my ( $itemnumber, $borrowernumber, $charge ) = @_;
3306 my $dbh = C4::Context->dbh;
3307 my $nextaccntno = getnextacctno( $borrowernumber );
3308 my $manager_id = 0;
3309 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
3310 my $query ="
3311 INSERT INTO accountlines
3312 (borrowernumber, itemnumber, accountno,
3313 date, amount, description, accounttype,
3314 amountoutstanding, manager_id)
3315 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?,?)
3317 my $sth = $dbh->prepare($query);
3318 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge, $manager_id );
3321 =head2 GetTransfers
3323 GetTransfers($itemnumber);
3325 =cut
3327 sub GetTransfers {
3328 my ($itemnumber) = @_;
3330 my $dbh = C4::Context->dbh;
3332 my $query = '
3333 SELECT datesent,
3334 frombranch,
3335 tobranch
3336 FROM branchtransfers
3337 WHERE itemnumber = ?
3338 AND datearrived IS NULL
3340 my $sth = $dbh->prepare($query);
3341 $sth->execute($itemnumber);
3342 my @row = $sth->fetchrow_array();
3343 return @row;
3346 =head2 GetTransfersFromTo
3348 @results = GetTransfersFromTo($frombranch,$tobranch);
3350 Returns the list of pending transfers between $from and $to branch
3352 =cut
3354 sub GetTransfersFromTo {
3355 my ( $frombranch, $tobranch ) = @_;
3356 return unless ( $frombranch && $tobranch );
3357 my $dbh = C4::Context->dbh;
3358 my $query = "
3359 SELECT itemnumber,datesent,frombranch
3360 FROM branchtransfers
3361 WHERE frombranch=?
3362 AND tobranch=?
3363 AND datearrived IS NULL
3365 my $sth = $dbh->prepare($query);
3366 $sth->execute( $frombranch, $tobranch );
3367 my @gettransfers;
3369 while ( my $data = $sth->fetchrow_hashref ) {
3370 push @gettransfers, $data;
3372 return (@gettransfers);
3375 =head2 DeleteTransfer
3377 &DeleteTransfer($itemnumber);
3379 =cut
3381 sub DeleteTransfer {
3382 my ($itemnumber) = @_;
3383 return unless $itemnumber;
3384 my $dbh = C4::Context->dbh;
3385 my $sth = $dbh->prepare(
3386 "DELETE FROM branchtransfers
3387 WHERE itemnumber=?
3388 AND datearrived IS NULL "
3390 return $sth->execute($itemnumber);
3393 =head2 AnonymiseIssueHistory
3395 ($rows,$err_history_not_deleted) = AnonymiseIssueHistory($date,$borrowernumber)
3397 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
3398 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
3400 If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy
3401 setting (force delete).
3403 return the number of affected rows and a value that evaluates to true if an error occurred deleting the history.
3405 =cut
3407 sub AnonymiseIssueHistory {
3408 my $date = shift;
3409 my $borrowernumber = shift;
3410 my $dbh = C4::Context->dbh;
3411 my $query = "
3412 UPDATE old_issues
3413 SET borrowernumber = ?
3414 WHERE returndate < ?
3415 AND borrowernumber IS NOT NULL
3418 # The default of 0 does not work due to foreign key constraints
3419 # The anonymisation should not fail quietly if AnonymousPatron is not a valid entry
3420 # Set it to undef (NULL)
3421 my $anonymouspatron = C4::Context->preference('AnonymousPatron') || undef;
3422 my @bind_params = ($anonymouspatron, $date);
3423 if (defined $borrowernumber) {
3424 $query .= " AND borrowernumber = ?";
3425 push @bind_params, $borrowernumber;
3426 } else {
3427 $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0";
3429 my $sth = $dbh->prepare($query);
3430 $sth->execute(@bind_params);
3431 my $anonymisation_err = $dbh->err;
3432 my $rows_affected = $sth->rows; ### doublecheck row count return function
3433 return ($rows_affected, $anonymisation_err);
3436 =head2 SendCirculationAlert
3438 Send out a C<check-in> or C<checkout> alert using the messaging system.
3440 B<Parameters>:
3442 =over 4
3444 =item type
3446 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3448 =item item
3450 Hashref of information about the item being checked in or out.
3452 =item borrower
3454 Hashref of information about the borrower of the item.
3456 =item branch
3458 The branchcode from where the checkout or check-in took place.
3460 =back
3462 B<Example>:
3464 SendCirculationAlert({
3465 type => 'CHECKOUT',
3466 item => $item,
3467 borrower => $borrower,
3468 branch => $branch,
3471 =cut
3473 sub SendCirculationAlert {
3474 my ($opts) = @_;
3475 my ($type, $item, $borrower, $branch) =
3476 ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
3477 my %message_name = (
3478 CHECKIN => 'Item_Check_in',
3479 CHECKOUT => 'Item_Checkout',
3480 RENEWAL => 'Item_Checkout',
3482 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
3483 borrowernumber => $borrower->{borrowernumber},
3484 message_name => $message_name{$type},
3486 my $issues_table = ( $type eq 'CHECKOUT' || $type eq 'RENEWAL' ) ? 'issues' : 'old_issues';
3488 my @transports = keys %{ $borrower_preferences->{transports} };
3489 # warn "no transports" unless @transports;
3490 for (@transports) {
3491 # warn "transport: $_";
3492 my $message = C4::Message->find_last_message($borrower, $type, $_);
3493 if (!$message) {
3494 #warn "create new message";
3495 my $letter = C4::Letters::GetPreparedLetter (
3496 module => 'circulation',
3497 letter_code => $type,
3498 branchcode => $branch,
3499 message_transport_type => $_,
3500 tables => {
3501 $issues_table => $item->{itemnumber},
3502 'items' => $item->{itemnumber},
3503 'biblio' => $item->{biblionumber},
3504 'biblioitems' => $item->{biblionumber},
3505 'borrowers' => $borrower,
3506 'branches' => $branch,
3508 ) or next;
3509 C4::Message->enqueue($letter, $borrower, $_);
3510 } else {
3511 #warn "append to old message";
3512 my $letter = C4::Letters::GetPreparedLetter (
3513 module => 'circulation',
3514 letter_code => $type,
3515 branchcode => $branch,
3516 message_transport_type => $_,
3517 tables => {
3518 $issues_table => $item->{itemnumber},
3519 'items' => $item->{itemnumber},
3520 'biblio' => $item->{biblionumber},
3521 'biblioitems' => $item->{biblionumber},
3522 'borrowers' => $borrower,
3523 'branches' => $branch,
3525 ) or next;
3526 $message->append($letter);
3527 $message->update;
3531 return;
3534 =head2 updateWrongTransfer
3536 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
3538 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
3540 =cut
3542 sub updateWrongTransfer {
3543 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3544 my $dbh = C4::Context->dbh;
3545 # first step validate the actual line of transfert .
3546 my $sth =
3547 $dbh->prepare(
3548 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
3550 $sth->execute($FromLibrary,$itemNumber);
3552 # second step create a new line of branchtransfer to the right location .
3553 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
3555 #third step changing holdingbranch of item
3556 UpdateHoldingbranch($FromLibrary,$itemNumber);
3559 =head2 UpdateHoldingbranch
3561 $items = UpdateHoldingbranch($branch,$itmenumber);
3563 Simple methode for updating hodlingbranch in items BDD line
3565 =cut
3567 sub UpdateHoldingbranch {
3568 my ( $branch,$itemnumber ) = @_;
3569 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
3572 =head2 CalcDateDue
3574 $newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower);
3576 this function calculates the due date given the start date and configured circulation rules,
3577 checking against the holidays calendar as per the 'useDaysMode' syspref.
3578 C<$startdate> = DateTime object representing start date of loan period (assumed to be today)
3579 C<$itemtype> = itemtype code of item in question
3580 C<$branch> = location whose calendar to use
3581 C<$borrower> = Borrower object
3582 C<$isrenewal> = Boolean: is true if we want to calculate the date due for a renewal. Else is false.
3584 =cut
3586 sub CalcDateDue {
3587 my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3589 $isrenewal ||= 0;
3591 # loanlength now a href
3592 my $loanlength =
3593 GetLoanLength( $borrower->{'categorycode'}, $itemtype, $branch );
3595 my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod} )
3596 ? qq{renewalperiod}
3597 : qq{issuelength};
3599 my $datedue;
3600 if ( $startdate ) {
3601 if (ref $startdate ne 'DateTime' ) {
3602 $datedue = dt_from_string($datedue);
3603 } else {
3604 $datedue = $startdate->clone;
3606 } else {
3607 $datedue =
3608 DateTime->now( time_zone => C4::Context->tz() )
3609 ->truncate( to => 'minute' );
3613 # calculate the datedue as normal
3614 if ( C4::Context->preference('useDaysMode') eq 'Days' )
3615 { # ignoring calendar
3616 if ( $loanlength->{lengthunit} eq 'hours' ) {
3617 $datedue->add( hours => $loanlength->{$length_key} );
3618 } else { # days
3619 $datedue->add( days => $loanlength->{$length_key} );
3620 $datedue->set_hour(23);
3621 $datedue->set_minute(59);
3623 } else {
3624 my $dur;
3625 if ($loanlength->{lengthunit} eq 'hours') {
3626 $dur = DateTime::Duration->new( hours => $loanlength->{$length_key});
3628 else { # days
3629 $dur = DateTime::Duration->new( days => $loanlength->{$length_key});
3631 my $calendar = Koha::Calendar->new( branchcode => $branch );
3632 $datedue = $calendar->addDate( $datedue, $dur, $loanlength->{lengthunit} );
3633 if ($loanlength->{lengthunit} eq 'days') {
3634 $datedue->set_hour(23);
3635 $datedue->set_minute(59);
3639 # if Hard Due Dates are used, retrieve them and apply as necessary
3640 my ( $hardduedate, $hardduedatecompare ) =
3641 GetHardDueDate( $borrower->{'categorycode'}, $itemtype, $branch );
3642 if ($hardduedate) { # hardduedates are currently dates
3643 $hardduedate->truncate( to => 'minute' );
3644 $hardduedate->set_hour(23);
3645 $hardduedate->set_minute(59);
3646 my $cmp = DateTime->compare( $hardduedate, $datedue );
3648 # if the calculated due date is after the 'before' Hard Due Date (ceiling), override
3649 # if the calculated date is before the 'after' Hard Due Date (floor), override
3650 # if the hard due date is set to 'exactly', overrride
3651 if ( $hardduedatecompare == 0 || $hardduedatecompare == $cmp ) {
3652 $datedue = $hardduedate->clone;
3655 # in all other cases, keep the date due as it is
3659 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
3660 if ( C4::Context->preference('ReturnBeforeExpiry') ) {
3661 my $expiry_dt = dt_from_string( $borrower->{dateexpiry}, 'iso', 'floating');
3662 if( $expiry_dt ) { #skip empty expiry date..
3663 $expiry_dt->set( hour => 23, minute => 59);
3664 my $d1= $datedue->clone->set_time_zone('floating');
3665 if ( DateTime->compare( $d1, $expiry_dt ) == 1 ) {
3666 $datedue = $expiry_dt->clone->set_time_zone( C4::Context->tz );
3671 return $datedue;
3675 sub CheckValidBarcode{
3676 my ($barcode) = @_;
3677 my $dbh = C4::Context->dbh;
3678 my $query=qq|SELECT count(*)
3679 FROM items
3680 WHERE barcode=?
3682 my $sth = $dbh->prepare($query);
3683 $sth->execute($barcode);
3684 my $exist=$sth->fetchrow ;
3685 return $exist;
3688 =head2 IsBranchTransferAllowed
3690 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3692 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
3694 =cut
3696 sub IsBranchTransferAllowed {
3697 my ( $toBranch, $fromBranch, $code ) = @_;
3699 if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
3701 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3702 my $dbh = C4::Context->dbh;
3704 my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
3705 $sth->execute( $toBranch, $fromBranch, $code );
3706 my $limit = $sth->fetchrow_hashref();
3708 ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
3709 if ( $limit->{'limitId'} ) {
3710 return 0;
3711 } else {
3712 return 1;
3716 =head2 CreateBranchTransferLimit
3718 CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
3720 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
3722 =cut
3724 sub CreateBranchTransferLimit {
3725 my ( $toBranch, $fromBranch, $code ) = @_;
3726 return unless defined($toBranch) && defined($fromBranch);
3727 my $limitType = C4::Context->preference("BranchTransferLimitsType");
3729 my $dbh = C4::Context->dbh;
3731 my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
3732 return $sth->execute( $code, $toBranch, $fromBranch );
3735 =head2 DeleteBranchTransferLimits
3737 my $result = DeleteBranchTransferLimits($frombranch);
3739 Deletes all the library transfer limits for one library. Returns the
3740 number of limits deleted, 0e0 if no limits were deleted, or undef if
3741 no arguments are supplied.
3743 =cut
3745 sub DeleteBranchTransferLimits {
3746 my $branch = shift;
3747 return unless defined $branch;
3748 my $dbh = C4::Context->dbh;
3749 my $sth = $dbh->prepare("DELETE FROM branch_transfer_limits WHERE fromBranch = ?");
3750 return $sth->execute($branch);
3753 sub ReturnLostItem{
3754 my ( $borrowernumber, $itemnum ) = @_;
3756 MarkIssueReturned( $borrowernumber, $itemnum );
3757 my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
3758 my $item = C4::Items::GetItem( $itemnum );
3759 my $old_note = ($item->{'paidfor'} && ($item->{'paidfor'} ne q{})) ? $item->{'paidfor'}.' / ' : q{};
3760 my @datearr = localtime(time);
3761 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
3762 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
3763 ModItem({ paidfor => $old_note."Paid for by $bor $date" }, undef, $itemnum);
3767 sub LostItem{
3768 my ($itemnumber, $mark_returned) = @_;
3770 my $dbh = C4::Context->dbh();
3771 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
3772 FROM issues
3773 JOIN items USING (itemnumber)
3774 JOIN biblio USING (biblionumber)
3775 WHERE issues.itemnumber=?");
3776 $sth->execute($itemnumber);
3777 my $issues=$sth->fetchrow_hashref();
3779 # If a borrower lost the item, add a replacement cost to the their record
3780 if ( my $borrowernumber = $issues->{borrowernumber} ){
3781 my $borrower = C4::Members::GetMemberDetails( $borrowernumber );
3783 if (C4::Context->preference('WhenLostForgiveFine')){
3784 my $fix = _FixOverduesOnReturn($borrowernumber, $itemnumber, 1, 0); # 1, 0 = exemptfine, no-dropbox
3785 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $itemnumber...) failed!"; # zero is OK, check defined
3787 if (C4::Context->preference('WhenLostChargeReplacementFee')){
3788 C4::Accounts::chargelostitem($borrowernumber, $itemnumber, $issues->{'replacementprice'}, "Lost Item $issues->{'title'} $issues->{'barcode'}");
3789 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
3790 #warn " $issues->{'borrowernumber'} / $itemnumber ";
3793 MarkIssueReturned($borrowernumber,$itemnumber,undef,undef,$borrower->{'privacy'}) if $mark_returned;
3797 sub GetOfflineOperations {
3798 my $dbh = C4::Context->dbh;
3799 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE branchcode=? ORDER BY timestamp");
3800 $sth->execute(C4::Context->userenv->{'branch'});
3801 my $results = $sth->fetchall_arrayref({});
3802 return $results;
3805 sub GetOfflineOperation {
3806 my $operationid = shift;
3807 return unless $operationid;
3808 my $dbh = C4::Context->dbh;
3809 my $sth = $dbh->prepare("SELECT * FROM pending_offline_operations WHERE operationid=?");
3810 $sth->execute( $operationid );
3811 return $sth->fetchrow_hashref;
3814 sub AddOfflineOperation {
3815 my ( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount ) = @_;
3816 my $dbh = C4::Context->dbh;
3817 my $sth = $dbh->prepare("INSERT INTO pending_offline_operations (userid, branchcode, timestamp, action, barcode, cardnumber, amount) VALUES(?,?,?,?,?,?,?)");
3818 $sth->execute( $userid, $branchcode, $timestamp, $action, $barcode, $cardnumber, $amount );
3819 return "Added.";
3822 sub DeleteOfflineOperation {
3823 my $dbh = C4::Context->dbh;
3824 my $sth = $dbh->prepare("DELETE FROM pending_offline_operations WHERE operationid=?");
3825 $sth->execute( shift );
3826 return "Deleted.";
3829 sub ProcessOfflineOperation {
3830 my $operation = shift;
3832 my $report;
3833 if ( $operation->{action} eq 'return' ) {
3834 $report = ProcessOfflineReturn( $operation );
3835 } elsif ( $operation->{action} eq 'issue' ) {
3836 $report = ProcessOfflineIssue( $operation );
3837 } elsif ( $operation->{action} eq 'payment' ) {
3838 $report = ProcessOfflinePayment( $operation );
3841 DeleteOfflineOperation( $operation->{operationid} ) if $operation->{operationid};
3843 return $report;
3846 sub ProcessOfflineReturn {
3847 my $operation = shift;
3849 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3851 if ( $itemnumber ) {
3852 my $issue = GetOpenIssue( $itemnumber );
3853 if ( $issue ) {
3854 MarkIssueReturned(
3855 $issue->{borrowernumber},
3856 $itemnumber,
3857 undef,
3858 $operation->{timestamp},
3860 ModItem(
3861 { renewals => 0, onloan => undef },
3862 $issue->{'biblionumber'},
3863 $itemnumber
3865 return "Success.";
3866 } else {
3867 return "Item not issued.";
3869 } else {
3870 return "Item not found.";
3874 sub ProcessOfflineIssue {
3875 my $operation = shift;
3877 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3879 if ( $borrower->{borrowernumber} ) {
3880 my $itemnumber = C4::Items::GetItemnumberFromBarcode( $operation->{barcode} );
3881 unless ($itemnumber) {
3882 return "Barcode not found.";
3884 my $issue = GetOpenIssue( $itemnumber );
3886 if ( $issue and ( $issue->{borrowernumber} ne $borrower->{borrowernumber} ) ) { # Item already issued to another borrower, mark it returned
3887 MarkIssueReturned(
3888 $issue->{borrowernumber},
3889 $itemnumber,
3890 undef,
3891 $operation->{timestamp},
3894 AddIssue(
3895 $borrower,
3896 $operation->{'barcode'},
3897 undef,
3899 $operation->{timestamp},
3900 undef,
3902 return "Success.";
3903 } else {
3904 return "Borrower not found.";
3908 sub ProcessOfflinePayment {
3909 my $operation = shift;
3911 my $borrower = C4::Members::GetMemberDetails( undef, $operation->{cardnumber} ); # Get borrower from operation cardnumber
3912 my $amount = $operation->{amount};
3914 recordpayment( $borrower->{borrowernumber}, $amount );
3916 return "Success."
3920 =head2 TransferSlip
3922 TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3924 Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3926 =cut
3928 sub TransferSlip {
3929 my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3931 my $item = GetItem( $itemnumber, $barcode )
3932 or return;
3934 return C4::Letters::GetPreparedLetter (
3935 module => 'circulation',
3936 letter_code => 'TRANSFERSLIP',
3937 branchcode => $branch,
3938 tables => {
3939 'branches' => $to_branch,
3940 'biblio' => $item->{biblionumber},
3941 'items' => $item,
3946 =head2 CheckIfIssuedToPatron
3948 CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3950 Return 1 if any record item is issued to patron, otherwise return 0
3952 =cut
3954 sub CheckIfIssuedToPatron {
3955 my ($borrowernumber, $biblionumber) = @_;
3957 my $dbh = C4::Context->dbh;
3958 my $query = q|
3959 SELECT COUNT(*) FROM issues
3960 LEFT JOIN items ON items.itemnumber = issues.itemnumber
3961 WHERE items.biblionumber = ?
3962 AND issues.borrowernumber = ?
3964 my $is_issued = $dbh->selectrow_array($query, {}, $biblionumber, $borrowernumber );
3965 return 1 if $is_issued;
3966 return;
3969 =head2 IsItemIssued
3971 IsItemIssued( $itemnumber )
3973 Return 1 if the item is on loan, otherwise return 0
3975 =cut
3977 sub IsItemIssued {
3978 my $itemnumber = shift;
3979 my $dbh = C4::Context->dbh;
3980 my $sth = $dbh->prepare(q{
3981 SELECT COUNT(*)
3982 FROM issues
3983 WHERE itemnumber = ?
3985 $sth->execute($itemnumber);
3986 return $sth->fetchrow;
3989 =head2 GetAgeRestriction
3991 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions, $borrower);
3992 my ($ageRestriction, $daysToAgeRestriction) = GetAgeRestriction($record_restrictions);
3994 if($daysToAgeRestriction <= 0) { #Borrower is allowed to access this material, as he is older or as old as the agerestriction }
3995 if($daysToAgeRestriction > 0) { #Borrower is this many days from meeting the agerestriction }
3997 @PARAM1 the koha.biblioitems.agerestriction value, like K18, PEGI 13, ...
3998 @PARAM2 a borrower-object with koha.borrowers.dateofbirth. (OPTIONAL)
3999 @RETURNS The age restriction age in years and the days to fulfill the age restriction for the given borrower.
4000 Negative days mean the borrower has gone past the age restriction age.
4002 =cut
4004 sub GetAgeRestriction {
4005 my ($record_restrictions, $borrower) = @_;
4006 my $markers = C4::Context->preference('AgeRestrictionMarker');
4008 # Split $record_restrictions to something like FSK 16 or PEGI 6
4009 my @values = split ' ', uc($record_restrictions);
4010 return unless @values;
4012 # Search first occurrence of one of the markers
4013 my @markers = split /\|/, uc($markers);
4014 return unless @markers;
4016 my $index = 0;
4017 my $restriction_year = 0;
4018 for my $value (@values) {
4019 $index++;
4020 for my $marker (@markers) {
4021 $marker =~ s/^\s+//; #remove leading spaces
4022 $marker =~ s/\s+$//; #remove trailing spaces
4023 if ( $marker eq $value ) {
4024 if ( $index <= $#values ) {
4025 $restriction_year += $values[$index];
4027 last;
4029 elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
4031 # Perhaps it is something like "K16" (as in Finland)
4032 $restriction_year += $1;
4033 last;
4036 last if ( $restriction_year > 0 );
4039 #Check if the borrower is age restricted for this material and for how long.
4040 if ($restriction_year && $borrower) {
4041 if ( $borrower->{'dateofbirth'} ) {
4042 my @alloweddate = split /-/, $borrower->{'dateofbirth'};
4043 $alloweddate[0] += $restriction_year;
4045 #Prevent runime eror on leap year (invalid date)
4046 if ( ( $alloweddate[1] == 2 ) && ( $alloweddate[2] == 29 ) ) {
4047 $alloweddate[2] = 28;
4050 #Get how many days the borrower has to reach the age restriction
4051 my @Today = split /-/, DateTime->today->ymd();
4052 my $daysToAgeRestriction = Date_to_Days(@alloweddate) - Date_to_Days(@Today);
4053 #Negative days means the borrower went past the age restriction age
4054 return ($restriction_year, $daysToAgeRestriction);
4058 return ($restriction_year);
4062 =head2 GetPendingOnSiteCheckouts
4064 =cut
4066 sub GetPendingOnSiteCheckouts {
4067 my $dbh = C4::Context->dbh;
4068 return $dbh->selectall_arrayref(q|
4069 SELECT
4070 items.barcode,
4071 items.biblionumber,
4072 items.itemnumber,
4073 items.itemnotes,
4074 items.itemcallnumber,
4075 items.location,
4076 issues.date_due,
4077 issues.branchcode,
4078 issues.date_due < NOW() AS is_overdue,
4079 biblio.author,
4080 biblio.title,
4081 borrowers.firstname,
4082 borrowers.surname,
4083 borrowers.cardnumber,
4084 borrowers.borrowernumber
4085 FROM items
4086 LEFT JOIN issues ON items.itemnumber = issues.itemnumber
4087 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
4088 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
4089 WHERE issues.onsite_checkout = 1
4090 |, { Slice => {} } );
4093 sub GetTopIssues {
4094 my ($params) = @_;
4096 my ($count, $branch, $itemtype, $ccode, $newness)
4097 = @$params{qw(count branch itemtype ccode newness)};
4099 my $dbh = C4::Context->dbh;
4100 my $query = q{
4101 SELECT b.biblionumber, b.title, b.author, bi.itemtype, bi.publishercode,
4102 bi.place, bi.publicationyear, b.copyrightdate, bi.pages, bi.size,
4103 i.ccode, SUM(i.issues) AS count
4104 FROM biblio b
4105 LEFT JOIN items i ON (i.biblionumber = b.biblionumber)
4106 LEFT JOIN biblioitems bi ON (bi.biblionumber = b.biblionumber)
4109 my (@where_strs, @where_args);
4111 if ($branch) {
4112 push @where_strs, 'i.homebranch = ?';
4113 push @where_args, $branch;
4115 if ($itemtype) {
4116 if (C4::Context->preference('item-level_itypes')){
4117 push @where_strs, 'i.itype = ?';
4118 push @where_args, $itemtype;
4119 } else {
4120 push @where_strs, 'bi.itemtype = ?';
4121 push @where_args, $itemtype;
4124 if ($ccode) {
4125 push @where_strs, 'i.ccode = ?';
4126 push @where_args, $ccode;
4128 if ($newness) {
4129 push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4130 push @where_args, $newness;
4133 if (@where_strs) {
4134 $query .= 'WHERE ' . join(' AND ', @where_strs);
4137 $query .= q{
4138 GROUP BY b.biblionumber
4139 HAVING count > 0
4140 ORDER BY count DESC
4143 $count = int($count);
4144 if ($count > 0) {
4145 $query .= "LIMIT $count";
4148 my $rows = $dbh->selectall_arrayref($query, { Slice => {} }, @where_args);
4150 return @$rows;
4154 __END__
4156 =head1 AUTHOR
4158 Koha Development Team <http://koha-community.org/>
4160 =cut