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 = $item->{C4
::Context
->preference("HomeOrHoldingBranch")} || '';
1443 # item must be from items table -- issues table has branchcode and issuingbranch, not homebranch nor holdingbranch
1445 my $borrowernumber = $borrower->{'borrowernumber'} || undef; # we don't know if we had a borrower or not
1447 # check if the book is in a permanent collection....
1448 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1450 my $branches = GetBranches
(); # a potentially expensive call for a non-feature.
1451 $branches->{$hbr}->{PE
} and $messages->{'IsPermanent'} = $hbr;
1454 # if indy branches and returning to different branch, refuse the return
1455 if ($hbr ne $branch && C4
::Context
->preference("IndependantBranches")){
1456 $messages->{'Wrongbranch'} = {
1457 Wrongbranch
=> $branch,
1458 Rightbranch
=> $hbr,
1461 # bailing out here - in this case, current desired behavior
1462 # is to act as if no return ever happened at all.
1463 # FIXME - even in an indy branches situation, there should
1464 # still be an option for the library to accept the item
1465 # and transfer it to its owning library.
1466 return ( $doreturn, $messages, $issue, $borrower );
1469 if ( $item->{'wthdrawn'} ) { # book has been cancelled
1470 $messages->{'wthdrawn'} = 1;
1474 # case of a return of document (deal with issues and holdingbranch)
1476 $borrower or warn "AddReturn without current borrower";
1477 my $circControlBranch;
1479 # define circControlBranch only if dropbox mode is set
1480 # don't allow dropbox mode to create an invalid entry in issues (issuedate > today)
1481 # FIXME: check issuedate > returndate, factoring in holidays
1482 $circControlBranch = _GetCircControlBranch
($item,$borrower) unless ( $item->{'issuedate'} eq C4
::Dates
->today('iso') );;
1485 if ($borrowernumber) {
1486 MarkIssueReturned
($borrowernumber, $item->{'itemnumber'}, $circControlBranch);
1487 $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right? This could be the borrower hash.
1490 ModItem
({ onloan
=> undef }, $issue->{'biblionumber'}, $item->{'itemnumber'});
1493 # the holdingbranch is updated if the document is returned to another location.
1494 # this is always done regardless of whether the item was on loan or not
1495 if ($item->{'holdingbranch'} ne $branch) {
1496 UpdateHoldingbranch
($branch, $item->{'itemnumber'});
1497 $item->{'holdingbranch'} = $branch; # update item data holdingbranch too
1499 ModDateLastSeen
( $item->{'itemnumber'} );
1501 # check if we have a transfer for this document
1502 my ($datesent,$frombranch,$tobranch) = GetTransfers
( $item->{'itemnumber'} );
1504 # if we have a transfer to do, we update the line of transfers with the datearrived
1506 if ( $tobranch eq $branch ) {
1507 my $sth = C4
::Context
->dbh->prepare(
1508 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1510 $sth->execute( $item->{'itemnumber'} );
1511 # if we have a reservation with valid transfer, we can set it's status to 'W'
1512 C4
::Reserves
::ModReserveStatus
($item->{'itemnumber'}, 'W');
1514 $messages->{'WrongTransfer'} = $tobranch;
1515 $messages->{'WrongTransferItem'} = $item->{'itemnumber'};
1517 $validTransfert = 1;
1520 # fix up the accounts.....
1521 if ($item->{'itemlost'}) {
1522 _FixAccountForLostAndReturned
($item->{'itemnumber'}, $borrowernumber, $barcode); # can tolerate undef $borrowernumber
1523 $messages->{'WasLost'} = 1;
1526 # fix up the overdues in accounts...
1527 if ($borrowernumber) {
1528 my $fix = _FixOverduesOnReturn
($borrowernumber, $item->{itemnumber
}, $exemptfine, $dropbox);
1529 defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined
1532 # find reserves.....
1533 # if we don't have a reserve with the status W, we launch the Checkreserves routine
1534 my ($resfound, $resrec) = C4
::Reserves
::CheckReserves
( $item->{'itemnumber'} );
1536 $resrec->{'ResFound'} = $resfound;
1537 $messages->{'ResFound'} = $resrec;
1541 # Record the fact that this book was returned.
1543 $branch, 'return', '0', '',
1544 $item->{'itemnumber'},
1545 $biblio->{'itemtype'},
1549 # Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then.
1550 my $circulation_alert = 'C4::ItemCirculationAlertPreference';
1552 branchcode
=> $branch,
1553 categorycode
=> $borrower->{categorycode
},
1554 item_type
=> $item->{itype
},
1555 notification
=> 'CHECKIN',
1557 if ($doreturn && $circulation_alert->is_enabled_for(\
%conditions)) {
1558 SendCirculationAlert
({
1561 borrower
=> $borrower,
1566 logaction
("CIRCULATION", "RETURN", $borrowernumber, $item->{'biblionumber'})
1567 if C4
::Context
->preference("ReturnLog");
1569 # FIXME: make this comment intelligible.
1570 #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1571 #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1573 if ($doreturn and ($branch ne $hbr) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) ){
1574 if ( C4
::Context
->preference("AutomaticItemReturn" ) or
1575 (C4
::Context
->preference("UseBranchTransferLimits") and
1576 ! IsBranchTransferAllowed
($branch, $hbr, $item->{C4
::Context
->preference("BranchTransferLimitsType")} )
1578 $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $hbr;
1579 $debug and warn "item: " . Dumper
($item);
1580 ModItemTransfer
($item->{'itemnumber'}, $branch, $hbr);
1581 $messages->{'WasTransfered'} = 1;
1583 $messages->{'NeedsTransfer'} = 1; # TODO: instead of 1, specify branchcode that the transfer SHOULD go to, $item->{homebranch}
1586 return ( $doreturn, $messages, $issue, $borrower );
1589 =head2 MarkIssueReturned
1591 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate);
1593 Unconditionally marks an issue as being returned by
1594 moving the C<issues> row to C<old_issues> and
1595 setting C<returndate> to the current date, or
1596 the last non-holiday date of the branccode specified in
1597 C<dropbox_branch> . Assumes you've already checked that
1598 it's safe to do this, i.e. last non-holiday > issuedate.
1600 if C<$returndate> is specified (in iso format), it is used as the date
1601 of the return. It is ignored when a dropbox_branch is passed in.
1603 Ideally, this function would be internal to C<C4::Circulation>,
1604 not exported, but it is currently needed by one
1605 routine in C<C4::Accounts>.
1609 sub MarkIssueReturned
{
1610 my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate ) = @_;
1611 my $dbh = C4
::Context
->dbh;
1612 my $query = "UPDATE issues SET returndate=";
1614 if ($dropbox_branch) {
1615 my $calendar = C4
::Calendar
->new( branchcode
=> $dropbox_branch );
1616 my $dropboxdate = $calendar->addDate( C4
::Dates
->new(), -1 );
1618 push @bind, $dropboxdate->output('iso');
1619 } elsif ($returndate) {
1621 push @bind, $returndate;
1623 $query .= " now() ";
1625 $query .= " WHERE borrowernumber = ? AND itemnumber = ?";
1626 push @bind, $borrowernumber, $itemnumber;
1628 my $sth_upd = $dbh->prepare($query);
1629 $sth_upd->execute(@bind);
1630 my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1631 WHERE borrowernumber = ?
1632 AND itemnumber = ?");
1633 $sth_copy->execute($borrowernumber, $itemnumber);
1634 my $sth_del = $dbh->prepare("DELETE FROM issues
1635 WHERE borrowernumber = ?
1636 AND itemnumber = ?");
1637 $sth_del->execute($borrowernumber, $itemnumber);
1640 =head2 _FixOverduesOnReturn
1642 &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1644 C<$brn> borrowernumber
1648 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1649 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1651 Internal function, called only by AddReturn
1655 sub _FixOverduesOnReturn
{
1656 my ($borrowernumber, $item);
1657 unless ($borrowernumber = shift) {
1658 warn "_FixOverduesOnReturn() not supplied valid borrowernumber";
1661 unless ($item = shift) {
1662 warn "_FixOverduesOnReturn() not supplied valid itemnumber";
1665 my ($exemptfine, $dropbox) = @_;
1666 my $dbh = C4
::Context
->dbh;
1668 # check for overdue fine
1669 my $sth = $dbh->prepare(
1670 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1672 $sth->execute( $borrowernumber, $item );
1674 # alter fine to show that the book has been returned
1675 my $data = $sth->fetchrow_hashref;
1676 return 0 unless $data; # no warning, there's just nothing to fix
1679 my @bind = ($borrowernumber, $item, $data->{'accountno'});
1681 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1682 if (C4
::Context
->preference("FinesLog")) {
1683 &logaction
("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1685 } elsif ($dropbox && $data->{lastincrement
}) {
1686 my $outstanding = $data->{amountoutstanding
} - $data->{lastincrement
} ;
1687 my $amt = $data->{amount
} - $data->{lastincrement
} ;
1688 if (C4
::Context
->preference("FinesLog")) {
1689 &logaction
("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1691 $uquery = "update accountlines set accounttype='F' ";
1692 if($outstanding >= 0 && $amt >=0) {
1693 $uquery .= ", amount = ? , amountoutstanding=? ";
1694 unshift @bind, ($amt, $outstanding) ;
1697 $uquery = "update accountlines set accounttype='F' ";
1699 $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1700 my $usth = $dbh->prepare($uquery);
1701 return $usth->execute(@bind);
1704 =head2 _FixAccountForLostAndReturned
1706 &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]);
1708 Calculates the charge for a book lost and returned.
1710 Internal function, not exported, called only by AddReturn.
1712 FIXME: This function reflects how inscrutable fines logic is. Fix both.
1713 FIXME: Give a positive return value on success. It might be the $borrowernumber who received credit, or the amount forgiven.
1717 sub _FixAccountForLostAndReturned
{
1718 my $itemnumber = shift or return;
1719 my $borrowernumber = @_ ?
shift : undef;
1720 my $item_id = @_ ?
shift : $itemnumber; # Send the barcode if you want that logged in the description
1721 my $dbh = C4
::Context
->dbh;
1722 # check for charge made for lost book
1723 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1724 $sth->execute($itemnumber);
1725 my $data = $sth->fetchrow_hashref;
1726 $data or return; # bail if there is nothing to do
1728 # writeoff this amount
1730 my $amount = $data->{'amount'};
1731 my $acctno = $data->{'accountno'};
1732 my $amountleft; # Starts off undef/zero.
1733 if ($data->{'amountoutstanding'} == $amount) {
1734 $offset = $data->{'amount'};
1735 $amountleft = 0; # Hey, it's zero here, too.
1737 $offset = $amount - $data->{'amountoutstanding'}; # Um, isn't this the same as ZERO? We just tested those two things are ==
1738 $amountleft = $data->{'amountoutstanding'} - $amount; # Um, isn't this the same as ZERO? We just tested those two things are ==
1740 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1741 WHERE (borrowernumber = ?)
1742 AND (itemnumber = ?) AND (accountno = ?) ");
1743 $usth->execute($data->{'borrowernumber'},$itemnumber,$acctno); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in.
1744 #check if any credit is left if so writeoff other accounts
1745 my $nextaccntno = getnextacctno
($data->{'borrowernumber'});
1746 $amountleft *= -1 if ($amountleft < 0);
1747 if ($amountleft > 0) {
1748 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1749 AND (amountoutstanding >0) ORDER BY date"); # might want to order by amountoustanding ASC (pay smallest first)
1750 $msth->execute($data->{'borrowernumber'});
1751 # offset transactions
1754 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1755 if ($accdata->{'amountoutstanding'} < $amountleft) {
1757 $amountleft -= $accdata->{'amountoutstanding'};
1759 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1762 my $thisacct = $accdata->{'accountno'};
1763 # FIXME: move prepares outside while loop!
1764 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1765 WHERE (borrowernumber = ?)
1766 AND (accountno=?)");
1767 $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct'); # FIXME: '$thisacct' is a string literal!
1768 $usth = $dbh->prepare("INSERT INTO accountoffsets
1769 (borrowernumber, accountno, offsetaccount, offsetamount)
1772 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1774 $msth->finish; # $msth might actually have data left
1776 $amountleft *= -1 if ($amountleft > 0);
1777 my $desc = "Item Returned " . $item_id;
1778 $usth = $dbh->prepare("INSERT INTO accountlines
1779 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1780 VALUES (?,?,now(),?,?,'CR',?)");
1781 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1782 if ($borrowernumber) {
1783 # FIXME: same as query above. use 1 sth for both
1784 $usth = $dbh->prepare("INSERT INTO accountoffsets
1785 (borrowernumber, accountno, offsetaccount, offsetamount)
1787 $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset);
1789 ModItem
({ paidfor
=> '' }, undef, $itemnumber);
1793 =head2 _GetCircControlBranch
1795 my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower);
1799 Return the library code to be used to determine which circulation
1800 policy applies to a transaction. Looks up the CircControl and
1801 HomeOrHoldingBranch system preferences.
1803 C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used.
1805 C<$borrower> is a hashref to borrower. Only {branchcode} is used.
1809 sub _GetCircControlBranch
{
1810 my ($item, $borrower) = @_;
1811 my $circcontrol = C4
::Context
->preference('CircControl');
1814 if ($circcontrol eq 'PickupLibrary') {
1815 $branch= C4
::Context
->userenv->{'branch'};
1816 } elsif ($circcontrol eq 'PatronLibrary') {
1817 $branch=$borrower->{branchcode
};
1819 my $branchfield = C4
::Context
->preference('HomeOrHoldingBranch') || 'homebranch';
1820 $branch = $item->{$branchfield};
1821 # default to item home branch if holdingbranch is used
1822 # and is not defined
1823 if (!defined($branch) && $branchfield eq 'holdingbranch') {
1824 $branch = $item->{homebranch
};
1837 $issue = &GetItemIssue($itemnumber);
1839 Returns patron currently having a book, or undef if not checked out.
1841 C<$itemnumber> is the itemnumber.
1843 C<$issue> is a hashref of the row from the issues table.
1848 my ($itemnumber) = @_;
1849 return unless $itemnumber;
1850 my $sth = C4
::Context
->dbh->prepare(
1853 LEFT JOIN items ON issues.itemnumber=items.itemnumber
1854 WHERE issues.itemnumber=?");
1855 $sth->execute($itemnumber);
1856 my $data = $sth->fetchrow_hashref;
1857 return unless $data;
1858 $data->{'overdue'} = ($data->{'date_due'} lt C4
::Dates
->today('iso')) ?
1 : 0;
1864 $issue = GetOpenIssue( $itemnumber );
1866 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
1868 C<$itemnumber> is the item's itemnumber
1875 my ( $itemnumber ) = @_;
1877 my $dbh = C4
::Context
->dbh;
1878 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
1879 $sth->execute( $itemnumber );
1880 my $issue = $sth->fetchrow_hashref();
1884 =head2 GetItemIssues
1886 $issues = &GetItemIssues($itemnumber, $history);
1888 Returns patrons that have issued a book
1890 C<$itemnumber> is the itemnumber
1891 C<$history> is false if you just want the current "issuer" (if any)
1892 and true if you want issues history from old_issues also.
1894 Returns reference to an array of hashes
1899 my ( $itemnumber, $history ) = @_;
1901 my $today = C4
::Dates
->today('iso'); # get today date
1902 my $sql = "SELECT * FROM issues
1903 JOIN borrowers USING (borrowernumber)
1904 JOIN items USING (itemnumber)
1905 WHERE issues.itemnumber = ? ";
1908 SELECT * FROM old_issues
1909 LEFT JOIN borrowers USING (borrowernumber)
1910 JOIN items USING (itemnumber)
1911 WHERE old_issues.itemnumber = ? ";
1913 $sql .= "ORDER BY date_due DESC";
1914 my $sth = C4
::Context
->dbh->prepare($sql);
1916 $sth->execute($itemnumber, $itemnumber);
1918 $sth->execute($itemnumber);
1920 my $results = $sth->fetchall_arrayref({});
1921 foreach (@
$results) {
1922 $_->{'overdue'} = ($_->{'date_due'} lt $today) ?
1 : 0;
1927 =head2 GetBiblioIssues
1929 $issues = GetBiblioIssues($biblionumber);
1931 this function get all issues from a biblionumber.
1934 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1935 tables issues and the firstname,surname & cardnumber from borrowers.
1939 sub GetBiblioIssues
{
1940 my $biblionumber = shift;
1941 return undef unless $biblionumber;
1942 my $dbh = C4
::Context
->dbh;
1944 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1946 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1947 LEFT JOIN items ON issues.itemnumber = items.itemnumber
1948 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1949 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1950 WHERE biblio.biblionumber = ?
1952 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1954 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1955 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1956 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1957 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1958 WHERE biblio.biblionumber = ?
1961 my $sth = $dbh->prepare($query);
1962 $sth->execute($biblionumber, $biblionumber);
1965 while ( my $data = $sth->fetchrow_hashref ) {
1966 push @issues, $data;
1971 =head2 GetUpcomingDueIssues
1973 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
1977 sub GetUpcomingDueIssues
{
1980 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
1981 my $dbh = C4
::Context
->dbh;
1983 my $statement = <<END_SQL;
1984 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due
1986 LEFT JOIN items USING (itemnumber)
1987 WhERE returndate is NULL
1988 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
1991 my @bind_parameters = ( $params->{'days_in_advance'} );
1993 my $sth = $dbh->prepare( $statement );
1994 $sth->execute( @bind_parameters );
1995 my $upcoming_dues = $sth->fetchall_arrayref({});
1998 return $upcoming_dues;
2001 =head2 CanBookBeRenewed
2003 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
2005 Find out whether a borrowed item may be renewed.
2007 C<$dbh> is a DBI handle to the Koha database.
2009 C<$borrowernumber> is the borrower number of the patron who currently
2010 has the item on loan.
2012 C<$itemnumber> is the number of the item to renew.
2014 C<$override_limit>, if supplied with a true value, causes
2015 the limit on the number of times that the loan can be renewed
2016 (as controlled by the item type) to be ignored.
2018 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
2019 item must currently be on loan to the specified borrower; renewals
2020 must be allowed for the item's type; and the borrower must not have
2021 already renewed the loan. $error will contain the reason the renewal can not proceed
2025 sub CanBookBeRenewed {
2027 # check renewal status
2028 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
2029 my $dbh = C4::Context->dbh;
2034 # Look in the issues table for this item, lent to this borrower,
2035 # and not yet returned.
2037 # Look in the issues table for this item, lent to this borrower,
2038 # and not yet returned.
2040 'ItemHomeLibrary' => 'items.homebranch',
2041 'PickupLibrary' => 'items.holdingbranch',
2042 'PatronLibrary' => 'borrowers.branchcode'
2044 my $controlbranch = $branch{C4::Context->preference('CircControl')};
2045 my $itype = C4::Context->preference('item-level_itypes') ? 'items.itype' : 'biblioitems.itemtype';
2047 my $sthcount = $dbh->prepare("
2049 borrowers.categorycode, biblioitems.itemtype, issues.renewals, renewalsallowed, $controlbranch
2052 LEFT JOIN items USING (itemnumber)
2053 LEFT JOIN borrowers USING (borrowernumber)
2054 LEFT JOIN biblioitems USING (biblioitemnumber)
2057 (issuingrules.categorycode = borrowers.categorycode OR issuingrules.categorycode = '*')
2059 (issuingrules.itemtype = $itype OR issuingrules.itemtype = '*')
2061 (issuingrules.branchcode = $controlbranch OR issuingrules.branchcode = '*')
2067 issuingrules.categorycode desc,
2068 issuingrules.itemtype desc,
2069 issuingrules.branchcode desc
2073 $sthcount->execute( $borrowernumber, $itemnumber );
2074 if ( my $data1 = $sthcount->fetchrow_hashref ) {
2076 if ( ( $data1->{renewalsallowed} && $data1->{renewalsallowed} > $data1->{renewals} ) || $override_limit ) {
2083 my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
2090 return ($renewokay,$error);
2095 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
2099 C<$borrowernumber> is the borrower number of the patron who currently
2102 C<$itemnumber> is the number of the item to renew.
2104 C<$branch> is the library where the renewal took place (if any).
2105 The library that controls the circ policies for the renewal is retrieved from the issues record.
2107 C<$datedue> can be a C4::Dates object used to set the due date.
2109 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
2110 this parameter is not supplied, lastreneweddate is set to the current date.
2112 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2113 from the book's item type.
2118 my $borrowernumber = shift or return undef;
2119 my $itemnumber = shift or return undef;
2121 my $datedue = shift;
2122 my $lastreneweddate = shift || C4::Dates->new()->output('iso');
2123 my $item = GetItem($itemnumber) or return undef;
2124 my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
2126 my $dbh = C4::Context->dbh;
2127 # Find the issues record for this book
2129 $dbh->prepare("SELECT * FROM issues
2130 WHERE borrowernumber=?
2133 $sth->execute( $borrowernumber, $itemnumber );
2134 my $issuedata = $sth->fetchrow_hashref;
2136 if($datedue && ! $datedue->output('iso')){
2137 warn "Invalid date passed to AddRenewal.";
2140 # If the due date wasn't specified, calculate it by adding the
2141 # book's loan length to today's date or the current due date
2142 # based on the value of the RenewalPeriodBase syspref.
2145 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
2146 my $loanlength = GetLoanLength(
2147 $borrower->{'categorycode'},
2148 (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
2149 $issuedata->{'branchcode'} ); # that's the circ control branch.
2151 $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ?
2152 C4::Dates->new($issuedata->{date_due}, 'iso') :
2154 $datedue = CalcDateDue($datedue,$loanlength,$issuedata->{'branchcode'},$borrower);
2157 # Update the issues record to have the new due date, and a new count
2158 # of how many times it has been renewed.
2159 my $renews = $issuedata->{'renewals'} + 1;
2160 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2161 WHERE borrowernumber=?
2164 $sth->execute( $datedue->output('iso'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2167 # Update the renewal count on the item, and tell zebra to reindex
2168 $renews = $biblio->{'renewals'} + 1;
2169 ModItem({ renewals => $renews, onloan => $datedue->output('iso') }, $biblio->{'biblionumber'}, $itemnumber);
2171 # Charge a new rental fee, if applicable?
2172 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2173 if ( $charge > 0 ) {
2174 my $accountno = getnextacctno( $borrowernumber );
2175 my $item = GetBiblioFromItemNumber($itemnumber);
2176 $sth = $dbh->prepare(
2177 "INSERT INTO accountlines
2179 borrowernumber, accountno, amount,
2181 accounttype, amountoutstanding, itemnumber
2183 VALUES (now(),?,?,?,?,?,?,?)"
2185 $sth->execute( $borrowernumber, $accountno, $charge,
2186 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2187 'Rent', $charge, $itemnumber );
2191 UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2196 # check renewal status
2197 my ( $bornum, $itemno ) = @_;
2198 my $dbh = C4::Context->dbh;
2200 my $renewsallowed = 0;
2203 my $borrower = C4::Members::GetMemberDetails($bornum);
2204 my $item = GetItem($itemno);
2206 # Look in the issues table for this item, lent to this borrower,
2207 # and not yet returned.
2209 # FIXME - I think this function could be redone to use only one SQL call.
2210 my $sth = $dbh->prepare(
2211 "select * from issues
2212 where (borrowernumber = ?)
2213 and (itemnumber = ?)"
2215 $sth->execute( $bornum, $itemno );
2216 my $data = $sth->fetchrow_hashref;
2217 $renewcount = $data->{'renewals'} if $data->{'renewals'};
2219 # $item and $borrower should be calculated
2220 my $branchcode = _GetCircControlBranch($item, $borrower);
2222 my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode);
2224 $renewsallowed = $issuingrule->{'renewalsallowed'};
2225 $renewsleft = $renewsallowed - $renewcount;
2226 if($renewsleft < 0){ $renewsleft = 0; }
2227 return ( $renewcount, $renewsallowed, $renewsleft );
2230 =head2 GetIssuingCharges
2232 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2234 Calculate how much it would cost for a given patron to borrow a given
2235 item, including any applicable discounts.
2237 C<$itemnumber> is the item number of item the patron wishes to borrow.
2239 C<$borrowernumber> is the patron's borrower number.
2241 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2242 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2247 sub GetIssuingCharges {
2249 # calculate charges due
2250 my ( $itemnumber, $borrowernumber ) = @_;
2252 my $dbh = C4::Context->dbh;
2255 # Get the book's item type and rental charge (via its biblioitem).
2256 my $qcharge = "SELECT itemtypes.itemtype,rentalcharge FROM items
2257 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
2258 $qcharge .= (C4::Context->preference('item-level_itypes'))
2259 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2260 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2262 $qcharge .= "WHERE items.itemnumber =?";
2264 my $sth1 = $dbh->prepare($qcharge);
2265 $sth1->execute($itemnumber);
2266 if ( my $data1 = $sth1->fetchrow_hashref ) {
2267 $item_type = $data1->{'itemtype'};
2268 $charge = $data1->{'rentalcharge'};
2269 my $q2 = "SELECT rentaldiscount FROM borrowers
2270 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2271 WHERE borrowers.borrowernumber = ?
2272 AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*')";
2273 my $sth2 = $dbh->prepare($q2);
2274 $sth2->execute( $borrowernumber, $item_type );
2275 if ( my $data2 = $sth2->fetchrow_hashref ) {
2276 my $discount = $data2->{'rentaldiscount'};
2277 if ( $discount eq 'NULL' ) {
2280 $charge = ( $charge * ( 100 - $discount ) ) / 100;
2286 return ( $charge, $item_type );
2289 =head2 AddIssuingCharge
2291 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2295 sub AddIssuingCharge {
2296 my ( $itemnumber, $borrowernumber, $charge ) = @_;
2297 my $dbh = C4::Context->dbh;
2298 my $nextaccntno = getnextacctno( $borrowernumber );
2300 INSERT INTO accountlines
2301 (borrowernumber, itemnumber, accountno,
2302 date, amount, description, accounttype,
2304 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
2306 my $sth = $dbh->prepare($query);
2307 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
2313 GetTransfers($itemnumber);
2318 my ($itemnumber) = @_;
2320 my $dbh = C4::Context->dbh;
2326 FROM branchtransfers
2327 WHERE itemnumber = ?
2328 AND datearrived IS NULL
2330 my $sth = $dbh->prepare($query);
2331 $sth->execute($itemnumber);
2332 my @row = $sth->fetchrow_array();
2337 =head2 GetTransfersFromTo
2339 @results = GetTransfersFromTo($frombranch,$tobranch);
2341 Returns the list of pending transfers between $from and $to branch
2345 sub GetTransfersFromTo {
2346 my ( $frombranch, $tobranch ) = @_;
2347 return unless ( $frombranch && $tobranch );
2348 my $dbh = C4::Context->dbh;
2350 SELECT itemnumber,datesent,frombranch
2351 FROM branchtransfers
2354 AND datearrived IS NULL
2356 my $sth = $dbh->prepare($query);
2357 $sth->execute( $frombranch, $tobranch );
2360 while ( my $data = $sth->fetchrow_hashref ) {
2361 push @gettransfers, $data;
2364 return (@gettransfers);
2367 =head2 DeleteTransfer
2369 &DeleteTransfer($itemnumber);
2373 sub DeleteTransfer {
2374 my ($itemnumber) = @_;
2375 my $dbh = C4::Context->dbh;
2376 my $sth = $dbh->prepare(
2377 "DELETE FROM branchtransfers
2379 AND datearrived IS NULL "
2381 $sth->execute($itemnumber);
2385 =head2 AnonymiseIssueHistory
2387 $rows = AnonymiseIssueHistory($borrowernumber,$date)
2389 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2390 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2392 return the number of affected rows.
2396 sub AnonymiseIssueHistory {
2398 my $borrowernumber = shift;
2399 my $dbh = C4::Context->dbh;
2402 SET borrowernumber = NULL
2403 WHERE returndate < '".$date."'
2404 AND borrowernumber IS NOT NULL
2406 $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2407 my $rows_affected = $dbh->do($query);
2408 return $rows_affected;
2411 =head2 SendCirculationAlert
2413 Send out a C<check-in> or C<checkout> alert using the messaging system.
2421 Valid values for this parameter are: C<CHECKIN> and C<CHECKOUT>.
2425 Hashref of information about the item being checked in or out.
2429 Hashref of information about the borrower of the item.
2433 The branchcode from where the checkout or check-in took place.
2439 SendCirculationAlert({
2442 borrower => $borrower,
2448 sub SendCirculationAlert {
2450 my ($type, $item, $borrower, $branch) =
2451 ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch});
2452 my %message_name = (
2453 CHECKIN => 'Item Check-in',
2454 CHECKOUT => 'Item Checkout',
2456 my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({
2457 borrowernumber => $borrower->{borrowernumber},
2458 message_name => $message_name{$type},
2460 my $letter = C4::Letters::getletter('circulation', $type);
2461 C4::Letters::parseletter($letter, 'biblio', $item->{biblionumber});
2462 C4::Letters::parseletter($letter, 'biblioitems', $item->{biblionumber});
2463 C4::Letters::parseletter($letter, 'borrowers', $borrower->{borrowernumber});
2464 C4::Letters::parseletter($letter, 'branches', $branch);
2465 my @transports = @{ $borrower_preferences->{transports} };
2466 # warn "no transports" unless @transports;
2468 # warn "transport: $_";
2469 my $message = C4::Message->find_last_message($borrower, $type, $_);
2471 #warn "create new message";
2472 C4::Message->enqueue($letter, $borrower, $_);
2474 #warn "append to old message";
2475 $message->append($letter);
2482 =head2 updateWrongTransfer
2484 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2486 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
2490 sub updateWrongTransfer {
2491 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2492 my $dbh = C4::Context->dbh;
2493 # first step validate the actual line of transfert .
2496 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2498 $sth->execute($FromLibrary,$itemNumber);
2501 # second step create a new line of branchtransfer to the right location .
2502 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2504 #third step changing holdingbranch of item
2505 UpdateHoldingbranch($FromLibrary,$itemNumber);
2508 =head2 UpdateHoldingbranch
2510 $items = UpdateHoldingbranch($branch,$itmenumber);
2512 Simple methode for updating hodlingbranch in items BDD line
2516 sub UpdateHoldingbranch {
2517 my ( $branch,$itemnumber ) = @_;
2518 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2523 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2524 this function calculates the due date given the loan length ,
2525 checking against the holidays calendar as per the 'useDaysMode' syspref.
2526 C<$startdate> = C4::Dates object representing start date of loan period (assumed to be today)
2527 C<$branch> = location whose calendar to use
2528 C<$loanlength> = loan length prior to adjustment
2532 my ($startdate,$loanlength,$branch,$borrower) = @_;
2535 if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar
2536 my $timedue = time + ($loanlength) * 86400;
2537 #FIXME - assumes now even though we take a startdate
2538 my @datearr = localtime($timedue);
2539 $datedue = C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2541 my $calendar = C4::Calendar->new( branchcode => $branch );
2542 $datedue = $calendar->addDate($startdate, $loanlength);
2545 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
2546 if ( C4::Context->preference('ReturnBeforeExpiry') && $datedue->output('iso') gt $borrower->{dateexpiry} ) {
2547 $datedue = C4::Dates->new( $borrower->{dateexpiry}, 'iso' );
2550 # if ceilingDueDate ON the datedue can't be after the ceiling date
2551 if ( C4::Context->preference('ceilingDueDate')
2552 && ( C4::Context->preference('ceilingDueDate') =~ C4::Dates->regexp('syspref') ) ) {
2553 my $ceilingDate = C4::Dates->new( C4::Context->preference('ceilingDueDate') );
2554 if ( $datedue->output( 'iso' ) gt $ceilingDate->output( 'iso' ) ) {
2555 $datedue = $ceilingDate;
2562 =head2 CheckValidDatedue
2564 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2566 This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2567 To be replaced by CalcDateDue() once C4::Calendar use is tested.
2569 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2570 C<$date_due> = returndate calculate with no day check
2571 C<$itemnumber> = itemnumber
2572 C<$branchcode> = location of issue (affected by 'CircControl' syspref)
2573 C<$loanlength> = loan length prior to adjustment
2577 sub CheckValidDatedue {
2578 my ($date_due,$itemnumber,$branchcode)=@_;
2579 my @datedue=split('-',$date_due->output('iso'));
2580 my $years=$datedue[0];
2581 my $month=$datedue[1];
2582 my $day=$datedue[2];
2583 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2585 for (my $i=0;$i<2;$i++){
2586 $dow=Day_of_Week($years,$month,$day);
2587 ($dow=0) if ($dow>6);
2588 my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2589 my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2590 my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2591 if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2593 (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2596 my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2601 =head2 CheckRepeatableHolidays
2603 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2605 This function checks if the date due is a repeatable holiday
2607 C<$date_due> = returndate calculate with no day check
2608 C<$itemnumber> = itemnumber
2609 C<$branchcode> = localisation of issue
2613 sub CheckRepeatableHolidays{
2614 my($itemnumber,$week_day,$branchcode)=@_;
2615 my $dbh = C4::Context->dbh;
2616 my $query = qq|SELECT count(*)
2617 FROM repeatable_holidays
2620 my $sth = $dbh->prepare($query);
2621 $sth->execute($branchcode,$week_day);
2622 my $result=$sth->fetchrow;
2628 =head2 CheckSpecialHolidays
2630 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2632 This function check if the date is a special holiday
2634 C<$years> = the years of datedue
2635 C<$month> = the month of datedue
2636 C<$day> = the day of datedue
2637 C<$itemnumber> = itemnumber
2638 C<$branchcode> = localisation of issue
2642 sub CheckSpecialHolidays{
2643 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2644 my $dbh = C4::Context->dbh;
2645 my $query=qq|SELECT count(*)
2646 FROM `special_holidays`
2652 my $sth = $dbh->prepare($query);
2653 $sth->execute($years,$month,$day,$branchcode);
2654 my $countspecial=$sth->fetchrow ;
2656 return $countspecial;
2659 =head2 CheckRepeatableSpecialHolidays
2661 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2663 This function check if the date is a repeatble special holidays
2665 C<$month> = the month of datedue
2666 C<$day> = the day of datedue
2667 C<$itemnumber> = itemnumber
2668 C<$branchcode> = localisation of issue
2672 sub CheckRepeatableSpecialHolidays{
2673 my ($month,$day,$itemnumber,$branchcode) = @_;
2674 my $dbh = C4::Context->dbh;
2675 my $query=qq|SELECT count(*)
2676 FROM `repeatable_holidays`
2681 my $sth = $dbh->prepare($query);
2682 $sth->execute($month,$day,$branchcode);
2683 my $countspecial=$sth->fetchrow ;
2685 return $countspecial;
2690 sub CheckValidBarcode{
2692 my $dbh = C4::Context->dbh;
2693 my $query=qq|SELECT count(*)
2697 my $sth = $dbh->prepare($query);
2698 $sth->execute($barcode);
2699 my $exist=$sth->fetchrow ;
2704 =head2 IsBranchTransferAllowed
2706 $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code );
2708 Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType
2712 sub IsBranchTransferAllowed {
2713 my ( $toBranch, $fromBranch, $code ) = @_;
2715 if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed.
2717 my $limitType = C4::Context->preference("BranchTransferLimitsType");
2718 my $dbh = C4::Context->dbh;
2720 my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?");
2721 $sth->execute( $toBranch, $fromBranch, $code );
2722 my $limit = $sth->fetchrow_hashref();
2724 ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed*
2725 if ( $limit->{'limitId'} ) {
2732 =head2 CreateBranchTransferLimit
2734 CreateBranchTransferLimit( $toBranch, $fromBranch, $code );
2736 $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to.
2740 sub CreateBranchTransferLimit {
2741 my ( $toBranch, $fromBranch, $code ) = @_;
2743 my $limitType = C4::Context->preference("BranchTransferLimitsType");
2745 my $dbh = C4::Context->dbh;
2747 my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )");
2748 $sth->execute( $code, $toBranch, $fromBranch );
2751 =head2 DeleteBranchTransferLimits
2753 DeleteBranchTransferLimits();
2757 sub DeleteBranchTransferLimits {
2758 my $dbh = C4::Context->dbh;
2759 my $sth = $dbh->prepare("TRUNCATE TABLE branch_transfer_limits");
2770 Koha Development Team <http://koha-community.org/>