1 package C4
::Circulation
;
3 # Copyright 2000-2002 Katipo Communications
4 # copyright 2010 BibLibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 #use warnings; FIXME - Bug 2505
33 use C4
::ItemCirculationAlertPreference
;
36 use C4
::Branch
; # GetBranches
37 use C4
::Log
; # logaction
39 GetAuthorisedValueByCode
41 GetKohaAuthorisedValueLib
43 use C4
::Overdues
qw(CalcFine UpdateFine get_chargeable_units);
44 use C4
::RotatingCollections
qw(GetCollectionItemBranches);
45 use Algorithm
::CheckDigits
;
52 use Koha
::Patron
::Debarments
;
57 use List
::MoreUtils
qw( uniq );
58 use Scalar
::Util
qw( looks_like_number );
68 use vars
qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
74 # FIXME subs that should probably be elsewhere
79 &GetPendingOnSiteCheckouts
82 # subs to deal with issuing a book
94 &GetBranchBorrowerCircRule
98 &AnonymiseIssueHistory
99 &CheckIfIssuedToPatron
104 # subs to deal with returns
110 # subs to deal with transfers
117 &IsBranchTransferAllowed
118 &CreateBranchTransferLimit
119 &DeleteBranchTransferLimits
123 # subs to deal with offline circulation
125 &GetOfflineOperations
128 &DeleteOfflineOperation
129 &ProcessOfflineOperation
135 C4::Circulation - Koha circulation module
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 stocktaking.
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
166 # FIXME -- the &decode fcn below should be wrapped into this one.
167 # FIXME -- these plugins should be moved out of Circulation.pm
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') {
176 } elsif ($filter eq 'cuecat') {
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;
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;
204 warn "# [$barcode] not valid EAN-13/UPC-A\n";
207 return $barcode; # return barcode, modified or not
212 $str = &decode($chunk);
214 Decodes a segment of a string emitted by a CueCat barcode scanner and
217 FIXME: Should be replaced with Barcode::Cuecat from CPAN
218 or Javascript based decoding on the client side.
225 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
226 my @s = map { index( $seq, $_ ); } split( //, $encoded );
227 my $l = ( $#s + 1 ) % 4;
230 # warn "Error: Cuecat decode parsing failed!";
238 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
240 chr( ( $n >> 16 ) ^ 67 )
241 .chr( ( $n >> 8 & 255 ) ^ 67 )
242 .chr( ( $n & 255 ) ^ 67 );
245 $r = substr( $r, 0, length($r) - $l );
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:
269 is true if the transfer was successful.
273 is a reference-to-hash which may have any of the following keys:
279 There is no item in the catalog with the given barcode. The value is C<$barcode>.
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.
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.
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.
308 my ( $tbr, $barcode, $ignoreRs ) = @_;
311 my $branches = GetBranches
();
312 my $itemnumber = GetItemnumberFromBarcode
( $barcode );
313 my $issue = GetItemIssue
($itemnumber);
314 my $biblio = GetBiblioFromItemNumber
($itemnumber);
317 if ( not $itemnumber ) {
318 $messages->{'BadBarcode'} = $barcode;
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'};
333 } elsif ( ! IsBranchTransferAllowed
( $tbr, $fbr, $biblio->{ C4
::Context
->preference("BranchTransferLimitsType") } ) ) {
334 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4
::Context
->preference("BranchTransferLimitsType") };
340 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
341 $messages->{'IsPermanent'} = $hbr;
345 # can't transfer book if is already there....
346 if ( $fbr eq $tbr ) {
347 $messages->{'DestinationEqualsHolding'} = 1;
351 # check if it is still issued to someone, return it...
352 if ($issue->{borrowernumber
}) {
353 AddReturn
( $barcode, $fbr );
354 $messages->{'WasReturned'} = $issue->{borrowernumber
};
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;
368 #actually do the transfer....
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 );
382 my $borrower = shift;
383 my $biblionumber = shift;
386 my $onsite_checkout = $params->{onsite_checkout
} || 0;
387 my $cat_borrower = $borrower->{'categorycode'};
388 my $dbh = C4
::Context
->dbh;
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
403 if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
406 SELECT COUNT
(*) AS total
, COALESCE
(SUM
(onsite_checkout
), 0) AS onsite_checkouts
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
416 if (C4
::Context
->preference('item-level_itypes')) {
417 $count_query .= " WHERE items.itype NOT IN (
418 SELECT itemtype FROM issuingrules
420 AND (categorycode = ? OR categorycode = ?)
424 $count_query .= " JOIN biblioitems USING (biblionumber)
425 WHERE biblioitems.itemtype NOT IN (
426 SELECT itemtype FROM issuingrules
428 AND (categorycode = ? OR categorycode = ?)
432 push @bind_params, $issuing_rule->{branchcode
};
433 push @bind_params, $issuing_rule->{categorycode
};
434 push @bind_params, $cat_borrower;
436 # rule has specific item type, so count loans of that
438 if (C4
::Context
->preference('item-level_itypes')) {
439 $count_query .= " WHERE items.itype = ? ";
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
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 ) {
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 ) {
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 ) {
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
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
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 ) {
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 ) {
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 ) {
540 reason
=> 'TOO_MANY_CHECKOUTS',
541 count
=> $checkout_count - $onsite_checkout_count,
542 max_allowed
=> $max_checkouts_allowed,
548 # OK, the patron can issue !!!
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:
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.
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
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.
598 my ( $bibitem, $biblio ) = @_;
599 my $dbh = C4
::Context
->dbh;
601 $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
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
617 my $sth2 = $dbh->prepare(
618 "SELECT * FROM issues
619 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
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'};
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
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'};
653 $results[$i] = $data;
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.
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
684 override_high_holds - Ignore high holds
685 onsite_checkout - Checkout is an onsite checkout that will not leave the library
693 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
694 Possible values are :
700 sticky due date is invalid
704 borrower gone with no address
708 borrower declared it's card lost
714 =head3 UNKNOWN_BARCODE
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 :
741 renewing, not issuing
743 =head3 ISSUED_TO_ANOTHER
745 issued to someone else.
749 reserved for someone else.
753 sticky due date is invalid or due date in the past
757 if the borrower borrows to much things
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.
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);
806 $issuingimpossible{INVALID_DATE
} = output_pref
($duedate);
812 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode
} )) {
813 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
815 branch
=> C4
::Context
->userenv->{'branch'},
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;
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;
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 );
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;
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
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
};
937 $needsconfirmation{TOO_MANY
} = $toomany->{reason
};
938 $issuingimpossible{current_loan_count
} = $toomany->{count
};
939 $issuingimpossible{max_loans_allowed
} = $toomany->{max_allowed
};
946 if ( $item->{'notforloan'} )
948 if(!C4
::Context
->preference("AllowNotForLoanOverride")){
949 $issuingimpossible{NOT_FOR_LOAN
} = 1;
950 $issuingimpossible{item_notforloan
} = $item->{'notforloan'};
952 $needsconfirmation{NOT_FOR_LOAN_FORCING
} = 1;
953 $needsconfirmation{item_notforloan
} = $item->{'notforloan'};
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'};
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'};
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
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;
1037 $issuingimpossible{NO_MORE_RENEWALS
} = 1;
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'} );
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";
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
} ),
1116 $needsconfirmation{HIGHHOLDS
} = {
1117 num_holds
=> $check->{outstanding
},
1118 duration
=> $check->{duration
},
1119 returndate
=> output_pref
( $check->{due_date
} ),
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,
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
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
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
1180 sub CanBookBeReturned
{
1181 my ($item, $branch) = @_;
1182 my $allowreturntobranch = C4
::Context
->preference("AllowReturnToBranch") || 'anywhere';
1184 # assume return is allowed to start
1188 # identify all cases where return is forbidden
1189 if ($allowreturntobranch eq 'homebranch' && $branch ne $item->{'homebranch'}) {
1191 $message = $item->{'homebranch'};
1192 } elsif ($allowreturntobranch eq 'holdingbranch' && $branch ne $item->{'holdingbranch'}) {
1194 $message = $item->{'holdingbranch'};
1195 } elsif ($allowreturntobranch eq 'homeorholdingbranch' && $branch ne $item->{'homebranch'} && $branch ne $item->{'holdingbranch'}) {
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
1211 sub checkHighHolds
{
1212 my ( $item, $borrower ) = @_;
1213 my $biblio = GetBiblioFromItemNumber
( $item->{itemnumber
} );
1214 my $branch = _GetCircControlBranch
( $item, $borrower );
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 );
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;
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.
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
1320 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
1322 - fill reserve if reserve to this patron
1323 - cancel reserve or not, otherwise
1324 * TRANSFERT PENDING ?
1325 - complete the transfert
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);
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());
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'},
1374 $issuedate, # here interpreted as the renewal date
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
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'});
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 ....)
1395 "UPDATE branchtransfers
1396 SET datearrived = now(),
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.
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'},
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 ) {
1460 $item->{'itemnumber'},
1461 $borrower->{'borrowernumber'}, $charge
1463 $item->{'charge'} = $charge;
1466 # Record the fact that this book was issued.
1468 branch
=> C4
::Context
->userenv->{'branch'},
1469 type
=> ( $onsite_checkout ?
'onsite_checkout' : 'issue' ),
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';
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
({
1490 borrower
=> $borrower,
1496 logaction
("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'itemnumber'})
1497 if C4
::Context
->preference("IssueLog");
1502 =head2 GetLoanLength
1504 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1506 Get loan length for an itemtype, a borrower type and a branch
1511 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1512 my $dbh = C4
::Context
->dbh;
1513 my $sth = $dbh->prepare(qq{
1514 SELECT issuelength
, lengthunit
, renewalperiod
1516 WHERE categorycode
=?
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;
1528 if defined($loanlength) && defined $loanlength->{issuelength
};
1530 $sth->execute( $borrowertype, '*', $branchcode );
1531 $loanlength = $sth->fetchrow_hashref;
1533 if defined($loanlength) && defined $loanlength->{issuelength
};
1535 $sth->execute( '*', $itemtype, $branchcode );
1536 $loanlength = $sth->fetchrow_hashref;
1538 if defined($loanlength) && defined $loanlength->{issuelength
};
1540 $sth->execute( '*', '*', $branchcode );
1541 $loanlength = $sth->fetchrow_hashref;
1543 if defined($loanlength) && defined $loanlength->{issuelength
};
1545 $sth->execute( $borrowertype, $itemtype, '*' );
1546 $loanlength = $sth->fetchrow_hashref;
1548 if defined($loanlength) && defined $loanlength->{issuelength
};
1550 $sth->execute( $borrowertype, '*', '*' );
1551 $loanlength = $sth->fetchrow_hashref;
1553 if defined($loanlength) && defined $loanlength->{issuelength
};
1555 $sth->execute( '*', $itemtype, '*' );
1556 $loanlength = $sth->fetchrow_hashref;
1558 if defined($loanlength) && defined $loanlength->{issuelength
};
1560 $sth->execute( '*', '*', '*' );
1561 $loanlength = $sth->fetchrow_hashref;
1563 if defined($loanlength) && defined $loanlength->{issuelength
};
1565 # if no rule is set => 0 day (hardcoded)
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
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
});
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.
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=?" );
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,
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
1681 maxonsiteissueqty - undef
1683 C<$branchcode> and C<$categorycode> should contain the
1684 literal branch code and patron category code, respectively - no
1689 sub GetBranchBorrowerCircRule
{
1690 my ( $branchcode, $categorycode ) = @_;
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
1723 return $rules if $rules;
1725 # built-in default circulation rule
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 '*'.
1762 sub GetBranchItemRule
{
1763 my ( $branchcode, $itemtype ) = @_;
1764 my $dbh = C4
::Context
->dbh();
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 )
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'} );
1805 ($doreturn, $messages, $iteminformation, $borrower) =
1806 &AddReturn( $barcode, $branch [,$exemptfine] [,$dropbox] [,$returndate] );
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
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.
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:
1841 No item with this barcode exists. The value is C<$barcode>.
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.
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.
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.
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.
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'};
1895 $branch = C4
::Context
->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
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";
1914 $messages->{'NotIssued'} = $barcode;
1915 # even though item is not on loan, it may still be transferred; therefore, get current branch info
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';
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');
1949 $yaml = "$yaml\n\n"; # YAML is anal on ending \n. Surplus does not hurt
1951 eval { $rules = YAML
::Load
($yaml); };
1953 warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
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 );
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
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() );
1994 my $datedue = $issue->{date_due
};
1995 $borrower or warn "AddReturn without current borrower";
1996 my $circControlBranch;
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
};
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 );
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
},
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
},
2050 due
=> output_pref
($datedue),
2058 MarkIssueReturned
( $borrowernumber, $item->{'itemnumber'},
2059 $circControlBranch, $return_date, $borrower->{'privacy'} );
2062 $messages->{'Wrongbranch'} = {
2063 Wrongbranch
=> $branch,
2064 Rightbranch
=> $message
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'} );
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');
2101 $messages->{'WrongTransfer'} = $tobranch;
2102 $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
2104 $validTransfert = 1;
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
} ) {
2126 $today = $dropboxdate if $dropbox;
2127 my ($debardate,$reminder) = _debar_user_on_return
( $borrower, $item, $issue->{date_due
}, $today );
2129 $messages->{'PrevDebarred'} = $debardate;
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'};
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'} );
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
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';
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
({
2181 borrower
=> $borrower,
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")} )
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;
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>.
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=';
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 );
2260 push @bind, $dropboxdate->strftime('%Y-%m-%d %H:%M');
2261 } elsif ($returndate) {
2263 push @bind, $returndate;
2265 $query .= ' now() ';
2267 $query .= ' WHERE borrowernumber = ? AND itemnumber = ?';
2268 push @bind, $borrowernumber, $itemnumber;
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
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');
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);
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
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;
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();
2371 =head2 _FixOverduesOnReturn
2373 &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
2375 C<$brn> borrowernumber
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
2386 sub _FixOverduesOnReturn
{
2387 my ($borrowernumber, $item);
2388 unless ($borrowernumber = shift) {
2389 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
2392 unless ($item = shift) {
2393 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
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
2410 my @bind = ($data->{'accountlines_id'});
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) ;
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.
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
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.
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
2485 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
2486 if ($accdata->{'amountoutstanding'} < $amountleft) {
2488 $amountleft -= $accdata->{'amountoutstanding'};
2490 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
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)
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)
2516 $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
2518 ModItem
({ paidfor
=> '' }, undef, $itemnumber);
2522 =head2 _GetCircControlBranch
2524 my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
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.
2538 sub _GetCircControlBranch
{
2539 my ($item, $borrower) = @_;
2540 my $circcontrol = C4
::Context
->preference('CircControl');
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
};
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
};
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.
2577 my ($itemnumber) = @_;
2578 return unless $itemnumber;
2579 my $sth = C4
::Context
->dbh->prepare(
2580 "SELECT items.*, 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;
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
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();
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:
2632 =item * borrowernumber
2634 =item * biblionumber
2643 my ($criteria) = @_;
2647 my @allowed = qw(borrowernumber biblionumber itemnumber);
2648 foreach (@allowed) {
2649 if (defined $criteria->{$_}) {
2652 value
=> $criteria->{$_},
2657 # Do we need to join other tables ?
2659 if (defined $criteria->{biblionumber
}) {
2666 $where = "WHERE " . join(' AND ', map { "$_->{field} = ?" } @filters);
2672 if (defined $join{items
}) {
2674 LEFT JOIN items ON (issues.itemnumber = items.itemnumber)
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
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 = ? ";
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);
2720 $sth->execute($itemnumber, $itemnumber);
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;
2734 =head2 GetBiblioIssues
2736 $issues = GetBiblioIssues($biblionumber);
2738 this function get all issues from a biblionumber.
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.
2746 sub GetBiblioIssues
{
2747 my $biblionumber = shift;
2748 return unless $biblionumber;
2749 my $dbh = C4
::Context
->dbh;
2751 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
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 = ?
2759 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
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 = ?
2768 my $sth = $dbh->prepare($query);
2769 $sth->execute($biblionumber, $biblionumber);
2772 while ( my $data = $sth->fetchrow_hashref ) {
2773 push @issues, $data;
2778 =head2 GetUpcomingDueIssues
2780 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
2784 sub GetUpcomingDueIssues
{
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
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 <= ?
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
2832 sub CanBookBeRenewed {
2833 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2835 my $dbh = C4::Context->dbh;
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 )
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?
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();
2857 # There is an item level hold on this item, no other item can fill the hold
2862 # Get all other items that could possibly fill reserves
2863 my @itemnumbers = $schema->resultset('Item')->search(
2865 biblionumber => $resrec->{biblionumber},
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;
2876 my ( $reserve_found, $reserve, undef ) =
2877 C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
2879 if ($reserve_found) {
2880 push( @borrowernumbers, $reserve->{borrowernumber} );
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.
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 ) {
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 );
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()
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 );
2975 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2979 C<$borrowernumber> is the borrower number of the patron who currently
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.
2998 my $borrowernumber = shift;
2999 my $itemnumber = shift or return;
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
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.';
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.
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=?
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);
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';
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({
3084 borrower => $borrower,
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' });
3101 UpdateStats({branch => $branch,
3104 itemnumber => $itemnumber,
3105 itemtype => $item->{itype},
3106 borrowernumber => $borrowernumber,
3107 ccode => $item->{'ccode'}}
3113 # check renewal status
3114 my ( $bornum, $itemno ) = @_;
3115 my $dbh = C4::Context->dbh;
3117 my $renewsallowed = 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
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)
3177 my $branchcode = _GetCircControlBranch( $item, $borrower );
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()
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;
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>
3218 sub GetIssuingCharges {
3220 # calculate charges due
3221 my ( $itemnumber, $borrowernumber ) = @_;
3223 my $dbh = C4::Context->dbh;
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
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) = @_;
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};
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};
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};
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};
3291 $discount = $d[0]->{rentaldiscount
};
3292 return (defined $discount) ?
$discount : 0;
3298 =head2 AddIssuingCharge
3300 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
3304 sub AddIssuingCharge
{
3305 my ( $itemnumber, $borrowernumber, $charge ) = @_;
3306 my $dbh = C4
::Context
->dbh;
3307 my $nextaccntno = getnextacctno
( $borrowernumber );
3309 $manager_id = C4
::Context
->userenv->{'number'} if C4
::Context
->userenv;
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 );
3323 GetTransfers($itemnumber);
3328 my ($itemnumber) = @_;
3330 my $dbh = C4
::Context
->dbh;
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();
3346 =head2 GetTransfersFromTo
3348 @results = GetTransfersFromTo($frombranch,$tobranch);
3350 Returns the list of pending transfers between $from and $to branch
3354 sub GetTransfersFromTo
{
3355 my ( $frombranch, $tobranch ) = @_;
3356 return unless ( $frombranch && $tobranch );
3357 my $dbh = C4
::Context
->dbh;
3359 SELECT itemnumber,datesent,frombranch
3360 FROM branchtransfers
3363 AND datearrived IS NULL
3365 my $sth = $dbh->prepare($query);
3366 $sth->execute( $frombranch, $tobranch );
3369 while ( my $data = $sth->fetchrow_hashref ) {
3370 push @gettransfers, $data;
3372 return (@gettransfers);
3375 =head2 DeleteTransfer
3377 &DeleteTransfer($itemnumber);
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
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.
3407 sub AnonymiseIssueHistory
{
3409 my $borrowernumber = shift;
3410 my $dbh = C4
::Context
->dbh;
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;
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.
3446 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
3450 Hashref of information about the item being checked in or out.
3454 Hashref of information about the borrower of the item.
3458 The branchcode from where the checkout or check-in took place.
3464 SendCirculationAlert({
3467 borrower => $borrower,
3473 sub SendCirculationAlert
{
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;
3491 # warn "transport: $_";
3492 my $message = C4
::Message
->find_last_message($borrower, $type, $_);
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
=> $_,
3501 $issues_table => $item->{itemnumber
},
3502 'items' => $item->{itemnumber
},
3503 'biblio' => $item->{biblionumber
},
3504 'biblioitems' => $item->{biblionumber
},
3505 'borrowers' => $borrower,
3506 'branches' => $branch,
3509 C4
::Message
->enqueue($letter, $borrower, $_);
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
=> $_,
3518 $issues_table => $item->{itemnumber
},
3519 'items' => $item->{itemnumber
},
3520 'biblio' => $item->{biblionumber
},
3521 'biblioitems' => $item->{biblionumber
},
3522 'borrowers' => $borrower,
3523 'branches' => $branch,
3526 $message->append($letter);
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
3542 sub updateWrongTransfer
{
3543 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
3544 my $dbh = C4
::Context
->dbh;
3545 # first step validate the actual line of transfert .
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
3567 sub UpdateHoldingbranch
{
3568 my ( $branch,$itemnumber ) = @_;
3569 ModItem
({ holdingbranch
=> $branch }, undef, $itemnumber);
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.
3587 my ( $startdate, $itemtype, $branch, $borrower, $isrenewal ) = @_;
3591 # loanlength now a href
3593 GetLoanLength
( $borrower->{'categorycode'}, $itemtype, $branch );
3595 my $length_key = ( $isrenewal and defined $loanlength->{renewalperiod
} )
3601 if (ref $startdate ne 'DateTime' ) {
3602 $datedue = dt_from_string
($datedue);
3604 $datedue = $startdate->clone;
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} );
3619 $datedue->add( days
=> $loanlength->{$length_key} );
3620 $datedue->set_hour(23);
3621 $datedue->set_minute(59);
3625 if ($loanlength->{lengthunit
} eq 'hours') {
3626 $dur = DateTime
::Duration
->new( hours
=> $loanlength->{$length_key});
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 );
3675 sub CheckValidBarcode
{
3677 my $dbh = C4
::Context
->dbh;
3678 my $query=qq|SELECT count
(*)
3682 my $sth = $dbh->prepare($query);
3683 $sth->execute($barcode);
3684 my $exist=$sth->fetchrow ;
3688 =head2 IsBranchTransferAllowed
3690 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
3692 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
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'} ) {
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.
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.
3745 sub DeleteBranchTransferLimits
{
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);
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);
3768 my ($itemnumber, $mark_returned) = @_;
3770 my $dbh = C4
::Context
->dbh();
3771 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
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({});
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 );
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 );
3829 sub ProcessOfflineOperation
{
3830 my $operation = shift;
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
};
3846 sub ProcessOfflineReturn
{
3847 my $operation = shift;
3849 my $itemnumber = C4
::Items
::GetItemnumberFromBarcode
( $operation->{barcode
} );
3851 if ( $itemnumber ) {
3852 my $issue = GetOpenIssue
( $itemnumber );
3855 $issue->{borrowernumber
},
3858 $operation->{timestamp
},
3861 { renewals
=> 0, onloan
=> undef },
3862 $issue->{'biblionumber'},
3867 return "Item not issued.";
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
3888 $issue->{borrowernumber
},
3891 $operation->{timestamp
},
3896 $operation->{'barcode'},
3899 $operation->{timestamp
},
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 );
3922 TransferSlip($user_branch, $itemnumber, $barcode, $to_branch)
3924 Returns letter hash ( see C4::Letters::GetPreparedLetter ) or undef
3929 my ($branch, $itemnumber, $barcode, $to_branch) = @_;
3931 my $item = GetItem
( $itemnumber, $barcode )
3934 return C4
::Letters
::GetPreparedLetter
(
3935 module
=> 'circulation',
3936 letter_code
=> 'TRANSFERSLIP',
3937 branchcode
=> $branch,
3939 'branches' => $to_branch,
3940 'biblio' => $item->{biblionumber
},
3946 =head2 CheckIfIssuedToPatron
3948 CheckIfIssuedToPatron($borrowernumber, $biblionumber)
3950 Return 1 if any record item is issued to patron, otherwise return 0
3954 sub CheckIfIssuedToPatron
{
3955 my ($borrowernumber, $biblionumber) = @_;
3957 my $dbh = C4
::Context
->dbh;
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;
3971 IsItemIssued( $itemnumber )
3973 Return 1 if the item is on loan, otherwise return 0
3978 my $itemnumber = shift;
3979 my $dbh = C4
::Context
->dbh;
3980 my $sth = $dbh->prepare(q{
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.
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;
4017 my $restriction_year = 0;
4018 for my $value (@values) {
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];
4029 elsif ( $value =~ /^\Q$marker\E(\d+)$/ ) {
4031 # Perhaps it is something like "K16" (as in Finland)
4032 $restriction_year += $1;
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
4066 sub GetPendingOnSiteCheckouts
{
4067 my $dbh = C4
::Context
->dbh;
4068 return $dbh->selectall_arrayref(q
|
4074 items
.itemcallnumber
,
4078 issues
.date_due
< NOW
() AS is_overdue
,
4081 borrowers
.firstname
,
4083 borrowers
.cardnumber
,
4084 borrowers
.borrowernumber
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
=> {} } );
4096 my ($count, $branch, $itemtype, $ccode, $newness)
4097 = @
$params{qw(count branch itemtype ccode newness)};
4099 my $dbh = C4
::Context
->dbh;
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
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);
4112 push @where_strs, 'i.homebranch = ?';
4113 push @where_args, $branch;
4116 if (C4
::Context
->preference('item-level_itypes')){
4117 push @where_strs, 'i.itype = ?';
4118 push @where_args, $itemtype;
4120 push @where_strs, 'bi.itemtype = ?';
4121 push @where_args, $itemtype;
4125 push @where_strs, 'i.ccode = ?';
4126 push @where_args, $ccode;
4129 push @where_strs, 'TO_DAYS(NOW()) - TO_DAYS(b.datecreated) <= ?';
4130 push @where_args, $newness;
4134 $query .= 'WHERE ' . join(' AND ', @where_strs);
4138 GROUP BY b.biblionumber
4143 $count = int($count);
4145 $query .= "LIMIT $count";
4148 my $rows = $dbh->selectall_arrayref($query, { Slice
=> {} }, @where_args);
4158 Koha Development Team <http://koha-community.org/>