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
39 use POSIX qw(strftime);
40 use C4::Branch; # GetBranches
41 use C4::Log; # logaction
45 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,%EXPORT_TAGS);
47 # set the version for version checking
52 C4::Circulation - Koha circulation module
60 The functions in this module deal with circulation, issues, and
61 returns, as well as general information about the library.
62 Also deals with stocktaking.
70 # FIXME subs that should probably be elsewhere
76 # subs to deal with issuing a book
88 &AnonymiseIssueHistory
90 # subs to deal with returns
95 # subs to deal with transfers
104 # FIXME - At least, I'm pretty sure this is for decoding CueCat stuff.
105 # 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 ?
109 =head3 $str = &decode($chunk);
113 =item Decodes a segment of a string emitted by a CueCat barcode scanner and
120 sub cuecatbarcodedecode {
123 my @fields = split( /\./, $barcode );
124 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
125 if ( $#results == 2 ) {
135 =head3 $str = &decode($chunk);
139 =item Decodes a segment of a string emitted by a CueCat barcode scanner and
149 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
150 my @s = map { index( $seq, $_ ); } split( //, $encoded );
151 my $l = ( $#s + 1 ) % 4;
162 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
164 chr( ( $n >> 16 ) ^ 67 )
165 .chr( ( $n >> 8 & 255 ) ^ 67 )
166 .chr( ( $n & 255 ) ^ 67 );
169 $r = substr( $r, 0, length($r) - $l );
175 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, $barcode, $ignore_reserves);
177 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
179 C<$newbranch> is the code for the branch to which the item should be transferred.
181 C<$barcode> is the barcode of the item to be transferred.
183 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
184 Otherwise, if an item is reserved, the transfer fails.
186 Returns three values:
190 is true if the transfer was successful.
194 is a reference-to-hash which may have any of the following keys:
200 There is no item in the catalog with the given barcode. The value is C<$barcode>.
204 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.
206 =item C<DestinationEqualsHolding>
208 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.
212 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.
216 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>.
218 =item C<WasTransferred>
220 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
227 my ( $tbr, $barcode, $ignoreRs ) = @_;
230 my $branches = GetBranches();
231 my $itemnumber = GetItemnumberFromBarcode( $barcode );
232 my $issue = GetItemIssue($itemnumber);
233 my $biblio = GetBiblioFromItemNumber($itemnumber);
236 if ( not $itemnumber ) {
237 $messages->{'BadBarcode'} = $barcode;
241 # get branches of book...
242 my $hbr = $biblio->{'homebranch'};
243 my $fbr = $biblio->{'holdingbranch'};
246 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
247 $messages->{'IsPermanent'} = $hbr;
250 # can't transfer book if is already there....
251 if ( $fbr eq $tbr ) {
252 $messages->{'DestinationEqualsHolding'} = 1;
256 # check if it is still issued to someone, return it...
257 if ($issue->{borrowernumber}) {
258 AddReturn( $barcode, $fbr );
259 $messages->{'WasReturned'} = $issue->{borrowernumber};
263 # That'll save a database query.
264 my ( $resfound, $resrec ) =
265 CheckReserves( $itemnumber );
266 if ( $resfound and not $ignoreRs ) {
267 $resrec->{'ResFound'} = $resfound;
269 # $messages->{'ResFound'} = $resrec;
273 #actually do the transfer....
275 ModItemTransfer( $itemnumber, $fbr, $tbr );
277 # don't need to update MARC anymore, we do it in batch now
278 $messages->{'WasTransfered'} = 1;
279 ModDateLastSeen( $itemnumber );
281 return ( $dotransfer, $messages, $biblio );
284 =head2 CanBookBeIssued
286 Check if a book can be issued.
288 my ($issuingimpossible,$needsconfirmation) = CanBookBeIssued($borrower,$barcode,$year,$month,$day);
292 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
294 =item C<$barcode> is the bar code of the book being issued.
296 =item C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate".
304 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
305 Possible values are :
311 sticky due date is invalid
315 borrower gone with no address
319 borrower declared it's card lost
325 =head3 UNKNOWN_BARCODE
339 item is restricted (set by ??)
341 C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
342 Possible values are :
350 renewing, not issuing
352 =head3 ISSUED_TO_ANOTHER
354 issued to someone else.
358 reserved for someone else.
362 sticky due date is invalid
366 if the borrower borrows to much things
370 # check if a book can be issued.
374 my $borrower = shift;
375 my $biblionumber = shift;
377 my $cat_borrower = $borrower->{'categorycode'};
378 my $branch_borrower = $borrower->{'branchcode'};
379 my $dbh = C4::Context->dbh;
381 my $branch_issuer = C4::Context->userenv->{'branchcode'};
382 # TODO : specify issuer or borrower for circrule.
383 my $type = (C4::Context->preference('item-level_itypes'))
384 ? $item->{'itype'} # item-level
385 : $item->{'itemtype'}; # biblio-level
389 'SELECT * FROM issuingrules
390 WHERE categorycode = ?
395 my $query2 = "SELECT COUNT(*) FROM issues i, biblioitems s1, items s2
396 WHERE i.borrowernumber = ?
397 AND i.returndate IS NULL
398 AND i.itemnumber = s2.itemnumber
399 AND s1.biblioitemnumber = s2.biblioitemnumber";
400 if (C4::Context->preference('item-level_itypes')){
401 $query2.=" AND s2.itype=? ";
403 $query2.=" AND s1.itemtype= ? ";
405 my $sth2= $dbh->prepare($query2);
408 'SELECT COUNT(*) FROM issues
409 WHERE borrowernumber = ?
410 AND returndate IS NULL'
414 # check the 3 parameters (branch / itemtype / category code
415 $sth->execute( $cat_borrower, $type, $branch_borrower );
416 my $result = $sth->fetchrow_hashref;
417 # warn "$cat_borrower, $type, $branch_borrower = ".Data::Dumper::Dumper($result);
419 if ( $result->{maxissueqty} ne '' ) {
420 # warn "checking on everything set";
421 $sth2->execute( $borrower->{'borrowernumber'}, $type );
422 my $alreadyissued = $sth2->fetchrow;
423 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
424 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/itemtype failed)" );
426 # now checking for total
427 $sth->execute( $cat_borrower, '', $branch_borrower );
428 my $result = $sth->fetchrow_hashref;
429 if ( $result->{maxissueqty} ne '*' ) {
430 $sth2->execute( $borrower->{'borrowernumber'}, $type );
431 my $alreadyissued = $sth2->fetchrow;
432 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
433 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/total failed)" );
438 # check the 2 parameters (branch / itemtype / default categorycode
439 $sth->execute( '*', $type, $branch_borrower );
440 my $result = $sth->fetchrow_hashref;
441 # warn "*, $type, $branch_borrower = ".Data::Dumper::Dumper($result);
443 if ( $result->{maxissueqty} ne '' ) {
444 # warn "checking on 2 parameters (default categorycode)";
445 $sth2->execute( $borrower->{'borrowernumber'}, $type );
446 my $alreadyissued = $sth2->fetchrow;
447 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
448 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / itemtype failed)" );
450 # now checking for total
451 $sth->execute( '*', '*', $branch_borrower );
452 my $result = $sth->fetchrow_hashref;
453 if ( $result->{maxissueqty} ne '' ) {
454 $sth2->execute( $borrower->{'borrowernumber'}, $type );
455 my $alreadyissued = $sth2->fetchrow;
456 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
457 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / total failed)" );
462 # check the 1 parameters (default branch / itemtype / categorycode
463 $sth->execute( $cat_borrower, $type, '*' );
464 my $result = $sth->fetchrow_hashref;
465 # warn "$cat_borrower, $type, * = ".Data::Dumper::Dumper($result);
467 if ( $result->{maxissueqty} ne '' ) {
468 # warn "checking on 1 parameter (default branch + categorycode)";
469 $sth2->execute( $borrower->{'borrowernumber'}, $type );
470 my $alreadyissued = $sth2->fetchrow;
471 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
472 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch/category/itemtype failed)" );
474 # now checking for total
475 $sth->execute( $cat_borrower, '*', '*' );
476 my $result = $sth->fetchrow_hashref;
477 if ( $result->{maxissueqty} ne '' ) {
478 $sth2->execute( $borrower->{'borrowernumber'}, $type );
479 my $alreadyissued = $sth2->fetchrow;
480 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
481 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / category / total failed)" );
486 # check the 0 parameters (default branch / itemtype / default categorycode
487 $sth->execute( '*', $type, '*' );
488 my $result = $sth->fetchrow_hashref;
489 # warn "*, $type, * = ".Data::Dumper::Dumper($result);
491 if ( $result->{maxissueqty} ne '' ) {
492 # warn "checking on default branch and default categorycode";
493 $sth2->execute( $borrower->{'borrowernumber'}, $type );
494 my $alreadyissued = $sth2->fetchrow;
495 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
496 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / itemtype failed)" );
499 # now checking for total
500 $sth->execute( '*', '*', '*' );
501 my $result = $sth->fetchrow_hashref;
502 if ( $result->{maxissueqty} ne '' ) {
503 warn "checking total";
504 $sth2->execute( $borrower->{'borrowernumber'}, $type );
505 my $alreadyissued = $sth2->fetchrow;
506 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
507 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / total failed)" );
511 # OK, the patron can issue !!!
517 @issues = &itemissues($biblioitemnumber, $biblio);
519 Looks up information about who has borrowed the bookZ<>(s) with the
520 given biblioitemnumber.
522 C<$biblio> is ignored.
524 C<&itemissues> returns an array of references-to-hash. The keys
525 include the fields from the C<items> table in the Koha database.
526 Additional keys include:
532 If the item is currently on loan, this gives the due date.
534 If the item is not on loan, then this is either "Available" or
535 "Cancelled", if the item has been withdrawn.
539 If the item is currently on loan, this gives the card number of the
540 patron who currently has the item.
542 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
544 These give the timestamp for the last three times the item was
547 =item C<card0>, C<card1>, C<card2>
549 The card number of the last three patrons who borrowed this item.
551 =item C<borrower0>, C<borrower1>, C<borrower2>
553 The borrower number of the last three patrons who borrowed this item.
561 my ( $bibitem, $biblio ) = @_;
562 my $dbh = C4::Context->dbh;
564 # FIXME - If this function die()s, the script will abort, and the
565 # user won't get anything; depending on how far the script has
566 # gotten, the user might get a blank page. It would be much better
567 # to at least print an error message. The easiest way to do this
568 # is to set $SIG{__DIE__}.
570 $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
575 $sth->execute($bibitem) || die $sth->errstr;
577 while ( my $data = $sth->fetchrow_hashref ) {
579 # Find out who currently has this item.
580 # FIXME - Wouldn't it be better to do this as a left join of
581 # some sort? Currently, this code assumes that if
582 # fetchrow_hashref() fails, then the book is on the shelf.
583 # fetchrow_hashref() can fail for any number of reasons (e.g.,
584 # database server crash), not just because no items match the
586 my $sth2 = $dbh->prepare(
587 "SELECT * FROM issues
588 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
590 AND returndate IS NULL
594 $sth2->execute( $data->{'itemnumber'} );
595 if ( my $data2 = $sth2->fetchrow_hashref ) {
596 $data->{'date_due'} = $data2->{'date_due'};
597 $data->{'card'} = $data2->{'cardnumber'};
598 $data->{'borrower'} = $data2->{'borrowernumber'};
601 if ( $data->{'wthdrawn'} eq '1' ) {
602 $data->{'date_due'} = 'Cancelled';
605 $data->{'date_due'} = 'Available';
611 # Find the last 3 people who borrowed this item.
612 $sth2 = $dbh->prepare(
613 "SELECT * FROM issues
614 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
616 AND returndate IS NOT NULL
617 ORDER BY returndate DESC,timestamp DESC"
620 $sth2->execute( $data->{'itemnumber'} );
621 for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
622 { # FIXME : error if there is less than 3 pple borrowing this item
623 if ( my $data2 = $sth2->fetchrow_hashref ) {
624 $data->{"timestamp$i2"} = $data2->{'timestamp'};
625 $data->{"card$i2"} = $data2->{'cardnumber'};
626 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
631 $results[$i] = $data;
639 =head2 CanBookBeIssued
641 $issuingimpossible, $needsconfirmation =
642 CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess );
643 C<$duedatespec> is a C4::Dates object.
644 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
648 sub CanBookBeIssued {
649 my ( $borrower, $barcode, $duedate, $inprocess ) = @_;
650 my %needsconfirmation; # filled with problems that needs confirmations
651 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
652 my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
653 my $issue = GetItemIssue($item->{itemnumber});
654 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
655 $item->{'itemtype'}=$biblioitem->{'itemtype'};
656 my $dbh = C4::Context->dbh;
659 # DUE DATE is OK ? -- should already have checked.
661 #$issuingimpossible{INVALID_DATE} = 1 unless ($duedate);
666 if ( $borrower->{flags}->{GNA} ) {
667 $issuingimpossible{GNA} = 1;
669 if ( $borrower->{flags}->{'LOST'} ) {
670 $issuingimpossible{CARD_LOST} = 1;
672 if ( $borrower->{flags}->{'DBARRED'} ) {
673 $issuingimpossible{DEBARRED} = 1;
675 if ( $borrower->{'dateexpiry'} eq '0000-00-00') {
676 $issuingimpossible{EXPIRED} = 1;
678 my @expirydate= split /-/,$borrower->{'dateexpiry'};
679 if($expirydate[0]==0 || $expirydate[1]==0|| $expirydate[2]==0 ||
680 Date_to_Days(Today) > Date_to_Days( @expirydate )) {
681 $issuingimpossible{EXPIRED} = 1;
690 C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->output('iso') );
691 if ( C4::Context->preference("IssuingInProcess") ) {
692 my $amountlimit = C4::Context->preference("noissuescharge");
693 if ( $amount > $amountlimit && !$inprocess ) {
694 $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
696 elsif ( $amount <= $amountlimit && !$inprocess ) {
697 $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
702 $needsconfirmation{DEBT} = $amount;
707 # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
709 my $toomany = TooMany( $borrower, $item->{biblionumber}, $item );
710 $needsconfirmation{TOO_MANY} = $toomany if $toomany;
715 unless ( $item->{barcode} ) {
716 $issuingimpossible{UNKNOWN_BARCODE} = 1;
718 if ( $item->{'notforloan'}
719 && $item->{'notforloan'} > 0 )
721 $issuingimpossible{NOT_FOR_LOAN} = 1;
723 elsif ( !$item->{'notforloan'} ){
724 # we have to check itemtypes.notforloan also
725 if (C4::Context->preference('item-level_itypes')){
726 # this should probably be a subroutine
727 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
728 $sth->execute($item->{'itemtype'});
729 my $notforloan=$sth->fetchrow_hashref();
731 if ($notforloan->{'notforloan'} == 1){
732 $issuingimpossible{NOT_FOR_LOAN} = 1;
735 elsif ($biblioitem->{'notforloan'} == 1){
736 $issuingimpossible{NOT_FOR_LOAN} = 1;
739 if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
741 $issuingimpossible{WTHDRAWN} = 1;
743 if ( $item->{'restricted'}
744 && $item->{'restricted'} == 1 )
746 $issuingimpossible{RESTRICTED} = 1;
748 if ( C4::Context->preference("IndependantBranches") ) {
749 my $userenv = C4::Context->userenv;
750 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
751 $issuingimpossible{NOTSAMEBRANCH} = 1
752 if ( $item->{C4::Context->preference("HomeOrHoldingbranch")} ne $userenv->{branch} );
757 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
759 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
762 # Already issued to current borrower. Ask whether the loan should
764 my ($CanBookBeRenewed) = CanBookBeRenewed(
765 $borrower->{'borrowernumber'},
766 $item->{'itemnumber'}
768 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
769 $issuingimpossible{NO_MORE_RENEWALS} = 1;
772 $needsconfirmation{RENEW_ISSUE} = 1;
775 elsif ($issue->{borrowernumber}) {
777 # issued to someone else
778 my $currborinfo = GetMemberDetails( $issue->{borrowernumber} );
780 # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
781 $needsconfirmation{ISSUED_TO_ANOTHER} =
782 "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
785 # See if the item is on reserve.
786 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
788 my $resbor = $res->{'borrowernumber'};
789 if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
792 # The item is on reserve and waiting, but has been
793 # reserved by some other patron.
794 my ( $resborrower, $flags ) =
795 GetMemberDetails( $resbor, 0 );
796 my $branches = GetBranches();
798 $branches->{ $res->{'branchcode'} }->{'branchname'};
799 $needsconfirmation{RESERVE_WAITING} =
800 "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
802 # CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't belong in a checking subroutine.
804 elsif ( $restype eq "Reserved" ) {
806 # The item is on reserve for someone else.
807 my ( $resborrower, $flags ) =
808 GetMemberDetails( $resbor, 0 );
809 my $branches = GetBranches();
811 $branches->{ $res->{'branchcode'} }->{'branchname'};
812 $needsconfirmation{RESERVED} =
813 "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
816 if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" ) {
817 if ( $borrower->{'categorycode'} eq 'W' ) {
818 my %issuingimpossible;
819 return ( \%issuingimpossible, \%needsconfirmation );
821 return ( \%issuingimpossible, \%needsconfirmation );
824 return ( \%issuingimpossible, \%needsconfirmation );
830 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
832 &AddIssue($borrower,$barcode,$date)
836 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
838 =item C<$barcode> is the bar code of the book being issued.
840 =item C<$date> contains the max date of return. calculated if empty.
842 AddIssue does the following things :
843 - step 01: check that there is a borrowernumber & a barcode provided
844 - check for RENEWAL (book issued & being issued to the same patron)
845 - renewal YES = Calculate Charge & renew
847 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
849 - fill reserve if reserve to this patron
850 - cancel reserve or not, otherwise
851 * TRANSFERT PENDING ?
852 - complete the transfert
860 my ( $borrower, $barcode, $date, $cancelreserve ) = @_;
861 my $dbh = C4::Context->dbh;
862 my $barcodecheck=CheckValidBarcode($barcode);
863 if ($borrower and $barcode and $barcodecheck ne '0'){
864 # my ($borrower, $flags) = &GetMemberDetails($borrowernumber, 0);
865 # find which item we issue
866 my $item = GetItem('', $barcode);
869 # get actual issuing if there is one
870 my $actualissue = GetItemIssue( $item->{itemnumber});
872 # get biblioinformation for this item
873 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
876 # check if we just renew the issue.
878 if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) {
880 $borrower->{'borrowernumber'},
881 $item->{'itemnumber'},
882 C4::Context->userenv->{'branch'},
889 if ( $actualissue->{borrowernumber}) {
890 # This book is currently on loan, but not to the person
891 # who wants to borrow it now. mark it returned before issuing to the new borrower
894 C4::Context->userenv->{'branch'}
898 # See if the item is on reserve.
899 my ( $restype, $res ) =
900 C4::Reserves::CheckReserves( $item->{'itemnumber'} );
902 my $resbor = $res->{'borrowernumber'};
903 if ( $resbor eq $borrower->{'borrowernumber'} ) {
905 # The item is reserved by the current patron
906 ModReserveFill($res);
908 elsif ( $restype eq "Waiting" ) {
911 # The item is on reserve and waiting, but has been
912 # reserved by some other patron.
913 my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 );
914 my $branches = GetBranches();
916 $branches->{ $res->{'branchcode'} }->{'branchname'};
918 elsif ( $restype eq "Reserved" ) {
921 # The item is reserved by someone else.
922 my ( $resborrower, $flags ) =
923 GetMemberDetails( $resbor, 0 );
924 my $branches = GetBranches();
926 $branches->{ $res->{'branchcode'} }->{'branchname'};
927 if ($cancelreserve) { # cancel reserves on this item
928 CancelReserve( 0, $res->{'itemnumber'},
929 $res->{'borrowernumber'} );
932 if ($cancelreserve) {
933 CancelReserve( $res->{'biblionumber'}, 0,
934 $res->{'borrowernumber'} );
937 # set waiting reserve to first in reserve queue as book isn't waiting now
940 $res->{'biblionumber'},
941 $res->{'borrowernumber'},
947 # Starting process for transfer job (checking transfert and validate it if we have one)
948 my ($datesent) = GetTransfers($item->{'itemnumber'});
950 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....)
953 "UPDATE branchtransfers
954 SET datearrived = now(),
956 comments = 'Forced branchtransfert'
957 WHERE itemnumber= ? AND datearrived IS NULL"
959 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
963 # Record in the database the fact that the book was issued.
967 (borrowernumber, itemnumber,issuedate, date_due, branchcode)
974 my $itype=(C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ;
975 my $loanlength = GetLoanLength(
976 $borrower->{'categorycode'},
978 $borrower->{'branchcode'}
980 $datedue = time + ($loanlength) * 86400;
981 my @datearr = localtime($datedue);
982 $dateduef = C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
983 $dateduef=CheckValidDatedue($dateduef,$item->{'itemnumber'},C4::Context->userenv->{'branch'});
985 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
986 if ( C4::Context->preference('ReturnBeforeExpiry') && $dateduef->output('iso') gt $borrower->{dateexpiry} ) {
987 $dateduef = C4::Dates->new($borrower->{dateexpiry},'iso');
991 $borrower->{'borrowernumber'},
992 $item->{'itemnumber'},
993 strftime( "%Y-%m-%d", localtime ),$dateduef->output('iso'), C4::Context->userenv->{'branch'}
999 "UPDATE items SET issues=?, holdingbranch=?, itemlost=0, datelastborrowed = now(), onloan = ? WHERE itemnumber=?");
1002 C4::Context->userenv->{'branch'},
1003 $dateduef->output('iso'),
1004 $item->{'itemnumber'}
1007 &ModDateLastSeen( $item->{'itemnumber'} );
1008 my $record = GetMarcItem( $item->{'biblionumber'}, $item->{'itemnumber'} );
1009 my $frameworkcode = GetFrameworkCode( $item->{'biblionumber'} );
1010 ModItemInMarc( $record, $item->{'biblionumber'}, $item->{'itemnumber'}, $frameworkcode );
1011 # If it costs to borrow this book, charge it to the patron's account.
1012 my ( $charge, $itemtype ) = GetIssuingCharges(
1013 $item->{'itemnumber'},
1014 $borrower->{'borrowernumber'}
1016 if ( $charge > 0 ) {
1018 $item->{'itemnumber'},
1019 $borrower->{'borrowernumber'}, $charge
1021 $item->{'charge'} = $charge;
1024 # Record the fact that this book was issued.
1026 C4::Context->userenv->{'branch'},
1028 '', $item->{'itemnumber'},
1029 $item->{'itemtype'}, $borrower->{'borrowernumber'}
1033 &logaction(C4::Context->userenv->{'number'},"CIRCULATION","ISSUE",$borrower->{'borrowernumber'},$biblio->{'biblionumber'})
1034 if C4::Context->preference("IssueLog");
1039 =head2 GetLoanLength
1041 Get loan length for an itemtype, a borrower type and a branch
1043 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1048 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1049 my $dbh = C4::Context->dbh;
1052 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"
1054 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1055 # try to find issuelength & return the 1st available.
1056 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1057 $sth->execute( $borrowertype, $itemtype, $branchcode );
1058 my $loanlength = $sth->fetchrow_hashref;
1059 return $loanlength->{issuelength}
1060 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1062 $sth->execute( $borrowertype, $itemtype, "*" );
1063 $loanlength = $sth->fetchrow_hashref;
1064 return $loanlength->{issuelength}
1065 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1067 $sth->execute( $borrowertype, "*", $branchcode );
1068 $loanlength = $sth->fetchrow_hashref;
1069 return $loanlength->{issuelength}
1070 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1072 $sth->execute( "*", $itemtype, $branchcode );
1073 $loanlength = $sth->fetchrow_hashref;
1074 return $loanlength->{issuelength}
1075 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1077 $sth->execute( $borrowertype, "*", "*" );
1078 $loanlength = $sth->fetchrow_hashref;
1079 return $loanlength->{issuelength}
1080 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1082 $sth->execute( "*", "*", $branchcode );
1083 $loanlength = $sth->fetchrow_hashref;
1084 return $loanlength->{issuelength}
1085 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1087 $sth->execute( "*", $itemtype, "*" );
1088 $loanlength = $sth->fetchrow_hashref;
1089 return $loanlength->{issuelength}
1090 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1092 $sth->execute( "*", "*", "*" );
1093 $loanlength = $sth->fetchrow_hashref;
1094 return $loanlength->{issuelength}
1095 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1097 # if no rule is set => 21 days (hardcoded)
1103 ($doreturn, $messages, $iteminformation, $borrower) =
1104 &AddReturn($barcode, $branch, $exemptfine);
1108 C<$barcode> is the bar code of the book being returned. C<$branch> is
1109 the code of the branch where the book is being returned. C<$exemptfine>
1110 indicates that overdue charges for the item will not be applied.
1112 C<&AddReturn> returns a list of four items:
1114 C<$doreturn> is true iff the return succeeded.
1116 C<$messages> is a reference-to-hash giving the reason for failure:
1122 No item with this barcode exists. The value is C<$barcode>.
1126 The book is not currently on loan. The value is C<$barcode>.
1128 =item C<IsPermanent>
1130 The book's home branch is a permanent collection. If you have borrowed
1131 this book, you are not allowed to return it. The value is the code for
1132 the book's home branch.
1136 This book has been withdrawn/cancelled. The value should be ignored.
1140 The item was reserved. The value is a reference-to-hash whose keys are
1141 fields from the reserves table of the Koha database, and
1142 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1143 either C<Waiting>, C<Reserved>, or 0.
1147 C<$borrower> is a reference-to-hash, giving information about the
1148 patron who last borrowed the book.
1153 my ( $barcode, $branch, $exemptfine ) = @_;
1154 my $dbh = C4::Context->dbh;
1158 my $validTransfert = 0;
1159 my $reserveDone = 0;
1161 # get information on item
1162 my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
1163 my $biblio = GetBiblioFromItemNumber($iteminformation->{'itemnumber'});
1164 unless ($iteminformation->{'itemnumber'} ) {
1165 $messages->{'BadBarcode'} = $barcode;
1169 if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1170 $messages->{'NotIssued'} = $barcode;
1174 # check if the book is in a permanent collection....
1175 my $hbr = $iteminformation->{'homebranch'};
1176 my $branches = GetBranches();
1177 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1178 $messages->{'IsPermanent'} = $hbr;
1181 # if independent branches are on and returning to different branch, refuse the return
1182 if ($hbr ne C4::Context->userenv->{'branch'} && C4::Context->preference("IndependantBranches")){
1183 $messages->{'Wrongbranch'} = 1;
1187 # check that the book has been cancelled
1188 if ( $iteminformation->{'wthdrawn'} ) {
1189 $messages->{'wthdrawn'} = 1;
1193 # new op dev : if the book returned in an other branch update the holding branch
1195 # update issues, thereby returning book (should push this out into another subroutine
1196 $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1198 # case of a return of document (deal with issues and holdingbranch)
1203 "UPDATE issues SET returndate = now() WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (returndate IS NULL)"
1205 $sth->execute( $borrower->{'borrowernumber'},
1206 $iteminformation->{'itemnumber'} );
1207 $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
1210 # continue to deal with returns cases, but not only if we have an issue
1212 # the holdingbranch is updated if the document is returned in an other location .
1213 if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) {
1214 UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
1215 # reload iteminformation holdingbranch with the userenv value
1216 $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1218 ModDateLastSeen( $iteminformation->{'itemnumber'} );
1219 my $sth = $dbh->prepare("UPDATE items SET onloan = NULL where itemnumber = ?");
1220 $sth->execute($iteminformation->{'itemnumber'});
1222 my $record = GetMarcItem( $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'} );
1223 my $frameworkcode = GetFrameworkCode( $biblio->{'biblionumber'} );
1224 ModItemInMarc( $record, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'}, $frameworkcode );
1226 if ($iteminformation->{borrowernumber}){
1227 ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1229 # fix up the accounts.....
1230 if ( $iteminformation->{'itemlost'} ) {
1231 $messages->{'WasLost'} = 1;
1234 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1235 # check if we have a transfer for this document
1236 my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1238 # if we have a transfer to do, we update the line of transfers with the datearrived
1240 if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1243 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1245 $sth->execute( $iteminformation->{'itemnumber'} );
1247 # 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'
1248 C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1251 $messages->{'WrongTransfer'} = $tobranch;
1252 $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1254 $validTransfert = 1;
1257 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1258 # fix up the accounts.....
1259 if ($iteminformation->{'itemlost'}) {
1260 FixAccountForLostAndReturned($iteminformation, $borrower);
1261 $messages->{'WasLost'} = 1;
1263 # fix up the overdues in accounts...
1264 FixOverduesOnReturn( $borrower->{'borrowernumber'},
1265 $iteminformation->{'itemnumber'}, $exemptfine );
1267 # find reserves.....
1268 # if we don't have a reserve with the status W, we launch the Checkreserves routine
1269 my ( $resfound, $resrec ) =
1270 C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1272 $resrec->{'ResFound'} = $resfound;
1273 $messages->{'ResFound'} = $resrec;
1278 # Record the fact that this book was returned.
1280 $branch, 'return', '0', '',
1281 $iteminformation->{'itemnumber'},
1282 $iteminformation->{'itemtype'},
1283 $borrower->{'borrowernumber'}
1286 &logaction(C4::Context->userenv->{'number'},"CIRCULATION","RETURN",$iteminformation->{borrowernumber},$iteminformation->{'biblionumber'})
1287 if C4::Context->preference("ReturnLog");
1289 #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1290 #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1292 if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1293 if (C4::Context->preference("AutomaticItemReturn") == 1) {
1294 ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1295 $messages->{'WasTransfered'} = 1;
1298 $messages->{'NeedsTransfer'} = 1;
1302 return ( $doreturn, $messages, $iteminformation, $borrower );
1305 =head2 FixOverduesOnReturn
1307 &FixOverduesOnReturn($brn,$itm, $exemptfine);
1309 C<$brn> borrowernumber
1313 internal function, called only by AddReturn
1317 sub FixOverduesOnReturn {
1318 my ( $borrowernumber, $item, $exemptfine ) = @_;
1319 my $dbh = C4::Context->dbh;
1321 # check for overdue fine
1324 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1326 $sth->execute( $borrowernumber, $item );
1328 # alter fine to show that the book has been returned
1330 if ($data = $sth->fetchrow_hashref) {
1331 my $uquery =($exemptfine)? "update accountlines set accounttype='FFOR', amountoutstanding=0":"update accountlines set accounttype='F' ";
1332 $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1333 my $usth = $dbh->prepare($uquery);
1334 $usth->execute($borrowernumber,$item ,$data->{'accountno'});
1342 =head2 FixAccountForLostAndReturned
1344 &FixAccountForLostAndReturned($iteminfo,$borrower);
1346 Calculates the charge for a book lost and returned (Not exported & used only once)
1348 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1350 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1352 Internal function, called by AddReturn
1356 sub FixAccountForLostAndReturned {
1357 my ($iteminfo, $borrower) = @_;
1359 my $dbh = C4::Context->dbh;
1360 my $itm = $iteminfo->{'itemnumber'};
1361 # check for charge made for lost book
1362 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1363 $sth->execute($itm);
1364 if (my $data = $sth->fetchrow_hashref) {
1365 # writeoff this amount
1367 my $amount = $data->{'amount'};
1368 my $acctno = $data->{'accountno'};
1370 if ($data->{'amountoutstanding'} == $amount) {
1371 $offset = $data->{'amount'};
1374 $offset = $amount - $data->{'amountoutstanding'};
1375 $amountleft = $data->{'amountoutstanding'} - $amount;
1377 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1378 WHERE (borrowernumber = ?)
1379 AND (itemnumber = ?) AND (accountno = ?) ");
1380 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1382 #check if any credit is left if so writeoff other accounts
1383 my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
1384 if ($amountleft < 0){
1387 if ($amountleft > 0){
1388 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1389 AND (amountoutstanding >0) ORDER BY date");
1390 $msth->execute($data->{'borrowernumber'});
1391 # offset transactions
1394 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1395 if ($accdata->{'amountoutstanding'} < $amountleft) {
1397 $amountleft -= $accdata->{'amountoutstanding'};
1399 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1402 my $thisacct = $accdata->{'accountno'};
1403 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1404 WHERE (borrowernumber = ?)
1405 AND (accountno=?)");
1406 $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1408 $usth = $dbh->prepare("INSERT INTO accountoffsets
1409 (borrowernumber, accountno, offsetaccount, offsetamount)
1412 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1417 if ($amountleft > 0){
1420 my $desc="Item Returned ".$iteminfo->{'barcode'};
1421 $usth = $dbh->prepare("INSERT INTO accountlines
1422 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1423 VALUES (?,?,now(),?,?,'CR',?)");
1424 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1426 $usth = $dbh->prepare("INSERT INTO accountoffsets
1427 (borrowernumber, accountno, offsetaccount, offsetamount)
1429 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1431 $usth = $dbh->prepare("UPDATE items SET paidfor='' WHERE itemnumber=?");
1432 $usth->execute($itm);
1441 $issues = &GetItemIssue($itemnumber);
1443 Returns patrons currently having a book. nothing if item is not issued atm
1445 C<$itemnumber> is the itemnumber
1447 Returns an array of hashes
1451 my ( $itemnumber) = @_;
1452 return unless $itemnumber;
1453 my $dbh = C4::Context->dbh;
1457 my $today = POSIX::strftime("%Y%m%d", localtime);
1459 my $sth = $dbh->prepare(
1460 "SELECT * FROM issues
1461 LEFT JOIN items ON issues.itemnumber=items.itemnumber
1463 issues.itemnumber=? AND returndate IS NULL ");
1464 $sth->execute($itemnumber);
1465 my $data = $sth->fetchrow_hashref;
1466 my $datedue = $data->{'date_due'};
1468 if ( $datedue < $today ) {
1469 $data->{'overdue'} = 1;
1471 $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1476 =head2 GetItemIssues
1478 $issues = &GetItemIssues($itemnumber, $history);
1480 Returns patrons that have issued a book
1482 C<$itemnumber> is the itemnumber
1483 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1485 Returns an array of hashes
1489 my ( $itemnumber,$history ) = @_;
1490 my $dbh = C4::Context->dbh;
1494 my $today = POSIX::strftime("%Y%m%d", localtime);
1496 my $sth = $dbh->prepare(
1497 "SELECT * FROM issues
1498 LEFT JOIN borrowers ON borrowers.borrowernumber
1499 LEFT JOIN items ON items.itemnumber=issues.itemnumber
1501 issues.itemnumber=?".($history?"":" AND returndate IS NULL ").
1502 "ORDER BY issues.date_due DESC"
1504 $sth->execute($itemnumber);
1505 while ( my $data = $sth->fetchrow_hashref ) {
1506 my $datedue = $data->{'date_due'};
1508 if ( $datedue < $today ) {
1509 $data->{'overdue'} = 1;
1511 my $itemnumber = $data->{'itemnumber'};
1512 push @GetItemIssues, $data;
1515 return ( \@GetItemIssues );
1518 =head2 GetBiblioIssues
1520 $issues = GetBiblioIssues($biblionumber);
1522 this function get all issues from a biblionumber.
1525 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1526 tables issues and the firstname,surname & cardnumber from borrowers.
1530 sub GetBiblioIssues {
1531 my $biblionumber = shift;
1532 return undef unless $biblionumber;
1533 my $dbh = C4::Context->dbh;
1535 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1537 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1538 LEFT JOIN items ON issues.itemnumber = items.itemnumber
1539 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1540 LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1541 WHERE biblio.biblionumber = ?
1542 ORDER BY issues.timestamp
1544 my $sth = $dbh->prepare($query);
1545 $sth->execute($biblionumber);
1548 while ( my $data = $sth->fetchrow_hashref ) {
1549 push @issues, $data;
1554 =head2 CanBookBeRenewed
1556 $ok = &CanBookBeRenewed($borrowernumber, $itemnumber);
1558 Find out whether a borrowed item may be renewed.
1560 C<$dbh> is a DBI handle to the Koha database.
1562 C<$borrowernumber> is the borrower number of the patron who currently
1563 has the item on loan.
1565 C<$itemnumber> is the number of the item to renew.
1567 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1568 item must currently be on loan to the specified borrower; renewals
1569 must be allowed for the item's type; and the borrower must not have
1570 already renewed the loan.
1574 sub CanBookBeRenewed {
1576 # check renewal status
1577 my ( $borrowernumber, $itemnumber ) = @_;
1578 my $dbh = C4::Context->dbh;
1582 # Look in the issues table for this item, lent to this borrower,
1583 # and not yet returned.
1585 # FIXME - I think this function could be redone to use only one SQL call.
1586 my $sth1 = $dbh->prepare(
1587 "SELECT * FROM issues
1588 WHERE borrowernumber = ?
1590 AND returndate IS NULL"
1592 $sth1->execute( $borrowernumber, $itemnumber );
1593 if ( my $data1 = $sth1->fetchrow_hashref ) {
1595 # Found a matching item
1597 # See if this item may be renewed. This query is convoluted
1598 # because it's a bit messy: given the item number, we need to find
1599 # the biblioitem, which gives us the itemtype, which tells us
1600 # whether it may be renewed.
1601 my $sth2 = $dbh->prepare(
1602 "SELECT renewalsallowed FROM items
1603 LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1604 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
1605 WHERE items.itemnumber = ?
1608 $sth2->execute($itemnumber);
1609 if ( my $data2 = $sth2->fetchrow_hashref ) {
1610 $renews = $data2->{'renewalsallowed'};
1612 if ( $renews && $renews >= $data1->{'renewals'} ) {
1616 my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1623 return ($renewokay);
1628 &AddRenewal($borrowernumber, $itemnumber, $datedue);
1632 C<$borrowernumber> is the borrower number of the patron who currently
1635 C<$itemnumber> is the number of the item to renew.
1637 C<$datedue> can be used to set the due date. If C<$datedue> is the
1638 empty string, C<&AddRenewal> will calculate the due date automatically
1639 from the book's item type. If you wish to set the due date manually,
1640 C<$datedue> should be in the form YYYY-MM-DD.
1646 my ( $borrowernumber, $itemnumber, $branch ,$datedue ) = @_;
1647 my $dbh = C4::Context->dbh;
1649 my $biblio = GetBiblioFromItemNumber($itemnumber);
1650 # If the due date wasn't specified, calculate it by adding the
1651 # book's loan length to today's date.
1652 unless ( $datedue ) {
1655 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 );
1656 my $loanlength = GetLoanLength(
1657 $borrower->{'categorycode'},
1658 (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
1659 $borrower->{'branchcode'}
1661 #FIXME -- choose issuer or borrower branch.
1662 #FIXME -- where's the calendar ?
1663 #FIXME -- $debug-ify the (0)
1664 my @darray = Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 );
1665 $datedue = C4::Dates->new( sprintf("%04d-%02d-%02d",@darray[0..2]), 'iso');
1666 (0) and print STDERR "C4::Dates->new->output = " . C4::Dates->new()->output()
1667 . "\ndatedue->output = " . $datedue->output()
1668 . "\n(Y,M,D) = " . join ',', @darray;
1669 $datedue=CheckValidDatedue($datedue,$itemnumber,$branch);
1672 # Find the issues record for this book
1674 $dbh->prepare("SELECT * FROM issues
1675 WHERE borrowernumber=?
1677 AND returndate IS NULL"
1679 $sth->execute( $borrowernumber, $itemnumber );
1680 my $issuedata = $sth->fetchrow_hashref;
1683 # Update the issues record to have the new due date, and a new count
1684 # of how many times it has been renewed.
1685 my $renews = $issuedata->{'renewals'} + 1;
1686 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?
1687 WHERE borrowernumber=?
1689 AND returndate IS NULL"
1691 $sth->execute( $datedue->output('iso'), $renews, $borrowernumber, $itemnumber );
1694 # Update the renewal count on the item, and tell zebra to reindex
1695 $renews = $biblio->{'renewals'} + 1;
1696 $sth = $dbh->prepare("UPDATE items SET renewals = ? WHERE itemnumber = ?");
1697 $sth->execute($renews,$itemnumber);
1699 my $record = GetMarcItem( $biblio->{'biblionumber'}, $itemnumber );
1700 my $frameworkcode = GetFrameworkCode( $biblio->{'biblionumber'} );
1701 ModItemInMarc( $record, $biblio->{'biblionumber'}, $itemnumber, $frameworkcode );
1703 # Charge a new rental fee, if applicable?
1704 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1705 if ( $charge > 0 ) {
1706 my $accountno = getnextacctno( $borrowernumber );
1707 my $item = GetBiblioFromItemNumber($itemnumber);
1708 $sth = $dbh->prepare(
1709 "INSERT INTO accountlines
1710 (borrowernumber,accountno,date,amount,
1711 description,accounttype,amountoutstanding,
1713 VALUES (?,?,now(),?,?,?,?,?)"
1715 $sth->execute( $borrowernumber, $accountno, $charge,
1716 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
1717 'Rent', $charge, $itemnumber );
1721 UpdateStats( $branch, 'renew', $charge, '', $itemnumber );
1725 # check renewal status
1726 my ($bornum,$itemno)=@_;
1727 my $dbh = C4::Context->dbh;
1729 my $renewsallowed = 0;
1731 # Look in the issues table for this item, lent to this borrower,
1732 # and not yet returned.
1734 # FIXME - I think this function could be redone to use only one SQL call.
1735 my $sth = $dbh->prepare("select * from issues
1736 where (borrowernumber = ?)
1737 and (itemnumber = ?)
1738 and returndate is null");
1739 $sth->execute($bornum,$itemno);
1740 my $data = $sth->fetchrow_hashref;
1741 $renewcount = $data->{'renewals'} if $data->{'renewals'};
1742 my $sth2 = $dbh->prepare("select renewalsallowed from items,biblioitems,itemtypes
1743 where (items.itemnumber = ?)
1744 and (items.biblioitemnumber = biblioitems.biblioitemnumber)
1745 and (biblioitems.itemtype = itemtypes.itemtype)");
1746 $sth2->execute($itemno);
1747 my $data2 = $sth2->fetchrow_hashref();
1748 $renewsallowed = $data2->{'renewalsallowed'};
1749 $renewsleft = $renewsallowed - $renewcount;
1750 warn "Renewcount:$renewcount RenewsAll:$renewsallowed RenewLeft:$renewsleft";
1751 return ($renewcount,$renewsallowed,$renewsleft);
1753 =head2 GetIssuingCharges
1755 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
1757 Calculate how much it would cost for a given patron to borrow a given
1758 item, including any applicable discounts.
1760 C<$itemnumber> is the item number of item the patron wishes to borrow.
1762 C<$borrowernumber> is the patron's borrower number.
1764 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
1765 and C<$item_type> is the code for the item's item type (e.g., C<VID>
1770 sub GetIssuingCharges {
1772 # calculate charges due
1773 my ( $itemnumber, $borrowernumber ) = @_;
1775 my $dbh = C4::Context->dbh;
1778 # Get the book's item type and rental charge (via its biblioitem).
1779 my $qcharge = "SELECT itemtypes.itemtype,rentalcharge FROM items
1780 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
1781 $qcharge .= (C4::Context->preference('item-level_itypes'))
1782 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1783 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1785 $qcharge .= "WHERE items.itemnumber =?";
1787 my $sth1 = $dbh->prepare($qcharge);
1788 $sth1->execute($itemnumber);
1789 if ( my $data1 = $sth1->fetchrow_hashref ) {
1790 $item_type = $data1->{'itemtype'};
1791 $charge = $data1->{'rentalcharge'};
1792 my $q2 = "SELECT rentaldiscount FROM borrowers
1793 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
1794 WHERE borrowers.borrowernumber = ?
1795 AND issuingrules.itemtype = ?";
1796 my $sth2 = $dbh->prepare($q2);
1797 $sth2->execute( $borrowernumber, $item_type );
1798 if ( my $data2 = $sth2->fetchrow_hashref ) {
1799 my $discount = $data2->{'rentaldiscount'};
1800 if ( $discount eq 'NULL' ) {
1803 $charge = ( $charge * ( 100 - $discount ) ) / 100;
1809 return ( $charge, $item_type );
1812 =head2 AddIssuingCharge
1814 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
1818 sub AddIssuingCharge {
1819 my ( $itemnumber, $borrowernumber, $charge ) = @_;
1820 my $dbh = C4::Context->dbh;
1821 my $nextaccntno = getnextacctno( $borrowernumber );
1823 INSERT INTO accountlines
1824 (borrowernumber, itemnumber, accountno,
1825 date, amount, description, accounttype,
1827 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
1829 my $sth = $dbh->prepare($query);
1830 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
1836 GetTransfers($itemnumber);
1841 my ($itemnumber) = @_;
1843 my $dbh = C4::Context->dbh;
1849 FROM branchtransfers
1850 WHERE itemnumber = ?
1851 AND datearrived IS NULL
1853 my $sth = $dbh->prepare($query);
1854 $sth->execute($itemnumber);
1855 my @row = $sth->fetchrow_array();
1861 =head2 GetTransfersFromTo
1863 @results = GetTransfersFromTo($frombranch,$tobranch);
1865 Returns the list of pending transfers between $from and $to branch
1869 sub GetTransfersFromTo {
1870 my ( $frombranch, $tobranch ) = @_;
1871 return unless ( $frombranch && $tobranch );
1872 my $dbh = C4::Context->dbh;
1874 SELECT itemnumber,datesent,frombranch
1875 FROM branchtransfers
1878 AND datearrived IS NULL
1880 my $sth = $dbh->prepare($query);
1881 $sth->execute( $frombranch, $tobranch );
1884 while ( my $data = $sth->fetchrow_hashref ) {
1885 push @gettransfers, $data;
1888 return (@gettransfers);
1891 =head2 DeleteTransfer
1893 &DeleteTransfer($itemnumber);
1897 sub DeleteTransfer {
1898 my ($itemnumber) = @_;
1899 my $dbh = C4::Context->dbh;
1900 my $sth = $dbh->prepare(
1901 "DELETE FROM branchtransfers
1903 AND datearrived IS NULL "
1905 $sth->execute($itemnumber);
1909 =head2 AnonymiseIssueHistory
1911 $rows = AnonymiseIssueHistory($borrowernumber,$date)
1913 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
1914 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
1916 return the number of affected rows.
1920 sub AnonymiseIssueHistory {
1922 my $borrowernumber = shift;
1923 my $dbh = C4::Context->dbh;
1926 SET borrowernumber = NULL
1927 WHERE returndate < '".$date."'
1928 AND borrowernumber IS NOT NULL
1930 $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
1931 my $rows_affected = $dbh->do($query);
1932 return $rows_affected;
1935 =head2 updateWrongTransfer
1937 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
1939 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
1943 sub updateWrongTransfer {
1944 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
1945 my $dbh = C4::Context->dbh;
1946 # first step validate the actual line of transfert .
1949 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
1951 $sth->execute($FromLibrary,$itemNumber);
1954 # second step create a new line of branchtransfer to the right location .
1955 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
1957 #third step changing holdingbranch of item
1958 UpdateHoldingbranch($FromLibrary,$itemNumber);
1961 =head2 UpdateHoldingbranch
1963 $items = UpdateHoldingbranch($branch,$itmenumber);
1964 Simple methode for updating hodlingbranch in items BDD line
1967 sub UpdateHoldingbranch {
1968 my ( $branch,$itmenumber ) = @_;
1969 my $dbh = C4::Context->dbh;
1970 # first step validate the actual line of transfert .
1973 "update items set holdingbranch = ? where itemnumber= ?"
1975 $sth->execute($branch,$itmenumber);
1980 =head2 CheckValidDatedue
1982 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
1983 this function return a new date due after checked if it's a repeatable or special holiday
1984 C<$date_due> = returndate calculate with no day check
1985 C<$itemnumber> = itemnumber
1986 C<$branchcode> = localisation of issue
1988 # Why not create calendar object? -
1989 # TODO add 'duedate' option to useDaysMode .
1990 sub CheckValidDatedue {
1991 my ($date_due,$itemnumber,$branchcode)=@_;
1992 my @datedue=split('-',$date_due->output('iso'));
1993 my $years=$datedue[0];
1994 my $month=$datedue[1];
1995 my $day=$datedue[2];
1996 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
1998 for (my $i=0;$i<2;$i++){
1999 $dow=Day_of_Week($years,$month,$day);
2000 ($dow=0) if ($dow>6);
2001 my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2002 my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2003 my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2004 if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2006 (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2009 my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2012 =head2 CheckRepeatableHolidays
2014 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2015 this function check if the date due is a repeatable holiday
2016 C<$date_due> = returndate calculate with no day check
2017 C<$itemnumber> = itemnumber
2018 C<$branchcode> = localisation of issue
2022 sub CheckRepeatableHolidays{
2023 my($itemnumber,$week_day,$branchcode)=@_;
2024 my $dbh = C4::Context->dbh;
2025 my $query = qq|SELECT count(*)
2026 FROM repeatable_holidays
2029 my $sth = $dbh->prepare($query);
2030 $sth->execute($branchcode,$week_day);
2031 my $result=$sth->fetchrow;
2037 =head2 CheckSpecialHolidays
2039 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2040 this function check if the date is a special holiday
2041 C<$years> = the years of datedue
2042 C<$month> = the month of datedue
2043 C<$day> = the day of datedue
2044 C<$itemnumber> = itemnumber
2045 C<$branchcode> = localisation of issue
2047 sub CheckSpecialHolidays{
2048 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2049 my $dbh = C4::Context->dbh;
2050 my $query=qq|SELECT count(*)
2051 FROM `special_holidays`
2057 my $sth = $dbh->prepare($query);
2058 $sth->execute($years,$month,$day,$branchcode);
2059 my $countspecial=$sth->fetchrow ;
2061 return $countspecial;
2064 =head2 CheckRepeatableSpecialHolidays
2066 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2067 this function check if the date is a repeatble special holidays
2068 C<$month> = the month of datedue
2069 C<$day> = the day of datedue
2070 C<$itemnumber> = itemnumber
2071 C<$branchcode> = localisation of issue
2073 sub CheckRepeatableSpecialHolidays{
2074 my ($month,$day,$itemnumber,$branchcode) = @_;
2075 my $dbh = C4::Context->dbh;
2076 my $query=qq|SELECT count(*)
2077 FROM `repeatable_holidays`
2082 my $sth = $dbh->prepare($query);
2083 $sth->execute($month,$day,$branchcode);
2084 my $countspecial=$sth->fetchrow ;
2086 return $countspecial;
2091 sub CheckValidBarcode{
2093 my $dbh = C4::Context->dbh;
2094 my $query=qq|SELECT count(*)
2098 my $sth = $dbh->prepare($query);
2099 $sth->execute($barcode);
2100 my $exist=$sth->fetchrow ;
2111 Koha Developement team <info@koha.org>