1 package C4::Circulation;
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
42 use POSIX qw(strftime);
43 use C4::Branch; # GetBranches
44 use C4::Log; # logaction
48 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
51 # set the version for version checking
55 # FIXME subs that should probably be elsewhere
61 # subs to deal with issuing a book
73 &GetBranchBorrowerCircRule
75 &AnonymiseIssueHistory
78 # subs to deal with returns
84 # subs to deal with transfers
96 C4::Circulation - Koha circulation module
104 The functions in this module deal with circulation, issues, and
105 returns, as well as general information about the library.
106 Also deals with stocktaking.
112 =head3 $str = &barcodedecode($barcode);
116 =item Generic filter function for barcode string.
117 Called on every circ if the System Pref itemBarcodeInputFilter is set.
118 Will do some manipulation of the barcode for systems that deliver a barcode
119 to circulation.pl that differs from the barcode stored for the item.
120 For proper functioning of this filter, calling the function on the
121 correct barcode string (items.barcode) should return an unaltered barcode.
127 # FIXME -- the &decode fcn below should be wrapped into this one.
128 # FIXME -- these plugins should be moved out of Circulation.pm
132 my $filter = C4::Context->preference('itemBarcodeInputFilter');
133 if($filter eq 'whitespace') {
136 } elsif($filter eq 'cuecat') {
138 my @fields = split( /\./, $barcode );
139 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
140 if ( $#results == 2 ) {
146 } elsif($filter eq 'T-prefix') {
147 if ( $barcode =~ /^[Tt]/) {
148 if (substr($barcode,1,1) eq '0') {
151 $barcode = substr($barcode,2) + 0 ;
154 return sprintf( "T%07d",$barcode);
160 =head3 $str = &decode($chunk);
164 =item Decodes a segment of a string emitted by a CueCat barcode scanner and
174 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
175 my @s = map { index( $seq, $_ ); } split( //, $encoded );
176 my $l = ( $#s + 1 ) % 4;
187 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
189 chr( ( $n >> 16 ) ^ 67 )
190 .chr( ( $n >> 8 & 255 ) ^ 67 )
191 .chr( ( $n & 255 ) ^ 67 );
194 $r = substr( $r, 0, length($r) - $l );
200 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, $barcode, $ignore_reserves);
202 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
204 C<$newbranch> is the code for the branch to which the item should be transferred.
206 C<$barcode> is the barcode of the item to be transferred.
208 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
209 Otherwise, if an item is reserved, the transfer fails.
211 Returns three values:
215 is true if the transfer was successful.
219 is a reference-to-hash which may have any of the following keys:
225 There is no item in the catalog with the given barcode. The value is C<$barcode>.
229 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.
231 =item C<DestinationEqualsHolding>
233 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.
237 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.
241 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>.
243 =item C<WasTransferred>
245 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
252 my ( $tbr, $barcode, $ignoreRs ) = @_;
255 my $branches = GetBranches();
256 my $itemnumber = GetItemnumberFromBarcode( $barcode );
257 my $issue = GetItemIssue($itemnumber);
258 my $biblio = GetBiblioFromItemNumber($itemnumber);
261 if ( not $itemnumber ) {
262 $messages->{'BadBarcode'} = $barcode;
266 # get branches of book...
267 my $hbr = $biblio->{'homebranch'};
268 my $fbr = $biblio->{'holdingbranch'};
271 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
272 $messages->{'IsPermanent'} = $hbr;
275 # can't transfer book if is already there....
276 if ( $fbr eq $tbr ) {
277 $messages->{'DestinationEqualsHolding'} = 1;
281 # check if it is still issued to someone, return it...
282 if ($issue->{borrowernumber}) {
283 AddReturn( $barcode, $fbr );
284 $messages->{'WasReturned'} = $issue->{borrowernumber};
288 # That'll save a database query.
289 my ( $resfound, $resrec ) =
290 CheckReserves( $itemnumber );
291 if ( $resfound and not $ignoreRs ) {
292 $resrec->{'ResFound'} = $resfound;
294 # $messages->{'ResFound'} = $resrec;
298 #actually do the transfer....
300 ModItemTransfer( $itemnumber, $fbr, $tbr );
302 # don't need to update MARC anymore, we do it in batch now
303 $messages->{'WasTransfered'} = 1;
304 ModDateLastSeen( $itemnumber );
306 return ( $dotransfer, $messages, $biblio );
309 =head2 CanBookBeIssued
311 Check if a book can be issued.
313 my ($issuingimpossible,$needsconfirmation) = CanBookBeIssued($borrower,$barcode,$year,$month,$day);
317 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
319 =item C<$barcode> is the bar code of the book being issued.
321 =item C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate".
329 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
330 Possible values are :
336 sticky due date is invalid
340 borrower gone with no address
344 borrower declared it's card lost
350 =head3 UNKNOWN_BARCODE
364 item is restricted (set by ??)
366 C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
367 Possible values are :
375 renewing, not issuing
377 =head3 ISSUED_TO_ANOTHER
379 issued to someone else.
383 reserved for someone else.
387 sticky due date is invalid
391 if the borrower borrows to much things
395 # check if a book can be issued.
399 my $borrower = shift;
400 my $biblionumber = shift;
402 my $cat_borrower = $borrower->{'categorycode'};
403 my $dbh = C4::Context->dbh;
405 # Get which branchcode we need
406 if (C4::Context->preference('CircControl') eq 'PickupLibrary'){
407 $branch = C4::Context->userenv->{'branch'};
409 elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){
410 $branch = $borrower->{'branchcode'};
414 $branch = $item->{'homebranch'};
416 my $type = (C4::Context->preference('item-level_itypes'))
417 ? $item->{'itype'} # item-level
418 : $item->{'itemtype'}; # biblio-level
422 'SELECT * FROM issuingrules
423 WHERE categorycode = ?
428 my $query2 = "SELECT COUNT(*) FROM issues i, biblioitems s1, items s2
429 WHERE i.borrowernumber = ?
430 AND i.itemnumber = s2.itemnumber
431 AND s1.biblioitemnumber = s2.biblioitemnumber";
432 if (C4::Context->preference('item-level_itypes')){
433 $query2.=" AND s2.itype=? ";
435 $query2.=" AND s1.itemtype= ? ";
437 my $sth2= $dbh->prepare($query2);
440 'SELECT COUNT(*) FROM issues
441 WHERE borrowernumber = ?'
445 # check the 3 parameters (branch / itemtype / category code
446 $sth->execute( $cat_borrower, $type, $branch );
447 my $result = $sth->fetchrow_hashref;
448 # warn "$cat_borrower, $type, $branch = ".Data::Dumper::Dumper($result);
449 if ( $result->{maxissueqty} ne '' ) {
450 # warn "checking on everything set";
451 $sth2->execute( $borrower->{'borrowernumber'}, $type );
452 my $alreadyissued = $sth2->fetchrow;
453 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
454 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/itemtype failed)" );
456 # now checking for total
457 $sth->execute( $cat_borrower, '*', $branch );
458 my $result = $sth->fetchrow_hashref;
459 if ( $result->{maxissueqty} ne '' ) {
460 $sth3->execute( $borrower->{'borrowernumber'} );
461 my $alreadyissued = $sth3->fetchrow;
462 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
463 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/total failed)" );
468 # check the 2 parameters (branch / itemtype / default categorycode
469 $sth->execute( '*', $type, $branch );
470 $result = $sth->fetchrow_hashref;
471 # warn "*, $type, $branch = ".Data::Dumper::Dumper($result);
473 if ( $result->{maxissueqty} ne '' ) {
474 # warn "checking on 2 parameters (default categorycode)";
475 $sth2->execute( $borrower->{'borrowernumber'}, $type );
476 my $alreadyissued = $sth2->fetchrow;
477 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
478 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / itemtype failed)" );
480 # now checking for total
481 $sth->execute( '*', '*', $branch );
482 my $result = $sth->fetchrow_hashref;
483 if ( $result->{maxissueqty} ne '' ) {
484 $sth3->execute( $borrower->{'borrowernumber'} );
485 my $alreadyissued = $sth3->fetchrow;
486 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
487 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / total failed)" );
492 # check the 1 parameters (default branch / itemtype / categorycode
493 $sth->execute( $cat_borrower, $type, '*' );
494 $result = $sth->fetchrow_hashref;
495 # warn "$cat_borrower, $type, * = ".Data::Dumper::Dumper($result);
497 if ( $result->{maxissueqty} ne '' ) {
498 # warn "checking on 1 parameter (default branch + categorycode)";
499 $sth2->execute( $borrower->{'borrowernumber'}, $type );
500 my $alreadyissued = $sth2->fetchrow;
501 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
502 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch/category/itemtype failed)" );
504 # now checking for total
505 $sth->execute( $cat_borrower, '*', '*' );
506 my $result = $sth->fetchrow_hashref;
507 if ( $result->{maxissueqty} ne '' ) {
508 $sth3->execute( $borrower->{'borrowernumber'} );
509 my $alreadyissued = $sth3->fetchrow;
510 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
511 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / category / total failed)" );
516 # check the 0 parameters (default branch / itemtype / default categorycode
517 $sth->execute( '*', $type, '*' );
518 $result = $sth->fetchrow_hashref;
519 # warn "*, $type, * = ".Data::Dumper::Dumper($result);
521 if ( $result->{maxissueqty} ne '' ) {
522 # warn "checking on default branch and default categorycode";
523 $sth2->execute( $borrower->{'borrowernumber'}, $type );
524 my $alreadyissued = $sth2->fetchrow;
525 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
526 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / itemtype failed)" );
529 # now checking for total
530 $sth->execute( '*', '*', '*' );
531 $result = $sth->fetchrow_hashref;
532 if ( $result->{maxissueqty} ne '' ) {
533 warn "checking total";
534 $sth2->execute( $borrower->{'borrowernumber'}, $type );
535 my $alreadyissued = $sth2->fetchrow;
536 if ( $result->{'maxissueqty'} <= $alreadyissued ) {
537 return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / total failed)" );
541 # OK, the patron can issue !!!
547 @issues = &itemissues($biblioitemnumber, $biblio);
549 Looks up information about who has borrowed the bookZ<>(s) with the
550 given biblioitemnumber.
552 C<$biblio> is ignored.
554 C<&itemissues> returns an array of references-to-hash. The keys
555 include the fields from the C<items> table in the Koha database.
556 Additional keys include:
562 If the item is currently on loan, this gives the due date.
564 If the item is not on loan, then this is either "Available" or
565 "Cancelled", if the item has been withdrawn.
569 If the item is currently on loan, this gives the card number of the
570 patron who currently has the item.
572 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
574 These give the timestamp for the last three times the item was
577 =item C<card0>, C<card1>, C<card2>
579 The card number of the last three patrons who borrowed this item.
581 =item C<borrower0>, C<borrower1>, C<borrower2>
583 The borrower number of the last three patrons who borrowed this item.
591 my ( $bibitem, $biblio ) = @_;
592 my $dbh = C4::Context->dbh;
594 $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
599 $sth->execute($bibitem) || die $sth->errstr;
601 while ( my $data = $sth->fetchrow_hashref ) {
603 # Find out who currently has this item.
604 # FIXME - Wouldn't it be better to do this as a left join of
605 # some sort? Currently, this code assumes that if
606 # fetchrow_hashref() fails, then the book is on the shelf.
607 # fetchrow_hashref() can fail for any number of reasons (e.g.,
608 # database server crash), not just because no items match the
610 my $sth2 = $dbh->prepare(
611 "SELECT * FROM issues
612 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
617 $sth2->execute( $data->{'itemnumber'} );
618 if ( my $data2 = $sth2->fetchrow_hashref ) {
619 $data->{'date_due'} = $data2->{'date_due'};
620 $data->{'card'} = $data2->{'cardnumber'};
621 $data->{'borrower'} = $data2->{'borrowernumber'};
624 $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available';
629 # Find the last 3 people who borrowed this item.
630 $sth2 = $dbh->prepare(
631 "SELECT * FROM old_issues
632 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
634 ORDER BY returndate DESC,timestamp DESC"
637 $sth2->execute( $data->{'itemnumber'} );
638 for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
639 { # FIXME : error if there is less than 3 pple borrowing this item
640 if ( my $data2 = $sth2->fetchrow_hashref ) {
641 $data->{"timestamp$i2"} = $data2->{'timestamp'};
642 $data->{"card$i2"} = $data2->{'cardnumber'};
643 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
648 $results[$i] = $data;
656 =head2 CanBookBeIssued
658 ( $issuingimpossible, $needsconfirmation ) =
659 CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess );
660 C<$duedatespec> is a C4::Dates object.
661 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
665 sub CanBookBeIssued {
666 my ( $borrower, $barcode, $duedate, $inprocess ) = @_;
667 my %needsconfirmation; # filled with problems that needs confirmations
668 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
669 my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
670 my $issue = GetItemIssue($item->{itemnumber});
671 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
672 $item->{'itemtype'}=$item->{'itype'};
673 my $dbh = C4::Context->dbh;
676 # DUE DATE is OK ? -- should already have checked.
678 #$issuingimpossible{INVALID_DATE} = 1 unless ($duedate);
683 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
684 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
685 &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'});
686 return( { STATS => 1 }, {});
688 if ( $borrower->{flags}->{GNA} ) {
689 $issuingimpossible{GNA} = 1;
691 if ( $borrower->{flags}->{'LOST'} ) {
692 $issuingimpossible{CARD_LOST} = 1;
694 if ( $borrower->{flags}->{'DBARRED'} ) {
695 $issuingimpossible{DEBARRED} = 1;
697 if ( $borrower->{'dateexpiry'} eq '0000-00-00') {
698 $issuingimpossible{EXPIRED} = 1;
700 my @expirydate= split /-/,$borrower->{'dateexpiry'};
701 if($expirydate[0]==0 || $expirydate[1]==0|| $expirydate[2]==0 ||
702 Date_to_Days(Today) > Date_to_Days( @expirydate )) {
703 $issuingimpossible{EXPIRED} = 1;
712 C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->output('iso') );
713 if ( C4::Context->preference("IssuingInProcess") ) {
714 my $amountlimit = C4::Context->preference("noissuescharge");
715 if ( $amount > $amountlimit && !$inprocess ) {
716 $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
718 elsif ( $amount <= $amountlimit && !$inprocess ) {
719 $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
724 $needsconfirmation{DEBT} = $amount;
729 # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
731 my $toomany = TooMany( $borrower, $item->{biblionumber}, $item );
732 $needsconfirmation{TOO_MANY} = $toomany if $toomany;
737 unless ( $item->{barcode} ) {
738 $issuingimpossible{UNKNOWN_BARCODE} = 1;
740 if ( $item->{'notforloan'}
741 && $item->{'notforloan'} > 0 )
743 $issuingimpossible{NOT_FOR_LOAN} = 1;
745 elsif ( !$item->{'notforloan'} ){
746 # we have to check itemtypes.notforloan also
747 if (C4::Context->preference('item-level_itypes')){
748 # this should probably be a subroutine
749 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
750 $sth->execute($item->{'itemtype'});
751 my $notforloan=$sth->fetchrow_hashref();
753 if ($notforloan->{'notforloan'} == 1){
754 $issuingimpossible{NOT_FOR_LOAN} = 1;
757 elsif ($biblioitem->{'notforloan'} == 1){
758 $issuingimpossible{NOT_FOR_LOAN} = 1;
761 if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
763 $issuingimpossible{WTHDRAWN} = 1;
765 if ( $item->{'restricted'}
766 && $item->{'restricted'} == 1 )
768 $issuingimpossible{RESTRICTED} = 1;
770 if ( C4::Context->preference("IndependantBranches") ) {
771 my $userenv = C4::Context->userenv;
772 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
773 $issuingimpossible{NOTSAMEBRANCH} = 1
774 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
779 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
781 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
784 # Already issued to current borrower. Ask whether the loan should
786 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
787 $borrower->{'borrowernumber'},
788 $item->{'itemnumber'}
790 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
791 $issuingimpossible{NO_MORE_RENEWALS} = 1;
794 $needsconfirmation{RENEW_ISSUE} = 1;
797 elsif ($issue->{borrowernumber}) {
799 # issued to someone else
800 my $currborinfo = GetMemberDetails( $issue->{borrowernumber} );
802 # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
803 $needsconfirmation{ISSUED_TO_ANOTHER} =
804 "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
807 # See if the item is on reserve.
808 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
810 my $resbor = $res->{'borrowernumber'};
811 my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 );
812 my $branches = GetBranches();
813 my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
814 if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
816 # The item is on reserve and waiting, but has been
817 # reserved by some other patron.
818 $needsconfirmation{RESERVE_WAITING} =
819 "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
821 elsif ( $restype eq "Reserved" ) {
822 # The item is on reserve for someone else.
823 $needsconfirmation{RESERVED} =
824 "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
827 if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" ) {
828 if ( $borrower->{'categorycode'} eq 'W' ) {
830 return ( \%emptyhash, \%needsconfirmation );
833 return ( \%issuingimpossible, \%needsconfirmation );
838 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
840 &AddIssue($borrower,$barcode,$date)
844 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
846 =item C<$barcode> is the bar code of the book being issued.
848 =item C<$date> contains the max date of return. calculated if empty.
850 AddIssue does the following things :
851 - step 01: check that there is a borrowernumber & a barcode provided
852 - check for RENEWAL (book issued & being issued to the same patron)
853 - renewal YES = Calculate Charge & renew
855 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
857 - fill reserve if reserve to this patron
858 - cancel reserve or not, otherwise
859 * TRANSFERT PENDING ?
860 - complete the transfert
868 my ( $borrower, $barcode, $date, $cancelreserve ) = @_;
869 my $dbh = C4::Context->dbh;
870 my $barcodecheck=CheckValidBarcode($barcode);
871 if ($borrower and $barcode and $barcodecheck ne '0'){
872 # find which item we issue
873 my $item = GetItem('', $barcode);
877 # Get which branchcode we need
878 if (C4::Context->preference('CircControl') eq 'PickupLibrary'){
879 $branch = C4::Context->userenv->{'branch'};
881 elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){
882 $branch = $borrower->{'branchcode'};
886 $branch = $item->{'homebranch'};
889 # get actual issuing if there is one
890 my $actualissue = GetItemIssue( $item->{itemnumber});
892 # get biblioinformation for this item
893 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
896 # check if we just renew the issue.
898 if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) {
900 $borrower->{'borrowernumber'},
901 $item->{'itemnumber'},
909 if ( $actualissue->{borrowernumber}) {
910 # This book is currently on loan, but not to the person
911 # who wants to borrow it now. mark it returned before issuing to the new borrower
914 C4::Context->userenv->{'branch'}
918 # See if the item is on reserve.
919 my ( $restype, $res ) =
920 C4::Reserves::CheckReserves( $item->{'itemnumber'} );
922 my $resbor = $res->{'borrowernumber'};
923 if ( $resbor eq $borrower->{'borrowernumber'} ) {
925 # The item is reserved by the current patron
926 ModReserveFill($res);
928 elsif ( $restype eq "Waiting" ) {
931 # The item is on reserve and waiting, but has been
932 # reserved by some other patron.
933 my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 );
934 my $branches = GetBranches();
936 $branches->{ $res->{'branchcode'} }->{'branchname'};
938 elsif ( $restype eq "Reserved" ) {
941 # The item is reserved by someone else.
942 my ( $resborrower, $flags ) =
943 GetMemberDetails( $resbor, 0 );
944 my $branches = GetBranches();
945 my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
946 if ($cancelreserve) { # cancel reserves on this item
947 CancelReserve( 0, $res->{'itemnumber'},
948 $res->{'borrowernumber'} );
951 if ($cancelreserve) {
952 CancelReserve( $res->{'biblionumber'}, 0,
953 $res->{'borrowernumber'} );
956 # set waiting reserve to first in reserve queue as book isn't waiting now
958 $res->{'biblionumber'},
959 $res->{'borrowernumber'},
965 # Starting process for transfer job (checking transfert and validate it if we have one)
966 my ($datesent) = GetTransfers($item->{'itemnumber'});
968 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....)
971 "UPDATE branchtransfers
972 SET datearrived = now(),
974 comments = 'Forced branchtransfer'
975 WHERE itemnumber= ? AND datearrived IS NULL"
977 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
981 # Record in the database the fact that the book was issued.
985 (borrowernumber, itemnumber,issuedate, date_due, branchcode)
992 my $itype=(C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ;
993 my $loanlength = GetLoanLength(
994 $borrower->{'categorycode'},
998 $dateduef = CalcDateDue(C4::Dates->new(),$loanlength,$branch);
999 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
1000 if ( C4::Context->preference('ReturnBeforeExpiry') && $dateduef->output('iso') gt $borrower->{dateexpiry} ) {
1001 $dateduef = C4::Dates->new($borrower->{dateexpiry},'iso');
1005 $borrower->{'borrowernumber'},
1006 $item->{'itemnumber'},
1007 strftime( "%Y-%m-%d", localtime ),$dateduef->output('iso'), C4::Context->userenv->{'branch'}
1010 $item->{'issues'}++;
1011 ModItem({ issues => $item->{'issues'},
1012 holdingbranch => C4::Context->userenv->{'branch'},
1014 datelastborrowed => C4::Dates->new()->output('iso'),
1015 onloan => $dateduef->output('iso'),
1016 }, $item->{'biblionumber'}, $item->{'itemnumber'});
1017 ModDateLastSeen( $item->{'itemnumber'} );
1019 # If it costs to borrow this book, charge it to the patron's account.
1020 my ( $charge, $itemtype ) = GetIssuingCharges(
1021 $item->{'itemnumber'},
1022 $borrower->{'borrowernumber'}
1024 if ( $charge > 0 ) {
1026 $item->{'itemnumber'},
1027 $borrower->{'borrowernumber'}, $charge
1029 $item->{'charge'} = $charge;
1032 # Record the fact that this book was issued.
1034 C4::Context->userenv->{'branch'},
1036 '', $item->{'itemnumber'},
1037 $item->{'itype'}, $borrower->{'borrowernumber'}
1041 logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
1042 if C4::Context->preference("IssueLog");
1047 =head2 GetLoanLength
1049 Get loan length for an itemtype, a borrower type and a branch
1051 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1056 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1057 my $dbh = C4::Context->dbh;
1060 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"
1062 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1063 # try to find issuelength & return the 1st available.
1064 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1065 $sth->execute( $borrowertype, $itemtype, $branchcode );
1066 my $loanlength = $sth->fetchrow_hashref;
1067 return $loanlength->{issuelength}
1068 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1070 $sth->execute( $borrowertype, "*", $branchcode );
1071 $loanlength = $sth->fetchrow_hashref;
1072 return $loanlength->{issuelength}
1073 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1075 $sth->execute( "*", $itemtype, $branchcode );
1076 $loanlength = $sth->fetchrow_hashref;
1077 return $loanlength->{issuelength}
1078 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1080 $sth->execute( "*", "*", $branchcode );
1081 $loanlength = $sth->fetchrow_hashref;
1082 return $loanlength->{issuelength}
1083 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1085 $sth->execute( $borrowertype, $itemtype, "*" );
1086 $loanlength = $sth->fetchrow_hashref;
1087 return $loanlength->{issuelength}
1088 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1090 $sth->execute( $borrowertype, "*", "*" );
1091 $loanlength = $sth->fetchrow_hashref;
1092 return $loanlength->{issuelength}
1093 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1095 $sth->execute( "*", $itemtype, "*" );
1096 $loanlength = $sth->fetchrow_hashref;
1097 return $loanlength->{issuelength}
1098 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1100 $sth->execute( "*", "*", "*" );
1101 $loanlength = $sth->fetchrow_hashref;
1102 return $loanlength->{issuelength}
1103 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1105 # if no rule is set => 21 days (hardcoded)
1109 =head2 GetIssuingRule
1111 FIXME - This is a copy-paste of GetLoanLength
1112 as a stop-gap. Do not wish to change API for GetLoanLength
1113 this close to release, however, Overdues::GetIssuingRules is broken.
1115 Get the issuing rule for an itemtype, a borrower type and a branch
1116 Returns a hashref from the issuingrules table.
1118 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1122 sub GetIssuingRule {
1123 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1124 my $dbh = C4::Context->dbh;
1125 my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null" );
1128 $sth->execute( $borrowertype, $itemtype, $branchcode );
1129 $irule = $sth->fetchrow_hashref;
1130 return $irule if defined($irule) ;
1132 $sth->execute( $borrowertype, "*", $branchcode );
1133 $irule = $sth->fetchrow_hashref;
1134 return $irule if defined($irule) ;
1136 $sth->execute( "*", $itemtype, $branchcode );
1137 $irule = $sth->fetchrow_hashref;
1138 return $irule if defined($irule) ;
1140 $sth->execute( "*", "*", $branchcode );
1141 $irule = $sth->fetchrow_hashref;
1142 return $irule if defined($irule) ;
1144 $sth->execute( $borrowertype, $itemtype, "*" );
1145 $irule = $sth->fetchrow_hashref;
1146 return $irule if defined($irule) ;
1148 $sth->execute( $borrowertype, "*", "*" );
1149 $irule = $sth->fetchrow_hashref;
1150 return $irule if defined($irule) ;
1152 $sth->execute( "*", $itemtype, "*" );
1153 $irule = $sth->fetchrow_hashref;
1154 return $irule if defined($irule) ;
1156 $sth->execute( "*", "*", "*" );
1157 $irule = $sth->fetchrow_hashref;
1158 return $irule if defined($irule) ;
1160 # if no rule matches,
1164 =head2 GetBranchBorrowerCircRule
1168 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1172 Retrieves circulation rule attributes that apply to the given
1173 branch and patron category, regardless of item type.
1174 The return value is a hashref containing the following key:
1176 maxissueqty - maximum number of loans that a
1177 patron of the given category can have at the given
1178 branch. If the value is undef, no limit.
1180 This will first check for a specific branch and
1181 category match from branch_borrower_circ_rules.
1183 If no rule is found, it will then check default_branch_circ_rules
1184 (same branch, default category). If no rule is found,
1185 it will then check default_borrower_circ_rules (default
1186 branch, same category), then failing that, default_circ_rules
1187 (default branch, default category).
1189 If no rule has been found in the database, it will default to
1194 C<$branchcode> and C<$categorycode> should contain the
1195 literal branch code and patron category code, respectively - no
1200 sub GetBranchBorrowerCircRule {
1201 my $branchcode = shift;
1202 my $categorycode = shift;
1204 my $branch_cat_query = "SELECT maxissueqty
1205 FROM branch_borrower_circ_rules
1206 WHERE branchcode = ?
1207 AND categorycode = ?";
1208 my $dbh = C4::Context->dbh();
1209 my $sth = $dbh->prepare($branch_cat_query);
1210 $sth->execute($branchcode, $categorycode);
1212 if ($result = $sth->fetchrow_hashref()) {
1216 # try same branch, default borrower category
1217 my $branch_query = "SELECT maxissueqty
1218 FROM default_branch_circ_rules
1219 WHERE branchcode = ?";
1220 $sth = $dbh->prepare($branch_query);
1221 $sth->execute($branchcode);
1222 if ($result = $sth->fetchrow_hashref()) {
1226 # try default branch, same borrower category
1227 my $category_query = "SELECT maxissueqty
1228 FROM default_borrower_circ_rules
1229 WHERE categorycode = ?";
1230 $sth = $dbh->prepare($category_query);
1231 $sth->execute($categorycode);
1232 if ($result = $sth->fetchrow_hashref()) {
1236 # try default branch, default borrower category
1237 my $default_query = "SELECT maxissueqty
1238 FROM default_circ_rules";
1239 $sth = $dbh->prepare($default_query);
1241 if ($result = $sth->fetchrow_hashref()) {
1245 # built-in default circulation rule
1247 maxissueqty => undef,
1253 ($doreturn, $messages, $iteminformation, $borrower) =
1254 &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1258 C<$barcode> is the bar code of the book being returned. C<$branch> is
1259 the code of the branch where the book is being returned. C<$exemptfine>
1260 indicates that overdue charges for the item will be removed. C<$dropbox>
1261 indicates that the check-in date is assumed to be yesterday, or the last
1262 non-holiday as defined in C4::Calendar . If overdue
1263 charges are applied and C<$dropbox> is true, the last charge will be removed.
1264 This assumes that the fines accrual script has run for _today_.
1266 C<&AddReturn> returns a list of four items:
1268 C<$doreturn> is true iff the return succeeded.
1270 C<$messages> is a reference-to-hash giving the reason for failure:
1276 No item with this barcode exists. The value is C<$barcode>.
1280 The book is not currently on loan. The value is C<$barcode>.
1282 =item C<IsPermanent>
1284 The book's home branch is a permanent collection. If you have borrowed
1285 this book, you are not allowed to return it. The value is the code for
1286 the book's home branch.
1290 This book has been withdrawn/cancelled. The value should be ignored.
1294 The item was reserved. The value is a reference-to-hash whose keys are
1295 fields from the reserves table of the Koha database, and
1296 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1297 either C<Waiting>, C<Reserved>, or 0.
1301 C<$borrower> is a reference-to-hash, giving information about the
1302 patron who last borrowed the book.
1307 my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1308 my $dbh = C4::Context->dbh;
1312 my $validTransfert = 0;
1313 my $reserveDone = 0;
1315 # get information on item
1316 my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
1317 my $biblio = GetBiblioItemData($iteminformation->{'biblioitemnumber'});
1318 # use Data::Dumper;warn Data::Dumper::Dumper($iteminformation);
1319 unless ($iteminformation->{'itemnumber'} ) {
1320 $messages->{'BadBarcode'} = $barcode;
1324 if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1325 $messages->{'NotIssued'} = $barcode;
1326 # even though item is not on loan, it may still
1327 # be transferred; therefore, get current branch information
1328 my $curr_iteminfo = GetItem($iteminformation->{'itemnumber'});
1329 $iteminformation->{'homebranch'} = $curr_iteminfo->{'homebranch'};
1330 $iteminformation->{'holdingbranch'} = $curr_iteminfo->{'holdingbranch'};
1334 # check if the book is in a permanent collection....
1335 my $hbr = $iteminformation->{C4::Context->preference("HomeOrHoldingBranch")};
1336 my $branches = GetBranches();
1337 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1338 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1339 $messages->{'IsPermanent'} = $hbr;
1342 # if independent branches are on and returning to different branch, refuse the return
1343 if ($hbr ne C4::Context->userenv->{'branch'} && C4::Context->preference("IndependantBranches")){
1344 $messages->{'Wrongbranch'} = 1;
1348 # check that the book has been cancelled
1349 if ( $iteminformation->{'wthdrawn'} ) {
1350 $messages->{'wthdrawn'} = 1;
1354 # new op dev : if the book returned in an other branch update the holding branch
1356 # update issues, thereby returning book (should push this out into another subroutine
1357 $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1359 # case of a return of document (deal with issues and holdingbranch)
1362 my $circControlBranch;
1364 # don't allow dropbox mode to create an invalid entry in issues (issuedate > returndate) FIXME: actually checks eq, not gt
1365 undef($dropbox) if ( $iteminformation->{'issuedate'} eq C4::Dates->today('iso') );
1366 if (C4::Context->preference('CircControl') eq 'ItemHomeBranch' ) {
1367 $circControlBranch = $iteminformation->{homebranch};
1368 } elsif ( C4::Context->preference('CircControl') eq 'PatronLibrary') {
1369 $circControlBranch = $borrower->{branchcode};
1370 } else { # CircControl must be PickupLibrary.
1371 $circControlBranch = $iteminformation->{holdingbranch};
1372 # FIXME - is this right ? are we sure that the holdingbranch is still the pickup branch?
1375 MarkIssueReturned($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'},$circControlBranch);
1376 $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
1379 # continue to deal with returns cases, but not only if we have an issue
1381 # the holdingbranch is updated if the document is returned in an other location .
1382 if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) {
1383 UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
1384 # reload iteminformation holdingbranch with the userenv value
1385 $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1387 ModDateLastSeen( $iteminformation->{'itemnumber'} );
1388 ModItem({ onloan => undef }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'});
1390 if ($iteminformation->{borrowernumber}){
1391 ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1393 # fix up the accounts.....
1394 if ( $iteminformation->{'itemlost'} ) {
1395 $messages->{'WasLost'} = 1;
1398 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1399 # check if we have a transfer for this document
1400 my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1402 # if we have a transfer to do, we update the line of transfers with the datearrived
1404 if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1407 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1409 $sth->execute( $iteminformation->{'itemnumber'} );
1411 # 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'
1412 C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1415 $messages->{'WrongTransfer'} = $tobranch;
1416 $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1418 $validTransfert = 1;
1421 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1422 # fix up the accounts.....
1423 if ($iteminformation->{'itemlost'}) {
1424 FixAccountForLostAndReturned($iteminformation, $borrower);
1425 $messages->{'WasLost'} = 1;
1427 # fix up the overdues in accounts...
1428 FixOverduesOnReturn( $borrower->{'borrowernumber'},
1429 $iteminformation->{'itemnumber'}, $exemptfine, $dropbox );
1431 # find reserves.....
1432 # if we don't have a reserve with the status W, we launch the Checkreserves routine
1433 my ( $resfound, $resrec ) =
1434 C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1436 $resrec->{'ResFound'} = $resfound;
1437 $messages->{'ResFound'} = $resrec;
1442 # Record the fact that this book was returned.
1444 $branch, 'return', '0', '',
1445 $iteminformation->{'itemnumber'},
1446 $biblio->{'itemtype'},
1447 $borrower->{'borrowernumber'}
1450 logaction("CIRCULATION", "RETURN", $iteminformation->{borrowernumber}, $iteminformation->{'biblionumber'})
1451 if C4::Context->preference("ReturnLog");
1453 #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1454 #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1456 if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1457 if (C4::Context->preference("AutomaticItemReturn") == 1) {
1458 ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1459 $messages->{'WasTransfered'} = 1;
1462 $messages->{'NeedsTransfer'} = 1;
1466 return ( $doreturn, $messages, $iteminformation, $borrower );
1469 =head2 MarkIssueReturned
1473 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch);
1477 Unconditionally marks an issue as being returned by
1478 moving the C<issues> row to C<old_issues> and
1479 setting C<returndate> to the current date, or
1480 the last non-holiday date of the branccode specified in
1481 C<dropbox> . Assumes you've already checked that
1482 it's safe to do this, i.e. last non-holiday > issuedate.
1484 Ideally, this function would be internal to C<C4::Circulation>,
1485 not exported, but it is currently needed by one
1486 routine in C<C4::Accounts>.
1490 sub MarkIssueReturned {
1491 my ($borrowernumber, $itemnumber, $dropbox_branch ) = @_;
1492 my $dbh = C4::Context->dbh;
1493 my $query = "UPDATE issues SET returndate=";
1494 my @bind = ($borrowernumber,$itemnumber);
1495 if($dropbox_branch) {
1496 my $calendar = C4::Calendar->new( branchcode => $dropbox_branch );
1497 my $dropboxdate = $calendar->addDate(C4::Dates->new(), -1 );
1498 unshift @bind, $dropboxdate->output('iso') ;
1501 $query .= " now() ";
1503 $query .= " WHERE borrowernumber = ? AND itemnumber = ?";
1505 my $sth_upd = $dbh->prepare($query);
1506 $sth_upd->execute(@bind);
1507 my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1508 WHERE borrowernumber = ?
1509 AND itemnumber = ?");
1510 $sth_copy->execute($borrowernumber, $itemnumber);
1511 my $sth_del = $dbh->prepare("DELETE FROM issues
1512 WHERE borrowernumber = ?
1513 AND itemnumber = ?");
1514 $sth_del->execute($borrowernumber, $itemnumber);
1517 =head2 FixOverduesOnReturn
1519 &FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1521 C<$brn> borrowernumber
1525 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1526 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1528 internal function, called only by AddReturn
1532 sub FixOverduesOnReturn {
1533 my ( $borrowernumber, $item, $exemptfine, $dropbox ) = @_;
1534 my $dbh = C4::Context->dbh;
1536 # check for overdue fine
1539 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1541 $sth->execute( $borrowernumber, $item );
1543 # alter fine to show that the book has been returned
1545 if ($data = $sth->fetchrow_hashref) {
1547 my @bind = ($borrowernumber,$item ,$data->{'accountno'});
1549 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1550 if (C4::Context->preference("FinesLog")) {
1551 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1553 } elsif ($dropbox && $data->{lastincrement}) {
1554 my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1555 my $amt = $data->{amount} - $data->{lastincrement} ;
1556 if (C4::Context->preference("FinesLog")) {
1557 &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1559 $uquery = "update accountlines set accounttype='F' ";
1560 if($outstanding >= 0 && $amt >=0) {
1561 $uquery .= ", amount = ? , amountoutstanding=? ";
1562 unshift @bind, ($amt, $outstanding) ;
1565 $uquery = "update accountlines set accounttype='F' ";
1567 $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1568 my $usth = $dbh->prepare($uquery);
1569 $usth->execute(@bind);
1577 =head2 FixAccountForLostAndReturned
1579 &FixAccountForLostAndReturned($iteminfo,$borrower);
1581 Calculates the charge for a book lost and returned (Not exported & used only once)
1583 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1585 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1587 Internal function, called by AddReturn
1591 sub FixAccountForLostAndReturned {
1592 my ($iteminfo, $borrower) = @_;
1593 my $dbh = C4::Context->dbh;
1594 my $itm = $iteminfo->{'itemnumber'};
1595 # check for charge made for lost book
1596 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1597 $sth->execute($itm);
1598 if (my $data = $sth->fetchrow_hashref) {
1599 # writeoff this amount
1601 my $amount = $data->{'amount'};
1602 my $acctno = $data->{'accountno'};
1604 if ($data->{'amountoutstanding'} == $amount) {
1605 $offset = $data->{'amount'};
1608 $offset = $amount - $data->{'amountoutstanding'};
1609 $amountleft = $data->{'amountoutstanding'} - $amount;
1611 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1612 WHERE (borrowernumber = ?)
1613 AND (itemnumber = ?) AND (accountno = ?) ");
1614 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1616 #check if any credit is left if so writeoff other accounts
1617 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1618 if ($amountleft < 0){
1621 if ($amountleft > 0){
1622 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1623 AND (amountoutstanding >0) ORDER BY date");
1624 $msth->execute($data->{'borrowernumber'});
1625 # offset transactions
1628 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1629 if ($accdata->{'amountoutstanding'} < $amountleft) {
1631 $amountleft -= $accdata->{'amountoutstanding'};
1633 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1636 my $thisacct = $accdata->{'accountno'};
1637 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1638 WHERE (borrowernumber = ?)
1639 AND (accountno=?)");
1640 $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1642 $usth = $dbh->prepare("INSERT INTO accountoffsets
1643 (borrowernumber, accountno, offsetaccount, offsetamount)
1646 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1651 if ($amountleft > 0){
1654 my $desc="Item Returned ".$iteminfo->{'barcode'};
1655 $usth = $dbh->prepare("INSERT INTO accountlines
1656 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1657 VALUES (?,?,now(),?,?,'CR',?)");
1658 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1660 $usth = $dbh->prepare("INSERT INTO accountoffsets
1661 (borrowernumber, accountno, offsetaccount, offsetamount)
1663 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1665 ModItem({ paidfor => '' }, undef, $itm);
1673 $issues = &GetItemIssue($itemnumber);
1675 Returns patrons currently having a book. nothing if item is not issued atm
1677 C<$itemnumber> is the itemnumber
1679 Returns an array of hashes
1684 my ( $itemnumber) = @_;
1685 return unless $itemnumber;
1686 my $dbh = C4::Context->dbh;
1690 my $today = POSIX::strftime("%Y%m%d", localtime);
1692 my $sth = $dbh->prepare(
1693 "SELECT * FROM issues
1694 LEFT JOIN items ON issues.itemnumber=items.itemnumber
1696 issues.itemnumber=?");
1697 $sth->execute($itemnumber);
1698 my $data = $sth->fetchrow_hashref;
1699 my $datedue = $data->{'date_due'};
1701 if ( $datedue < $today ) {
1702 $data->{'overdue'} = 1;
1704 $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1709 =head2 GetItemIssues
1711 $issues = &GetItemIssues($itemnumber, $history);
1713 Returns patrons that have issued a book
1715 C<$itemnumber> is the itemnumber
1716 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1718 Returns an array of hashes
1723 my ( $itemnumber,$history ) = @_;
1724 my $dbh = C4::Context->dbh;
1728 my $today = POSIX::strftime("%Y%m%d", localtime);
1730 my $sql = "SELECT * FROM issues
1731 JOIN borrowers USING (borrowernumber)
1732 JOIN items USING (itemnumber)
1733 WHERE issues.itemnumber = ? ";
1736 SELECT * FROM old_issues
1737 LEFT JOIN borrowers USING (borrowernumber)
1738 JOIN items USING (itemnumber)
1739 WHERE old_issues.itemnumber = ? ";
1741 $sql .= "ORDER BY date_due DESC";
1742 my $sth = $dbh->prepare($sql);
1744 $sth->execute($itemnumber, $itemnumber);
1746 $sth->execute($itemnumber);
1748 while ( my $data = $sth->fetchrow_hashref ) {
1749 my $datedue = $data->{'date_due'};
1751 if ( $datedue < $today ) {
1752 $data->{'overdue'} = 1;
1754 my $itemnumber = $data->{'itemnumber'};
1755 push @GetItemIssues, $data;
1758 return ( \@GetItemIssues );
1761 =head2 GetBiblioIssues
1763 $issues = GetBiblioIssues($biblionumber);
1765 this function get all issues from a biblionumber.
1768 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1769 tables issues and the firstname,surname & cardnumber from borrowers.
1773 sub GetBiblioIssues {
1774 my $biblionumber = shift;
1775 return undef unless $biblionumber;
1776 my $dbh = C4::Context->dbh;
1778 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1780 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1781 LEFT JOIN items ON issues.itemnumber = items.itemnumber
1782 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1783 LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1784 WHERE biblio.biblionumber = ?
1786 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1788 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1789 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1790 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1791 LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1792 WHERE biblio.biblionumber = ?
1795 my $sth = $dbh->prepare($query);
1796 $sth->execute($biblionumber, $biblionumber);
1799 while ( my $data = $sth->fetchrow_hashref ) {
1800 push @issues, $data;
1805 =head2 CanBookBeRenewed
1807 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber);
1809 Find out whether a borrowed item may be renewed.
1811 C<$dbh> is a DBI handle to the Koha database.
1813 C<$borrowernumber> is the borrower number of the patron who currently
1814 has the item on loan.
1816 C<$itemnumber> is the number of the item to renew.
1818 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1819 item must currently be on loan to the specified borrower; renewals
1820 must be allowed for the item's type; and the borrower must not have
1821 already renewed the loan. $error will contain the reason the renewal can not proceed
1825 sub CanBookBeRenewed {
1827 # check renewal status
1828 my ( $borrowernumber, $itemnumber ) = @_;
1829 my $dbh = C4::Context->dbh;
1834 # Look in the issues table for this item, lent to this borrower,
1835 # and not yet returned.
1837 # FIXME - I think this function could be redone to use only one SQL call.
1838 my $sth1 = $dbh->prepare(
1839 "SELECT * FROM issues
1840 WHERE borrowernumber = ?
1843 $sth1->execute( $borrowernumber, $itemnumber );
1844 if ( my $data1 = $sth1->fetchrow_hashref ) {
1846 # Found a matching item
1848 # See if this item may be renewed. This query is convoluted
1849 # because it's a bit messy: given the item number, we need to find
1850 # the biblioitem, which gives us the itemtype, which tells us
1851 # whether it may be renewed.
1852 my $query = "SELECT renewalsallowed FROM items ";
1853 $query .= (C4::Context->preference('item-level_itypes'))
1854 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1855 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1856 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1857 $query .= "WHERE items.itemnumber = ?";
1858 my $sth2 = $dbh->prepare($query);
1859 $sth2->execute($itemnumber);
1860 if ( my $data2 = $sth2->fetchrow_hashref ) {
1861 $renews = $data2->{'renewalsallowed'};
1863 if ( $renews && $renews > $data1->{'renewals'} ) {
1870 my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1878 return ($renewokay,$error);
1883 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue]);
1887 C<$borrowernumber> is the borrower number of the patron who currently
1890 C<$itemnumber> is the number of the item to renew.
1892 C<$branch> is the library branch. Defaults to the homebranch of the ITEM.
1894 C<$datedue> can be a C4::Dates object used to set the due date.
1896 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
1897 from the book's item type.
1902 my $borrowernumber = shift or return undef;
1903 my $itemnumber = shift or return undef;
1904 my $item = GetItem($itemnumber) or return undef;
1905 my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
1906 my $branch = (@_) ? shift : $item->{homebranch}; # opac-renew doesn't send branch
1908 # If the due date wasn't specified, calculate it by adding the
1909 # book's loan length to today's date.
1910 unless (@_ and $datedue = shift and $datedue->output('iso')) {
1912 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
1913 my $loanlength = GetLoanLength(
1914 $borrower->{'categorycode'},
1915 (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
1916 $item->{homebranch} # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument?
1918 #FIXME -- use circControl?
1919 $datedue = CalcDateDue(C4::Dates->new(),$loanlength,$branch); # this branch is the transactional branch.
1920 # The question of whether to use item's homebranch calendar is open.
1923 my $dbh = C4::Context->dbh;
1924 # Find the issues record for this book
1926 $dbh->prepare("SELECT * FROM issues
1927 WHERE borrowernumber=?
1930 $sth->execute( $borrowernumber, $itemnumber );
1931 my $issuedata = $sth->fetchrow_hashref;
1934 # Update the issues record to have the new due date, and a new count
1935 # of how many times it has been renewed.
1936 my $renews = $issuedata->{'renewals'} + 1;
1937 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?
1938 WHERE borrowernumber=?
1941 $sth->execute( $datedue->output('iso'), $renews, $borrowernumber, $itemnumber );
1944 # Update the renewal count on the item, and tell zebra to reindex
1945 $renews = $biblio->{'renewals'} + 1;
1946 ModItem({ renewals => $renews }, $biblio->{'biblionumber'}, $itemnumber);
1948 # Charge a new rental fee, if applicable?
1949 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1950 if ( $charge > 0 ) {
1951 my $accountno = getnextacctno( $borrowernumber );
1952 my $item = GetBiblioFromItemNumber($itemnumber);
1953 $sth = $dbh->prepare(
1954 "INSERT INTO accountlines
1956 borrowernumber, accountno, amount,
1958 accounttype, amountoutstanding, itemnumber
1960 VALUES (now(),?,?,?,?,?,?,?)"
1962 $sth->execute( $borrowernumber, $accountno, $charge,
1963 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
1964 'Rent', $charge, $itemnumber );
1968 UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
1972 # check renewal status
1973 my ($bornum,$itemno)=@_;
1974 my $dbh = C4::Context->dbh;
1976 my $renewsallowed = 0;
1978 # Look in the issues table for this item, lent to this borrower,
1979 # and not yet returned.
1981 # FIXME - I think this function could be redone to use only one SQL call.
1982 my $sth = $dbh->prepare("select * from issues
1983 where (borrowernumber = ?)
1984 and (itemnumber = ?)");
1985 $sth->execute($bornum,$itemno);
1986 my $data = $sth->fetchrow_hashref;
1987 $renewcount = $data->{'renewals'} if $data->{'renewals'};
1989 my $query = "SELECT renewalsallowed FROM items ";
1990 $query .= (C4::Context->preference('item-level_itypes'))
1991 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1992 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1993 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1994 $query .= "WHERE items.itemnumber = ?";
1995 my $sth2 = $dbh->prepare($query);
1996 $sth2->execute($itemno);
1997 my $data2 = $sth2->fetchrow_hashref();
1998 $renewsallowed = $data2->{'renewalsallowed'};
1999 $renewsleft = $renewsallowed - $renewcount;
2000 return ($renewcount,$renewsallowed,$renewsleft);
2003 =head2 GetIssuingCharges
2005 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2007 Calculate how much it would cost for a given patron to borrow a given
2008 item, including any applicable discounts.
2010 C<$itemnumber> is the item number of item the patron wishes to borrow.
2012 C<$borrowernumber> is the patron's borrower number.
2014 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2015 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2020 sub GetIssuingCharges {
2022 # calculate charges due
2023 my ( $itemnumber, $borrowernumber ) = @_;
2025 my $dbh = C4::Context->dbh;
2028 # Get the book's item type and rental charge (via its biblioitem).
2029 my $qcharge = "SELECT itemtypes.itemtype,rentalcharge FROM items
2030 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
2031 $qcharge .= (C4::Context->preference('item-level_itypes'))
2032 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2033 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2035 $qcharge .= "WHERE items.itemnumber =?";
2037 my $sth1 = $dbh->prepare($qcharge);
2038 $sth1->execute($itemnumber);
2039 if ( my $data1 = $sth1->fetchrow_hashref ) {
2040 $item_type = $data1->{'itemtype'};
2041 $charge = $data1->{'rentalcharge'};
2042 my $q2 = "SELECT rentaldiscount FROM borrowers
2043 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2044 WHERE borrowers.borrowernumber = ?
2045 AND issuingrules.itemtype = ?";
2046 my $sth2 = $dbh->prepare($q2);
2047 $sth2->execute( $borrowernumber, $item_type );
2048 if ( my $data2 = $sth2->fetchrow_hashref ) {
2049 my $discount = $data2->{'rentaldiscount'};
2050 if ( $discount eq 'NULL' ) {
2053 $charge = ( $charge * ( 100 - $discount ) ) / 100;
2059 return ( $charge, $item_type );
2062 =head2 AddIssuingCharge
2064 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2068 sub AddIssuingCharge {
2069 my ( $itemnumber, $borrowernumber, $charge ) = @_;
2070 my $dbh = C4::Context->dbh;
2071 my $nextaccntno = getnextacctno( $borrowernumber );
2073 INSERT INTO accountlines
2074 (borrowernumber, itemnumber, accountno,
2075 date, amount, description, accounttype,
2077 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
2079 my $sth = $dbh->prepare($query);
2080 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
2086 GetTransfers($itemnumber);
2091 my ($itemnumber) = @_;
2093 my $dbh = C4::Context->dbh;
2099 FROM branchtransfers
2100 WHERE itemnumber = ?
2101 AND datearrived IS NULL
2103 my $sth = $dbh->prepare($query);
2104 $sth->execute($itemnumber);
2105 my @row = $sth->fetchrow_array();
2111 =head2 GetTransfersFromTo
2113 @results = GetTransfersFromTo($frombranch,$tobranch);
2115 Returns the list of pending transfers between $from and $to branch
2119 sub GetTransfersFromTo {
2120 my ( $frombranch, $tobranch ) = @_;
2121 return unless ( $frombranch && $tobranch );
2122 my $dbh = C4::Context->dbh;
2124 SELECT itemnumber,datesent,frombranch
2125 FROM branchtransfers
2128 AND datearrived IS NULL
2130 my $sth = $dbh->prepare($query);
2131 $sth->execute( $frombranch, $tobranch );
2134 while ( my $data = $sth->fetchrow_hashref ) {
2135 push @gettransfers, $data;
2138 return (@gettransfers);
2141 =head2 DeleteTransfer
2143 &DeleteTransfer($itemnumber);
2147 sub DeleteTransfer {
2148 my ($itemnumber) = @_;
2149 my $dbh = C4::Context->dbh;
2150 my $sth = $dbh->prepare(
2151 "DELETE FROM branchtransfers
2153 AND datearrived IS NULL "
2155 $sth->execute($itemnumber);
2159 =head2 AnonymiseIssueHistory
2161 $rows = AnonymiseIssueHistory($borrowernumber,$date)
2163 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2164 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2166 return the number of affected rows.
2170 sub AnonymiseIssueHistory {
2172 my $borrowernumber = shift;
2173 my $dbh = C4::Context->dbh;
2176 SET borrowernumber = NULL
2177 WHERE returndate < '".$date."'
2178 AND borrowernumber IS NOT NULL
2180 $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2181 my $rows_affected = $dbh->do($query);
2182 return $rows_affected;
2185 =head2 updateWrongTransfer
2187 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2189 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
2193 sub updateWrongTransfer {
2194 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2195 my $dbh = C4::Context->dbh;
2196 # first step validate the actual line of transfert .
2199 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2201 $sth->execute($FromLibrary,$itemNumber);
2204 # second step create a new line of branchtransfer to the right location .
2205 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2207 #third step changing holdingbranch of item
2208 UpdateHoldingbranch($FromLibrary,$itemNumber);
2211 =head2 UpdateHoldingbranch
2213 $items = UpdateHoldingbranch($branch,$itmenumber);
2214 Simple methode for updating hodlingbranch in items BDD line
2218 sub UpdateHoldingbranch {
2219 my ( $branch,$itemnumber ) = @_;
2220 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2225 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2226 this function calculates the due date given the loan length ,
2227 checking against the holidays calendar as per the 'useDaysMode' syspref.
2228 C<$startdate> = C4::Dates object representing start date of loan period (assumed to be today)
2229 C<$branch> = location whose calendar to use
2230 C<$loanlength> = loan length prior to adjustment
2234 my ($startdate,$loanlength,$branch) = @_;
2235 if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar
2236 my $datedue = time + ($loanlength) * 86400;
2237 #FIXME - assumes now even though we take a startdate
2238 my @datearr = localtime($datedue);
2239 return C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2241 my $calendar = C4::Calendar->new( branchcode => $branch );
2242 my $datedue = $calendar->addDate($startdate, $loanlength);
2247 =head2 CheckValidDatedue
2248 This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2249 To be replaced by CalcDateDue() once C4::Calendar use is tested.
2251 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2252 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2253 C<$date_due> = returndate calculate with no day check
2254 C<$itemnumber> = itemnumber
2255 C<$branchcode> = location of issue (affected by 'CircControl' syspref)
2256 C<$loanlength> = loan length prior to adjustment
2259 sub CheckValidDatedue {
2260 my ($date_due,$itemnumber,$branchcode)=@_;
2261 my @datedue=split('-',$date_due->output('iso'));
2262 my $years=$datedue[0];
2263 my $month=$datedue[1];
2264 my $day=$datedue[2];
2265 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2267 for (my $i=0;$i<2;$i++){
2268 $dow=Day_of_Week($years,$month,$day);
2269 ($dow=0) if ($dow>6);
2270 my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2271 my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2272 my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2273 if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2275 (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2278 my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2283 =head2 CheckRepeatableHolidays
2285 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2286 this function checks if the date due is a repeatable holiday
2287 C<$date_due> = returndate calculate with no day check
2288 C<$itemnumber> = itemnumber
2289 C<$branchcode> = localisation of issue
2293 sub CheckRepeatableHolidays{
2294 my($itemnumber,$week_day,$branchcode)=@_;
2295 my $dbh = C4::Context->dbh;
2296 my $query = qq|SELECT count(*)
2297 FROM repeatable_holidays
2300 my $sth = $dbh->prepare($query);
2301 $sth->execute($branchcode,$week_day);
2302 my $result=$sth->fetchrow;
2308 =head2 CheckSpecialHolidays
2310 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2311 this function check if the date is a special holiday
2312 C<$years> = the years of datedue
2313 C<$month> = the month of datedue
2314 C<$day> = the day of datedue
2315 C<$itemnumber> = itemnumber
2316 C<$branchcode> = localisation of issue
2320 sub CheckSpecialHolidays{
2321 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2322 my $dbh = C4::Context->dbh;
2323 my $query=qq|SELECT count(*)
2324 FROM `special_holidays`
2330 my $sth = $dbh->prepare($query);
2331 $sth->execute($years,$month,$day,$branchcode);
2332 my $countspecial=$sth->fetchrow ;
2334 return $countspecial;
2337 =head2 CheckRepeatableSpecialHolidays
2339 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2340 this function check if the date is a repeatble special holidays
2341 C<$month> = the month of datedue
2342 C<$day> = the day of datedue
2343 C<$itemnumber> = itemnumber
2344 C<$branchcode> = localisation of issue
2348 sub CheckRepeatableSpecialHolidays{
2349 my ($month,$day,$itemnumber,$branchcode) = @_;
2350 my $dbh = C4::Context->dbh;
2351 my $query=qq|SELECT count(*)
2352 FROM `repeatable_holidays`
2357 my $sth = $dbh->prepare($query);
2358 $sth->execute($month,$day,$branchcode);
2359 my $countspecial=$sth->fetchrow ;
2361 return $countspecial;
2366 sub CheckValidBarcode{
2368 my $dbh = C4::Context->dbh;
2369 my $query=qq|SELECT count(*)
2373 my $sth = $dbh->prepare($query);
2374 $sth->execute($barcode);
2375 my $exist=$sth->fetchrow ;
2386 Koha Developement team <info@koha.org>