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 with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
42 use POSIX qw(strftime);
43 use C4::Branch; # GetBranches
44 use C4::Log; # logaction
48 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
51 # set the version for version checking
55 # FIXME subs that should probably be elsewhere
61 # subs to deal with issuing a book
74 &AnonymiseIssueHistory
77 # subs to deal with returns
83 # subs to deal with transfers
95 C4::Circulation - Koha circulation module
103 The functions in this module deal with circulation, issues, and
104 returns, as well as general information about the library.
105 Also deals with stocktaking.
111 =head3 $str = &barcodedecode($barcode);
115 =item Generic filter function for barcode string.
116 Called on every circ if the System Pref itemBarcodeInputFilter is set.
117 Will do some manipulation of the barcode for systems that deliver a barcode
118 to circulation.pl that differs from the barcode stored for the item.
119 For proper functioning of this filter, calling the function on the
120 correct barcode string (items.barcode) should return an unaltered barcode.
126 # FIXME -- the &decode fcn below should be wrapped into this one.
127 # FIXME -- these plugins should be moved out of Circulation.pm
131 my $filter = C4::Context->preference('itemBarcodeInputFilter');
132 if($filter eq 'whitespace') {
135 } elsif($filter eq 'cuecat') {
137 my @fields = split( /\./, $barcode );
138 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
139 if ( $#results == 2 ) {
145 } elsif($filter eq 'T-prefix') {
146 if ( $barcode =~ /^[Tt]/) {
147 if (substr($barcode,1,1) eq '0') {
150 $barcode = substr($barcode,2) + 0 ;
153 return sprintf( "T%07d",$barcode);
159 =head3 $str = &decode($chunk);
163 =item Decodes a segment of a string emitted by a CueCat barcode scanner and
173 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
174 my @s = map { index( $seq, $_ ); } split( //, $encoded );
175 my $l = ( $#s + 1 ) % 4;
186 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
188 chr( ( $n >> 16 ) ^ 67 )
189 .chr( ( $n >> 8 & 255 ) ^ 67 )
190 .chr( ( $n & 255 ) ^ 67 );
193 $r = substr( $r, 0, length($r) - $l );
199 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, $barcode, $ignore_reserves);
201 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
203 C<$newbranch> is the code for the branch to which the item should be transferred.
205 C<$barcode> is the barcode of the item to be transferred.
207 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
208 Otherwise, if an item is reserved, the transfer fails.
210 Returns three values:
214 is true if the transfer was successful.
218 is a reference-to-hash which may have any of the following keys:
224 There is no item in the catalog with the given barcode. The value is C<$barcode>.
228 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.
230 =item C<DestinationEqualsHolding>
232 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.
236 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.
240 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>.
242 =item C<WasTransferred>
244 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
251 my ( $tbr, $barcode, $ignoreRs ) = @_;
254 my $branches = GetBranches();
255 my $itemnumber = GetItemnumberFromBarcode( $barcode );
256 my $issue = GetItemIssue($itemnumber);
257 my $biblio = GetBiblioFromItemNumber($itemnumber);
260 if ( not $itemnumber ) {
261 $messages->{'BadBarcode'} = $barcode;
265 # get branches of book...
266 my $hbr = $biblio->{'homebranch'};
267 my $fbr = $biblio->{'holdingbranch'};
270 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
271 $messages->{'IsPermanent'} = $hbr;
274 # can't transfer book if is already there....
275 if ( $fbr eq $tbr ) {
276 $messages->{'DestinationEqualsHolding'} = 1;
280 # check if it is still issued to someone, return it...
281 if ($issue->{borrowernumber}) {
282 AddReturn( $barcode, $fbr );
283 $messages->{'WasReturned'} = $issue->{borrowernumber};
287 # That'll save a database query.
288 my ( $resfound, $resrec ) =
289 CheckReserves( $itemnumber );
290 if ( $resfound and not $ignoreRs ) {
291 $resrec->{'ResFound'} = $resfound;
293 # $messages->{'ResFound'} = $resrec;
297 #actually do the transfer....
299 ModItemTransfer( $itemnumber, $fbr, $tbr );
301 # don't need to update MARC anymore, we do it in batch now
302 $messages->{'WasTransfered'} = 1;
303 ModDateLastSeen( $itemnumber );
305 return ( $dotransfer, $messages, $biblio );
308 =head2 CanBookBeIssued
310 Check if a book can be issued.
312 my ($issuingimpossible,$needsconfirmation) = CanBookBeIssued($borrower,$barcode,$year,$month,$day);
316 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
318 =item C<$barcode> is the bar code of the book being issued.
320 =item C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate".
328 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
329 Possible values are :
335 sticky due date is invalid
339 borrower gone with no address
343 borrower declared it's card lost
349 =head3 UNKNOWN_BARCODE
363 item is restricted (set by ??)
365 C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
366 Possible values are :
374 renewing, not issuing
376 =head3 ISSUED_TO_ANOTHER
378 issued to someone else.
382 reserved for someone else.
386 sticky due date is invalid
390 if the borrower borrows to much things
394 # check if a book can be issued.
398 my $borrower = shift;
399 my $biblionumber = shift;
401 my $cat_borrower = $borrower->{'categorycode'};
402 my $dbh = C4::Context->dbh;
404 # Get which branchcode we need
405 if (C4::Context->preference('CircControl') eq 'PickupLibrary'){
406 $branch = C4::Context->userenv->{'branch'};
408 elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){
409 $branch = $borrower->{'branchcode'};
413 $branch = $item->{'homebranch'};
415 my $type = (C4::Context->preference('item-level_itypes'))
416 ? $item->{'itype'} # item-level
417 : $item->{'itemtype'}; # biblio-level
421 'SELECT * FROM issuingrules
422 WHERE categorycode = ?
427 my $query2 = "SELECT COUNT(*) FROM issues i, biblioitems s1, items s2
428 WHERE i.borrowernumber = ?
429 AND i.itemnumber = s2.itemnumber
430 AND s1.biblioitemnumber = s2.biblioitemnumber";
431 if (C4::Context->preference('item-level_itypes')){
432 $query2.=" AND s2.itype=? ";
434 $query2.=" AND s1.itemtype= ? ";
436 my $sth2= $dbh->prepare($query2);
439 'SELECT COUNT(*) FROM issues
440 WHERE borrowernumber = ?'
444 # check the 3 parameters (branch / itemtype / category code
445 $sth->execute( $cat_borrower, $type, $branch );
446 my $result = $sth->fetchrow_hashref;
447 # warn "$cat_borrower, $type, $branch = ".Data::Dumper::Dumper($result);
448 if ( $result->{maxissueqty} ne '' ) {
449 # warn "checking on everything set";
450 $sth2->execute( $borrower->{'borrowernumber'}, $type );
451 my $alreadyissued = $sth2->fetchrow;
452 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
453 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/itemtype failed)" );
455 # now checking for total
456 $sth->execute( $cat_borrower, '*', $branch );
457 my $result = $sth->fetchrow_hashref;
458 if ( $result->{maxissueqty} ne '' ) {
459 $sth3->execute( $borrower->{'borrowernumber'} );
460 my $alreadyissued = $sth3->fetchrow;
461 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
462 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/total failed)" );
467 # check the 2 parameters (branch / itemtype / default categorycode
468 $sth->execute( '*', $type, $branch );
469 $result = $sth->fetchrow_hashref;
470 # warn "*, $type, $branch = ".Data::Dumper::Dumper($result);
472 if ( $result->{maxissueqty} ne '' ) {
473 # warn "checking on 2 parameters (default categorycode)";
474 $sth2->execute( $borrower->{'borrowernumber'}, $type );
475 my $alreadyissued = $sth2->fetchrow;
476 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
477 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / itemtype failed)" );
479 # now checking for total
480 $sth->execute( '*', '*', $branch );
481 my $result = $sth->fetchrow_hashref;
482 if ( $result->{maxissueqty} ne '' ) {
483 $sth3->execute( $borrower->{'borrowernumber'} );
484 my $alreadyissued = $sth3->fetchrow;
485 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
486 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / total failed)" );
491 # check the 1 parameters (default branch / itemtype / categorycode
492 $sth->execute( $cat_borrower, $type, '*' );
493 $result = $sth->fetchrow_hashref;
494 # warn "$cat_borrower, $type, * = ".Data::Dumper::Dumper($result);
496 if ( $result->{maxissueqty} ne '' ) {
497 # warn "checking on 1 parameter (default branch + categorycode)";
498 $sth2->execute( $borrower->{'borrowernumber'}, $type );
499 my $alreadyissued = $sth2->fetchrow;
500 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
501 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch/category/itemtype failed)" );
503 # now checking for total
504 $sth->execute( $cat_borrower, '*', '*' );
505 my $result = $sth->fetchrow_hashref;
506 if ( $result->{maxissueqty} ne '' ) {
507 $sth3->execute( $borrower->{'borrowernumber'} );
508 my $alreadyissued = $sth3->fetchrow;
509 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
510 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / category / total failed)" );
515 # check the 0 parameters (default branch / itemtype / default categorycode
516 $sth->execute( '*', $type, '*' );
517 $result = $sth->fetchrow_hashref;
518 # warn "*, $type, * = ".Data::Dumper::Dumper($result);
520 if ( $result->{maxissueqty} ne '' ) {
521 # warn "checking on default branch and default categorycode";
522 $sth2->execute( $borrower->{'borrowernumber'}, $type );
523 my $alreadyissued = $sth2->fetchrow;
524 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
525 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / itemtype failed)" );
528 # now checking for total
529 $sth->execute( '*', '*', '*' );
530 $result = $sth->fetchrow_hashref;
531 if ( $result->{maxissueqty} ne '' ) {
532 warn "checking total";
533 $sth2->execute( $borrower->{'borrowernumber'}, $type );
534 my $alreadyissued = $sth2->fetchrow;
535 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
536 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / total failed)" );
540 # OK, the patron can issue !!!
546 @issues = &itemissues($biblioitemnumber, $biblio);
548 Looks up information about who has borrowed the bookZ<>(s) with the
549 given biblioitemnumber.
551 C<$biblio> is ignored.
553 C<&itemissues> returns an array of references-to-hash. The keys
554 include the fields from the C<items> table in the Koha database.
555 Additional keys include:
561 If the item is currently on loan, this gives the due date.
563 If the item is not on loan, then this is either "Available" or
564 "Cancelled", if the item has been withdrawn.
568 If the item is currently on loan, this gives the card number of the
569 patron who currently has the item.
571 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
573 These give the timestamp for the last three times the item was
576 =item C<card0>, C<card1>, C<card2>
578 The card number of the last three patrons who borrowed this item.
580 =item C<borrower0>, C<borrower1>, C<borrower2>
582 The borrower number of the last three patrons who borrowed this item.
590 my ( $bibitem, $biblio ) = @_;
591 my $dbh = C4::Context->dbh;
593 $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
598 $sth->execute($bibitem) || die $sth->errstr;
600 while ( my $data = $sth->fetchrow_hashref ) {
602 # Find out who currently has this item.
603 # FIXME - Wouldn't it be better to do this as a left join of
604 # some sort? Currently, this code assumes that if
605 # fetchrow_hashref() fails, then the book is on the shelf.
606 # fetchrow_hashref() can fail for any number of reasons (e.g.,
607 # database server crash), not just because no items match the
609 my $sth2 = $dbh->prepare(
610 "SELECT * FROM issues
611 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
616 $sth2->execute( $data->{'itemnumber'} );
617 if ( my $data2 = $sth2->fetchrow_hashref ) {
618 $data->{'date_due'} = $data2->{'date_due'};
619 $data->{'card'} = $data2->{'cardnumber'};
620 $data->{'borrower'} = $data2->{'borrowernumber'};
623 $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available';
628 # Find the last 3 people who borrowed this item.
629 $sth2 = $dbh->prepare(
630 "SELECT * FROM old_issues
631 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
633 ORDER BY returndate DESC,timestamp DESC"
636 $sth2->execute( $data->{'itemnumber'} );
637 for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
638 { # FIXME : error if there is less than 3 pple borrowing this item
639 if ( my $data2 = $sth2->fetchrow_hashref ) {
640 $data->{"timestamp$i2"} = $data2->{'timestamp'};
641 $data->{"card$i2"} = $data2->{'cardnumber'};
642 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
647 $results[$i] = $data;
655 =head2 CanBookBeIssued
657 ( $issuingimpossible, $needsconfirmation ) =
658 CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess );
659 C<$duedatespec> is a C4::Dates object.
660 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
664 sub CanBookBeIssued {
665 my ( $borrower, $barcode, $duedate, $inprocess ) = @_;
666 my %needsconfirmation; # filled with problems that needs confirmations
667 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
668 my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
669 my $issue = GetItemIssue($item->{itemnumber});
670 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
671 $item->{'itemtype'}=$item->{'itype'};
672 my $dbh = C4::Context->dbh;
675 # DUE DATE is OK ? -- should already have checked.
677 #$issuingimpossible{INVALID_DATE} = 1 unless ($duedate);
682 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
683 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
684 &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'});
685 return( { STATS => 1 }, {});
687 if ( $borrower->{flags}->{GNA} ) {
688 $issuingimpossible{GNA} = 1;
690 if ( $borrower->{flags}->{'LOST'} ) {
691 $issuingimpossible{CARD_LOST} = 1;
693 if ( $borrower->{flags}->{'DBARRED'} ) {
694 $issuingimpossible{DEBARRED} = 1;
696 if ( $borrower->{'dateexpiry'} eq '0000-00-00') {
697 $issuingimpossible{EXPIRED} = 1;
699 my @expirydate= split /-/,$borrower->{'dateexpiry'};
700 if($expirydate[0]==0 || $expirydate[1]==0|| $expirydate[2]==0 ||
701 Date_to_Days(Today) > Date_to_Days( @expirydate )) {
702 $issuingimpossible{EXPIRED} = 1;
711 C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->output('iso') );
712 if ( C4::Context->preference("IssuingInProcess") ) {
713 my $amountlimit = C4::Context->preference("noissuescharge");
714 if ( $amount > $amountlimit && !$inprocess ) {
715 $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
717 elsif ( $amount <= $amountlimit && !$inprocess ) {
718 $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
723 $needsconfirmation{DEBT} = $amount;
728 # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
730 my $toomany = TooMany( $borrower, $item->{biblionumber}, $item );
731 $needsconfirmation{TOO_MANY} = $toomany if $toomany;
736 unless ( $item->{barcode} ) {
737 $issuingimpossible{UNKNOWN_BARCODE} = 1;
739 if ( $item->{'notforloan'}
740 && $item->{'notforloan'} > 0 )
742 $issuingimpossible{NOT_FOR_LOAN} = 1;
744 elsif ( !$item->{'notforloan'} ){
745 # we have to check itemtypes.notforloan also
746 if (C4::Context->preference('item-level_itypes')){
747 # this should probably be a subroutine
748 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
749 $sth->execute($item->{'itemtype'});
750 my $notforloan=$sth->fetchrow_hashref();
752 if ($notforloan->{'notforloan'} == 1){
753 $issuingimpossible{NOT_FOR_LOAN} = 1;
756 elsif ($biblioitem->{'notforloan'} == 1){
757 $issuingimpossible{NOT_FOR_LOAN} = 1;
760 if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
762 $issuingimpossible{WTHDRAWN} = 1;
764 if ( $item->{'restricted'}
765 && $item->{'restricted'} == 1 )
767 $issuingimpossible{RESTRICTED} = 1;
769 if ( C4::Context->preference("IndependantBranches") ) {
770 my $userenv = C4::Context->userenv;
771 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
772 $issuingimpossible{NOTSAMEBRANCH} = 1
773 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
778 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
780 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
783 # Already issued to current borrower. Ask whether the loan should
785 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
786 $borrower->{'borrowernumber'},
787 $item->{'itemnumber'}
789 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
790 $issuingimpossible{NO_MORE_RENEWALS} = 1;
793 $needsconfirmation{RENEW_ISSUE} = 1;
796 elsif ($issue->{borrowernumber}) {
798 # issued to someone else
799 my $currborinfo = GetMemberDetails( $issue->{borrowernumber} );
801 # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
802 $needsconfirmation{ISSUED_TO_ANOTHER} =
803 "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
806 # See if the item is on reserve.
807 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
809 my $resbor = $res->{'borrowernumber'};
810 my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 );
811 my $branches = GetBranches();
812 my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
813 if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
815 # The item is on reserve and waiting, but has been
816 # reserved by some other patron.
817 $needsconfirmation{RESERVE_WAITING} =
818 "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
820 elsif ( $restype eq "Reserved" ) {
821 # The item is on reserve for someone else.
822 $needsconfirmation{RESERVED} =
823 "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
826 if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" ) {
827 if ( $borrower->{'categorycode'} eq 'W' ) {
829 return ( \%emptyhash, \%needsconfirmation );
832 return ( \%issuingimpossible, \%needsconfirmation );
837 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
839 &AddIssue($borrower,$barcode,$date)
843 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
845 =item C<$barcode> is the bar code of the book being issued.
847 =item C<$date> contains the max date of return. calculated if empty.
849 AddIssue does the following things :
850 - step 01: check that there is a borrowernumber & a barcode provided
851 - check for RENEWAL (book issued & being issued to the same patron)
852 - renewal YES = Calculate Charge & renew
854 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
856 - fill reserve if reserve to this patron
857 - cancel reserve or not, otherwise
858 * TRANSFERT PENDING ?
859 - complete the transfert
867 my ( $borrower, $barcode, $date, $cancelreserve ) = @_;
868 my $dbh = C4::Context->dbh;
869 my $barcodecheck=CheckValidBarcode($barcode);
870 if ($borrower and $barcode and $barcodecheck ne '0'){
871 # find which item we issue
872 my $item = GetItem('', $barcode);
876 # Get which branchcode we need
877 if (C4::Context->preference('CircControl') eq 'PickupLibrary'){
878 $branch = C4::Context->userenv->{'branch'};
880 elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){
881 $branch = $borrower->{'branchcode'};
885 $branch = $item->{'homebranch'};
888 # get actual issuing if there is one
889 my $actualissue = GetItemIssue( $item->{itemnumber});
891 # get biblioinformation for this item
892 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
895 # check if we just renew the issue.
897 if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) {
899 $borrower->{'borrowernumber'},
900 $item->{'itemnumber'},
908 if ( $actualissue->{borrowernumber}) {
909 # This book is currently on loan, but not to the person
910 # who wants to borrow it now. mark it returned before issuing to the new borrower
913 C4::Context->userenv->{'branch'}
917 # See if the item is on reserve.
918 my ( $restype, $res ) =
919 C4::Reserves::CheckReserves( $item->{'itemnumber'} );
921 my $resbor = $res->{'borrowernumber'};
922 if ( $resbor eq $borrower->{'borrowernumber'} ) {
924 # The item is reserved by the current patron
925 ModReserveFill($res);
927 elsif ( $restype eq "Waiting" ) {
930 # The item is on reserve and waiting, but has been
931 # reserved by some other patron.
932 my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 );
933 my $branches = GetBranches();
935 $branches->{ $res->{'branchcode'} }->{'branchname'};
937 elsif ( $restype eq "Reserved" ) {
940 # The item is reserved by someone else.
941 my ( $resborrower, $flags ) =
942 GetMemberDetails( $resbor, 0 );
943 my $branches = GetBranches();
944 my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
945 if ($cancelreserve) { # cancel reserves on this item
946 CancelReserve( 0, $res->{'itemnumber'},
947 $res->{'borrowernumber'} );
950 if ($cancelreserve) {
951 CancelReserve( $res->{'biblionumber'}, 0,
952 $res->{'borrowernumber'} );
955 # set waiting reserve to first in reserve queue as book isn't waiting now
957 $res->{'biblionumber'},
958 $res->{'borrowernumber'},
964 # Starting process for transfer job (checking transfert and validate it if we have one)
965 my ($datesent) = GetTransfers($item->{'itemnumber'});
967 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....)
970 "UPDATE branchtransfers
971 SET datearrived = now(),
973 comments = 'Forced branchtransfer'
974 WHERE itemnumber= ? AND datearrived IS NULL"
976 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
980 # Record in the database the fact that the book was issued.
984 (borrowernumber, itemnumber,issuedate, date_due, branchcode)
991 my $itype=(C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ;
992 my $loanlength = GetLoanLength(
993 $borrower->{'categorycode'},
997 $dateduef = CalcDateDue(C4::Dates->new(),$loanlength,$branch);
998 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
999 if ( C4::Context->preference('ReturnBeforeExpiry') && $dateduef->output('iso') gt $borrower->{dateexpiry} ) {
1000 $dateduef = C4::Dates->new($borrower->{dateexpiry},'iso');
1004 $borrower->{'borrowernumber'},
1005 $item->{'itemnumber'},
1006 strftime( "%Y-%m-%d", localtime ),$dateduef->output('iso'), C4::Context->userenv->{'branch'}
1009 $item->{'issues'}++;
1010 ModItem({ issues => $item->{'issues'},
1011 holdingbranch => C4::Context->userenv->{'branch'},
1013 datelastborrowed => C4::Dates->new()->output('iso'),
1014 onloan => $dateduef->output('iso'),
1015 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1016 ModDateLastSeen( $item->{'itemnumber'} );
1018 # If it costs to borrow this book, charge it to the patron's account.
1019 my ( $charge, $itemtype ) = GetIssuingCharges(
1020 $item->{'itemnumber'},
1021 $borrower->{'borrowernumber'}
1023 if ( $charge > 0 ) {
1025 $item->{'itemnumber'},
1026 $borrower->{'borrowernumber'}, $charge
1028 $item->{'charge'} = $charge;
1031 # Record the fact that this book was issued.
1033 C4::Context->userenv->{'branch'},
1035 '', $item->{'itemnumber'},
1036 $item->{'itype'}, $borrower->{'borrowernumber'}
1040 logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
1041 if C4::Context->preference("IssueLog");
1046 =head2 GetLoanLength
1048 Get loan length for an itemtype, a borrower type and a branch
1050 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1055 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1056 my $dbh = C4::Context->dbh;
1059 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"
1061 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1062 # try to find issuelength & return the 1st available.
1063 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1064 $sth->execute( $borrowertype, $itemtype, $branchcode );
1065 my $loanlength = $sth->fetchrow_hashref;
1066 return $loanlength->{issuelength}
1067 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1069 $sth->execute( $borrowertype, $itemtype, "*" );
1070 $loanlength = $sth->fetchrow_hashref;
1071 return $loanlength->{issuelength}
1072 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1074 $sth->execute( $borrowertype, "*", $branchcode );
1075 $loanlength = $sth->fetchrow_hashref;
1076 return $loanlength->{issuelength}
1077 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1079 $sth->execute( "*", $itemtype, $branchcode );
1080 $loanlength = $sth->fetchrow_hashref;
1081 return $loanlength->{issuelength}
1082 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1084 $sth->execute( $borrowertype, "*", "*" );
1085 $loanlength = $sth->fetchrow_hashref;
1086 return $loanlength->{issuelength}
1087 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1089 $sth->execute( "*", "*", $branchcode );
1090 $loanlength = $sth->fetchrow_hashref;
1091 return $loanlength->{issuelength}
1092 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1094 $sth->execute( "*", $itemtype, "*" );
1095 $loanlength = $sth->fetchrow_hashref;
1096 return $loanlength->{issuelength}
1097 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1099 $sth->execute( "*", "*", "*" );
1100 $loanlength = $sth->fetchrow_hashref;
1101 return $loanlength->{issuelength}
1102 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1104 # if no rule is set => 21 days (hardcoded)
1108 =head2 GetIssuingRule
1110 FIXME - This is a copy-paste of GetLoanLength
1111 as a stop-gap. Do not wish to change API for GetLoanLength
1112 this close to release, however, Overdues::GetIssuingRules is broken.
1114 Get the issuing rule for an itemtype, a borrower type and a branch
1115 Returns a hashref from the issuingrules table.
1117 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1121 sub GetIssuingRule {
1122 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1123 my $dbh = C4::Context->dbh;
1124 my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null" );
1127 $sth->execute( $borrowertype, $itemtype, $branchcode );
1128 $irule = $sth->fetchrow_hashref;
1129 return $irule if defined($irule) ;
1131 $sth->execute( $borrowertype, $itemtype, "*" );
1132 $irule = $sth->fetchrow_hashref;
1133 return $irule if defined($irule) ;
1135 $sth->execute( $borrowertype, "*", $branchcode );
1136 $irule = $sth->fetchrow_hashref;
1137 return $irule if defined($irule) ;
1139 $sth->execute( "*", $itemtype, $branchcode );
1140 $irule = $sth->fetchrow_hashref;
1141 return $irule if defined($irule) ;
1143 $sth->execute( $borrowertype, "*", "*" );
1144 $irule = $sth->fetchrow_hashref;
1145 return $irule if defined($irule) ;
1147 $sth->execute( "*", "*", $branchcode );
1148 $irule = $sth->fetchrow_hashref;
1149 return $irule if defined($irule) ;
1151 $sth->execute( "*", $itemtype, "*" );
1152 $irule = $sth->fetchrow_hashref;
1153 return $irule if defined($irule) ;
1155 $sth->execute( "*", "*", "*" );
1156 $irule = $sth->fetchrow_hashref;
1157 return $irule if defined($irule) ;
1159 # if no rule matches,
1165 ($doreturn, $messages, $iteminformation, $borrower) =
1166 &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1170 C<$barcode> is the bar code of the book being returned. C<$branch> is
1171 the code of the branch where the book is being returned. C<$exemptfine>
1172 indicates that overdue charges for the item will be removed. C<$dropbox>
1173 indicates that the check-in date is assumed to be yesterday, or the last
1174 non-holiday as defined in C4::Calendar . If overdue
1175 charges are applied and C<$dropbox> is true, the last charge will be removed.
1176 This assumes that the fines accrual script has run for _today_.
1178 C<&AddReturn> returns a list of four items:
1180 C<$doreturn> is true iff the return succeeded.
1182 C<$messages> is a reference-to-hash giving the reason for failure:
1188 No item with this barcode exists. The value is C<$barcode>.
1192 The book is not currently on loan. The value is C<$barcode>.
1194 =item C<IsPermanent>
1196 The book's home branch is a permanent collection. If you have borrowed
1197 this book, you are not allowed to return it. The value is the code for
1198 the book's home branch.
1202 This book has been withdrawn/cancelled. The value should be ignored.
1206 The item was reserved. The value is a reference-to-hash whose keys are
1207 fields from the reserves table of the Koha database, and
1208 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1209 either C<Waiting>, C<Reserved>, or 0.
1213 C<$borrower> is a reference-to-hash, giving information about the
1214 patron who last borrowed the book.
1219 my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1220 my $dbh = C4::Context->dbh;
1224 my $validTransfert = 0;
1225 my $reserveDone = 0;
1227 # get information on item
1228 my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
1229 my $biblio = GetBiblioItemData($iteminformation->{'biblioitemnumber'});
1230 # use Data::Dumper;warn Data::Dumper::Dumper($iteminformation);
1231 unless ($iteminformation->{'itemnumber'} ) {
1232 $messages->{'BadBarcode'} = $barcode;
1236 if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1237 $messages->{'NotIssued'} = $barcode;
1238 # even though item is not on loan, it may still
1239 # be transferred; therefore, get current branch information
1240 my $curr_iteminfo = GetItem($iteminformation->{'itemnumber'});
1241 $iteminformation->{'homebranch'} = $curr_iteminfo->{'homebranch'};
1242 $iteminformation->{'holdingbranch'} = $curr_iteminfo->{'holdingbranch'};
1246 # check if the book is in a permanent collection....
1247 my $hbr = $iteminformation->{C4::Context->preference("HomeOrHoldingBranch")};
1248 my $branches = GetBranches();
1249 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1250 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1251 $messages->{'IsPermanent'} = $hbr;
1254 # if independent branches are on and returning to different branch, refuse the return
1255 if ($hbr ne C4::Context->userenv->{'branch'} && C4::Context->preference("IndependantBranches")){
1256 $messages->{'Wrongbranch'} = 1;
1260 # check that the book has been cancelled
1261 if ( $iteminformation->{'wthdrawn'} ) {
1262 $messages->{'wthdrawn'} = 1;
1266 # new op dev : if the book returned in an other branch update the holding branch
1268 # update issues, thereby returning book (should push this out into another subroutine
1269 $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1271 # case of a return of document (deal with issues and holdingbranch)
1274 my $circControlBranch;
1276 # don't allow dropbox mode to create an invalid entry in issues (issuedate > returndate) FIXME: actually checks eq, not gt
1277 undef($dropbox) if ( $iteminformation->{'issuedate'} eq C4::Dates->today('iso') );
1278 if (C4::Context->preference('CircControl') eq 'ItemHomeBranch' ) {
1279 $circControlBranch = $iteminformation->{homebranch};
1280 } elsif ( C4::Context->preference('CircControl') eq 'PatronLibrary') {
1281 $circControlBranch = $borrower->{branchcode};
1282 } else { # CircControl must be PickupLibrary.
1283 $circControlBranch = $iteminformation->{holdingbranch};
1284 # FIXME - is this right ? are we sure that the holdingbranch is still the pickup branch?
1287 MarkIssueReturned($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'},$circControlBranch);
1288 $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
1291 # continue to deal with returns cases, but not only if we have an issue
1293 # the holdingbranch is updated if the document is returned in an other location .
1294 if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) {
1295 UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
1296 # reload iteminformation holdingbranch with the userenv value
1297 $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1299 ModDateLastSeen( $iteminformation->{'itemnumber'} );
1300 ModItem({ onloan => undef }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'});
1302 if ($iteminformation->{borrowernumber}){
1303 ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1305 # fix up the accounts.....
1306 if ( $iteminformation->{'itemlost'} ) {
1307 $messages->{'WasLost'} = 1;
1310 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1311 # check if we have a transfer for this document
1312 my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1314 # if we have a transfer to do, we update the line of transfers with the datearrived
1316 if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1319 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1321 $sth->execute( $iteminformation->{'itemnumber'} );
1323 # now we check if there is a reservation with the validate of transfer if we have one, we can set it with the status 'W'
1324 C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1327 $messages->{'WrongTransfer'} = $tobranch;
1328 $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1330 $validTransfert = 1;
1333 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1334 # fix up the accounts.....
1335 if ($iteminformation->{'itemlost'}) {
1336 FixAccountForLostAndReturned($iteminformation, $borrower);
1337 $messages->{'WasLost'} = 1;
1339 # fix up the overdues in accounts...
1340 FixOverduesOnReturn( $borrower->{'borrowernumber'},
1341 $iteminformation->{'itemnumber'}, $exemptfine, $dropbox );
1343 # find reserves.....
1344 # if we don't have a reserve with the status W, we launch the Checkreserves routine
1345 my ( $resfound, $resrec ) =
1346 C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1348 $resrec->{'ResFound'} = $resfound;
1349 $messages->{'ResFound'} = $resrec;
1354 # Record the fact that this book was returned.
1356 $branch, 'return', '0', '',
1357 $iteminformation->{'itemnumber'},
1358 $biblio->{'itemtype'},
1359 $borrower->{'borrowernumber'}
1362 logaction("CIRCULATION", "RETURN", $iteminformation->{borrowernumber}, $iteminformation->{'biblionumber'})
1363 if C4::Context->preference("ReturnLog");
1365 #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1366 #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1368 if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1369 if (C4::Context->preference("AutomaticItemReturn") == 1) {
1370 ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1371 $messages->{'WasTransfered'} = 1;
1374 $messages->{'NeedsTransfer'} = 1;
1378 return ( $doreturn, $messages, $iteminformation, $borrower );
1381 =head2 MarkIssueReturned
1385 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch);
1389 Unconditionally marks an issue as being returned by
1390 moving the C<issues> row to C<old_issues> and
1391 setting C<returndate> to the current date, or
1392 the last non-holiday date of the branccode specified in
1393 C<dropbox> . Assumes you've already checked that
1394 it's safe to do this, i.e. last non-holiday > issuedate.
1396 Ideally, this function would be internal to C<C4::Circulation>,
1397 not exported, but it is currently needed by one
1398 routine in C<C4::Accounts>.
1402 sub MarkIssueReturned {
1403 my ($borrowernumber, $itemnumber, $dropbox_branch ) = @_;
1404 my $dbh = C4::Context->dbh;
1405 my $query = "UPDATE issues SET returndate=";
1406 my @bind = ($borrowernumber,$itemnumber);
1407 if($dropbox_branch) {
1408 my $calendar = C4::Calendar->new( branchcode => $dropbox_branch );
1409 my $dropboxdate = $calendar->addDate(C4::Dates->new(), -1 );
1410 unshift @bind, $dropboxdate->output('iso') ;
1413 $query .= " now() ";
1415 $query .= " WHERE borrowernumber = ? AND itemnumber = ?";
1417 my $sth_upd = $dbh->prepare($query);
1418 $sth_upd->execute(@bind);
1419 my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1420 WHERE borrowernumber = ?
1421 AND itemnumber = ?");
1422 $sth_copy->execute($borrowernumber, $itemnumber);
1423 my $sth_del = $dbh->prepare("DELETE FROM issues
1424 WHERE borrowernumber = ?
1425 AND itemnumber = ?");
1426 $sth_del->execute($borrowernumber, $itemnumber);
1429 =head2 FixOverduesOnReturn
1431 &FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1433 C<$brn> borrowernumber
1437 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1438 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1440 internal function, called only by AddReturn
1444 sub FixOverduesOnReturn {
1445 my ( $borrowernumber, $item, $exemptfine, $dropbox ) = @_;
1446 my $dbh = C4::Context->dbh;
1448 # check for overdue fine
1451 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1453 $sth->execute( $borrowernumber, $item );
1455 # alter fine to show that the book has been returned
1457 if ($data = $sth->fetchrow_hashref) {
1459 my @bind = ($borrowernumber,$item ,$data->{'accountno'});
1461 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1462 if (C4::Context->preference("FinesLog")) {
1463 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1465 } elsif ($dropbox && $data->{lastincrement}) {
1466 my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1467 my $amt = $data->{amount} - $data->{lastincrement} ;
1468 if (C4::Context->preference("FinesLog")) {
1469 &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1471 $uquery = "update accountlines set accounttype='F' ";
1472 if($outstanding >= 0 && $amt >=0) {
1473 $uquery .= ", amount = ? , amountoutstanding=? ";
1474 unshift @bind, ($amt, $outstanding) ;
1477 $uquery = "update accountlines set accounttype='F' ";
1479 $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1480 my $usth = $dbh->prepare($uquery);
1481 $usth->execute(@bind);
1489 =head2 FixAccountForLostAndReturned
1491 &FixAccountForLostAndReturned($iteminfo,$borrower);
1493 Calculates the charge for a book lost and returned (Not exported & used only once)
1495 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1497 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1499 Internal function, called by AddReturn
1503 sub FixAccountForLostAndReturned {
1504 my ($iteminfo, $borrower) = @_;
1505 my $dbh = C4::Context->dbh;
1506 my $itm = $iteminfo->{'itemnumber'};
1507 # check for charge made for lost book
1508 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1509 $sth->execute($itm);
1510 if (my $data = $sth->fetchrow_hashref) {
1511 # writeoff this amount
1513 my $amount = $data->{'amount'};
1514 my $acctno = $data->{'accountno'};
1516 if ($data->{'amountoutstanding'} == $amount) {
1517 $offset = $data->{'amount'};
1520 $offset = $amount - $data->{'amountoutstanding'};
1521 $amountleft = $data->{'amountoutstanding'} - $amount;
1523 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1524 WHERE (borrowernumber = ?)
1525 AND (itemnumber = ?) AND (accountno = ?) ");
1526 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1528 #check if any credit is left if so writeoff other accounts
1529 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1530 if ($amountleft < 0){
1533 if ($amountleft > 0){
1534 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1535 AND (amountoutstanding >0) ORDER BY date");
1536 $msth->execute($data->{'borrowernumber'});
1537 # offset transactions
1540 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1541 if ($accdata->{'amountoutstanding'} < $amountleft) {
1543 $amountleft -= $accdata->{'amountoutstanding'};
1545 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1548 my $thisacct = $accdata->{'accountno'};
1549 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1550 WHERE (borrowernumber = ?)
1551 AND (accountno=?)");
1552 $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1554 $usth = $dbh->prepare("INSERT INTO accountoffsets
1555 (borrowernumber, accountno, offsetaccount, offsetamount)
1558 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1563 if ($amountleft > 0){
1566 my $desc="Item Returned ".$iteminfo->{'barcode'};
1567 $usth = $dbh->prepare("INSERT INTO accountlines
1568 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1569 VALUES (?,?,now(),?,?,'CR',?)");
1570 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1572 $usth = $dbh->prepare("INSERT INTO accountoffsets
1573 (borrowernumber, accountno, offsetaccount, offsetamount)
1575 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1577 ModItem({ paidfor => '' }, undef, $itm);
1585 $issues = &GetItemIssue($itemnumber);
1587 Returns patrons currently having a book. nothing if item is not issued atm
1589 C<$itemnumber> is the itemnumber
1591 Returns an array of hashes
1596 my ( $itemnumber) = @_;
1597 return unless $itemnumber;
1598 my $dbh = C4::Context->dbh;
1602 my $today = POSIX::strftime("%Y%m%d", localtime);
1604 my $sth = $dbh->prepare(
1605 "SELECT * FROM issues
1606 LEFT JOIN items ON issues.itemnumber=items.itemnumber
1608 issues.itemnumber=?");
1609 $sth->execute($itemnumber);
1610 my $data = $sth->fetchrow_hashref;
1611 my $datedue = $data->{'date_due'};
1613 if ( $datedue < $today ) {
1614 $data->{'overdue'} = 1;
1616 $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1621 =head2 GetItemIssues
1623 $issues = &GetItemIssues($itemnumber, $history);
1625 Returns patrons that have issued a book
1627 C<$itemnumber> is the itemnumber
1628 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1630 Returns an array of hashes
1635 my ( $itemnumber,$history ) = @_;
1636 my $dbh = C4::Context->dbh;
1640 my $today = POSIX::strftime("%Y%m%d", localtime);
1642 my $sql = "SELECT * FROM issues
1643 JOIN borrowers USING (borrowernumber)
1644 JOIN items USING (itemnumber)
1645 WHERE issues.itemnumber = ? ";
1648 SELECT * FROM old_issues
1649 LEFT JOIN borrowers USING (borrowernumber)
1650 JOIN items USING (itemnumber)
1651 WHERE old_issues.itemnumber = ? ";
1653 $sql .= "ORDER BY date_due DESC";
1654 my $sth = $dbh->prepare($sql);
1656 $sth->execute($itemnumber, $itemnumber);
1658 $sth->execute($itemnumber);
1660 while ( my $data = $sth->fetchrow_hashref ) {
1661 my $datedue = $data->{'date_due'};
1663 if ( $datedue < $today ) {
1664 $data->{'overdue'} = 1;
1666 my $itemnumber = $data->{'itemnumber'};
1667 push @GetItemIssues, $data;
1670 return ( \@GetItemIssues );
1673 =head2 GetBiblioIssues
1675 $issues = GetBiblioIssues($biblionumber);
1677 this function get all issues from a biblionumber.
1680 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1681 tables issues and the firstname,surname & cardnumber from borrowers.
1685 sub GetBiblioIssues {
1686 my $biblionumber = shift;
1687 return undef unless $biblionumber;
1688 my $dbh = C4::Context->dbh;
1690 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1692 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1693 LEFT JOIN items ON issues.itemnumber = items.itemnumber
1694 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1695 LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1696 WHERE biblio.biblionumber = ?
1698 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1700 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1701 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1702 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1703 LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1704 WHERE biblio.biblionumber = ?
1707 my $sth = $dbh->prepare($query);
1708 $sth->execute($biblionumber, $biblionumber);
1711 while ( my $data = $sth->fetchrow_hashref ) {
1712 push @issues, $data;
1717 =head2 CanBookBeRenewed
1719 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber);
1721 Find out whether a borrowed item may be renewed.
1723 C<$dbh> is a DBI handle to the Koha database.
1725 C<$borrowernumber> is the borrower number of the patron who currently
1726 has the item on loan.
1728 C<$itemnumber> is the number of the item to renew.
1730 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1731 item must currently be on loan to the specified borrower; renewals
1732 must be allowed for the item's type; and the borrower must not have
1733 already renewed the loan. $error will contain the reason the renewal can not proceed
1737 sub CanBookBeRenewed {
1739 # check renewal status
1740 my ( $borrowernumber, $itemnumber ) = @_;
1741 my $dbh = C4::Context->dbh;
1746 # Look in the issues table for this item, lent to this borrower,
1747 # and not yet returned.
1749 # FIXME - I think this function could be redone to use only one SQL call.
1750 my $sth1 = $dbh->prepare(
1751 "SELECT * FROM issues
1752 WHERE borrowernumber = ?
1755 $sth1->execute( $borrowernumber, $itemnumber );
1756 if ( my $data1 = $sth1->fetchrow_hashref ) {
1758 # Found a matching item
1760 # See if this item may be renewed. This query is convoluted
1761 # because it's a bit messy: given the item number, we need to find
1762 # the biblioitem, which gives us the itemtype, which tells us
1763 # whether it may be renewed.
1764 my $query = "SELECT renewalsallowed FROM items ";
1765 $query .= (C4::Context->preference('item-level_itypes'))
1766 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1767 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1768 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1769 $query .= "WHERE items.itemnumber = ?";
1770 my $sth2 = $dbh->prepare($query);
1771 $sth2->execute($itemnumber);
1772 if ( my $data2 = $sth2->fetchrow_hashref ) {
1773 $renews = $data2->{'renewalsallowed'};
1775 if ( $renews && $renews > $data1->{'renewals'} ) {
1782 my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1790 return ($renewokay,$error);
1795 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue]);
1799 C<$borrowernumber> is the borrower number of the patron who currently
1802 C<$itemnumber> is the number of the item to renew.
1804 C<$branch> is the library branch. Defaults to the homebranch of the ITEM.
1806 C<$datedue> can be a C4::Dates object used to set the due date.
1808 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
1809 from the book's item type.
1814 my $borrowernumber = shift or return undef;
1815 my $itemnumber = shift or return undef;
1816 my $item = GetItem($itemnumber) or return undef;
1817 my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
1818 my $branch = (@_) ? shift : $item->{homebranch}; # opac-renew doesn't send branch
1820 # If the due date wasn't specified, calculate it by adding the
1821 # book's loan length to today's date.
1822 unless (@_ and $datedue = shift and $datedue->output('iso')) {
1824 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
1825 my $loanlength = GetLoanLength(
1826 $borrower->{'categorycode'},
1827 (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
1828 $item->{homebranch} # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument?
1830 #FIXME -- use circControl?
1831 $datedue = CalcDateDue(C4::Dates->new(),$loanlength,$branch); # this branch is the transactional branch.
1832 # The question of whether to use item's homebranch calendar is open.
1835 my $dbh = C4::Context->dbh;
1836 # Find the issues record for this book
1838 $dbh->prepare("SELECT * FROM issues
1839 WHERE borrowernumber=?
1842 $sth->execute( $borrowernumber, $itemnumber );
1843 my $issuedata = $sth->fetchrow_hashref;
1846 # Update the issues record to have the new due date, and a new count
1847 # of how many times it has been renewed.
1848 my $renews = $issuedata->{'renewals'} + 1;
1849 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?
1850 WHERE borrowernumber=?
1853 $sth->execute( $datedue->output('iso'), $renews, $borrowernumber, $itemnumber );
1856 # Update the renewal count on the item, and tell zebra to reindex
1857 $renews = $biblio->{'renewals'} + 1;
1858 ModItem({ renewals => $renews }, $biblio->{'biblionumber'}, $itemnumber);
1860 # Charge a new rental fee, if applicable?
1861 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1862 if ( $charge > 0 ) {
1863 my $accountno = getnextacctno( $borrowernumber );
1864 my $item = GetBiblioFromItemNumber($itemnumber);
1865 $sth = $dbh->prepare(
1866 "INSERT INTO accountlines
1868 borrowernumber, accountno, amount,
1870 accounttype, amountoutstanding, itemnumber
1872 VALUES (now(),?,?,?,?,?,?,?)"
1874 $sth->execute( $borrowernumber, $accountno, $charge,
1875 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
1876 'Rent', $charge, $itemnumber );
1880 UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
1884 # check renewal status
1885 my ($bornum,$itemno)=@_;
1886 my $dbh = C4::Context->dbh;
1888 my $renewsallowed = 0;
1890 # Look in the issues table for this item, lent to this borrower,
1891 # and not yet returned.
1893 # FIXME - I think this function could be redone to use only one SQL call.
1894 my $sth = $dbh->prepare("select * from issues
1895 where (borrowernumber = ?)
1896 and (itemnumber = ?)");
1897 $sth->execute($bornum,$itemno);
1898 my $data = $sth->fetchrow_hashref;
1899 $renewcount = $data->{'renewals'} if $data->{'renewals'};
1901 my $query = "SELECT renewalsallowed FROM items ";
1902 $query .= (C4::Context->preference('item-level_itypes'))
1903 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1904 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1905 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1906 $query .= "WHERE items.itemnumber = ?";
1907 my $sth2 = $dbh->prepare($query);
1908 $sth2->execute($itemno);
1909 my $data2 = $sth2->fetchrow_hashref();
1910 $renewsallowed = $data2->{'renewalsallowed'};
1911 $renewsleft = $renewsallowed - $renewcount;
1912 return ($renewcount,$renewsallowed,$renewsleft);
1915 =head2 GetIssuingCharges
1917 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
1919 Calculate how much it would cost for a given patron to borrow a given
1920 item, including any applicable discounts.
1922 C<$itemnumber> is the item number of item the patron wishes to borrow.
1924 C<$borrowernumber> is the patron's borrower number.
1926 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
1927 and C<$item_type> is the code for the item's item type (e.g., C<VID>
1932 sub GetIssuingCharges {
1934 # calculate charges due
1935 my ( $itemnumber, $borrowernumber ) = @_;
1937 my $dbh = C4::Context->dbh;
1940 # Get the book's item type and rental charge (via its biblioitem).
1941 my $qcharge = "SELECT itemtypes.itemtype,rentalcharge FROM items
1942 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
1943 $qcharge .= (C4::Context->preference('item-level_itypes'))
1944 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1945 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1947 $qcharge .= "WHERE items.itemnumber =?";
1949 my $sth1 = $dbh->prepare($qcharge);
1950 $sth1->execute($itemnumber);
1951 if ( my $data1 = $sth1->fetchrow_hashref ) {
1952 $item_type = $data1->{'itemtype'};
1953 $charge = $data1->{'rentalcharge'};
1954 my $q2 = "SELECT rentaldiscount FROM borrowers
1955 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
1956 WHERE borrowers.borrowernumber = ?
1957 AND issuingrules.itemtype = ?";
1958 my $sth2 = $dbh->prepare($q2);
1959 $sth2->execute( $borrowernumber, $item_type );
1960 if ( my $data2 = $sth2->fetchrow_hashref ) {
1961 my $discount = $data2->{'rentaldiscount'};
1962 if ( $discount eq 'NULL' ) {
1965 $charge = ( $charge * ( 100 - $discount ) ) / 100;
1971 return ( $charge, $item_type );
1974 =head2 AddIssuingCharge
1976 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
1980 sub AddIssuingCharge {
1981 my ( $itemnumber, $borrowernumber, $charge ) = @_;
1982 my $dbh = C4::Context->dbh;
1983 my $nextaccntno = getnextacctno( $borrowernumber );
1985 INSERT INTO accountlines
1986 (borrowernumber, itemnumber, accountno,
1987 date, amount, description, accounttype,
1989 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
1991 my $sth = $dbh->prepare($query);
1992 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
1998 GetTransfers($itemnumber);
2003 my ($itemnumber) = @_;
2005 my $dbh = C4::Context->dbh;
2011 FROM branchtransfers
2012 WHERE itemnumber = ?
2013 AND datearrived IS NULL
2015 my $sth = $dbh->prepare($query);
2016 $sth->execute($itemnumber);
2017 my @row = $sth->fetchrow_array();
2023 =head2 GetTransfersFromTo
2025 @results = GetTransfersFromTo($frombranch,$tobranch);
2027 Returns the list of pending transfers between $from and $to branch
2031 sub GetTransfersFromTo {
2032 my ( $frombranch, $tobranch ) = @_;
2033 return unless ( $frombranch && $tobranch );
2034 my $dbh = C4::Context->dbh;
2036 SELECT itemnumber,datesent,frombranch
2037 FROM branchtransfers
2040 AND datearrived IS NULL
2042 my $sth = $dbh->prepare($query);
2043 $sth->execute( $frombranch, $tobranch );
2046 while ( my $data = $sth->fetchrow_hashref ) {
2047 push @gettransfers, $data;
2050 return (@gettransfers);
2053 =head2 DeleteTransfer
2055 &DeleteTransfer($itemnumber);
2059 sub DeleteTransfer {
2060 my ($itemnumber) = @_;
2061 my $dbh = C4::Context->dbh;
2062 my $sth = $dbh->prepare(
2063 "DELETE FROM branchtransfers
2065 AND datearrived IS NULL "
2067 $sth->execute($itemnumber);
2071 =head2 AnonymiseIssueHistory
2073 $rows = AnonymiseIssueHistory($borrowernumber,$date)
2075 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2076 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2078 return the number of affected rows.
2082 sub AnonymiseIssueHistory {
2084 my $borrowernumber = shift;
2085 my $dbh = C4::Context->dbh;
2088 SET borrowernumber = NULL
2089 WHERE returndate < '".$date."'
2090 AND borrowernumber IS NOT NULL
2092 $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2093 my $rows_affected = $dbh->do($query);
2094 return $rows_affected;
2097 =head2 updateWrongTransfer
2099 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2101 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
2105 sub updateWrongTransfer {
2106 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2107 my $dbh = C4::Context->dbh;
2108 # first step validate the actual line of transfert .
2111 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2113 $sth->execute($FromLibrary,$itemNumber);
2116 # second step create a new line of branchtransfer to the right location .
2117 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2119 #third step changing holdingbranch of item
2120 UpdateHoldingbranch($FromLibrary,$itemNumber);
2123 =head2 UpdateHoldingbranch
2125 $items = UpdateHoldingbranch($branch,$itmenumber);
2126 Simple methode for updating hodlingbranch in items BDD line
2130 sub UpdateHoldingbranch {
2131 my ( $branch,$itemnumber ) = @_;
2132 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2137 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2138 this function calculates the due date given the loan length ,
2139 checking against the holidays calendar as per the 'useDaysMode' syspref.
2140 C<$startdate> = C4::Dates object representing start date of loan period (assumed to be today)
2141 C<$branch> = location whose calendar to use
2142 C<$loanlength> = loan length prior to adjustment
2146 my ($startdate,$loanlength,$branch) = @_;
2147 if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar
2148 my $datedue = time + ($loanlength) * 86400;
2149 #FIXME - assumes now even though we take a startdate
2150 my @datearr = localtime($datedue);
2151 return C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2153 my $calendar = C4::Calendar->new( branchcode => $branch );
2154 my $datedue = $calendar->addDate($startdate, $loanlength);
2159 =head2 CheckValidDatedue
2160 This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2161 To be replaced by CalcDateDue() once C4::Calendar use is tested.
2163 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2164 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2165 C<$date_due> = returndate calculate with no day check
2166 C<$itemnumber> = itemnumber
2167 C<$branchcode> = location of issue (affected by 'CircControl' syspref)
2168 C<$loanlength> = loan length prior to adjustment
2171 sub CheckValidDatedue {
2172 my ($date_due,$itemnumber,$branchcode)=@_;
2173 my @datedue=split('-',$date_due->output('iso'));
2174 my $years=$datedue[0];
2175 my $month=$datedue[1];
2176 my $day=$datedue[2];
2177 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2179 for (my $i=0;$i<2;$i++){
2180 $dow=Day_of_Week($years,$month,$day);
2181 ($dow=0) if ($dow>6);
2182 my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2183 my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2184 my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2185 if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2187 (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2190 my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2195 =head2 CheckRepeatableHolidays
2197 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2198 this function checks if the date due is a repeatable holiday
2199 C<$date_due> = returndate calculate with no day check
2200 C<$itemnumber> = itemnumber
2201 C<$branchcode> = localisation of issue
2205 sub CheckRepeatableHolidays{
2206 my($itemnumber,$week_day,$branchcode)=@_;
2207 my $dbh = C4::Context->dbh;
2208 my $query = qq|SELECT count(*)
2209 FROM repeatable_holidays
2212 my $sth = $dbh->prepare($query);
2213 $sth->execute($branchcode,$week_day);
2214 my $result=$sth->fetchrow;
2220 =head2 CheckSpecialHolidays
2222 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2223 this function check if the date is a special holiday
2224 C<$years> = the years of datedue
2225 C<$month> = the month of datedue
2226 C<$day> = the day of datedue
2227 C<$itemnumber> = itemnumber
2228 C<$branchcode> = localisation of issue
2232 sub CheckSpecialHolidays{
2233 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2234 my $dbh = C4::Context->dbh;
2235 my $query=qq|SELECT count(*)
2236 FROM `special_holidays`
2242 my $sth = $dbh->prepare($query);
2243 $sth->execute($years,$month,$day,$branchcode);
2244 my $countspecial=$sth->fetchrow ;
2246 return $countspecial;
2249 =head2 CheckRepeatableSpecialHolidays
2251 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2252 this function check if the date is a repeatble special holidays
2253 C<$month> = the month of datedue
2254 C<$day> = the day of datedue
2255 C<$itemnumber> = itemnumber
2256 C<$branchcode> = localisation of issue
2260 sub CheckRepeatableSpecialHolidays{
2261 my ($month,$day,$itemnumber,$branchcode) = @_;
2262 my $dbh = C4::Context->dbh;
2263 my $query=qq|SELECT count(*)
2264 FROM `repeatable_holidays`
2269 my $sth = $dbh->prepare($query);
2270 $sth->execute($month,$day,$branchcode);
2271 my $countspecial=$sth->fetchrow ;
2273 return $countspecial;
2278 sub CheckValidBarcode{
2280 my $dbh = C4::Context->dbh;
2281 my $query=qq|SELECT count(*)
2285 my $sth = $dbh->prepare($query);
2286 $sth->execute($barcode);
2287 my $exist=$sth->fetchrow ;
2298 Koha Developement team <info@koha.org>