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
41 use POSIX qw(strftime);
42 use C4::Branch; # GetBranches
43 use C4::Log; # logaction
47 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
50 # set the version for version checking
54 # FIXME subs that should probably be elsewhere
60 # subs to deal with issuing a book
72 &AnonymiseIssueHistory
75 # subs to deal with returns
81 # subs to deal with transfers
93 C4::Circulation - Koha circulation module
101 The functions in this module deal with circulation, issues, and
102 returns, as well as general information about the library.
103 Also deals with stocktaking.
109 =head3 $str = &decode($chunk);
113 =item Generic filter function for barcode string.
119 # FIXME From Paul : i don't understand what this sub does & why it has to be called on every circ. Speak of this with chris maybe ?
120 # FIXME -- the &decode fcn below should be wrapped into this one.
124 my $filter = C4::Context->preference('itemBarcodeInputFilter');
125 if($filter eq 'whitespace') {
128 } elsif($filter eq 'cuecat') {
130 my @fields = split( /\./, $barcode );
131 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
132 if ( $#results == 2 ) {
138 } elsif($filter eq 'T-prefix') {
139 my $num = ( $barcode =~ /^[Tt] /) ? substr($barcode,2) + 0 : $barcode;
140 return sprintf( "T%07d",$num);
146 =head3 $str = &decode($chunk);
150 =item Decodes a segment of a string emitted by a CueCat barcode scanner and
160 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
161 my @s = map { index( $seq, $_ ); } split( //, $encoded );
162 my $l = ( $#s + 1 ) % 4;
173 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
175 chr( ( $n >> 16 ) ^ 67 )
176 .chr( ( $n >> 8 & 255 ) ^ 67 )
177 .chr( ( $n & 255 ) ^ 67 );
180 $r = substr( $r, 0, length($r) - $l );
186 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, $barcode, $ignore_reserves);
188 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
190 C<$newbranch> is the code for the branch to which the item should be transferred.
192 C<$barcode> is the barcode of the item to be transferred.
194 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
195 Otherwise, if an item is reserved, the transfer fails.
197 Returns three values:
201 is true if the transfer was successful.
205 is a reference-to-hash which may have any of the following keys:
211 There is no item in the catalog with the given barcode. The value is C<$barcode>.
215 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.
217 =item C<DestinationEqualsHolding>
219 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.
223 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.
227 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>.
229 =item C<WasTransferred>
231 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
238 my ( $tbr, $barcode, $ignoreRs ) = @_;
241 my $branches = GetBranches();
242 my $itemnumber = GetItemnumberFromBarcode( $barcode );
243 my $issue = GetItemIssue($itemnumber);
244 my $biblio = GetBiblioFromItemNumber($itemnumber);
247 if ( not $itemnumber ) {
248 $messages->{'BadBarcode'} = $barcode;
252 # get branches of book...
253 my $hbr = $biblio->{'homebranch'};
254 my $fbr = $biblio->{'holdingbranch'};
257 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
258 $messages->{'IsPermanent'} = $hbr;
261 # can't transfer book if is already there....
262 if ( $fbr eq $tbr ) {
263 $messages->{'DestinationEqualsHolding'} = 1;
267 # check if it is still issued to someone, return it...
268 if ($issue->{borrowernumber}) {
269 AddReturn( $barcode, $fbr );
270 $messages->{'WasReturned'} = $issue->{borrowernumber};
274 # That'll save a database query.
275 my ( $resfound, $resrec ) =
276 CheckReserves( $itemnumber );
277 if ( $resfound and not $ignoreRs ) {
278 $resrec->{'ResFound'} = $resfound;
280 # $messages->{'ResFound'} = $resrec;
284 #actually do the transfer....
286 ModItemTransfer( $itemnumber, $fbr, $tbr );
288 # don't need to update MARC anymore, we do it in batch now
289 $messages->{'WasTransfered'} = 1;
290 ModDateLastSeen( $itemnumber );
292 return ( $dotransfer, $messages, $biblio );
295 =head2 CanBookBeIssued
297 Check if a book can be issued.
299 my ($issuingimpossible,$needsconfirmation) = CanBookBeIssued($borrower,$barcode,$year,$month,$day);
303 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
305 =item C<$barcode> is the bar code of the book being issued.
307 =item C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate".
315 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
316 Possible values are :
322 sticky due date is invalid
326 borrower gone with no address
330 borrower declared it's card lost
336 =head3 UNKNOWN_BARCODE
350 item is restricted (set by ??)
352 C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
353 Possible values are :
361 renewing, not issuing
363 =head3 ISSUED_TO_ANOTHER
365 issued to someone else.
369 reserved for someone else.
373 sticky due date is invalid
377 if the borrower borrows to much things
381 # check if a book can be issued.
385 my $borrower = shift;
386 my $biblionumber = shift;
388 my $cat_borrower = $borrower->{'categorycode'};
389 my $dbh = C4::Context->dbh;
391 # Get which branchcode we need
392 if (C4::Context->preference('CircControl') eq 'PickupLibrary'){
393 $branch = C4::Context->userenv->{'branch'};
395 elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){
396 $branch = $borrower->{'branchcode'};
400 $branch = $item->{'homebranch'};
402 my $type = (C4::Context->preference('item-level_itypes'))
403 ? $item->{'itype'} # item-level
404 : $item->{'itemtype'}; # biblio-level
408 'SELECT * FROM issuingrules
409 WHERE categorycode = ?
414 my $query2 = "SELECT COUNT(*) FROM issues i, biblioitems s1, items s2
415 WHERE i.borrowernumber = ?
416 AND i.itemnumber = s2.itemnumber
417 AND s1.biblioitemnumber = s2.biblioitemnumber";
418 if (C4::Context->preference('item-level_itypes')){
419 $query2.=" AND s2.itype=? ";
421 $query2.=" AND s1.itemtype= ? ";
423 my $sth2= $dbh->prepare($query2);
426 'SELECT COUNT(*) FROM issues
427 WHERE borrowernumber = ?'
431 # check the 3 parameters (branch / itemtype / category code
432 $sth->execute( $cat_borrower, $type, $branch );
433 my $result = $sth->fetchrow_hashref;
434 # warn "$cat_borrower, $type, $branch = ".Data::Dumper::Dumper($result);
436 if ( $result->{maxissueqty} ne '' ) {
437 # warn "checking on everything set";
438 $sth2->execute( $borrower->{'borrowernumber'}, $type );
439 my $alreadyissued = $sth2->fetchrow;
440 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
441 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/itemtype failed)" );
443 # now checking for total
444 $sth->execute( $cat_borrower, '*', $branch );
445 my $result = $sth->fetchrow_hashref;
446 if ( $result->{maxissueqty} ne '' ) {
447 $sth2->execute( $borrower->{'borrowernumber'}, $type );
448 my $alreadyissued = $sth2->fetchrow;
449 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
450 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/total failed)" );
455 # check the 2 parameters (branch / itemtype / default categorycode
456 $sth->execute( '*', $type, $branch );
457 $result = $sth->fetchrow_hashref;
458 # warn "*, $type, $branch = ".Data::Dumper::Dumper($result);
460 if ( $result->{maxissueqty} ne '' ) {
461 # warn "checking on 2 parameters (default categorycode)";
462 $sth2->execute( $borrower->{'borrowernumber'}, $type );
463 my $alreadyissued = $sth2->fetchrow;
464 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
465 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / itemtype failed)" );
467 # now checking for total
468 $sth->execute( '*', '*', $branch );
469 my $result = $sth->fetchrow_hashref;
470 if ( $result->{maxissueqty} ne '' ) {
471 $sth2->execute( $borrower->{'borrowernumber'}, $type );
472 my $alreadyissued = $sth2->fetchrow;
473 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
474 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / total failed)" );
479 # check the 1 parameters (default branch / itemtype / categorycode
480 $sth->execute( $cat_borrower, $type, '*' );
481 $result = $sth->fetchrow_hashref;
482 # warn "$cat_borrower, $type, * = ".Data::Dumper::Dumper($result);
484 if ( $result->{maxissueqty} ne '' ) {
485 # warn "checking on 1 parameter (default branch + categorycode)";
486 $sth2->execute( $borrower->{'borrowernumber'}, $type );
487 my $alreadyissued = $sth2->fetchrow;
488 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
489 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch/category/itemtype failed)" );
491 # now checking for total
492 $sth->execute( $cat_borrower, '*', '*' );
493 my $result = $sth->fetchrow_hashref;
494 if ( $result->{maxissueqty} ne '' ) {
495 $sth2->execute( $borrower->{'borrowernumber'}, $type );
496 my $alreadyissued = $sth2->fetchrow;
497 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
498 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / category / total failed)" );
503 # check the 0 parameters (default branch / itemtype / default categorycode
504 $sth->execute( '*', $type, '*' );
505 $result = $sth->fetchrow_hashref;
506 # warn "*, $type, * = ".Data::Dumper::Dumper($result);
508 if ( $result->{maxissueqty} ne '' ) {
509 # warn "checking on default branch and default categorycode";
510 $sth2->execute( $borrower->{'borrowernumber'}, $type );
511 my $alreadyissued = $sth2->fetchrow;
512 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
513 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / itemtype failed)" );
516 # now checking for total
517 $sth->execute( '*', '*', '*' );
518 $result = $sth->fetchrow_hashref;
519 if ( $result->{maxissueqty} ne '' ) {
520 warn "checking total";
521 $sth2->execute( $borrower->{'borrowernumber'}, $type );
522 my $alreadyissued = $sth2->fetchrow;
523 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
524 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / total failed)" );
528 # OK, the patron can issue !!!
534 @issues = &itemissues($biblioitemnumber, $biblio);
536 Looks up information about who has borrowed the bookZ<>(s) with the
537 given biblioitemnumber.
539 C<$biblio> is ignored.
541 C<&itemissues> returns an array of references-to-hash. The keys
542 include the fields from the C<items> table in the Koha database.
543 Additional keys include:
549 If the item is currently on loan, this gives the due date.
551 If the item is not on loan, then this is either "Available" or
552 "Cancelled", if the item has been withdrawn.
556 If the item is currently on loan, this gives the card number of the
557 patron who currently has the item.
559 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
561 These give the timestamp for the last three times the item was
564 =item C<card0>, C<card1>, C<card2>
566 The card number of the last three patrons who borrowed this item.
568 =item C<borrower0>, C<borrower1>, C<borrower2>
570 The borrower number of the last three patrons who borrowed this item.
578 my ( $bibitem, $biblio ) = @_;
579 my $dbh = C4::Context->dbh;
581 $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
586 $sth->execute($bibitem) || die $sth->errstr;
588 while ( my $data = $sth->fetchrow_hashref ) {
590 # Find out who currently has this item.
591 # FIXME - Wouldn't it be better to do this as a left join of
592 # some sort? Currently, this code assumes that if
593 # fetchrow_hashref() fails, then the book is on the shelf.
594 # fetchrow_hashref() can fail for any number of reasons (e.g.,
595 # database server crash), not just because no items match the
597 my $sth2 = $dbh->prepare(
598 "SELECT * FROM issues
599 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
604 $sth2->execute( $data->{'itemnumber'} );
605 if ( my $data2 = $sth2->fetchrow_hashref ) {
606 $data->{'date_due'} = $data2->{'date_due'};
607 $data->{'card'} = $data2->{'cardnumber'};
608 $data->{'borrower'} = $data2->{'borrowernumber'};
611 $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available';
616 # Find the last 3 people who borrowed this item.
617 $sth2 = $dbh->prepare(
618 "SELECT * FROM old_issues
619 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
621 ORDER BY returndate DESC,timestamp DESC"
624 $sth2->execute( $data->{'itemnumber'} );
625 for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
626 { # FIXME : error if there is less than 3 pple borrowing this item
627 if ( my $data2 = $sth2->fetchrow_hashref ) {
628 $data->{"timestamp$i2"} = $data2->{'timestamp'};
629 $data->{"card$i2"} = $data2->{'cardnumber'};
630 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
635 $results[$i] = $data;
643 =head2 CanBookBeIssued
645 ( $issuingimpossible, $needsconfirmation ) =
646 CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess );
647 C<$duedatespec> is a C4::Dates object.
648 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
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;
663 # DUE DATE is OK ? -- should already have checked.
665 #$issuingimpossible{INVALID_DATE} = 1 unless ($duedate);
670 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
671 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
672 &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'});
673 return( { STATS => 1 }, {});
675 if ( $borrower->{flags}->{GNA} ) {
676 $issuingimpossible{GNA} = 1;
678 if ( $borrower->{flags}->{'LOST'} ) {
679 $issuingimpossible{CARD_LOST} = 1;
681 if ( $borrower->{flags}->{'DBARRED'} ) {
682 $issuingimpossible{DEBARRED} = 1;
684 if ( $borrower->{'dateexpiry'} eq '0000-00-00') {
685 $issuingimpossible{EXPIRED} = 1;
687 my @expirydate= split /-/,$borrower->{'dateexpiry'};
688 if($expirydate[0]==0 || $expirydate[1]==0|| $expirydate[2]==0 ||
689 Date_to_Days(Today) > Date_to_Days( @expirydate )) {
690 $issuingimpossible{EXPIRED} = 1;
699 C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->output('iso') );
700 if ( C4::Context->preference("IssuingInProcess") ) {
701 my $amountlimit = C4::Context->preference("noissuescharge");
702 if ( $amount > $amountlimit && !$inprocess ) {
703 $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
705 elsif ( $amount <= $amountlimit && !$inprocess ) {
706 $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
711 $needsconfirmation{DEBT} = $amount;
716 # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
718 my $toomany = TooMany( $borrower, $item->{biblionumber}, $item );
719 $needsconfirmation{TOO_MANY} = $toomany if $toomany;
724 unless ( $item->{barcode} ) {
725 $issuingimpossible{UNKNOWN_BARCODE} = 1;
727 if ( $item->{'notforloan'}
728 && $item->{'notforloan'} > 0 )
730 $issuingimpossible{NOT_FOR_LOAN} = 1;
732 elsif ( !$item->{'notforloan'} ){
733 # we have to check itemtypes.notforloan also
734 if (C4::Context->preference('item-level_itypes')){
735 # this should probably be a subroutine
736 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
737 $sth->execute($item->{'itemtype'});
738 my $notforloan=$sth->fetchrow_hashref();
740 if ($notforloan->{'notforloan'} == 1){
741 $issuingimpossible{NOT_FOR_LOAN} = 1;
744 elsif ($biblioitem->{'notforloan'} == 1){
745 $issuingimpossible{NOT_FOR_LOAN} = 1;
748 if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
750 $issuingimpossible{WTHDRAWN} = 1;
752 if ( $item->{'restricted'}
753 && $item->{'restricted'} == 1 )
755 $issuingimpossible{RESTRICTED} = 1;
757 if ( C4::Context->preference("IndependantBranches") ) {
758 my $userenv = C4::Context->userenv;
759 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
760 $issuingimpossible{NOTSAMEBRANCH} = 1
761 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
766 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
768 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
771 # Already issued to current borrower. Ask whether the loan should
773 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
774 $borrower->{'borrowernumber'},
775 $item->{'itemnumber'}
777 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
778 $issuingimpossible{NO_MORE_RENEWALS} = 1;
781 $needsconfirmation{RENEW_ISSUE} = 1;
784 elsif ($issue->{borrowernumber}) {
786 # issued to someone else
787 my $currborinfo = GetMemberDetails( $issue->{borrowernumber} );
789 # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
790 $needsconfirmation{ISSUED_TO_ANOTHER} =
791 "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
794 # See if the item is on reserve.
795 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
797 my $resbor = $res->{'borrowernumber'};
798 my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 );
799 my $branches = GetBranches();
800 my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
801 if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
803 # The item is on reserve and waiting, but has been
804 # reserved by some other patron.
805 $needsconfirmation{RESERVE_WAITING} =
806 "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
808 elsif ( $restype eq "Reserved" ) {
809 # The item is on reserve for someone else.
810 $needsconfirmation{RESERVED} =
811 "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
814 if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" ) {
815 if ( $borrower->{'categorycode'} eq 'W' ) {
817 return ( \%emptyhash, \%needsconfirmation );
820 return ( \%issuingimpossible, \%needsconfirmation );
825 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
827 &AddIssue($borrower,$barcode,$date)
831 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
833 =item C<$barcode> is the bar code of the book being issued.
835 =item C<$date> contains the max date of return. calculated if empty.
837 AddIssue does the following things :
838 - step 01: check that there is a borrowernumber & a barcode provided
839 - check for RENEWAL (book issued & being issued to the same patron)
840 - renewal YES = Calculate Charge & renew
842 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
844 - fill reserve if reserve to this patron
845 - cancel reserve or not, otherwise
846 * TRANSFERT PENDING ?
847 - complete the transfert
855 my ( $borrower, $barcode, $date, $cancelreserve ) = @_;
856 my $dbh = C4::Context->dbh;
857 my $barcodecheck=CheckValidBarcode($barcode);
858 if ($borrower and $barcode and $barcodecheck ne '0'){
859 # find which item we issue
860 my $item = GetItem('', $barcode);
864 # Get which branchcode we need
865 if (C4::Context->preference('CircControl') eq 'PickupLibrary'){
866 $branch = C4::Context->userenv->{'branch'};
868 elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){
869 $branch = $borrower->{'branchcode'};
873 $branch = $item->{'homebranch'};
876 # get actual issuing if there is one
877 my $actualissue = GetItemIssue( $item->{itemnumber});
879 # get biblioinformation for this item
880 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
883 # check if we just renew the issue.
885 if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) {
887 $borrower->{'borrowernumber'},
888 $item->{'itemnumber'},
896 if ( $actualissue->{borrowernumber}) {
897 # This book is currently on loan, but not to the person
898 # who wants to borrow it now. mark it returned before issuing to the new borrower
901 C4::Context->userenv->{'branch'}
905 # See if the item is on reserve.
906 my ( $restype, $res ) =
907 C4::Reserves::CheckReserves( $item->{'itemnumber'} );
909 my $resbor = $res->{'borrowernumber'};
910 if ( $resbor eq $borrower->{'borrowernumber'} ) {
912 # The item is reserved by the current patron
913 ModReserveFill($res);
915 elsif ( $restype eq "Waiting" ) {
918 # The item is on reserve and waiting, but has been
919 # reserved by some other patron.
920 my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 );
921 my $branches = GetBranches();
923 $branches->{ $res->{'branchcode'} }->{'branchname'};
925 elsif ( $restype eq "Reserved" ) {
928 # The item is reserved by someone else.
929 my ( $resborrower, $flags ) =
930 GetMemberDetails( $resbor, 0 );
931 my $branches = GetBranches();
932 my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
933 if ($cancelreserve) { # cancel reserves on this item
934 CancelReserve( 0, $res->{'itemnumber'},
935 $res->{'borrowernumber'} );
938 if ($cancelreserve) {
939 CancelReserve( $res->{'biblionumber'}, 0,
940 $res->{'borrowernumber'} );
943 # set waiting reserve to first in reserve queue as book isn't waiting now
945 $res->{'biblionumber'},
946 $res->{'borrowernumber'},
952 # Starting process for transfer job (checking transfert and validate it if we have one)
953 my ($datesent) = GetTransfers($item->{'itemnumber'});
955 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....)
958 "UPDATE branchtransfers
959 SET datearrived = now(),
961 comments = 'Forced branchtransfer'
962 WHERE itemnumber= ? AND datearrived IS NULL"
964 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
968 # Record in the database the fact that the book was issued.
972 (borrowernumber, itemnumber,issuedate, date_due, branchcode)
979 my $itype=(C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ;
980 my $loanlength = GetLoanLength(
981 $borrower->{'categorycode'},
985 $dateduef = CalcDateDue(C4::Dates->new(),$loanlength,$branch);
986 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
987 if ( C4::Context->preference('ReturnBeforeExpiry') && $dateduef->output('iso') gt $borrower->{dateexpiry} ) {
988 $dateduef = C4::Dates->new($borrower->{dateexpiry},'iso');
992 $borrower->{'borrowernumber'},
993 $item->{'itemnumber'},
994 strftime( "%Y-%m-%d", localtime ),$dateduef->output('iso'), C4::Context->userenv->{'branch'}
998 ModItem({ issues => $item->{'issues'},
999 holdingbranch => C4::Context->userenv->{'branch'},
1001 datelastborrowed => C4::Dates->new()->output('iso'),
1002 onloan => $dateduef->output('iso'),
1003 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1004 ModDateLastSeen( $item->{'itemnumber'} );
1006 # If it costs to borrow this book, charge it to the patron's account.
1007 my ( $charge, $itemtype ) = GetIssuingCharges(
1008 $item->{'itemnumber'},
1009 $borrower->{'borrowernumber'}
1011 if ( $charge > 0 ) {
1013 $item->{'itemnumber'},
1014 $borrower->{'borrowernumber'}, $charge
1016 $item->{'charge'} = $charge;
1019 # Record the fact that this book was issued.
1021 C4::Context->userenv->{'branch'},
1023 '', $item->{'itemnumber'},
1024 $item->{'itemtype'}, $borrower->{'borrowernumber'}
1028 &logaction(C4::Context->userenv->{'number'},"CIRCULATION","ISSUE",$borrower->{'borrowernumber'},$biblio->{'biblionumber'})
1029 if C4::Context->preference("IssueLog");
1034 =head2 GetLoanLength
1036 Get loan length for an itemtype, a borrower type and a branch
1038 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1043 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1044 my $dbh = C4::Context->dbh;
1047 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"
1049 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1050 # try to find issuelength & return the 1st available.
1051 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1052 $sth->execute( $borrowertype, $itemtype, $branchcode );
1053 my $loanlength = $sth->fetchrow_hashref;
1054 return $loanlength->{issuelength}
1055 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1057 $sth->execute( $borrowertype, $itemtype, "*" );
1058 $loanlength = $sth->fetchrow_hashref;
1059 return $loanlength->{issuelength}
1060 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1062 $sth->execute( $borrowertype, "*", $branchcode );
1063 $loanlength = $sth->fetchrow_hashref;
1064 return $loanlength->{issuelength}
1065 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1067 $sth->execute( "*", $itemtype, $branchcode );
1068 $loanlength = $sth->fetchrow_hashref;
1069 return $loanlength->{issuelength}
1070 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1072 $sth->execute( $borrowertype, "*", "*" );
1073 $loanlength = $sth->fetchrow_hashref;
1074 return $loanlength->{issuelength}
1075 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1077 $sth->execute( "*", "*", $branchcode );
1078 $loanlength = $sth->fetchrow_hashref;
1079 return $loanlength->{issuelength}
1080 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1082 $sth->execute( "*", $itemtype, "*" );
1083 $loanlength = $sth->fetchrow_hashref;
1084 return $loanlength->{issuelength}
1085 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1087 $sth->execute( "*", "*", "*" );
1088 $loanlength = $sth->fetchrow_hashref;
1089 return $loanlength->{issuelength}
1090 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1092 # if no rule is set => 21 days (hardcoded)
1098 ($doreturn, $messages, $iteminformation, $borrower) =
1099 &AddReturn($barcode, $branch, $exemptfine);
1103 C<$barcode> is the bar code of the book being returned. C<$branch> is
1104 the code of the branch where the book is being returned. C<$exemptfine>
1105 indicates that overdue charges for the item will not be applied.
1107 C<&AddReturn> returns a list of four items:
1109 C<$doreturn> is true iff the return succeeded.
1111 C<$messages> is a reference-to-hash giving the reason for failure:
1117 No item with this barcode exists. The value is C<$barcode>.
1121 The book is not currently on loan. The value is C<$barcode>.
1123 =item C<IsPermanent>
1125 The book's home branch is a permanent collection. If you have borrowed
1126 this book, you are not allowed to return it. The value is the code for
1127 the book's home branch.
1131 This book has been withdrawn/cancelled. The value should be ignored.
1135 The item was reserved. The value is a reference-to-hash whose keys are
1136 fields from the reserves table of the Koha database, and
1137 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1138 either C<Waiting>, C<Reserved>, or 0.
1142 C<$borrower> is a reference-to-hash, giving information about the
1143 patron who last borrowed the book.
1148 my ( $barcode, $branch, $exemptfine ) = @_;
1149 my $dbh = C4::Context->dbh;
1153 my $validTransfert = 0;
1154 my $reserveDone = 0;
1156 # get information on item
1157 my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
1158 my $biblio = GetBiblioItemData($iteminformation->{'biblioitemnumber'});
1159 # use Data::Dumper;warn Data::Dumper::Dumper($iteminformation);
1160 unless ($iteminformation->{'itemnumber'} ) {
1161 $messages->{'BadBarcode'} = $barcode;
1165 if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1166 $messages->{'NotIssued'} = $barcode;
1170 # check if the book is in a permanent collection....
1171 my $hbr = $iteminformation->{'homebranch'};
1172 my $branches = GetBranches();
1173 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1174 $messages->{'IsPermanent'} = $hbr;
1177 # if independent branches are on and returning to different branch, refuse the return
1178 if ($hbr ne C4::Context->userenv->{'branch'} && C4::Context->preference("IndependantBranches")){
1179 $messages->{'Wrongbranch'} = 1;
1183 # check that the book has been cancelled
1184 if ( $iteminformation->{'wthdrawn'} ) {
1185 $messages->{'wthdrawn'} = 1;
1189 # new op dev : if the book returned in an other branch update the holding branch
1191 # update issues, thereby returning book (should push this out into another subroutine
1192 $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1194 # case of a return of document (deal with issues and holdingbranch)
1197 MarkIssueReturned($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
1198 $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
1201 # continue to deal with returns cases, but not only if we have an issue
1203 # the holdingbranch is updated if the document is returned in an other location .
1204 if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) {
1205 UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
1206 # reload iteminformation holdingbranch with the userenv value
1207 $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1209 ModDateLastSeen( $iteminformation->{'itemnumber'} );
1210 ModItem({ onloan => undef }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'});
1212 if ($iteminformation->{borrowernumber}){
1213 ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1215 # fix up the accounts.....
1216 if ( $iteminformation->{'itemlost'} ) {
1217 $messages->{'WasLost'} = 1;
1220 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1221 # check if we have a transfer for this document
1222 my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1224 # if we have a transfer to do, we update the line of transfers with the datearrived
1226 if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1229 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1231 $sth->execute( $iteminformation->{'itemnumber'} );
1233 # 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'
1234 C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1237 $messages->{'WrongTransfer'} = $tobranch;
1238 $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1240 $validTransfert = 1;
1243 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1244 # fix up the accounts.....
1245 if ($iteminformation->{'itemlost'}) {
1246 FixAccountForLostAndReturned($iteminformation, $borrower);
1247 $messages->{'WasLost'} = 1;
1249 # fix up the overdues in accounts...
1250 FixOverduesOnReturn( $borrower->{'borrowernumber'},
1251 $iteminformation->{'itemnumber'}, $exemptfine );
1253 # find reserves.....
1254 # if we don't have a reserve with the status W, we launch the Checkreserves routine
1255 my ( $resfound, $resrec ) =
1256 C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1258 $resrec->{'ResFound'} = $resfound;
1259 $messages->{'ResFound'} = $resrec;
1264 # Record the fact that this book was returned.
1266 $branch, 'return', '0', '',
1267 $iteminformation->{'itemnumber'},
1268 $biblio->{'itemtype'},
1269 $borrower->{'borrowernumber'}
1272 &logaction(C4::Context->userenv->{'number'},"CIRCULATION","RETURN",$iteminformation->{borrowernumber},$iteminformation->{'biblionumber'})
1273 if C4::Context->preference("ReturnLog");
1275 #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1276 #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1278 if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1279 if (C4::Context->preference("AutomaticItemReturn") == 1) {
1280 ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1281 $messages->{'WasTransfered'} = 1;
1284 $messages->{'NeedsTransfer'} = 1;
1288 return ( $doreturn, $messages, $iteminformation, $borrower );
1291 =head2 MarkIssueReturned
1295 MarkIssueReturned($borrowernumber, $itemnumber);
1299 Unconditionally marks an issue as being returned by
1300 moving the C<issues> row to C<old_issues> and
1301 setting C<returndate> to the current date.
1303 Ideally, this function would be internal to C<C4::Circulation>,
1304 not exported, but it is currently needed by one
1305 routine in C<C4::Accounts>.
1309 sub MarkIssueReturned {
1310 my ($borrowernumber, $itemnumber) = @_;
1312 my $dbh = C4::Context->dbh;
1314 my $sth_upd = $dbh->prepare("UPDATE issues SET returndate = now()
1315 WHERE borrowernumber = ?
1316 AND itemnumber = ?");
1317 $sth_upd->execute($borrowernumber, $itemnumber);
1318 my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1319 WHERE borrowernumber = ?
1320 AND itemnumber = ?");
1321 $sth_copy->execute($borrowernumber, $itemnumber);
1322 my $sth_del = $dbh->prepare("DELETE FROM issues
1323 WHERE borrowernumber = ?
1324 AND itemnumber = ?");
1325 $sth_del->execute($borrowernumber, $itemnumber);
1328 =head2 FixOverduesOnReturn
1330 &FixOverduesOnReturn($brn,$itm, $exemptfine);
1332 C<$brn> borrowernumber
1336 internal function, called only by AddReturn
1340 sub FixOverduesOnReturn {
1341 my ( $borrowernumber, $item, $exemptfine ) = @_;
1342 my $dbh = C4::Context->dbh;
1344 # check for overdue fine
1347 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1349 $sth->execute( $borrowernumber, $item );
1351 # alter fine to show that the book has been returned
1353 if ($data = $sth->fetchrow_hashref) {
1354 my $uquery =($exemptfine)? "update accountlines set accounttype='FFOR', amountoutstanding=0":"update accountlines set accounttype='F' ";
1355 $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1356 my $usth = $dbh->prepare($uquery);
1357 $usth->execute($borrowernumber,$item ,$data->{'accountno'});
1365 =head2 FixAccountForLostAndReturned
1367 &FixAccountForLostAndReturned($iteminfo,$borrower);
1369 Calculates the charge for a book lost and returned (Not exported & used only once)
1371 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1373 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1375 Internal function, called by AddReturn
1379 sub FixAccountForLostAndReturned {
1380 my ($iteminfo, $borrower) = @_;
1382 my $dbh = C4::Context->dbh;
1383 my $itm = $iteminfo->{'itemnumber'};
1384 # check for charge made for lost book
1385 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1386 $sth->execute($itm);
1387 if (my $data = $sth->fetchrow_hashref) {
1388 # writeoff this amount
1390 my $amount = $data->{'amount'};
1391 my $acctno = $data->{'accountno'};
1393 if ($data->{'amountoutstanding'} == $amount) {
1394 $offset = $data->{'amount'};
1397 $offset = $amount - $data->{'amountoutstanding'};
1398 $amountleft = $data->{'amountoutstanding'} - $amount;
1400 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1401 WHERE (borrowernumber = ?)
1402 AND (itemnumber = ?) AND (accountno = ?) ");
1403 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1405 #check if any credit is left if so writeoff other accounts
1406 my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
1407 if ($amountleft < 0){
1410 if ($amountleft > 0){
1411 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1412 AND (amountoutstanding >0) ORDER BY date");
1413 $msth->execute($data->{'borrowernumber'});
1414 # offset transactions
1417 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1418 if ($accdata->{'amountoutstanding'} < $amountleft) {
1420 $amountleft -= $accdata->{'amountoutstanding'};
1422 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1425 my $thisacct = $accdata->{'accountno'};
1426 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1427 WHERE (borrowernumber = ?)
1428 AND (accountno=?)");
1429 $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1431 $usth = $dbh->prepare("INSERT INTO accountoffsets
1432 (borrowernumber, accountno, offsetaccount, offsetamount)
1435 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1440 if ($amountleft > 0){
1443 my $desc="Item Returned ".$iteminfo->{'barcode'};
1444 $usth = $dbh->prepare("INSERT INTO accountlines
1445 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1446 VALUES (?,?,now(),?,?,'CR',?)");
1447 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1449 $usth = $dbh->prepare("INSERT INTO accountoffsets
1450 (borrowernumber, accountno, offsetaccount, offsetamount)
1452 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1454 ModItem({ paidfor => '' }, undef, $itm);
1462 $issues = &GetItemIssue($itemnumber);
1464 Returns patrons currently having a book. nothing if item is not issued atm
1466 C<$itemnumber> is the itemnumber
1468 Returns an array of hashes
1473 my ( $itemnumber) = @_;
1474 return unless $itemnumber;
1475 my $dbh = C4::Context->dbh;
1479 my $today = POSIX::strftime("%Y%m%d", localtime);
1481 my $sth = $dbh->prepare(
1482 "SELECT * FROM issues
1483 LEFT JOIN items ON issues.itemnumber=items.itemnumber
1485 issues.itemnumber=?");
1486 $sth->execute($itemnumber);
1487 my $data = $sth->fetchrow_hashref;
1488 my $datedue = $data->{'date_due'};
1490 if ( $datedue < $today ) {
1491 $data->{'overdue'} = 1;
1493 $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1498 =head2 GetItemIssues
1500 $issues = &GetItemIssues($itemnumber, $history);
1502 Returns patrons that have issued a book
1504 C<$itemnumber> is the itemnumber
1505 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1507 Returns an array of hashes
1512 my ( $itemnumber,$history ) = @_;
1513 my $dbh = C4::Context->dbh;
1517 my $today = POSIX::strftime("%Y%m%d", localtime);
1519 my $sql = "SELECT * FROM issues
1520 JOIN borrowers USING (borrowernumber)
1521 JOIN items USING (itemnumber)
1522 WHERE issues.itemnumber = ? ";
1525 SELECT * FROM old_issues
1526 LEFT JOIN borrowers USING (borrowernumber)
1527 JOIN items USING (itemnumber)
1528 WHERE old_issues.itemnumber = ? ";
1530 $sql .= "ORDER BY date_due DESC";
1531 my $sth = $dbh->prepare($sql);
1533 $sth->execute($itemnumber, $itemnumber);
1535 $sth->execute($itemnumber);
1537 while ( my $data = $sth->fetchrow_hashref ) {
1538 my $datedue = $data->{'date_due'};
1540 if ( $datedue < $today ) {
1541 $data->{'overdue'} = 1;
1543 my $itemnumber = $data->{'itemnumber'};
1544 push @GetItemIssues, $data;
1547 return ( \@GetItemIssues );
1550 =head2 GetBiblioIssues
1552 $issues = GetBiblioIssues($biblionumber);
1554 this function get all issues from a biblionumber.
1557 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1558 tables issues and the firstname,surname & cardnumber from borrowers.
1562 sub GetBiblioIssues {
1563 my $biblionumber = shift;
1564 return undef unless $biblionumber;
1565 my $dbh = C4::Context->dbh;
1567 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1569 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1570 LEFT JOIN items ON issues.itemnumber = items.itemnumber
1571 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1572 LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1573 WHERE biblio.biblionumber = ?
1575 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1577 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1578 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1579 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1580 LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1581 WHERE biblio.biblionumber = ?
1584 my $sth = $dbh->prepare($query);
1585 $sth->execute($biblionumber, $biblionumber);
1588 while ( my $data = $sth->fetchrow_hashref ) {
1589 push @issues, $data;
1594 =head2 CanBookBeRenewed
1596 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber);
1598 Find out whether a borrowed item may be renewed.
1600 C<$dbh> is a DBI handle to the Koha database.
1602 C<$borrowernumber> is the borrower number of the patron who currently
1603 has the item on loan.
1605 C<$itemnumber> is the number of the item to renew.
1607 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1608 item must currently be on loan to the specified borrower; renewals
1609 must be allowed for the item's type; and the borrower must not have
1610 already renewed the loan. $error will contain the reason the renewal can not proceed
1614 sub CanBookBeRenewed {
1616 # check renewal status
1617 my ( $borrowernumber, $itemnumber ) = @_;
1618 my $dbh = C4::Context->dbh;
1623 # Look in the issues table for this item, lent to this borrower,
1624 # and not yet returned.
1626 # FIXME - I think this function could be redone to use only one SQL call.
1627 my $sth1 = $dbh->prepare(
1628 "SELECT * FROM issues
1629 WHERE borrowernumber = ?
1632 $sth1->execute( $borrowernumber, $itemnumber );
1633 if ( my $data1 = $sth1->fetchrow_hashref ) {
1635 # Found a matching item
1637 # See if this item may be renewed. This query is convoluted
1638 # because it's a bit messy: given the item number, we need to find
1639 # the biblioitem, which gives us the itemtype, which tells us
1640 # whether it may be renewed.
1641 my $sth2 = $dbh->prepare(
1642 "SELECT renewalsallowed FROM items
1643 LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1644 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
1645 WHERE items.itemnumber = ?
1648 $sth2->execute($itemnumber);
1649 if ( my $data2 = $sth2->fetchrow_hashref ) {
1650 $renews = $data2->{'renewalsallowed'};
1652 if ( $renews && $renews > $data1->{'renewals'} ) {
1659 my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1667 return ($renewokay,$error);
1672 &AddRenewal($borrowernumber, $itemnumber, $datedue);
1676 C<$borrowernumber> is the borrower number of the patron who currently
1679 C<$itemnumber> is the number of the item to renew.
1681 C<$datedue> can be used to set the due date. If C<$datedue> is the
1682 empty string, C<&AddRenewal> will calculate the due date automatically
1683 from the book's item type. If you wish to set the due date manually,
1684 C<$datedue> should be in the form YYYY-MM-DD.
1690 my ( $borrowernumber, $itemnumber, $branch ,$datedue ) = @_;
1691 my $dbh = C4::Context->dbh;
1692 my $biblio = GetBiblioFromItemNumber($itemnumber);
1693 # If the due date wasn't specified, calculate it by adding the
1694 # book's loan length to today's date.
1695 unless ( $datedue ) {
1698 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
1699 my $loanlength = GetLoanLength(
1700 $borrower->{'categorycode'},
1701 (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
1702 $borrower->{'branchcode'}
1704 #FIXME -- choose issuer or borrower branch -- use circControl.
1706 #FIXME -- $debug-ify the (0)
1707 #my @darray = Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 );
1708 #$datedue = C4::Dates->new( sprintf("%04d-%02d-%02d",@darray[0..2]), 'iso');
1709 #(0) and print STDERR "C4::Dates->new->output = " . C4::Dates->new()->output()
1710 # . "\ndatedue->output = " . $datedue->output()
1711 # . "\n(Y,M,D) = " . join ',', @darray;
1712 #$datedue=CheckValidDatedue($datedue,$itemnumber,$branch,$loanlength);
1713 $datedue = CalcDateDue(C4::Dates->new(),$loanlength,$branch);
1716 # Find the issues record for this book
1718 $dbh->prepare("SELECT * FROM issues
1719 WHERE borrowernumber=?
1722 $sth->execute( $borrowernumber, $itemnumber );
1723 my $issuedata = $sth->fetchrow_hashref;
1726 # Update the issues record to have the new due date, and a new count
1727 # of how many times it has been renewed.
1728 my $renews = $issuedata->{'renewals'} + 1;
1729 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?
1730 WHERE borrowernumber=?
1733 $sth->execute( $datedue->output('iso'), $renews, $borrowernumber, $itemnumber );
1736 # Update the renewal count on the item, and tell zebra to reindex
1737 $renews = $biblio->{'renewals'} + 1;
1738 ModItem({ renewals => $renews }, $biblio->{'biblionumber'}, $itemnumber);
1740 # Charge a new rental fee, if applicable?
1741 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1742 if ( $charge > 0 ) {
1743 my $accountno = getnextacctno( $borrowernumber );
1744 my $item = GetBiblioFromItemNumber($itemnumber);
1745 $sth = $dbh->prepare(
1746 "INSERT INTO accountlines
1747 (borrowernumber,accountno,date,amount,
1748 description,accounttype,amountoutstanding,
1750 VALUES (?,?,now(),?,?,?,?,?)"
1752 $sth->execute( $borrowernumber, $accountno, $charge,
1753 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
1754 'Rent', $charge, $itemnumber );
1758 UpdateStats( $branch, 'renew', $charge, '', $itemnumber );
1762 # check renewal status
1763 my ($bornum,$itemno)=@_;
1764 my $dbh = C4::Context->dbh;
1766 my $renewsallowed = 0;
1768 # Look in the issues table for this item, lent to this borrower,
1769 # and not yet returned.
1771 # FIXME - I think this function could be redone to use only one SQL call.
1772 my $sth = $dbh->prepare("select * from issues
1773 where (borrowernumber = ?)
1774 and (itemnumber = ?)");
1775 $sth->execute($bornum,$itemno);
1776 my $data = $sth->fetchrow_hashref;
1777 $renewcount = $data->{'renewals'} if $data->{'renewals'};
1778 my $sth2 = $dbh->prepare("select renewalsallowed from items,biblioitems,itemtypes
1779 where (items.itemnumber = ?)
1780 and (items.biblioitemnumber = biblioitems.biblioitemnumber)
1781 and (biblioitems.itemtype = itemtypes.itemtype)");
1782 $sth2->execute($itemno);
1783 my $data2 = $sth2->fetchrow_hashref();
1784 $renewsallowed = $data2->{'renewalsallowed'};
1785 $renewsleft = $renewsallowed - $renewcount;
1786 # warn "Renewcount:$renewcount RenewsAll:$renewsallowed RenewLeft:$renewsleft";
1787 return ($renewcount,$renewsallowed,$renewsleft);
1789 =head2 GetIssuingCharges
1791 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
1793 Calculate how much it would cost for a given patron to borrow a given
1794 item, including any applicable discounts.
1796 C<$itemnumber> is the item number of item the patron wishes to borrow.
1798 C<$borrowernumber> is the patron's borrower number.
1800 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
1801 and C<$item_type> is the code for the item's item type (e.g., C<VID>
1806 sub GetIssuingCharges {
1808 # calculate charges due
1809 my ( $itemnumber, $borrowernumber ) = @_;
1811 my $dbh = C4::Context->dbh;
1814 # Get the book's item type and rental charge (via its biblioitem).
1815 my $qcharge = "SELECT itemtypes.itemtype,rentalcharge FROM items
1816 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
1817 $qcharge .= (C4::Context->preference('item-level_itypes'))
1818 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1819 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1821 $qcharge .= "WHERE items.itemnumber =?";
1823 my $sth1 = $dbh->prepare($qcharge);
1824 $sth1->execute($itemnumber);
1825 if ( my $data1 = $sth1->fetchrow_hashref ) {
1826 $item_type = $data1->{'itemtype'};
1827 $charge = $data1->{'rentalcharge'};
1828 my $q2 = "SELECT rentaldiscount FROM borrowers
1829 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
1830 WHERE borrowers.borrowernumber = ?
1831 AND issuingrules.itemtype = ?";
1832 my $sth2 = $dbh->prepare($q2);
1833 $sth2->execute( $borrowernumber, $item_type );
1834 if ( my $data2 = $sth2->fetchrow_hashref ) {
1835 my $discount = $data2->{'rentaldiscount'};
1836 if ( $discount eq 'NULL' ) {
1839 $charge = ( $charge * ( 100 - $discount ) ) / 100;
1845 return ( $charge, $item_type );
1848 =head2 AddIssuingCharge
1850 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
1854 sub AddIssuingCharge {
1855 my ( $itemnumber, $borrowernumber, $charge ) = @_;
1856 my $dbh = C4::Context->dbh;
1857 my $nextaccntno = getnextacctno( $borrowernumber );
1859 INSERT INTO accountlines
1860 (borrowernumber, itemnumber, accountno,
1861 date, amount, description, accounttype,
1863 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
1865 my $sth = $dbh->prepare($query);
1866 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
1872 GetTransfers($itemnumber);
1877 my ($itemnumber) = @_;
1879 my $dbh = C4::Context->dbh;
1885 FROM branchtransfers
1886 WHERE itemnumber = ?
1887 AND datearrived IS NULL
1889 my $sth = $dbh->prepare($query);
1890 $sth->execute($itemnumber);
1891 my @row = $sth->fetchrow_array();
1897 =head2 GetTransfersFromTo
1899 @results = GetTransfersFromTo($frombranch,$tobranch);
1901 Returns the list of pending transfers between $from and $to branch
1905 sub GetTransfersFromTo {
1906 my ( $frombranch, $tobranch ) = @_;
1907 return unless ( $frombranch && $tobranch );
1908 my $dbh = C4::Context->dbh;
1910 SELECT itemnumber,datesent,frombranch
1911 FROM branchtransfers
1914 AND datearrived IS NULL
1916 my $sth = $dbh->prepare($query);
1917 $sth->execute( $frombranch, $tobranch );
1920 while ( my $data = $sth->fetchrow_hashref ) {
1921 push @gettransfers, $data;
1924 return (@gettransfers);
1927 =head2 DeleteTransfer
1929 &DeleteTransfer($itemnumber);
1933 sub DeleteTransfer {
1934 my ($itemnumber) = @_;
1935 my $dbh = C4::Context->dbh;
1936 my $sth = $dbh->prepare(
1937 "DELETE FROM branchtransfers
1939 AND datearrived IS NULL "
1941 $sth->execute($itemnumber);
1945 =head2 AnonymiseIssueHistory
1947 $rows = AnonymiseIssueHistory($borrowernumber,$date)
1949 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
1950 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
1952 return the number of affected rows.
1956 sub AnonymiseIssueHistory {
1958 my $borrowernumber = shift;
1959 my $dbh = C4::Context->dbh;
1962 SET borrowernumber = NULL
1963 WHERE returndate < '".$date."'
1964 AND borrowernumber IS NOT NULL
1966 $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
1967 my $rows_affected = $dbh->do($query);
1968 return $rows_affected;
1971 =head2 updateWrongTransfer
1973 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
1975 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
1979 sub updateWrongTransfer {
1980 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
1981 my $dbh = C4::Context->dbh;
1982 # first step validate the actual line of transfert .
1985 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
1987 $sth->execute($FromLibrary,$itemNumber);
1990 # second step create a new line of branchtransfer to the right location .
1991 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
1993 #third step changing holdingbranch of item
1994 UpdateHoldingbranch($FromLibrary,$itemNumber);
1997 =head2 UpdateHoldingbranch
1999 $items = UpdateHoldingbranch($branch,$itmenumber);
2000 Simple methode for updating hodlingbranch in items BDD line
2004 sub UpdateHoldingbranch {
2005 my ( $branch,$itemnumber ) = @_;
2006 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2011 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2012 this function calculates the due date given the loan length ,
2013 checking against the holidays calendar as per the 'useDaysMode' syspref.
2014 C<$startdate> = C4::Dates object representing start date of loan period (assumed to be today)
2015 C<$branch> = location whose calendar to use
2016 C<$loanlength> = loan length prior to adjustment
2020 my ($startdate,$loanlength,$branch) = @_;
2021 if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar
2022 my $datedue = time + ($loanlength) * 86400;
2023 #FIXME - assumes now even though we take a startdate
2024 my @datearr = localtime($datedue);
2025 return C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2027 my $calendar = C4::Calendar->new( branchcode => $branch );
2028 my $datedue = $calendar->addDate($startdate, $loanlength);
2033 =head2 CheckValidDatedue
2034 This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2035 To be replaced by CalcDateDue() once C4::Calendar use is tested.
2037 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2038 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2039 C<$date_due> = returndate calculate with no day check
2040 C<$itemnumber> = itemnumber
2041 C<$branchcode> = location of issue (affected by 'CircControl' syspref)
2042 C<$loanlength> = loan length prior to adjustment
2045 sub CheckValidDatedue {
2046 my ($date_due,$itemnumber,$branchcode)=@_;
2047 my @datedue=split('-',$date_due->output('iso'));
2048 my $years=$datedue[0];
2049 my $month=$datedue[1];
2050 my $day=$datedue[2];
2051 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2053 for (my $i=0;$i<2;$i++){
2054 $dow=Day_of_Week($years,$month,$day);
2055 ($dow=0) if ($dow>6);
2056 my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2057 my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2058 my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2059 if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2061 (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2064 my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2069 =head2 CheckRepeatableHolidays
2071 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2072 this function checks if the date due is a repeatable holiday
2073 C<$date_due> = returndate calculate with no day check
2074 C<$itemnumber> = itemnumber
2075 C<$branchcode> = localisation of issue
2079 sub CheckRepeatableHolidays{
2080 my($itemnumber,$week_day,$branchcode)=@_;
2081 my $dbh = C4::Context->dbh;
2082 my $query = qq|SELECT count(*)
2083 FROM repeatable_holidays
2086 my $sth = $dbh->prepare($query);
2087 $sth->execute($branchcode,$week_day);
2088 my $result=$sth->fetchrow;
2094 =head2 CheckSpecialHolidays
2096 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2097 this function check if the date is a special holiday
2098 C<$years> = the years of datedue
2099 C<$month> = the month of datedue
2100 C<$day> = the day of datedue
2101 C<$itemnumber> = itemnumber
2102 C<$branchcode> = localisation of issue
2106 sub CheckSpecialHolidays{
2107 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2108 my $dbh = C4::Context->dbh;
2109 my $query=qq|SELECT count(*)
2110 FROM `special_holidays`
2116 my $sth = $dbh->prepare($query);
2117 $sth->execute($years,$month,$day,$branchcode);
2118 my $countspecial=$sth->fetchrow ;
2120 return $countspecial;
2123 =head2 CheckRepeatableSpecialHolidays
2125 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2126 this function check if the date is a repeatble special holidays
2127 C<$month> = the month of datedue
2128 C<$day> = the day of datedue
2129 C<$itemnumber> = itemnumber
2130 C<$branchcode> = localisation of issue
2134 sub CheckRepeatableSpecialHolidays{
2135 my ($month,$day,$itemnumber,$branchcode) = @_;
2136 my $dbh = C4::Context->dbh;
2137 my $query=qq|SELECT count(*)
2138 FROM `repeatable_holidays`
2143 my $sth = $dbh->prepare($query);
2144 $sth->execute($month,$day,$branchcode);
2145 my $countspecial=$sth->fetchrow ;
2147 return $countspecial;
2152 sub CheckValidBarcode{
2154 my $dbh = C4::Context->dbh;
2155 my $query=qq|SELECT count(*)
2159 my $sth = $dbh->prepare($query);
2160 $sth->execute($barcode);
2161 my $exist=$sth->fetchrow ;
2172 Koha Developement team <info@koha.org>