1 package C4::Circulation;
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
22 #use warnings; FIXME - Bug 2505
33 use C4::ItemCirculationAlertPreference;
45 use POSIX qw(strftime);
46 use C4::Branch; # GetBranches
47 use C4::Log; # logaction
51 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
55 $VERSION = 3.02; # for version checking
58 # FIXME subs that should probably be elsewhere
64 # subs to deal with issuing a book
76 &GetBranchBorrowerCircRule
80 &AnonymiseIssueHistory
83 # subs to deal with returns
89 # subs to deal with transfers
96 &IsBranchTransferAllowed
97 &CreateBranchTransferLimit
98 &DeleteBranchTransferLimits
104 C4::Circulation - Koha circulation module
112 The functions in this module deal with circulation, issues, and
113 returns, as well as general information about the library.
114 Also deals with stocktaking.
120 $str = &barcodedecode($barcode, [$filter]);
122 Generic filter function for barcode string.
123 Called on every circ if the System Pref itemBarcodeInputFilter is set.
124 Will do some manipulation of the barcode for systems that deliver a barcode
125 to circulation.pl that differs from the barcode stored for the item.
126 For proper functioning of this filter, calling the function on the
127 correct barcode string (items.barcode) should return an unaltered barcode.
129 The optional $filter argument is to allow for testing or explicit
130 behavior that ignores the System Pref. Valid values are the same as the
135 # FIXME -- the &decode fcn below should be wrapped into this one.
136 # FIXME -- these plugins should be moved out of Circulation.pm
139 my ($barcode, $filter) = @_;
140 $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
141 $filter or return $barcode; # ensure filter is defined, else return untouched barcode
142 if ($filter eq 'whitespace') {
144 } elsif ($filter eq 'cuecat') {
146 my @fields = split( /\./, $barcode );
147 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
148 ($#results == 2) and return $results[2];
149 } elsif ($filter eq 'T-prefix') {
150 if ($barcode =~ /^[Tt](\d)/) {
151 (defined($1) and $1 eq '0') and return $barcode;
152 $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1)
154 return sprintf("T%07d", $barcode);
155 # FIXME: $barcode could be "T1", causing warning: substr outside of string
156 # Why drop the nonzero digit after the T?
157 # Why pass non-digits (or empty string) to "T%07d"?
159 return $barcode; # return barcode, modified or not
164 $str = &decode($chunk);
166 Decodes a segment of a string emitted by a CueCat barcode scanner and
169 FIXME: Should be replaced with Barcode::Cuecat from CPAN
170 or Javascript based decoding on the client side.
177 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
178 my @s = map { index( $seq, $_ ); } split( //, $encoded );
179 my $l = ( $#s + 1 ) % 4;
182 # warn "Error: Cuecat decode parsing failed!";
190 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
192 chr( ( $n >> 16 ) ^ 67 )
193 .chr( ( $n >> 8 & 255 ) ^ 67 )
194 .chr( ( $n & 255 ) ^ 67 );
197 $r = substr( $r, 0, length($r) - $l );
203 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
204 $barcode, $ignore_reserves);
206 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
208 C<$newbranch> is the code for the branch to which the item should be transferred.
210 C<$barcode> is the barcode of the item to be transferred.
212 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
213 Otherwise, if an item is reserved, the transfer fails.
215 Returns three values:
221 is true if the transfer was successful.
225 is a reference-to-hash which may have any of the following keys:
231 There is no item in the catalog with the given barcode. The value is C<$barcode>.
235 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.
237 =item C<DestinationEqualsHolding>
239 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.
243 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.
247 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>.
249 =item C<WasTransferred>
251 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
260 my ( $tbr, $barcode, $ignoreRs ) = @_;
263 my $branches = GetBranches();
264 my $itemnumber = GetItemnumberFromBarcode( $barcode );
265 my $issue = GetItemIssue($itemnumber);
266 my $biblio = GetBiblioFromItemNumber($itemnumber);
269 if ( not $itemnumber ) {
270 $messages->{'BadBarcode'} = $barcode;
274 # get branches of book...
275 my $hbr = $biblio->{'homebranch'};
276 my $fbr = $biblio->{'holdingbranch'};
278 # if using Branch Transfer Limits
279 if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) {
280 if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) {
281 if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) {
282 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'};
285 } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) {
286 $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") };
292 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
293 $messages->{'IsPermanent'} = $hbr;
297 # can't transfer book if is already there....
298 if ( $fbr eq $tbr ) {
299 $messages->{'DestinationEqualsHolding'} = 1;
303 # check if it is still issued to someone, return it...
304 if ($issue->{borrowernumber}) {
305 AddReturn( $barcode, $fbr );
306 $messages->{'WasReturned'} = $issue->{borrowernumber};
310 # That'll save a database query.
311 my ( $resfound, $resrec ) =
312 CheckReserves( $itemnumber );
313 if ( $resfound and not $ignoreRs ) {
314 $resrec->{'ResFound'} = $resfound;
316 # $messages->{'ResFound'} = $resrec;
320 #actually do the transfer....
322 ModItemTransfer( $itemnumber, $fbr, $tbr );
324 # don't need to update MARC anymore, we do it in batch now
325 $messages->{'WasTransfered'} = 1;
328 ModDateLastSeen( $itemnumber );
329 return ( $dotransfer, $messages, $biblio );
334 my $borrower = shift;
335 my $biblionumber = shift;
337 my $cat_borrower = $borrower->{'categorycode'};
338 my $dbh = C4::Context->dbh;
340 # Get which branchcode we need
341 $branch = _GetCircControlBranch($item,$borrower);
342 my $type = (C4::Context->preference('item-level_itypes'))
343 ? $item->{'itype'} # item-level
344 : $item->{'itemtype'}; # biblio-level
346 # given branch, patron category, and item type, determine
347 # applicable issuing rule
348 my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
350 # if a rule is found and has a loan limit set, count
351 # how many loans the patron already has that meet that
353 if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
355 my $count_query = "SELECT COUNT(*) FROM issues
356 JOIN items USING (itemnumber) ";
358 my $rule_itemtype = $issuing_rule->{itemtype};
359 if ($rule_itemtype eq "*") {
360 # matching rule has the default item type, so count only
361 # those existing loans that don't fall under a more
363 if (C4::Context->preference('item-level_itypes')) {
364 $count_query .= " WHERE items.itype NOT IN (
365 SELECT itemtype FROM issuingrules
367 AND (categorycode = ? OR categorycode = ?)
371 $count_query .= " JOIN biblioitems USING (biblionumber)
372 WHERE biblioitems.itemtype NOT IN (
373 SELECT itemtype FROM issuingrules
375 AND (categorycode = ? OR categorycode = ?)
379 push @bind_params, $issuing_rule->{branchcode};
380 push @bind_params, $issuing_rule->{categorycode};
381 push @bind_params, $cat_borrower;
383 # rule has specific item type, so count loans of that
385 if (C4::Context->preference('item-level_itypes')) {
386 $count_query .= " WHERE items.itype = ? ";
388 $count_query .= " JOIN biblioitems USING (biblionumber)
389 WHERE biblioitems.itemtype= ? ";
391 push @bind_params, $type;
394 $count_query .= " AND borrowernumber = ? ";
395 push @bind_params, $borrower->{'borrowernumber'};
396 my $rule_branch = $issuing_rule->{branchcode};
397 if ($rule_branch ne "*") {
398 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
399 $count_query .= " AND issues.branchcode = ? ";
400 push @bind_params, $branch;
401 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
402 ; # if branch is the patron's home branch, then count all loans by patron
404 $count_query .= " AND items.homebranch = ? ";
405 push @bind_params, $branch;
409 my $count_sth = $dbh->prepare($count_query);
410 $count_sth->execute(@bind_params);
411 my ($current_loan_count) = $count_sth->fetchrow_array;
413 my $max_loans_allowed = $issuing_rule->{'maxissueqty'};
414 if ($current_loan_count >= $max_loans_allowed) {
415 return "$current_loan_count / $max_loans_allowed";
419 # Now count total loans against the limit for the branch
420 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
421 if (defined($branch_borrower_circ_rule->{maxissueqty})) {
422 my @bind_params = ();
423 my $branch_count_query = "SELECT COUNT(*) FROM issues
424 JOIN items USING (itemnumber)
425 WHERE borrowernumber = ? ";
426 push @bind_params, $borrower->{borrowernumber};
428 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
429 $branch_count_query .= " AND issues.branchcode = ? ";
430 push @bind_params, $branch;
431 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
432 ; # if branch is the patron's home branch, then count all loans by patron
434 $branch_count_query .= " AND items.homebranch = ? ";
435 push @bind_params, $branch;
437 my $branch_count_sth = $dbh->prepare($branch_count_query);
438 $branch_count_sth->execute(@bind_params);
439 my ($current_loan_count) = $branch_count_sth->fetchrow_array;
441 my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty};
442 if ($current_loan_count >= $max_loans_allowed) {
443 return "$current_loan_count / $max_loans_allowed";
447 # OK, the patron can issue !!!
453 @issues = &itemissues($biblioitemnumber, $biblio);
455 Looks up information about who has borrowed the bookZ<>(s) with the
456 given biblioitemnumber.
458 C<$biblio> is ignored.
460 C<&itemissues> returns an array of references-to-hash. The keys
461 include the fields from the C<items> table in the Koha database.
462 Additional keys include:
468 If the item is currently on loan, this gives the due date.
470 If the item is not on loan, then this is either "Available" or
471 "Cancelled", if the item has been withdrawn.
475 If the item is currently on loan, this gives the card number of the
476 patron who currently has the item.
478 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
480 These give the timestamp for the last three times the item was
483 =item C<card0>, C<card1>, C<card2>
485 The card number of the last three patrons who borrowed this item.
487 =item C<borrower0>, C<borrower1>, C<borrower2>
489 The borrower number of the last three patrons who borrowed this item.
497 my ( $bibitem, $biblio ) = @_;
498 my $dbh = C4::Context->dbh;
500 $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
505 $sth->execute($bibitem) || die $sth->errstr;
507 while ( my $data = $sth->fetchrow_hashref ) {
509 # Find out who currently has this item.
510 # FIXME - Wouldn't it be better to do this as a left join of
511 # some sort? Currently, this code assumes that if
512 # fetchrow_hashref() fails, then the book is on the shelf.
513 # fetchrow_hashref() can fail for any number of reasons (e.g.,
514 # database server crash), not just because no items match the
516 my $sth2 = $dbh->prepare(
517 "SELECT * FROM issues
518 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
523 $sth2->execute( $data->{'itemnumber'} );
524 if ( my $data2 = $sth2->fetchrow_hashref ) {
525 $data->{'date_due'} = $data2->{'date_due'};
526 $data->{'card'} = $data2->{'cardnumber'};
527 $data->{'borrower'} = $data2->{'borrowernumber'};
530 $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available';
534 # Find the last 3 people who borrowed this item.
535 $sth2 = $dbh->prepare(
536 "SELECT * FROM old_issues
537 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
539 ORDER BY returndate DESC,timestamp DESC"
542 $sth2->execute( $data->{'itemnumber'} );
543 for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
544 { # FIXME : error if there is less than 3 pple borrowing this item
545 if ( my $data2 = $sth2->fetchrow_hashref ) {
546 $data->{"timestamp$i2"} = $data2->{'timestamp'};
547 $data->{"card$i2"} = $data2->{'cardnumber'};
548 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
552 $results[$i] = $data;
559 =head2 CanBookBeIssued
561 ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower,
562 $barcode, $duedatespec, $inprocess );
564 Check if a book can be issued.
566 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
570 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
572 =item C<$barcode> is the bar code of the book being issued.
574 =item C<$duedatespec> is a C4::Dates object.
584 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
585 Possible values are :
591 sticky due date is invalid
595 borrower gone with no address
599 borrower declared it's card lost
605 =head3 UNKNOWN_BARCODE
619 item is restricted (set by ??)
621 C<$needsconfirmation> a reference to a hash. It contains reasons why the loan
622 could be prevented, but ones that can be overriden by the operator.
624 Possible values are :
632 renewing, not issuing
634 =head3 ISSUED_TO_ANOTHER
636 issued to someone else.
640 reserved for someone else.
644 sticky due date is invalid
648 if the borrower borrows to much things
652 sub CanBookBeIssued {
653 my ( $borrower, $barcode, $duedate, $inprocess ) = @_;
654 my %needsconfirmation; # filled with problems that needs confirmations
655 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
656 my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
657 my $issue = GetItemIssue($item->{itemnumber});
658 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
659 $item->{'itemtype'}=$item->{'itype'};
660 my $dbh = C4::Context->dbh;
662 # MANDATORY CHECKS - unless item exists, nothing else matters
663 unless ( $item->{barcode} ) {
664 $issuingimpossible{UNKNOWN_BARCODE} = 1;
666 return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible;
669 # DUE DATE is OK ? -- should already have checked.
671 unless ( $duedate ) {
672 my $issuedate = strftime( "%Y-%m-%d", localtime );
674 my $branch = _GetCircControlBranch($item,$borrower);
675 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'};
676 my $loanlength = GetLoanLength( $borrower->{'categorycode'}, $itype, $branch );
677 $duedate = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $loanlength, $branch, $borrower );
679 # Offline circ calls AddIssue directly, doesn't run through here
680 # So issuingimpossible should be ok.
682 $issuingimpossible{INVALID_DATE} = $duedate->output('syspref') unless ( $duedate && $duedate->output('iso') ge C4::Dates->today('iso') );
687 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
688 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
689 &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'});
690 ModDateLastSeen( $item->{'itemnumber'} );
691 return( { STATS => 1 }, {});
693 if ( $borrower->{flags}->{GNA} ) {
694 $issuingimpossible{GNA} = 1;
696 if ( $borrower->{flags}->{'LOST'} ) {
697 $issuingimpossible{CARD_LOST} = 1;
699 if ( $borrower->{flags}->{'DBARRED'} ) {
700 $issuingimpossible{DEBARRED} = 1;
702 if ( $borrower->{'dateexpiry'} eq '0000-00-00') {
703 $issuingimpossible{EXPIRED} = 1;
705 my @expirydate= split /-/,$borrower->{'dateexpiry'};
706 if($expirydate[0]==0 || $expirydate[1]==0|| $expirydate[2]==0 ||
707 Date_to_Days(Today) > Date_to_Days( @expirydate )) {
708 $issuingimpossible{EXPIRED} = 1;
717 C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->output('iso') );
718 if ( C4::Context->preference("IssuingInProcess") ) {
719 my $amountlimit = C4::Context->preference("noissuescharge");
720 if ( $amount > $amountlimit && !$inprocess ) {
721 $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
723 elsif ( $amount > 0 && $amount <= $amountlimit && !$inprocess ) {
724 $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
729 $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
733 my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'});
734 if ($blocktype == -1) {
735 ## patron has outstanding overdue loans
736 if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){
737 $issuingimpossible{USERBLOCKEDOVERDUE} = $count;
739 elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){
740 $needsconfirmation{USERBLOCKEDOVERDUE} = $count;
742 } elsif($blocktype == 1) {
743 # patron has accrued fine days
744 $issuingimpossible{USERBLOCKEDREMAINING} = $count;
748 # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
750 my $toomany = TooMany( $borrower, $item->{biblionumber}, $item );
751 # if TooMany return / 0, then the user has no permission to check out this book
752 if ($toomany =~ /\/ 0/) {
753 $needsconfirmation{PATRON_CANT} = 1;
755 $needsconfirmation{TOO_MANY} = $toomany if $toomany;
761 if ( $item->{'notforloan'}
762 && $item->{'notforloan'} > 0 )
764 if(!C4::Context->preference("AllowNotForLoanOverride")){
765 $issuingimpossible{NOT_FOR_LOAN} = 1;
767 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
770 elsif ( !$item->{'notforloan'} ){
771 # we have to check itemtypes.notforloan also
772 if (C4::Context->preference('item-level_itypes')){
773 # this should probably be a subroutine
774 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
775 $sth->execute($item->{'itemtype'});
776 my $notforloan=$sth->fetchrow_hashref();
778 if ($notforloan->{'notforloan'}) {
779 if (!C4::Context->preference("AllowNotForLoanOverride")) {
780 $issuingimpossible{NOT_FOR_LOAN} = 1;
782 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
786 elsif ($biblioitem->{'notforloan'} == 1){
787 if (!C4::Context->preference("AllowNotForLoanOverride")) {
788 $issuingimpossible{NOT_FOR_LOAN} = 1;
790 $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1;
794 if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
796 $issuingimpossible{WTHDRAWN} = 1;
798 if ( $item->{'restricted'}
799 && $item->{'restricted'} == 1 )
801 $issuingimpossible{RESTRICTED} = 1;
803 if ( C4::Context->preference("IndependantBranches") ) {
804 my $userenv = C4::Context->userenv;
805 if ( ($userenv) && ( $userenv->{flags} % 2 != 1 ) ) {
806 $issuingimpossible{ITEMNOTSAMEBRANCH} = 1
807 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
808 $needsconfirmation{BORRNOTSAMEBRANCH} = GetBranchName( $borrower->{'branchcode'} )
809 if ( $borrower->{'branchcode'} ne $userenv->{branch} );
814 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
816 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
819 # Already issued to current borrower. Ask whether the loan should
821 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
822 $borrower->{'borrowernumber'},
823 $item->{'itemnumber'}
825 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
826 $issuingimpossible{NO_MORE_RENEWALS} = 1;
829 $needsconfirmation{RENEW_ISSUE} = 1;
832 elsif ($issue->{borrowernumber}) {
834 # issued to someone else
835 my $currborinfo = C4::Members::GetMemberDetails( $issue->{borrowernumber} );
837 # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
838 $needsconfirmation{ISSUED_TO_ANOTHER} =
839 "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
842 # See if the item is on reserve.
843 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
845 my $resbor = $res->{'borrowernumber'};
846 my ( $resborrower ) = C4::Members::GetMemberDetails( $resbor, 0 );
847 my $branches = GetBranches();
848 my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
849 if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
851 # The item is on reserve and waiting, but has been
852 # reserved by some other patron.
853 $needsconfirmation{RESERVE_WAITING} =
854 "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
856 elsif ( $restype eq "Reserved" ) {
857 # The item is on reserve for someone else.
858 $needsconfirmation{RESERVED} =
859 "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
862 return ( \%issuingimpossible, \%needsconfirmation );
867 &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
869 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
873 =item C<$borrower> is a hash with borrower informations (from GetMemberDetails).
875 =item C<$barcode> is the barcode of the item being issued.
877 =item C<$datedue> is a C4::Dates object for the max date of return, i.e. the date due (optional).
880 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
882 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
883 Defaults to today. Unlike C<$datedue>, NOT a C4::Dates object, unfortunately.
885 AddIssue does the following things :
887 - step 01: check that there is a borrowernumber & a barcode provided
888 - check for RENEWAL (book issued & being issued to the same patron)
889 - renewal YES = Calculate Charge & renew
891 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
893 - fill reserve if reserve to this patron
894 - cancel reserve or not, otherwise
895 * TRANSFERT PENDING ?
896 - complete the transfert
904 my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_;
905 my $dbh = C4::Context->dbh;
906 my $barcodecheck=CheckValidBarcode($barcode);
907 # $issuedate defaults to today.
908 if ( ! defined $issuedate ) {
909 $issuedate = strftime( "%Y-%m-%d", localtime );
910 # TODO: for hourly circ, this will need to be a C4::Dates object
911 # and all calls to AddIssue including issuedate will need to pass a Dates object.
913 if ($borrower and $barcode and $barcodecheck ne '0'){
914 # find which item we issue
915 my $item = GetItem('', $barcode) or return undef; # if we don't get an Item, abort.
916 my $branch = _GetCircControlBranch($item,$borrower);
918 # get actual issuing if there is one
919 my $actualissue = GetItemIssue( $item->{itemnumber});
921 # get biblioinformation for this item
922 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
925 # check if we just renew the issue.
927 if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
928 $datedue = AddRenewal(
929 $borrower->{'borrowernumber'},
930 $item->{'itemnumber'},
933 $issuedate, # here interpreted as the renewal date
938 if ( $actualissue->{borrowernumber}) {
939 # This book is currently on loan, but not to the person
940 # who wants to borrow it now. mark it returned before issuing to the new borrower
943 C4::Context->userenv->{'branch'}
947 # See if the item is on reserve.
948 my ( $restype, $res ) =
949 C4::Reserves::CheckReserves( $item->{'itemnumber'} );
951 my $resbor = $res->{'borrowernumber'};
952 if ( $resbor eq $borrower->{'borrowernumber'} ) {
953 # The item is reserved by the current patron
954 ModReserveFill($res);
956 elsif ( $restype eq "Waiting" ) {
958 # The item is on reserve and waiting, but has been
959 # reserved by some other patron.
961 elsif ( $restype eq "Reserved" ) {
963 # The item is reserved by someone else.
964 if ($cancelreserve) { # cancel reserves on this item
965 CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
968 if ($cancelreserve) {
969 CancelReserve($res->{'biblionumber'}, 0, $res->{'borrowernumber'});
972 # set waiting reserve to first in reserve queue as book isn't waiting now
974 $res->{'biblionumber'},
975 $res->{'borrowernumber'},
981 # Starting process for transfer job (checking transfert and validate it if we have one)
982 my ($datesent) = GetTransfers($item->{'itemnumber'});
984 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....)
987 "UPDATE branchtransfers
988 SET datearrived = now(),
990 comments = 'Forced branchtransfer'
991 WHERE itemnumber= ? AND datearrived IS NULL"
993 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
996 # Record in the database the fact that the book was issued.
1000 (borrowernumber, itemnumber,issuedate, date_due, branchcode)
1004 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
1005 my $loanlength = GetLoanLength( $borrower->{'categorycode'}, $itype, $branch );
1006 $datedue = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $loanlength, $branch, $borrower );
1010 $borrower->{'borrowernumber'}, # borrowernumber
1011 $item->{'itemnumber'}, # itemnumber
1012 $issuedate, # issuedate
1013 $datedue->output('iso'), # date_due
1014 C4::Context->userenv->{'branch'} # branchcode
1017 if ( C4::Context->preference('ReturnToShelvingCart') ) { ## ReturnToShelvingCart is on, anything issued should be taken off the cart.
1018 CartToShelf( $item->{'itemnumber'} );
1020 $item->{'issues'}++;
1021 ModItem({ issues => $item->{'issues'},
1022 holdingbranch => C4::Context->userenv->{'branch'},
1024 datelastborrowed => C4::Dates->new()->output('iso'),
1025 onloan => $datedue->output('iso'),
1026 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1027 ModDateLastSeen( $item->{'itemnumber'} );
1029 # If it costs to borrow this book, charge it to the patron's account.
1030 my ( $charge, $itemtype ) = GetIssuingCharges(
1031 $item->{'itemnumber'},
1032 $borrower->{'borrowernumber'}
1034 if ( $charge > 0 ) {
1036 $item->{'itemnumber'},
1037 $borrower->{'borrowernumber'}, $charge
1039 $item->{'charge'} = $charge;
1042 # Record the fact that this book was issued.
1044 C4::Context->userenv->{'branch'},
1046 ($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'},
1047 $item->{'itype'}, $borrower->{'borrowernumber'}
1050 # Send a checkout slip.
1051 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1053 branchcode => $branch,
1054 categorycode => $borrower->{categorycode},
1055 item_type => $item->{itype},
1056 notification => 'CHECKOUT',
1058 if ($circulation_alert->is_enabled_for(\%conditions)) {
1059 SendCirculationAlert({
1062 borrower => $borrower,
1068 logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
1069 if C4::Context->preference("IssueLog");
1071 return ($datedue); # not necessarily the same as when it came in!
1074 =head2 GetLoanLength
1076 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1078 Get loan length for an itemtype, a borrower type and a branch
1083 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1084 my $dbh = C4::Context->dbh;
1087 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"
1089 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1090 # try to find issuelength & return the 1st available.
1091 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1092 $sth->execute( $borrowertype, $itemtype, $branchcode );
1093 my $loanlength = $sth->fetchrow_hashref;
1094 return $loanlength->{issuelength}
1095 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1097 $sth->execute( $borrowertype, "*", $branchcode );
1098 $loanlength = $sth->fetchrow_hashref;
1099 return $loanlength->{issuelength}
1100 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1102 $sth->execute( "*", $itemtype, $branchcode );
1103 $loanlength = $sth->fetchrow_hashref;
1104 return $loanlength->{issuelength}
1105 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1107 $sth->execute( "*", "*", $branchcode );
1108 $loanlength = $sth->fetchrow_hashref;
1109 return $loanlength->{issuelength}
1110 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1112 $sth->execute( $borrowertype, $itemtype, "*" );
1113 $loanlength = $sth->fetchrow_hashref;
1114 return $loanlength->{issuelength}
1115 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1117 $sth->execute( $borrowertype, "*", "*" );
1118 $loanlength = $sth->fetchrow_hashref;
1119 return $loanlength->{issuelength}
1120 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1122 $sth->execute( "*", $itemtype, "*" );
1123 $loanlength = $sth->fetchrow_hashref;
1124 return $loanlength->{issuelength}
1125 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1127 $sth->execute( "*", "*", "*" );
1128 $loanlength = $sth->fetchrow_hashref;
1129 return $loanlength->{issuelength}
1130 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1132 # if no rule is set => 21 days (hardcoded)
1136 =head2 GetIssuingRule
1138 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1140 FIXME - This is a copy-paste of GetLoanLength
1141 as a stop-gap. Do not wish to change API for GetLoanLength
1142 this close to release, however, Overdues::GetIssuingRules is broken.
1144 Get the issuing rule for an itemtype, a borrower type and a branch
1145 Returns a hashref from the issuingrules table.
1149 sub GetIssuingRule {
1150 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1151 my $dbh = C4::Context->dbh;
1152 my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null" );
1155 $sth->execute( $borrowertype, $itemtype, $branchcode );
1156 $irule = $sth->fetchrow_hashref;
1157 return $irule if defined($irule) ;
1159 $sth->execute( $borrowertype, "*", $branchcode );
1160 $irule = $sth->fetchrow_hashref;
1161 return $irule if defined($irule) ;
1163 $sth->execute( "*", $itemtype, $branchcode );
1164 $irule = $sth->fetchrow_hashref;
1165 return $irule if defined($irule) ;
1167 $sth->execute( "*", "*", $branchcode );
1168 $irule = $sth->fetchrow_hashref;
1169 return $irule if defined($irule) ;
1171 $sth->execute( $borrowertype, $itemtype, "*" );
1172 $irule = $sth->fetchrow_hashref;
1173 return $irule if defined($irule) ;
1175 $sth->execute( $borrowertype, "*", "*" );
1176 $irule = $sth->fetchrow_hashref;
1177 return $irule if defined($irule) ;
1179 $sth->execute( "*", $itemtype, "*" );
1180 $irule = $sth->fetchrow_hashref;
1181 return $irule if defined($irule) ;
1183 $sth->execute( "*", "*", "*" );
1184 $irule = $sth->fetchrow_hashref;
1185 return $irule if defined($irule) ;
1187 # if no rule matches,
1191 =head2 GetBranchBorrowerCircRule
1193 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1195 Retrieves circulation rule attributes that apply to the given
1196 branch and patron category, regardless of item type.
1197 The return value is a hashref containing the following key:
1199 maxissueqty - maximum number of loans that a
1200 patron of the given category can have at the given
1201 branch. If the value is undef, no limit.
1203 This will first check for a specific branch and
1204 category match from branch_borrower_circ_rules.
1206 If no rule is found, it will then check default_branch_circ_rules
1207 (same branch, default category). If no rule is found,
1208 it will then check default_borrower_circ_rules (default
1209 branch, same category), then failing that, default_circ_rules
1210 (default branch, default category).
1212 If no rule has been found in the database, it will default to
1217 C<$branchcode> and C<$categorycode> should contain the
1218 literal branch code and patron category code, respectively - no
1223 sub GetBranchBorrowerCircRule {
1224 my $branchcode = shift;
1225 my $categorycode = shift;
1227 my $branch_cat_query = "SELECT maxissueqty
1228 FROM branch_borrower_circ_rules
1229 WHERE branchcode = ?
1230 AND categorycode = ?";
1231 my $dbh = C4::Context->dbh();
1232 my $sth = $dbh->prepare($branch_cat_query);
1233 $sth->execute($branchcode, $categorycode);
1235 if ($result = $sth->fetchrow_hashref()) {
1239 # try same branch, default borrower category
1240 my $branch_query = "SELECT maxissueqty
1241 FROM default_branch_circ_rules
1242 WHERE branchcode = ?";
1243 $sth = $dbh->prepare($branch_query);
1244 $sth->execute($branchcode);
1245 if ($result = $sth->fetchrow_hashref()) {
1249 # try default branch, same borrower category
1250 my $category_query = "SELECT maxissueqty
1251 FROM default_borrower_circ_rules
1252 WHERE categorycode = ?";
1253 $sth = $dbh->prepare($category_query);
1254 $sth->execute($categorycode);
1255 if ($result = $sth->fetchrow_hashref()) {
1259 # try default branch, default borrower category
1260 my $default_query = "SELECT maxissueqty
1261 FROM default_circ_rules";
1262 $sth = $dbh->prepare($default_query);
1264 if ($result = $sth->fetchrow_hashref()) {
1268 # built-in default circulation rule
1270 maxissueqty => undef,
1274 =head2 GetBranchItemRule
1276 my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype);
1278 Retrieves circulation rule attributes that apply to the given
1279 branch and item type, regardless of patron category.
1281 The return value is a hashref containing the following key:
1283 holdallowed => Hold policy for this branch and itemtype. Possible values:
1284 0: No holds allowed.
1285 1: Holds allowed only by patrons that have the same homebranch as the item.
1286 2: Holds allowed from any patron.
1288 This searches branchitemrules in the following order:
1290 * Same branchcode and itemtype
1291 * Same branchcode, itemtype '*'
1292 * branchcode '*', same itemtype
1293 * branchcode and itemtype '*'
1295 Neither C<$branchcode> nor C<$categorycode> should be '*'.
1299 sub GetBranchItemRule {
1300 my ( $branchcode, $itemtype ) = @_;
1301 my $dbh = C4::Context->dbh();
1305 ['SELECT holdallowed
1306 FROM branch_item_rules
1307 WHERE branchcode = ?
1308 AND itemtype = ?', $branchcode, $itemtype],
1309 ['SELECT holdallowed
1310 FROM default_branch_circ_rules
1311 WHERE branchcode = ?', $branchcode],
1312 ['SELECT holdallowed
1313 FROM default_branch_item_rules
1314 WHERE itemtype = ?', $itemtype],
1315 ['SELECT holdallowed
1316 FROM default_circ_rules'],
1319 foreach my $attempt (@attempts) {
1320 my ($query, @bind_params) = @{$attempt};
1322 # Since branch/category and branch/itemtype use the same per-branch
1323 # defaults tables, we have to check that the key we want is set, not
1324 # just that a row was returned
1325 return $result if ( defined( $result->{'holdallowed'} = $dbh->selectrow_array( $query, {}, @bind_params ) ) );
1328 # built-in default circulation rule
1336 ($doreturn, $messages, $iteminformation, $borrower) =
1337 &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1343 =item C<$barcode> is the bar code of the book being returned.
1345 =item C<$branch> is the code of the branch where the book is being returned.
1347 =item C<$exemptfine> indicates that overdue charges for the item will be
1350 =item C<$dropbox> indicates that the check-in date is assumed to be
1351 yesterday, or the last non-holiday as defined in C4::Calendar . If
1352 overdue charges are applied and C<$dropbox> is true, the last charge
1353 will be removed. This assumes that the fines accrual script has run
1358 C<&AddReturn> returns a list of four items:
1360 C<$doreturn> is true iff the return succeeded.
1362 C<$messages> is a reference-to-hash giving feedback on the operation.
1363 The keys of the hash are:
1369 No item with this barcode exists. The value is C<$barcode>.
1373 The book is not currently on loan. The value is C<$barcode>.
1375 =item C<IsPermanent>
1377 The book's home branch is a permanent collection. If you have borrowed
1378 this book, you are not allowed to return it. The value is the code for
1379 the book's home branch.
1383 This book has been withdrawn/cancelled. The value should be ignored.
1385 =item C<Wrongbranch>
1387 This book has was returned to the wrong branch. The value is a hashref
1388 so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}>
1389 contain the branchcode of the incorrect and correct return library, respectively.
1393 The item was reserved. The value is a reference-to-hash whose keys are
1394 fields from the reserves table of the Koha database, and
1395 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1396 either C<Waiting>, C<Reserved>, or 0.
1400 C<$iteminformation> is a reference-to-hash, giving information about the
1401 returned item from the issues table.
1403 C<$borrower> is a reference-to-hash, giving information about the
1404 patron who last borrowed the book.
1409 my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1410 if ($branch and not GetBranchDetail($branch)) {
1411 warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'};
1414 $branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default
1419 my $validTransfert = 0;
1421 # get information on item
1422 my $itemnumber = GetItemnumberFromBarcode( $barcode );
1423 unless ($itemnumber) {
1424 return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower. bail out.
1426 my $issue = GetItemIssue($itemnumber);
1427 # warn Dumper($iteminformation);
1428 if ($issue and $issue->{borrowernumber}) {
1429 $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber})
1430 or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existant borrowernumber '$issue->{borrowernumber}'\n"
1431 . Dumper($issue) . "\n";
1433 $messages->{'NotIssued'} = $barcode;
1434 # even though item is not on loan, it may still be transferred; therefore, get current branch info
1436 # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later.
1439 my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed";
1440 # full item data, but no borrowernumber or checkout info (no issue)
1441 # we know GetItem should work because GetItemnumberFromBarcode worked
1442 my $hbr = C4::Context->preference("HomeOrHoldingBranchReturn") || "homebranch";
1443 $hbr = $item->{$hbr} || '';
1444 # item must be from items table -- issues table has branchcode and issuingbranch, not homebranch nor holdingbranch
1446 my $borrowernumber = $borrower->{'borrowernumber'} || undef; # we don't know if we had a borrower or not
1448 # check if the book is in a permanent collection....
1449 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1451 my $branches = GetBranches(); # a potentially expensive call for a non-feature.
1452 $branches->{$hbr}->{PE} and $messages->{'IsPermanent'} = $hbr;
1455 # if indy branches and returning to different branch, refuse the return
1456 if ($hbr ne $branch && C4::Context->preference("IndependantBranches")){
1457 $messages->{'Wrongbranch'} = {
1458 Wrongbranch => $branch,
1459 Rightbranch => $hbr,
1462 # bailing out here - in this case, current desired behavior
1463 # is to act as if no return ever happened at all.
1464 # FIXME - even in an indy branches situation, there should
1465 # still be an option for the library to accept the item
1466 # and transfer it to its owning library.
1467 return ( $doreturn, $messages, $issue, $borrower );
1470 if ( $item->{'wthdrawn'} ) { # book has been cancelled
1471 $messages->{'wthdrawn'} = 1;
1475 # case of a return of document (deal with issues and holdingbranch)
1477 $borrower or warn "AddReturn without current borrower";
1478 my $circControlBranch;
1480 # define circControlBranch only if dropbox mode is set
1481 # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1482 # FIXME: check issuedate > returndate, factoring in holidays
1483 $circControlBranch = _GetCircControlBranch($item,$borrower) unless ( $item->{'issuedate'} eq C4::Dates->today('iso') );;
1486 if ($borrowernumber) {
1487 MarkIssueReturned($borrowernumber, $item->{'itemnumber'}, $circControlBranch);
1488 $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right? This could be the borrower hash.
1491 ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1494 # the holdingbranch is updated if the document is returned to another location.
1495 # this is always done regardless of whether the item was on loan or not
1496 if ($item->{'holdingbranch'} ne $branch) {
1497 UpdateHoldingbranch($branch, $item->{'itemnumber'});
1498 $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1500 ModDateLastSeen( $item->{'itemnumber'} );
1502 # check if we have a transfer for this document
1503 my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} );
1505 # if we have a transfer to do, we update the line of transfers with the datearrived
1507 if ( $tobranch eq $branch ) {
1508 my $sth = C4::Context->dbh->prepare(
1509 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1511 $sth->execute( $item->{'itemnumber'} );
1512 # if we have a reservation with valid transfer, we can set it's status to 'W'
1513 C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W');
1515 $messages->{'WrongTransfer'} = $tobranch;
1516 $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1518 $validTransfert = 1;
1521 # fix up the accounts.....
1522 if ($item->{'itemlost'}) {
1523 _FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode); # can tolerate undef $borrowernumber
1524 $messages->{'WasLost'} = 1;
1527 # fix up the overdues in accounts...
1528 if ($borrowernumber) {
1529 my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox);
1530 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
1533 # find reserves.....
1534 # if we don't have a reserve with the status W, we launch the Checkreserves routine
1535 my ($resfound, $resrec) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
1537 $resrec->{'ResFound'} = $resfound;
1538 $messages->{'ResFound'} = $resrec;
1542 # Record the fact that this book was returned.
1544 $branch, 'return', '0', '',
1545 $item->{'itemnumber'},
1546 $biblio->{'itemtype'},
1550 # Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then.
1551 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1553 branchcode => $branch,
1554 categorycode => $borrower->{categorycode},
1555 item_type => $item->{itype},
1556 notification => 'CHECKIN',
1558 if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) {
1559 SendCirculationAlert({
1562 borrower => $borrower,
1567 logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'biblionumber'})
1568 if C4::Context->preference("ReturnLog");
1570 # FIXME: make this comment intelligible.
1571 #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1572 #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1574 if ($doreturn and ($branch ne $hbr) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) ){
1575 if ( C4::Context->preference("AutomaticItemReturn" ) or
1576 (C4::Context->preference("UseBranchTransferLimits") and
1577 ! IsBranchTransferAllowed($branch, $hbr, $item->{C4::Context->preference("BranchTransferLimitsType")} )
1579 $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $hbr;
1580 $debug and warn "item: " . Dumper($item);
1581 ModItemTransfer($item->{'itemnumber'}, $branch, $hbr);
1582 $messages->{'WasTransfered'} = 1;
1584 $messages->{'NeedsTransfer'} = 1; # TODO: instead of 1, specify branchcode that the transfer SHOULD go to, $item->{homebranch}
1587 return ( $doreturn, $messages, $issue, $borrower );
1590 =head2 MarkIssueReturned
1592 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate);
1594 Unconditionally marks an issue as being returned by
1595 moving the C<issues> row to C<old_issues> and
1596 setting C<returndate> to the current date, or
1597 the last non-holiday date of the branccode specified in
1598 C<dropbox_branch> . Assumes you've already checked that
1599 it's safe to do this, i.e. last non-holiday > issuedate.
1601 if C<$returndate> is specified (in iso format), it is used as the date
1602 of the return. It is ignored when a dropbox_branch is passed in.
1604 Ideally, this function would be internal to C<C4::Circulation>,
1605 not exported, but it is currently needed by one
1606 routine in C<C4::Accounts>.
1610 sub MarkIssueReturned {
1611 my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate ) = @_;
1612 my $dbh = C4::Context->dbh;
1613 my $query = "UPDATE issues SET returndate=";
1615 if ($dropbox_branch) {
1616 my $calendar = C4::Calendar->new( branchcode => $dropbox_branch );
1617 my $dropboxdate = $calendar->addDate( C4::Dates->new(), -1 );
1619 push @bind, $dropboxdate->output('iso');
1620 } elsif ($returndate) {
1622 push @bind, $returndate;
1624 $query .= " now() ";
1626 $query .= " WHERE borrowernumber = ? AND itemnumber = ?";
1627 push @bind, $borrowernumber, $itemnumber;
1629 my $sth_upd = $dbh->prepare($query);
1630 $sth_upd->execute(@bind);
1631 my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1632 WHERE borrowernumber = ?
1633 AND itemnumber = ?");
1634 $sth_copy->execute($borrowernumber, $itemnumber);
1635 my $sth_del = $dbh->prepare("DELETE FROM issues
1636 WHERE borrowernumber = ?
1637 AND itemnumber = ?");
1638 $sth_del->execute($borrowernumber, $itemnumber);
1641 =head2 _FixOverduesOnReturn
1643 &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1645 C<$brn> borrowernumber
1649 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1650 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1652 Internal function, called only by AddReturn
1656 sub _FixOverduesOnReturn {
1657 my ($borrowernumber, $item);
1658 unless ($borrowernumber = shift) {
1659 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
1662 unless ($item = shift) {
1663 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
1666 my ($exemptfine, $dropbox) = @_;
1667 my $dbh = C4::Context->dbh;
1669 # check for overdue fine
1670 my $sth = $dbh->prepare(
1671 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1673 $sth->execute( $borrowernumber, $item );
1675 # alter fine to show that the book has been returned
1676 my $data = $sth->fetchrow_hashref;
1677 return 0 unless $data; # no warning, there's just nothing to fix
1680 my @bind = ($borrowernumber, $item, $data->{'accountno'});
1682 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1683 if (C4::Context->preference("FinesLog")) {
1684 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1686 } elsif ($dropbox && $data->{lastincrement}) {
1687 my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1688 my $amt = $data->{amount} - $data->{lastincrement} ;
1689 if (C4::Context->preference("FinesLog")) {
1690 &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1692 $uquery = "update accountlines set accounttype='F' ";
1693 if($outstanding >= 0 && $amt >=0) {
1694 $uquery .= ", amount = ? , amountoutstanding=? ";
1695 unshift @bind, ($amt, $outstanding) ;
1698 $uquery = "update accountlines set accounttype='F' ";
1700 $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1701 my $usth = $dbh->prepare($uquery);
1702 return $usth->execute(@bind);
1705 =head2 _FixAccountForLostAndReturned
1707 &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
1709 Calculates the charge for a book lost and returned.
1711 Internal function, not exported, called only by AddReturn.
1713 FIXME: This function reflects how inscrutable fines logic is. Fix both.
1714 FIXME: Give a positive return value on success. It might be the $borrowernumber who received credit, or the amount forgiven.
1718 sub _FixAccountForLostAndReturned {
1719 my $itemnumber = shift or return;
1720 my $borrowernumber = @_ ? shift : undef;
1721 my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description
1722 my $dbh = C4::Context->dbh;
1723 # check for charge made for lost book
1724 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1725 $sth->execute($itemnumber);
1726 my $data = $sth->fetchrow_hashref;
1727 $data or return; # bail if there is nothing to do
1729 # writeoff this amount
1731 my $amount = $data->{'amount'};
1732 my $acctno = $data->{'accountno'};
1733 my $amountleft; # Starts off undef/zero.
1734 if ($data->{'amountoutstanding'} == $amount) {
1735 $offset = $data->{'amount'};
1736 $amountleft = 0; # Hey, it's zero here, too.
1738 $offset = $amount - $data->{'amountoutstanding'}; # Um, isn't this the same as ZERO? We just tested those two things are ==
1739 $amountleft = $data->{'amountoutstanding'} - $amount; # Um, isn't this the same as ZERO? We just tested those two things are ==
1741 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1742 WHERE (borrowernumber = ?)
1743 AND (itemnumber = ?) AND (accountno = ?) ");
1744 $usth->execute($data->{'borrowernumber'},$itemnumber,$acctno); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in.
1745 #check if any credit is left if so writeoff other accounts
1746 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1747 $amountleft *= -1 if ($amountleft < 0);
1748 if ($amountleft > 0) {
1749 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1750 AND (amountoutstanding >0) ORDER BY date"); # might want to order by amountoustanding ASC (pay smallest first)
1751 $msth->execute($data->{'borrowernumber'});
1752 # offset transactions
1755 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1756 if ($accdata->{'amountoutstanding'} < $amountleft) {
1758 $amountleft -= $accdata->{'amountoutstanding'};
1760 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1763 my $thisacct = $accdata->{'accountno'};
1764 # FIXME: move prepares outside while loop!
1765 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1766 WHERE (borrowernumber = ?)
1767 AND (accountno=?)");
1768 $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct'); # FIXME: '$thisacct' is a string literal!
1769 $usth = $dbh->prepare("INSERT INTO accountoffsets
1770 (borrowernumber, accountno, offsetaccount, offsetamount)
1773 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1775 $msth->finish; # $msth might actually have data left
1777 $amountleft *= -1 if ($amountleft > 0);
1778 my $desc = "Item Returned " . $item_id;
1779 $usth = $dbh->prepare("INSERT INTO accountlines
1780 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1781 VALUES (?,?,now(),?,?,'CR',?)");
1782 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1783 if ($borrowernumber) {
1784 # FIXME: same as query above. use 1 sth for both
1785 $usth = $dbh->prepare("INSERT INTO accountoffsets
1786 (borrowernumber, accountno, offsetaccount, offsetamount)
1788 $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
1790 ModItem({ paidfor => '' }, undef, $itemnumber);
1794 =head2 _GetCircControlBranch
1796 my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
1800 Return the library code to be used to determine which circulation
1801 policy applies to a transaction. Looks up the CircControl and
1802 HomeOrHoldingBranch system preferences.
1804 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
1806 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
1810 sub _GetCircControlBranch {
1811 my ($item, $borrower) = @_;
1812 my $circcontrol = C4::Context->preference('CircControl');
1815 if ($circcontrol eq 'PickupLibrary') {
1816 $branch= C4::Context->userenv->{'branch'};
1817 } elsif ($circcontrol eq 'PatronLibrary') {
1818 $branch=$borrower->{branchcode};
1820 my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch';
1821 $branch = $item->{$branchfield};
1822 # default to item home branch if holdingbranch is used
1823 # and is not defined
1824 if (!defined($branch) && $branchfield eq 'holdingbranch') {
1825 $branch = $item->{homebranch};
1838 $issue = &GetItemIssue($itemnumber);
1840 Returns patron currently having a book, or undef if not checked out.
1842 C<$itemnumber> is the itemnumber.
1844 C<$issue> is a hashref of the row from the issues table.
1849 my ($itemnumber) = @_;
1850 return unless $itemnumber;
1851 my $sth = C4::Context->dbh->prepare(
1854 LEFT JOIN items ON issues.itemnumber=items.itemnumber
1855 WHERE issues.itemnumber=?");
1856 $sth->execute($itemnumber);
1857 my $data = $sth->fetchrow_hashref;
1858 return unless $data;
1859 $data->{'overdue'} = ($data->{'date_due'} lt C4::Dates->today('iso')) ? 1 : 0;
1865 $issue = GetOpenIssue( $itemnumber );
1867 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
1869 C<$itemnumber> is the item's itemnumber
1876 my ( $itemnumber ) = @_;
1878 my $dbh = C4::Context->dbh;
1879 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
1880 $sth->execute( $itemnumber );
1881 my $issue = $sth->fetchrow_hashref();
1885 =head2 GetItemIssues
1887 $issues = &GetItemIssues($itemnumber, $history);
1889 Returns patrons that have issued a book
1891 C<$itemnumber> is the itemnumber
1892 C<$history> is false if you just want the current "issuer" (if any)
1893 and true if you want issues history from old_issues also.
1895 Returns reference to an array of hashes
1900 my ( $itemnumber, $history ) = @_;
1902 my $today = C4::Dates->today('iso'); # get today date
1903 my $sql = "SELECT * FROM issues
1904 JOIN borrowers USING (borrowernumber)
1905 JOIN items USING (itemnumber)
1906 WHERE issues.itemnumber = ? ";
1909 SELECT * FROM old_issues
1910 LEFT JOIN borrowers USING (borrowernumber)
1911 JOIN items USING (itemnumber)
1912 WHERE old_issues.itemnumber = ? ";
1914 $sql .= "ORDER BY date_due DESC";
1915 my $sth = C4::Context->dbh->prepare($sql);
1917 $sth->execute($itemnumber, $itemnumber);
1919 $sth->execute($itemnumber);
1921 my $results = $sth->fetchall_arrayref({});
1922 foreach (@$results) {
1923 $_->{'overdue'} = ($_->{'date_due'} lt $today) ? 1 : 0;
1928 =head2 GetBiblioIssues
1930 $issues = GetBiblioIssues($biblionumber);
1932 this function get all issues from a biblionumber.
1935 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1936 tables issues and the firstname,surname & cardnumber from borrowers.
1940 sub GetBiblioIssues {
1941 my $biblionumber = shift;
1942 return undef unless $biblionumber;
1943 my $dbh = C4::Context->dbh;
1945 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1947 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1948 LEFT JOIN items ON issues.itemnumber = items.itemnumber
1949 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1950 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1951 WHERE biblio.biblionumber = ?
1953 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1955 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1956 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1957 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1958 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1959 WHERE biblio.biblionumber = ?
1962 my $sth = $dbh->prepare($query);
1963 $sth->execute($biblionumber, $biblionumber);
1966 while ( my $data = $sth->fetchrow_hashref ) {
1967 push @issues, $data;
1972 =head2 GetUpcomingDueIssues
1974 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
1978 sub GetUpcomingDueIssues {
1981 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
1982 my $dbh = C4::Context->dbh;
1984 my $statement = <<END_SQL;
1985 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due
1987 LEFT JOIN items USING (itemnumber)
1988 WhERE returndate is NULL
1989 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
1992 my @bind_parameters = ( $params->{'days_in_advance'} );
1994 my $sth = $dbh->prepare( $statement );
1995 $sth->execute( @bind_parameters );
1996 my $upcoming_dues = $sth->fetchall_arrayref({});
1999 return $upcoming_dues;
2002 =head2 CanBookBeRenewed
2004 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2006 Find out whether a borrowed item may be renewed.
2008 C<$dbh> is a DBI handle to the Koha database.
2010 C<$borrowernumber> is the borrower number of the patron who currently
2011 has the item on loan.
2013 C<$itemnumber> is the number of the item to renew.
2015 C<$override_limit>, if supplied with a true value, causes
2016 the limit on the number of times that the loan can be renewed
2017 (as controlled by the item type) to be ignored.
2019 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
2020 item must currently be on loan to the specified borrower; renewals
2021 must be allowed for the item's type; and the borrower must not have
2022 already renewed the loan. $error will contain the reason the renewal can not proceed
2026 sub CanBookBeRenewed {
2028 # check renewal status
2029 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2030 my $dbh = C4::Context->dbh;
2035 # Look in the issues table for this item, lent to this borrower,
2036 # and not yet returned.
2038 # Look in the issues table for this item, lent to this borrower,
2039 # and not yet returned.
2041 'ItemHomeLibrary' => 'items.homebranch',
2042 'PickupLibrary' => 'items.holdingbranch',
2043 'PatronLibrary' => 'borrowers.branchcode'
2045 my $controlbranch = $branch{C4::Context->preference('CircControl')};
2046 my $itype = C4::Context->preference('item-level_itypes') ? 'items.itype' : 'biblioitems.itemtype';
2048 my $sthcount = $dbh->prepare("
2050 borrowers.categorycode, biblioitems.itemtype, issues.renewals, renewalsallowed, $controlbranch
2053 LEFT JOIN items USING (itemnumber)
2054 LEFT JOIN borrowers USING (borrowernumber)
2055 LEFT JOIN biblioitems USING (biblioitemnumber)
2058 (issuingrules.categorycode = borrowers.categorycode OR issuingrules.categorycode = '*')
2060 (issuingrules.itemtype = $itype OR issuingrules.itemtype = '*')
2062 (issuingrules.branchcode = $controlbranch OR issuingrules.branchcode = '*')
2068 issuingrules.categorycode desc,
2069 issuingrules.itemtype desc,
2070 issuingrules.branchcode desc
2074 $sthcount->execute( $borrowernumber, $itemnumber );
2075 if ( my $data1 = $sthcount->fetchrow_hashref ) {
2077 if ( ( $data1->{renewalsallowed} && $data1->{renewalsallowed} > $data1->{renewals} ) || $override_limit ) {
2084 my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
2091 return ($renewokay,$error);
2096 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2100 C<$borrowernumber> is the borrower number of the patron who currently
2103 C<$itemnumber> is the number of the item to renew.
2105 C<$branch> is the library where the renewal took place (if any).
2106 The library that controls the circ policies for the renewal is retrieved from the issues record.
2108 C<$datedue> can be a C4::Dates object used to set the due date.
2110 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
2111 this parameter is not supplied, lastreneweddate is set to the current date.
2113 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2114 from the book's item type.
2119 my $borrowernumber = shift or return undef;
2120 my $itemnumber = shift or return undef;
2122 my $datedue = shift;
2123 my $lastreneweddate = shift || C4::Dates->new()->output('iso');
2124 my $item = GetItem($itemnumber) or return undef;
2125 my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
2127 my $dbh = C4::Context->dbh;
2128 # Find the issues record for this book
2130 $dbh->prepare("SELECT * FROM issues
2131 WHERE borrowernumber=?
2134 $sth->execute( $borrowernumber, $itemnumber );
2135 my $issuedata = $sth->fetchrow_hashref;
2137 if($datedue && ! $datedue->output('iso')){
2138 warn "Invalid date passed to AddRenewal.";
2141 # If the due date wasn't specified, calculate it by adding the
2142 # book's loan length to today's date or the current due date
2143 # based on the value of the RenewalPeriodBase syspref.
2146 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
2147 my $loanlength = GetLoanLength(
2148 $borrower->{'categorycode'},
2149 (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
2150 $issuedata->{'branchcode'} ); # that's the circ control branch.
2152 $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2153 C4::Dates->new($issuedata->{date_due}, 'iso') :
2155 $datedue = CalcDateDue($datedue,$loanlength,$issuedata->{'branchcode'},$borrower);
2158 # Update the issues record to have the new due date, and a new count
2159 # of how many times it has been renewed.
2160 my $renews = $issuedata->{'renewals'} + 1;
2161 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2162 WHERE borrowernumber=?
2165 $sth->execute( $datedue->output('iso'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2168 # Update the renewal count on the item, and tell zebra to reindex
2169 $renews = $biblio->{'renewals'} + 1;
2170 ModItem({ renewals => $renews, onloan => $datedue->output('iso') }, $biblio->{'biblionumber'}, $itemnumber);
2172 # Charge a new rental fee, if applicable?
2173 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2174 if ( $charge > 0 ) {
2175 my $accountno = getnextacctno( $borrowernumber );
2176 my $item = GetBiblioFromItemNumber($itemnumber);
2177 $sth = $dbh->prepare(
2178 "INSERT INTO accountlines
2180 borrowernumber, accountno, amount,
2182 accounttype, amountoutstanding, itemnumber
2184 VALUES (now(),?,?,?,?,?,?,?)"
2186 $sth->execute( $borrowernumber, $accountno, $charge,
2187 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2188 'Rent', $charge, $itemnumber );
2192 UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2197 # check renewal status
2198 my ( $bornum, $itemno ) = @_;
2199 my $dbh = C4::Context->dbh;
2201 my $renewsallowed = 0;
2204 my $borrower = C4::Members::GetMemberDetails($bornum);
2205 my $item = GetItem($itemno);
2207 # Look in the issues table for this item, lent to this borrower,
2208 # and not yet returned.
2210 # FIXME - I think this function could be redone to use only one SQL call.
2211 my $sth = $dbh->prepare(
2212 "select * from issues
2213 where (borrowernumber = ?)
2214 and (itemnumber = ?)"
2216 $sth->execute( $bornum, $itemno );
2217 my $data = $sth->fetchrow_hashref;
2218 $renewcount = $data->{'renewals'} if $data->{'renewals'};
2220 # $item and $borrower should be calculated
2221 my $branchcode = _GetCircControlBranch($item, $borrower);
2223 my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
2225 $renewsallowed = $issuingrule->{'renewalsallowed'};
2226 $renewsleft = $renewsallowed - $renewcount;
2227 if($renewsleft < 0){ $renewsleft = 0; }
2228 return ( $renewcount, $renewsallowed, $renewsleft );
2231 =head2 GetIssuingCharges
2233 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2235 Calculate how much it would cost for a given patron to borrow a given
2236 item, including any applicable discounts.
2238 C<$itemnumber> is the item number of item the patron wishes to borrow.
2240 C<$borrowernumber> is the patron's borrower number.
2242 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2243 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2248 sub GetIssuingCharges {
2250 # calculate charges due
2251 my ( $itemnumber, $borrowernumber ) = @_;
2253 my $dbh = C4::Context->dbh;
2256 # Get the book's item type and rental charge (via its biblioitem).
2257 my $qcharge = "SELECT itemtypes.itemtype,rentalcharge FROM items
2258 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
2259 $qcharge .= (C4::Context->preference('item-level_itypes'))
2260 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2261 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2263 $qcharge .= "WHERE items.itemnumber =?";
2265 my $sth1 = $dbh->prepare($qcharge);
2266 $sth1->execute($itemnumber);
2267 if ( my $data1 = $sth1->fetchrow_hashref ) {
2268 $item_type = $data1->{'itemtype'};
2269 $charge = $data1->{'rentalcharge'};
2270 my $q2 = "SELECT rentaldiscount FROM borrowers
2271 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2272 WHERE borrowers.borrowernumber = ?
2273 AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')";
2274 my $sth2 = $dbh->prepare($q2);
2275 $sth2->execute( $borrowernumber, $item_type );
2276 if ( my $data2 = $sth2->fetchrow_hashref ) {
2277 my $discount = $data2->{'rentaldiscount'};
2278 if ( $discount eq 'NULL' ) {
2281 $charge = ( $charge * ( 100 - $discount ) ) / 100;
2287 return ( $charge, $item_type );
2290 =head2 AddIssuingCharge
2292 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2296 sub AddIssuingCharge {
2297 my ( $itemnumber, $borrowernumber, $charge ) = @_;
2298 my $dbh = C4::Context->dbh;
2299 my $nextaccntno = getnextacctno( $borrowernumber );
2301 INSERT INTO accountlines
2302 (borrowernumber, itemnumber, accountno,
2303 date, amount, description, accounttype,
2305 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
2307 my $sth = $dbh->prepare($query);
2308 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
2314 GetTransfers($itemnumber);
2319 my ($itemnumber) = @_;
2321 my $dbh = C4::Context->dbh;
2327 FROM branchtransfers
2328 WHERE itemnumber = ?
2329 AND datearrived IS NULL
2331 my $sth = $dbh->prepare($query);
2332 $sth->execute($itemnumber);
2333 my @row = $sth->fetchrow_array();
2338 =head2 GetTransfersFromTo
2340 @results = GetTransfersFromTo($frombranch,$tobranch);
2342 Returns the list of pending transfers between $from and $to branch
2346 sub GetTransfersFromTo {
2347 my ( $frombranch, $tobranch ) = @_;
2348 return unless ( $frombranch && $tobranch );
2349 my $dbh = C4::Context->dbh;
2351 SELECT itemnumber,datesent,frombranch
2352 FROM branchtransfers
2355 AND datearrived IS NULL
2357 my $sth = $dbh->prepare($query);
2358 $sth->execute( $frombranch, $tobranch );
2361 while ( my $data = $sth->fetchrow_hashref ) {
2362 push @gettransfers, $data;
2365 return (@gettransfers);
2368 =head2 DeleteTransfer
2370 &DeleteTransfer($itemnumber);
2374 sub DeleteTransfer {
2375 my ($itemnumber) = @_;
2376 my $dbh = C4::Context->dbh;
2377 my $sth = $dbh->prepare(
2378 "DELETE FROM branchtransfers
2380 AND datearrived IS NULL "
2382 $sth->execute($itemnumber);
2386 =head2 AnonymiseIssueHistory
2388 $rows = AnonymiseIssueHistory($borrowernumber,$date)
2390 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2391 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2393 return the number of affected rows.
2397 sub AnonymiseIssueHistory {
2399 my $borrowernumber = shift;
2400 my $dbh = C4::Context->dbh;
2403 SET borrowernumber = NULL
2404 WHERE returndate < '".$date."'
2405 AND borrowernumber IS NOT NULL
2407 $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2408 my $rows_affected = $dbh->do($query);
2409 return $rows_affected;
2412 =head2 SendCirculationAlert
2414 Send out a C<check-in> or C<checkout> alert using the messaging system.
2422 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
2426 Hashref of information about the item being checked in or out.
2430 Hashref of information about the borrower of the item.
2434 The branchcode from where the checkout or check-in took place.
2440 SendCirculationAlert({
2443 borrower => $borrower,
2449 sub SendCirculationAlert {
2451 my ($type, $item, $borrower, $branch) =
2452 ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
2453 my %message_name = (
2454 CHECKIN => 'Item Check-in',
2455 CHECKOUT => 'Item Checkout',
2457 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
2458 borrowernumber => $borrower->{borrowernumber},
2459 message_name => $message_name{$type},
2461 my $letter = C4::Letters::getletter('circulation', $type);
2462 C4::Letters::parseletter($letter, 'biblio', $item->{biblionumber});
2463 C4::Letters::parseletter($letter, 'biblioitems', $item->{biblionumber});
2464 C4::Letters::parseletter($letter, 'borrowers', $borrower->{borrowernumber});
2465 C4::Letters::parseletter($letter, 'branches', $branch);
2466 my @transports = @{ $borrower_preferences->{transports} };
2467 # warn "no transports" unless @transports;
2469 # warn "transport: $_";
2470 my $message = C4::Message->find_last_message($borrower, $type, $_);
2472 #warn "create new message";
2473 C4::Message->enqueue($letter, $borrower, $_);
2475 #warn "append to old message";
2476 $message->append($letter);
2483 =head2 updateWrongTransfer
2485 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2487 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
2491 sub updateWrongTransfer {
2492 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2493 my $dbh = C4::Context->dbh;
2494 # first step validate the actual line of transfert .
2497 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2499 $sth->execute($FromLibrary,$itemNumber);
2502 # second step create a new line of branchtransfer to the right location .
2503 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2505 #third step changing holdingbranch of item
2506 UpdateHoldingbranch($FromLibrary,$itemNumber);
2509 =head2 UpdateHoldingbranch
2511 $items = UpdateHoldingbranch($branch,$itmenumber);
2513 Simple methode for updating hodlingbranch in items BDD line
2517 sub UpdateHoldingbranch {
2518 my ( $branch,$itemnumber ) = @_;
2519 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2524 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2525 this function calculates the due date given the loan length ,
2526 checking against the holidays calendar as per the 'useDaysMode' syspref.
2527 C<$startdate> = C4::Dates object representing start date of loan period (assumed to be today)
2528 C<$branch> = location whose calendar to use
2529 C<$loanlength> = loan length prior to adjustment
2533 my ($startdate,$loanlength,$branch,$borrower) = @_;
2536 if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar
2537 my $timedue = time + ($loanlength) * 86400;
2538 #FIXME - assumes now even though we take a startdate
2539 my @datearr = localtime($timedue);
2540 $datedue = C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2542 my $calendar = C4::Calendar->new( branchcode => $branch );
2543 $datedue = $calendar->addDate($startdate, $loanlength);
2546 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
2547 if ( C4::Context->preference('ReturnBeforeExpiry') && $datedue->output('iso') gt $borrower->{dateexpiry} ) {
2548 $datedue = C4::Dates->new( $borrower->{dateexpiry}, 'iso' );
2551 # if ceilingDueDate ON the datedue can't be after the ceiling date
2552 if ( C4::Context->preference('ceilingDueDate')
2553 && ( C4::Context->preference('ceilingDueDate') =~ C4::Dates->regexp('syspref') ) ) {
2554 my $ceilingDate = C4::Dates->new( C4::Context->preference('ceilingDueDate') );
2555 if ( $datedue->output( 'iso' ) gt $ceilingDate->output( 'iso' ) ) {
2556 $datedue = $ceilingDate;
2563 =head2 CheckValidDatedue
2565 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2567 This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2568 To be replaced by CalcDateDue() once C4::Calendar use is tested.
2570 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2571 C<$date_due> = returndate calculate with no day check
2572 C<$itemnumber> = itemnumber
2573 C<$branchcode> = location of issue (affected by 'CircControl' syspref)
2574 C<$loanlength> = loan length prior to adjustment
2578 sub CheckValidDatedue {
2579 my ($date_due,$itemnumber,$branchcode)=@_;
2580 my @datedue=split('-',$date_due->output('iso'));
2581 my $years=$datedue[0];
2582 my $month=$datedue[1];
2583 my $day=$datedue[2];
2584 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2586 for (my $i=0;$i<2;$i++){
2587 $dow=Day_of_Week($years,$month,$day);
2588 ($dow=0) if ($dow>6);
2589 my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2590 my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2591 my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2592 if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2594 (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2597 my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2602 =head2 CheckRepeatableHolidays
2604 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2606 This function checks if the date due is a repeatable holiday
2608 C<$date_due> = returndate calculate with no day check
2609 C<$itemnumber> = itemnumber
2610 C<$branchcode> = localisation of issue
2614 sub CheckRepeatableHolidays{
2615 my($itemnumber,$week_day,$branchcode)=@_;
2616 my $dbh = C4::Context->dbh;
2617 my $query = qq|SELECT count(*)
2618 FROM repeatable_holidays
2621 my $sth = $dbh->prepare($query);
2622 $sth->execute($branchcode,$week_day);
2623 my $result=$sth->fetchrow;
2629 =head2 CheckSpecialHolidays
2631 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2633 This function check if the date is a special holiday
2635 C<$years> = the years of datedue
2636 C<$month> = the month of datedue
2637 C<$day> = the day of datedue
2638 C<$itemnumber> = itemnumber
2639 C<$branchcode> = localisation of issue
2643 sub CheckSpecialHolidays{
2644 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2645 my $dbh = C4::Context->dbh;
2646 my $query=qq|SELECT count(*)
2647 FROM `special_holidays`
2653 my $sth = $dbh->prepare($query);
2654 $sth->execute($years,$month,$day,$branchcode);
2655 my $countspecial=$sth->fetchrow ;
2657 return $countspecial;
2660 =head2 CheckRepeatableSpecialHolidays
2662 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2664 This function check if the date is a repeatble special holidays
2666 C<$month> = the month of datedue
2667 C<$day> = the day of datedue
2668 C<$itemnumber> = itemnumber
2669 C<$branchcode> = localisation of issue
2673 sub CheckRepeatableSpecialHolidays{
2674 my ($month,$day,$itemnumber,$branchcode) = @_;
2675 my $dbh = C4::Context->dbh;
2676 my $query=qq|SELECT count(*)
2677 FROM `repeatable_holidays`
2682 my $sth = $dbh->prepare($query);
2683 $sth->execute($month,$day,$branchcode);
2684 my $countspecial=$sth->fetchrow ;
2686 return $countspecial;
2691 sub CheckValidBarcode{
2693 my $dbh = C4::Context->dbh;
2694 my $query=qq|SELECT count(*)
2698 my $sth = $dbh->prepare($query);
2699 $sth->execute($barcode);
2700 my $exist=$sth->fetchrow ;
2705 =head2 IsBranchTransferAllowed
2707 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
2709 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
2713 sub IsBranchTransferAllowed {
2714 my ( $toBranch, $fromBranch, $code ) = @_;
2716 if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
2718 my $limitType = C4::Context->preference("BranchTransferLimitsType");
2719 my $dbh = C4::Context->dbh;
2721 my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
2722 $sth->execute( $toBranch, $fromBranch, $code );
2723 my $limit = $sth->fetchrow_hashref();
2725 ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
2726 if ( $limit->{'limitId'} ) {
2733 =head2 CreateBranchTransferLimit
2735 CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
2737 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
2741 sub CreateBranchTransferLimit {
2742 my ( $toBranch, $fromBranch, $code ) = @_;
2744 my $limitType = C4::Context->preference("BranchTransferLimitsType");
2746 my $dbh = C4::Context->dbh;
2748 my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
2749 $sth->execute( $code, $toBranch, $fromBranch );
2752 =head2 DeleteBranchTransferLimits
2754 DeleteBranchTransferLimits();
2758 sub DeleteBranchTransferLimits {
2759 my $dbh = C4::Context->dbh;
2760 my $sth = $dbh->prepare("TRUNCATE TABLE branch_transfer_limits");
2771 Koha Development Team <http://koha-community.org/>