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
22 #use warnings; # soon!
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);
52 $VERSION = 3.02; # for version checking
55 # FIXME subs that should probably be elsewhere
61 # subs to deal with issuing a book
74 &GetBranchBorrowerCircRule
76 &AnonymiseIssueHistory
79 # subs to deal with returns
85 # subs to deal with transfers
97 C4::Circulation - Koha circulation module
105 The functions in this module deal with circulation, issues, and
106 returns, as well as general information about the library.
107 Also deals with stocktaking.
113 =head3 $str = &barcodedecode($barcode);
117 =item Generic filter function for barcode string.
118 Called on every circ if the System Pref itemBarcodeInputFilter is set.
119 Will do some manipulation of the barcode for systems that deliver a barcode
120 to circulation.pl that differs from the barcode stored for the item.
121 For proper functioning of this filter, calling the function on the
122 correct barcode string (items.barcode) should return an unaltered barcode.
128 # FIXME -- the &decode fcn below should be wrapped into this one.
129 # FIXME -- these plugins should be moved out of Circulation.pm
133 my $filter = C4::Context->preference('itemBarcodeInputFilter');
134 if($filter eq 'whitespace') {
137 } elsif($filter eq 'cuecat') {
139 my @fields = split( /\./, $barcode );
140 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
141 if ( $#results == 2 ) {
147 } elsif($filter eq 'T-prefix') {
148 if ( $barcode =~ /^[Tt]/) {
149 if (substr($barcode,1,1) eq '0') {
152 $barcode = substr($barcode,2) + 0 ;
155 return sprintf( "T%07d",$barcode);
161 =head3 $str = &decode($chunk);
165 =item Decodes a segment of a string emitted by a CueCat barcode scanner and
175 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
176 my @s = map { index( $seq, $_ ); } split( //, $encoded );
177 my $l = ( $#s + 1 ) % 4;
188 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
190 chr( ( $n >> 16 ) ^ 67 )
191 .chr( ( $n >> 8 & 255 ) ^ 67 )
192 .chr( ( $n & 255 ) ^ 67 );
195 $r = substr( $r, 0, length($r) - $l );
201 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, $barcode, $ignore_reserves);
203 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
205 C<$newbranch> is the code for the branch to which the item should be transferred.
207 C<$barcode> is the barcode of the item to be transferred.
209 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
210 Otherwise, if an item is reserved, the transfer fails.
212 Returns three values:
216 is true if the transfer was successful.
220 is a reference-to-hash which may have any of the following keys:
226 There is no item in the catalog with the given barcode. The value is C<$barcode>.
230 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.
232 =item C<DestinationEqualsHolding>
234 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.
238 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.
242 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>.
244 =item C<WasTransferred>
246 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
253 my ( $tbr, $barcode, $ignoreRs ) = @_;
256 my $branches = GetBranches();
257 my $itemnumber = GetItemnumberFromBarcode( $barcode );
258 my $issue = GetItemIssue($itemnumber);
259 my $biblio = GetBiblioFromItemNumber($itemnumber);
262 if ( not $itemnumber ) {
263 $messages->{'BadBarcode'} = $barcode;
267 # get branches of book...
268 my $hbr = $biblio->{'homebranch'};
269 my $fbr = $biblio->{'holdingbranch'};
272 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
273 $messages->{'IsPermanent'} = $hbr;
276 # can't transfer book if is already there....
277 if ( $fbr eq $tbr ) {
278 $messages->{'DestinationEqualsHolding'} = 1;
282 # check if it is still issued to someone, return it...
283 if ($issue->{borrowernumber}) {
284 AddReturn( $barcode, $fbr );
285 $messages->{'WasReturned'} = $issue->{borrowernumber};
289 # That'll save a database query.
290 my ( $resfound, $resrec ) =
291 CheckReserves( $itemnumber );
292 if ( $resfound and not $ignoreRs ) {
293 $resrec->{'ResFound'} = $resfound;
295 # $messages->{'ResFound'} = $resrec;
299 #actually do the transfer....
301 ModItemTransfer( $itemnumber, $fbr, $tbr );
303 # don't need to update MARC anymore, we do it in batch now
304 $messages->{'WasTransfered'} = 1;
305 ModDateLastSeen( $itemnumber );
307 return ( $dotransfer, $messages, $biblio );
312 my $borrower = shift;
313 my $biblionumber = shift;
315 my $cat_borrower = $borrower->{'categorycode'};
316 my $dbh = C4::Context->dbh;
318 # Get which branchcode we need
319 if (C4::Context->preference('CircControl') eq 'PickupLibrary'){
320 $branch = C4::Context->userenv->{'branch'};
322 elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){
323 $branch = $borrower->{'branchcode'};
327 $branch = $item->{'homebranch'};
329 my $type = (C4::Context->preference('item-level_itypes'))
330 ? $item->{'itype'} # item-level
331 : $item->{'itemtype'}; # biblio-level
333 # given branch, patron category, and item type, determine
334 # applicable issuing rule
335 my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
337 # if a rule is found and has a loan limit set, count
338 # how many loans the patron already has that meet that
340 if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
342 my $count_query = "SELECT COUNT(*) FROM issues
343 JOIN items USING (itemnumber) ";
345 my $rule_itemtype = $issuing_rule->{itemtype};
346 if ($rule_itemtype eq "*") {
347 # matching rule has the default item type, so count only
348 # those existing loans that don't fall under a more
350 if (C4::Context->preference('item-level_itypes')) {
351 $count_query .= " WHERE items.itype NOT IN (
352 SELECT itemtype FROM issuingrules
354 AND (categorycode = ? OR categorycode = ?)
358 $count_query .= " JOIN biblioitems USING (biblionumber)
359 WHERE biblioitems.itemtype NOT IN (
360 SELECT itemtype FROM issuingrules
362 AND (categorycode = ? OR categorycode = ?)
366 push @bind_params, $issuing_rule->{branchcode};
367 push @bind_params, $issuing_rule->{categorycode};
368 push @bind_params, $cat_borrower;
370 # rule has specific item type, so count loans of that
372 if (C4::Context->preference('item-level_itypes')) {
373 $count_query .= " WHERE items.itype = ? ";
375 $count_query .= " JOIN biblioitems USING (biblionumber)
376 WHERE biblioitems.itemtype= ? ";
378 push @bind_params, $type;
381 $count_query .= " AND borrowernumber = ? ";
382 push @bind_params, $borrower->{'borrowernumber'};
383 my $rule_branch = $issuing_rule->{branchcode};
384 if ($rule_branch ne "*") {
385 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
386 $count_query .= " AND issues.branchcode = ? ";
387 push @bind_params, $branch;
388 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
389 ; # if branch is the patron's home branch, then count all loans by patron
391 $count_query .= " AND items.homebranch = ? ";
392 push @bind_params, $branch;
396 my $count_sth = $dbh->prepare($count_query);
397 $count_sth->execute(@bind_params);
398 my ($current_loan_count) = $count_sth->fetchrow_array;
400 my $max_loans_allowed = $issuing_rule->{'maxissueqty'};
401 if ($current_loan_count >= $max_loans_allowed) {
402 return "$current_loan_count / $max_loans_allowed";
406 # Now count total loans against the limit for the branch
407 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
408 if (defined($branch_borrower_circ_rule->{maxissueqty})) {
409 my @bind_params = ();
410 my $branch_count_query = "SELECT COUNT(*) FROM issues
411 JOIN items USING (itemnumber)
412 WHERE borrowernumber = ? ";
413 push @bind_params, $borrower->{borrowernumber};
415 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
416 $branch_count_query .= " AND issues.branchcode = ? ";
417 push @bind_params, $branch;
418 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
419 ; # if branch is the patron's home branch, then count all loans by patron
421 $branch_count_query .= " AND items.homebranch = ? ";
422 push @bind_params, $branch;
424 my $branch_count_sth = $dbh->prepare($branch_count_query);
425 $branch_count_sth->execute(@bind_params);
426 my ($current_loan_count) = $branch_count_sth->fetchrow_array;
428 my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty};
429 if ($current_loan_count >= $max_loans_allowed) {
430 return "$current_loan_count / $max_loans_allowed";
434 # OK, the patron can issue !!!
440 @issues = &itemissues($biblioitemnumber, $biblio);
442 Looks up information about who has borrowed the bookZ<>(s) with the
443 given biblioitemnumber.
445 C<$biblio> is ignored.
447 C<&itemissues> returns an array of references-to-hash. The keys
448 include the fields from the C<items> table in the Koha database.
449 Additional keys include:
455 If the item is currently on loan, this gives the due date.
457 If the item is not on loan, then this is either "Available" or
458 "Cancelled", if the item has been withdrawn.
462 If the item is currently on loan, this gives the card number of the
463 patron who currently has the item.
465 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
467 These give the timestamp for the last three times the item was
470 =item C<card0>, C<card1>, C<card2>
472 The card number of the last three patrons who borrowed this item.
474 =item C<borrower0>, C<borrower1>, C<borrower2>
476 The borrower number of the last three patrons who borrowed this item.
484 my ( $bibitem, $biblio ) = @_;
485 my $dbh = C4::Context->dbh;
487 $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
492 $sth->execute($bibitem) || die $sth->errstr;
494 while ( my $data = $sth->fetchrow_hashref ) {
496 # Find out who currently has this item.
497 # FIXME - Wouldn't it be better to do this as a left join of
498 # some sort? Currently, this code assumes that if
499 # fetchrow_hashref() fails, then the book is on the shelf.
500 # fetchrow_hashref() can fail for any number of reasons (e.g.,
501 # database server crash), not just because no items match the
503 my $sth2 = $dbh->prepare(
504 "SELECT * FROM issues
505 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
510 $sth2->execute( $data->{'itemnumber'} );
511 if ( my $data2 = $sth2->fetchrow_hashref ) {
512 $data->{'date_due'} = $data2->{'date_due'};
513 $data->{'card'} = $data2->{'cardnumber'};
514 $data->{'borrower'} = $data2->{'borrowernumber'};
517 $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available';
522 # Find the last 3 people who borrowed this item.
523 $sth2 = $dbh->prepare(
524 "SELECT * FROM old_issues
525 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
527 ORDER BY returndate DESC,timestamp DESC"
530 $sth2->execute( $data->{'itemnumber'} );
531 for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
532 { # FIXME : error if there is less than 3 pple borrowing this item
533 if ( my $data2 = $sth2->fetchrow_hashref ) {
534 $data->{"timestamp$i2"} = $data2->{'timestamp'};
535 $data->{"card$i2"} = $data2->{'cardnumber'};
536 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
541 $results[$i] = $data;
549 =head2 CanBookBeIssued
551 Check if a book can be issued.
553 ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess );
555 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
559 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
561 =item C<$barcode> is the bar code of the book being issued.
563 =item C<$duedatespec> is a C4::Dates object.
573 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
574 Possible values are :
580 sticky due date is invalid
584 borrower gone with no address
588 borrower declared it's card lost
594 =head3 UNKNOWN_BARCODE
608 item is restricted (set by ??)
610 C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
611 Possible values are :
619 renewing, not issuing
621 =head3 ISSUED_TO_ANOTHER
623 issued to someone else.
627 reserved for someone else.
631 sticky due date is invalid
635 if the borrower borrows to much things
639 sub CanBookBeIssued {
640 my ( $borrower, $barcode, $duedate, $inprocess ) = @_;
641 my %needsconfirmation; # filled with problems that needs confirmations
642 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
643 my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
644 my $issue = GetItemIssue($item->{itemnumber});
645 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
646 $item->{'itemtype'}=$item->{'itype'};
647 my $dbh = C4::Context->dbh;
650 # DUE DATE is OK ? -- should already have checked.
652 #$issuingimpossible{INVALID_DATE} = 1 unless ($duedate);
657 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
658 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
659 &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'});
660 return( { STATS => 1 }, {});
662 if ( $borrower->{flags}->{GNA} ) {
663 $issuingimpossible{GNA} = 1;
665 if ( $borrower->{flags}->{'LOST'} ) {
666 $issuingimpossible{CARD_LOST} = 1;
668 if ( $borrower->{flags}->{'DBARRED'} ) {
669 $issuingimpossible{DEBARRED} = 1;
671 if ( $borrower->{'dateexpiry'} eq '0000-00-00') {
672 $issuingimpossible{EXPIRED} = 1;
674 my @expirydate= split /-/,$borrower->{'dateexpiry'};
675 if($expirydate[0]==0 || $expirydate[1]==0|| $expirydate[2]==0 ||
676 Date_to_Days(Today) > Date_to_Days( @expirydate )) {
677 $issuingimpossible{EXPIRED} = 1;
686 C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->output('iso') );
687 if ( C4::Context->preference("IssuingInProcess") ) {
688 my $amountlimit = C4::Context->preference("noissuescharge");
689 if ( $amount > $amountlimit && !$inprocess ) {
690 $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
692 elsif ( $amount > 0 && $amount <= $amountlimit && !$inprocess ) {
693 $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
698 $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
703 # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
705 my $toomany = TooMany( $borrower, $item->{biblionumber}, $item );
706 $needsconfirmation{TOO_MANY} = $toomany if $toomany;
711 unless ( $item->{barcode} ) {
712 $issuingimpossible{UNKNOWN_BARCODE} = 1;
714 if ( $item->{'notforloan'}
715 && $item->{'notforloan'} > 0 )
717 $issuingimpossible{NOT_FOR_LOAN} = 1;
719 elsif ( !$item->{'notforloan'} ){
720 # we have to check itemtypes.notforloan also
721 if (C4::Context->preference('item-level_itypes')){
722 # this should probably be a subroutine
723 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
724 $sth->execute($item->{'itemtype'});
725 my $notforloan=$sth->fetchrow_hashref();
727 if ($notforloan->{'notforloan'} == 1){
728 $issuingimpossible{NOT_FOR_LOAN} = 1;
731 elsif ($biblioitem->{'notforloan'} == 1){
732 $issuingimpossible{NOT_FOR_LOAN} = 1;
735 if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
737 $issuingimpossible{WTHDRAWN} = 1;
739 if ( $item->{'restricted'}
740 && $item->{'restricted'} == 1 )
742 $issuingimpossible{RESTRICTED} = 1;
744 if ( C4::Context->preference("IndependantBranches") ) {
745 my $userenv = C4::Context->userenv;
746 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
747 $issuingimpossible{NOTSAMEBRANCH} = 1
748 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
753 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
755 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
758 # Already issued to current borrower. Ask whether the loan should
760 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
761 $borrower->{'borrowernumber'},
762 $item->{'itemnumber'}
764 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
765 $issuingimpossible{NO_MORE_RENEWALS} = 1;
768 $needsconfirmation{RENEW_ISSUE} = 1;
771 elsif ($issue->{borrowernumber}) {
773 # issued to someone else
774 my $currborinfo = GetMemberDetails( $issue->{borrowernumber} );
776 # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
777 $needsconfirmation{ISSUED_TO_ANOTHER} =
778 "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
781 # See if the item is on reserve.
782 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
784 my $resbor = $res->{'borrowernumber'};
785 my ( $resborrower ) = C4::Members::GetMemberDetails( $resbor, 0 );
786 my $branches = GetBranches();
787 my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
788 if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
790 # The item is on reserve and waiting, but has been
791 # reserved by some other patron.
792 $needsconfirmation{RESERVE_WAITING} =
793 "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
795 elsif ( $restype eq "Reserved" ) {
796 # The item is on reserve for someone else.
797 $needsconfirmation{RESERVED} =
798 "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
801 if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" ) {
802 if ( $borrower->{'categorycode'} eq 'W' ) {
804 return ( \%emptyhash, \%needsconfirmation );
807 return ( \%issuingimpossible, \%needsconfirmation );
812 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
814 &AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate])
818 =item C<$borrower> is a hash with borrower informations (from GetMemberDetails).
820 =item C<$barcode> is the barcode of the item being issued.
822 =item C<$datedue> is a C4::Dates object for the max date of return, i.e. the date due (optional).
825 =item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional).
827 =item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional).
828 Defaults to today. Unlike C<$datedue>, NOT a C4::Dates object, unfortunately.
830 AddIssue does the following things :
831 - step 01: check that there is a borrowernumber & a barcode provided
832 - check for RENEWAL (book issued & being issued to the same patron)
833 - renewal YES = Calculate Charge & renew
835 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
837 - fill reserve if reserve to this patron
838 - cancel reserve or not, otherwise
839 * TRANSFERT PENDING ?
840 - complete the transfert
848 my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate ) = @_;
849 my $dbh = C4::Context->dbh;
850 my $barcodecheck=CheckValidBarcode($barcode);
852 # $issuedate defaults to today.
853 if ( ! defined $issuedate ) {
854 $issuedate = strftime( "%Y-%m-%d", localtime );
856 if ($borrower and $barcode and $barcodecheck ne '0'){
857 # find which item we issue
858 my $item = GetItem('', $barcode) or return undef; # if we don't get an Item, abort.
860 # Get which branchcode we need
861 if (C4::Context->preference('CircControl') eq 'PickupLibrary'){
862 $branch = C4::Context->userenv->{'branch'};
864 elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){
865 $branch = $borrower->{'branchcode'};
869 $branch = $item->{'homebranch'};
872 # get actual issuing if there is one
873 my $actualissue = GetItemIssue( $item->{itemnumber});
875 # get biblioinformation for this item
876 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
879 # check if we just renew the issue.
881 if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) {
882 $datedue = AddRenewal(
883 $borrower->{'borrowernumber'},
884 $item->{'itemnumber'},
887 $issuedate, # here interpreted as the renewal date
892 if ( $actualissue->{borrowernumber}) {
893 # This book is currently on loan, but not to the person
894 # who wants to borrow it now. mark it returned before issuing to the new borrower
897 C4::Context->userenv->{'branch'}
901 # See if the item is on reserve.
902 my ( $restype, $res ) =
903 C4::Reserves::CheckReserves( $item->{'itemnumber'} );
905 my $resbor = $res->{'borrowernumber'};
906 if ( $resbor eq $borrower->{'borrowernumber'} ) {
908 # The item is reserved by the current patron
909 ModReserveFill($res);
911 elsif ( $restype eq "Waiting" ) {
914 # The item is on reserve and waiting, but has been
915 # reserved by some other patron.
917 elsif ( $restype eq "Reserved" ) {
920 # The item is reserved by someone else.
921 if ($cancelreserve) { # cancel reserves on this item
922 CancelReserve( 0, $res->{'itemnumber'},
923 $res->{'borrowernumber'} );
926 if ($cancelreserve) {
927 CancelReserve( $res->{'biblionumber'}, 0,
928 $res->{'borrowernumber'} );
931 # set waiting reserve to first in reserve queue as book isn't waiting now
933 $res->{'biblionumber'},
934 $res->{'borrowernumber'},
940 # Starting process for transfer job (checking transfert and validate it if we have one)
941 my ($datesent) = GetTransfers($item->{'itemnumber'});
943 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....)
946 "UPDATE branchtransfers
947 SET datearrived = now(),
949 comments = 'Forced branchtransfer'
950 WHERE itemnumber= ? AND datearrived IS NULL"
952 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
956 # Record in the database the fact that the book was issued.
960 (borrowernumber, itemnumber,issuedate, date_due, branchcode)
964 my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'};
965 my $loanlength = GetLoanLength( $borrower->{'categorycode'}, $itype, $branch );
966 $datedue = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $loanlength, $branch );
968 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
969 if ( C4::Context->preference('ReturnBeforeExpiry') && $datedue->output('iso') gt $borrower->{dateexpiry} ) {
970 $datedue = C4::Dates->new( $borrower->{dateexpiry}, 'iso' );
974 $borrower->{'borrowernumber'}, # borrowernumber
975 $item->{'itemnumber'}, # itemnumber
976 $issuedate, # issuedate
977 $datedue->output('iso'), # date_due
978 C4::Context->userenv->{'branch'} # branchcode
982 ModItem({ issues => $item->{'issues'},
983 holdingbranch => C4::Context->userenv->{'branch'},
985 datelastborrowed => C4::Dates->new()->output('iso'),
986 onloan => $datedue->output('iso'),
987 }, $item->{'biblionumber'}, $item->{'itemnumber'});
988 ModDateLastSeen( $item->{'itemnumber'} );
990 # If it costs to borrow this book, charge it to the patron's account.
991 my ( $charge, $itemtype ) = GetIssuingCharges(
992 $item->{'itemnumber'},
993 $borrower->{'borrowernumber'}
997 $item->{'itemnumber'},
998 $borrower->{'borrowernumber'}, $charge
1000 $item->{'charge'} = $charge;
1003 # Record the fact that this book was issued.
1005 C4::Context->userenv->{'branch'},
1007 '', $item->{'itemnumber'},
1008 $item->{'itype'}, $borrower->{'borrowernumber'}
1012 logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
1013 if C4::Context->preference("IssueLog");
1015 return ($datedue); # not necessarily the same as when it came in!
1018 =head2 GetLoanLength
1020 Get loan length for an itemtype, a borrower type and a branch
1022 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1027 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1028 my $dbh = C4::Context->dbh;
1031 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"
1033 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1034 # try to find issuelength & return the 1st available.
1035 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1036 $sth->execute( $borrowertype, $itemtype, $branchcode );
1037 my $loanlength = $sth->fetchrow_hashref;
1038 return $loanlength->{issuelength}
1039 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1041 $sth->execute( $borrowertype, "*", $branchcode );
1042 $loanlength = $sth->fetchrow_hashref;
1043 return $loanlength->{issuelength}
1044 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1046 $sth->execute( "*", $itemtype, $branchcode );
1047 $loanlength = $sth->fetchrow_hashref;
1048 return $loanlength->{issuelength}
1049 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1051 $sth->execute( "*", "*", $branchcode );
1052 $loanlength = $sth->fetchrow_hashref;
1053 return $loanlength->{issuelength}
1054 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1056 $sth->execute( $borrowertype, $itemtype, "*" );
1057 $loanlength = $sth->fetchrow_hashref;
1058 return $loanlength->{issuelength}
1059 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1061 $sth->execute( $borrowertype, "*", "*" );
1062 $loanlength = $sth->fetchrow_hashref;
1063 return $loanlength->{issuelength}
1064 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1066 $sth->execute( "*", $itemtype, "*" );
1067 $loanlength = $sth->fetchrow_hashref;
1068 return $loanlength->{issuelength}
1069 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1071 $sth->execute( "*", "*", "*" );
1072 $loanlength = $sth->fetchrow_hashref;
1073 return $loanlength->{issuelength}
1074 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1076 # if no rule is set => 21 days (hardcoded)
1080 =head2 GetIssuingRule
1082 FIXME - This is a copy-paste of GetLoanLength
1083 as a stop-gap. Do not wish to change API for GetLoanLength
1084 this close to release, however, Overdues::GetIssuingRules is broken.
1086 Get the issuing rule for an itemtype, a borrower type and a branch
1087 Returns a hashref from the issuingrules table.
1089 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1093 sub GetIssuingRule {
1094 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1095 my $dbh = C4::Context->dbh;
1096 my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null" );
1099 $sth->execute( $borrowertype, $itemtype, $branchcode );
1100 $irule = $sth->fetchrow_hashref;
1101 return $irule if defined($irule) ;
1103 $sth->execute( $borrowertype, "*", $branchcode );
1104 $irule = $sth->fetchrow_hashref;
1105 return $irule if defined($irule) ;
1107 $sth->execute( "*", $itemtype, $branchcode );
1108 $irule = $sth->fetchrow_hashref;
1109 return $irule if defined($irule) ;
1111 $sth->execute( "*", "*", $branchcode );
1112 $irule = $sth->fetchrow_hashref;
1113 return $irule if defined($irule) ;
1115 $sth->execute( $borrowertype, $itemtype, "*" );
1116 $irule = $sth->fetchrow_hashref;
1117 return $irule if defined($irule) ;
1119 $sth->execute( $borrowertype, "*", "*" );
1120 $irule = $sth->fetchrow_hashref;
1121 return $irule if defined($irule) ;
1123 $sth->execute( "*", $itemtype, "*" );
1124 $irule = $sth->fetchrow_hashref;
1125 return $irule if defined($irule) ;
1127 $sth->execute( "*", "*", "*" );
1128 $irule = $sth->fetchrow_hashref;
1129 return $irule if defined($irule) ;
1131 # if no rule matches,
1135 =head2 GetBranchBorrowerCircRule
1139 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1143 Retrieves circulation rule attributes that apply to the given
1144 branch and patron category, regardless of item type.
1145 The return value is a hashref containing the following key:
1147 maxissueqty - maximum number of loans that a
1148 patron of the given category can have at the given
1149 branch. If the value is undef, no limit.
1151 This will first check for a specific branch and
1152 category match from branch_borrower_circ_rules.
1154 If no rule is found, it will then check default_branch_circ_rules
1155 (same branch, default category). If no rule is found,
1156 it will then check default_borrower_circ_rules (default
1157 branch, same category), then failing that, default_circ_rules
1158 (default branch, default category).
1160 If no rule has been found in the database, it will default to
1165 C<$branchcode> and C<$categorycode> should contain the
1166 literal branch code and patron category code, respectively - no
1171 sub GetBranchBorrowerCircRule {
1172 my $branchcode = shift;
1173 my $categorycode = shift;
1175 my $branch_cat_query = "SELECT maxissueqty
1176 FROM branch_borrower_circ_rules
1177 WHERE branchcode = ?
1178 AND categorycode = ?";
1179 my $dbh = C4::Context->dbh();
1180 my $sth = $dbh->prepare($branch_cat_query);
1181 $sth->execute($branchcode, $categorycode);
1183 if ($result = $sth->fetchrow_hashref()) {
1187 # try same branch, default borrower category
1188 my $branch_query = "SELECT maxissueqty
1189 FROM default_branch_circ_rules
1190 WHERE branchcode = ?";
1191 $sth = $dbh->prepare($branch_query);
1192 $sth->execute($branchcode);
1193 if ($result = $sth->fetchrow_hashref()) {
1197 # try default branch, same borrower category
1198 my $category_query = "SELECT maxissueqty
1199 FROM default_borrower_circ_rules
1200 WHERE categorycode = ?";
1201 $sth = $dbh->prepare($category_query);
1202 $sth->execute($categorycode);
1203 if ($result = $sth->fetchrow_hashref()) {
1207 # try default branch, default borrower category
1208 my $default_query = "SELECT maxissueqty
1209 FROM default_circ_rules";
1210 $sth = $dbh->prepare($default_query);
1212 if ($result = $sth->fetchrow_hashref()) {
1216 # built-in default circulation rule
1218 maxissueqty => undef,
1224 ($doreturn, $messages, $iteminformation, $borrower) =
1225 &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1231 =item C<$barcode> is the bar code of the book being returned.
1233 =item C<$branch> is the code of the branch where the book is being returned.
1235 =item C<$exemptfine> indicates that overdue charges for the item will be
1238 =item C<$dropbox> indicates that the check-in date is assumed to be
1239 yesterday, or the last non-holiday as defined in C4::Calendar . If
1240 overdue charges are applied and C<$dropbox> is true, the last charge
1241 will be removed. This assumes that the fines accrual script has run
1246 C<&AddReturn> returns a list of four items:
1248 C<$doreturn> is true iff the return succeeded.
1250 C<$messages> is a reference-to-hash giving the reason for failure:
1256 No item with this barcode exists. The value is C<$barcode>.
1260 The book is not currently on loan. The value is C<$barcode>.
1262 =item C<IsPermanent>
1264 The book's home branch is a permanent collection. If you have borrowed
1265 this book, you are not allowed to return it. The value is the code for
1266 the book's home branch.
1270 This book has been withdrawn/cancelled. The value should be ignored.
1274 The item was reserved. The value is a reference-to-hash whose keys are
1275 fields from the reserves table of the Koha database, and
1276 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1277 either C<Waiting>, C<Reserved>, or 0.
1281 C<$borrower> is a reference-to-hash, giving information about the
1282 patron who last borrowed the book.
1287 my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1288 my $dbh = C4::Context->dbh;
1292 my $validTransfert = 0;
1293 my $reserveDone = 0;
1295 # get information on item
1296 my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
1297 my $biblio = GetBiblioItemData($iteminformation->{'biblioitemnumber'});
1298 # use Data::Dumper;warn Data::Dumper::Dumper($iteminformation);
1299 unless ($iteminformation->{'itemnumber'} ) {
1300 $messages->{'BadBarcode'} = $barcode;
1304 if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1305 $messages->{'NotIssued'} = $barcode;
1306 # even though item is not on loan, it may still
1307 # be transferred; therefore, get current branch information
1308 my $curr_iteminfo = GetItem($iteminformation->{'itemnumber'});
1309 $iteminformation->{'homebranch'} = $curr_iteminfo->{'homebranch'};
1310 $iteminformation->{'holdingbranch'} = $curr_iteminfo->{'holdingbranch'};
1314 # check if the book is in a permanent collection....
1315 my $hbr = $iteminformation->{C4::Context->preference("HomeOrHoldingBranch")};
1316 my $branches = GetBranches();
1317 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1318 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1319 $messages->{'IsPermanent'} = $hbr;
1322 # if independent branches are on and returning to different branch, refuse the return
1323 if ($hbr ne C4::Context->userenv->{'branch'} && C4::Context->preference("IndependantBranches")){
1324 $messages->{'Wrongbranch'} = 1;
1328 # check that the book has been cancelled
1329 if ( $iteminformation->{'wthdrawn'} ) {
1330 $messages->{'wthdrawn'} = 1;
1334 # new op dev : if the book returned in an other branch update the holding branch
1336 # update issues, thereby returning book (should push this out into another subroutine
1337 $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1339 # case of a return of document (deal with issues and holdingbranch)
1342 my $circControlBranch;
1344 # don't allow dropbox mode to create an invalid entry in issues (issuedate > returndate) FIXME: actually checks eq, not gt
1345 undef($dropbox) if ( $iteminformation->{'issuedate'} eq C4::Dates->today('iso') );
1346 if (C4::Context->preference('CircControl') eq 'ItemHomeBranch' ) {
1347 $circControlBranch = $iteminformation->{homebranch};
1348 } elsif ( C4::Context->preference('CircControl') eq 'PatronLibrary') {
1349 $circControlBranch = $borrower->{branchcode};
1350 } else { # CircControl must be PickupLibrary.
1351 $circControlBranch = $iteminformation->{holdingbranch};
1352 # FIXME - is this right ? are we sure that the holdingbranch is still the pickup branch?
1355 MarkIssueReturned($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'},$circControlBranch);
1356 $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
1359 # continue to deal with returns cases, but not only if we have an issue
1361 # the holdingbranch is updated if the document is returned in an other location .
1362 if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) {
1363 UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
1364 # reload iteminformation holdingbranch with the userenv value
1365 $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1367 ModDateLastSeen( $iteminformation->{'itemnumber'} );
1368 ModItem({ onloan => undef }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'});
1370 if ($iteminformation->{borrowernumber}){
1371 ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1373 # fix up the accounts.....
1374 if ( $iteminformation->{'itemlost'} ) {
1375 $messages->{'WasLost'} = 1;
1378 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1379 # check if we have a transfer for this document
1380 my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1382 # if we have a transfer to do, we update the line of transfers with the datearrived
1384 if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1387 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1389 $sth->execute( $iteminformation->{'itemnumber'} );
1391 # 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'
1392 C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1395 $messages->{'WrongTransfer'} = $tobranch;
1396 $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1398 $validTransfert = 1;
1401 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1402 # fix up the accounts.....
1403 if ($iteminformation->{'itemlost'}) {
1404 FixAccountForLostAndReturned($iteminformation, $borrower);
1405 $messages->{'WasLost'} = 1;
1407 # fix up the overdues in accounts...
1408 FixOverduesOnReturn( $borrower->{'borrowernumber'},
1409 $iteminformation->{'itemnumber'}, $exemptfine, $dropbox );
1411 # find reserves.....
1412 # if we don't have a reserve with the status W, we launch the Checkreserves routine
1413 my ( $resfound, $resrec ) =
1414 C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1416 $resrec->{'ResFound'} = $resfound;
1417 $messages->{'ResFound'} = $resrec;
1422 # Record the fact that this book was returned.
1424 $branch, 'return', '0', '',
1425 $iteminformation->{'itemnumber'},
1426 $biblio->{'itemtype'},
1427 $borrower->{'borrowernumber'}
1430 logaction("CIRCULATION", "RETURN", $iteminformation->{borrowernumber}, $iteminformation->{'biblionumber'})
1431 if C4::Context->preference("ReturnLog");
1433 #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1434 #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1436 if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1437 if (C4::Context->preference("AutomaticItemReturn") == 1) {
1438 ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1439 $messages->{'WasTransfered'} = 1;
1442 $messages->{'NeedsTransfer'} = 1;
1446 return ( $doreturn, $messages, $iteminformation, $borrower );
1449 =head2 MarkIssueReturned
1453 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate);
1457 Unconditionally marks an issue as being returned by
1458 moving the C<issues> row to C<old_issues> and
1459 setting C<returndate> to the current date, or
1460 the last non-holiday date of the branccode specified in
1461 C<dropbox_branch> . Assumes you've already checked that
1462 it's safe to do this, i.e. last non-holiday > issuedate.
1464 if C<$returndate> is specified (in iso format), it is used as the date
1465 of the return. It is ignored when a dropbox_branch is passed in.
1467 Ideally, this function would be internal to C<C4::Circulation>,
1468 not exported, but it is currently needed by one
1469 routine in C<C4::Accounts>.
1473 sub MarkIssueReturned {
1474 my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate ) = @_;
1475 my $dbh = C4::Context->dbh;
1476 my $query = "UPDATE issues SET returndate=";
1478 if ($dropbox_branch) {
1479 my $calendar = C4::Calendar->new( branchcode => $dropbox_branch );
1480 my $dropboxdate = $calendar->addDate( C4::Dates->new(), -1 );
1482 push @bind, $dropboxdate->output('iso');
1483 } elsif ($returndate) {
1485 push @bind, $returndate;
1487 $query .= " now() ";
1489 $query .= " WHERE borrowernumber = ? AND itemnumber = ?";
1490 push @bind, $borrowernumber, $itemnumber;
1492 my $sth_upd = $dbh->prepare($query);
1493 $sth_upd->execute(@bind);
1494 my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1495 WHERE borrowernumber = ?
1496 AND itemnumber = ?");
1497 $sth_copy->execute($borrowernumber, $itemnumber);
1498 my $sth_del = $dbh->prepare("DELETE FROM issues
1499 WHERE borrowernumber = ?
1500 AND itemnumber = ?");
1501 $sth_del->execute($borrowernumber, $itemnumber);
1504 =head2 FixOverduesOnReturn
1506 &FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1508 C<$brn> borrowernumber
1512 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1513 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1515 internal function, called only by AddReturn
1519 sub FixOverduesOnReturn {
1520 my ( $borrowernumber, $item, $exemptfine, $dropbox ) = @_;
1521 my $dbh = C4::Context->dbh;
1523 # check for overdue fine
1526 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1528 $sth->execute( $borrowernumber, $item );
1530 # alter fine to show that the book has been returned
1532 if ($data = $sth->fetchrow_hashref) {
1534 my @bind = ($borrowernumber,$item ,$data->{'accountno'});
1536 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1537 if (C4::Context->preference("FinesLog")) {
1538 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1540 } elsif ($dropbox && $data->{lastincrement}) {
1541 my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1542 my $amt = $data->{amount} - $data->{lastincrement} ;
1543 if (C4::Context->preference("FinesLog")) {
1544 &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1546 $uquery = "update accountlines set accounttype='F' ";
1547 if($outstanding >= 0 && $amt >=0) {
1548 $uquery .= ", amount = ? , amountoutstanding=? ";
1549 unshift @bind, ($amt, $outstanding) ;
1552 $uquery = "update accountlines set accounttype='F' ";
1554 $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1555 my $usth = $dbh->prepare($uquery);
1556 $usth->execute(@bind);
1564 =head2 FixAccountForLostAndReturned
1566 &FixAccountForLostAndReturned($iteminfo,$borrower);
1568 Calculates the charge for a book lost and returned (Not exported & used only once)
1570 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1572 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1574 Internal function, called by AddReturn
1578 sub FixAccountForLostAndReturned {
1579 my ($iteminfo, $borrower) = @_;
1580 my $dbh = C4::Context->dbh;
1581 my $itm = $iteminfo->{'itemnumber'};
1582 # check for charge made for lost book
1583 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1584 $sth->execute($itm);
1585 if (my $data = $sth->fetchrow_hashref) {
1586 # writeoff this amount
1588 my $amount = $data->{'amount'};
1589 my $acctno = $data->{'accountno'};
1591 if ($data->{'amountoutstanding'} == $amount) {
1592 $offset = $data->{'amount'};
1595 $offset = $amount - $data->{'amountoutstanding'};
1596 $amountleft = $data->{'amountoutstanding'} - $amount;
1598 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1599 WHERE (borrowernumber = ?)
1600 AND (itemnumber = ?) AND (accountno = ?) ");
1601 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1603 #check if any credit is left if so writeoff other accounts
1604 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1605 if ($amountleft < 0){
1608 if ($amountleft > 0){
1609 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1610 AND (amountoutstanding >0) ORDER BY date");
1611 $msth->execute($data->{'borrowernumber'});
1612 # offset transactions
1615 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1616 if ($accdata->{'amountoutstanding'} < $amountleft) {
1618 $amountleft -= $accdata->{'amountoutstanding'};
1620 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1623 my $thisacct = $accdata->{'accountno'};
1624 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1625 WHERE (borrowernumber = ?)
1626 AND (accountno=?)");
1627 $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1629 $usth = $dbh->prepare("INSERT INTO accountoffsets
1630 (borrowernumber, accountno, offsetaccount, offsetamount)
1633 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1638 if ($amountleft > 0){
1641 my $desc="Item Returned ".$iteminfo->{'barcode'};
1642 $usth = $dbh->prepare("INSERT INTO accountlines
1643 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1644 VALUES (?,?,now(),?,?,'CR',?)");
1645 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1647 $usth = $dbh->prepare("INSERT INTO accountoffsets
1648 (borrowernumber, accountno, offsetaccount, offsetamount)
1650 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1652 ModItem({ paidfor => '' }, undef, $itm);
1660 $issues = &GetItemIssue($itemnumber);
1662 Returns patrons currently having a book. nothing if item is not issued atm
1664 C<$itemnumber> is the itemnumber
1666 Returns an array of hashes
1668 FIXME: Though the above says that this function returns nothing if the
1669 item is not issued, this actually returns a hasref that looks like
1680 my ( $itemnumber) = @_;
1681 return unless $itemnumber;
1682 my $dbh = C4::Context->dbh;
1686 my $today = POSIX::strftime("%Y%m%d", localtime);
1688 my $sth = $dbh->prepare(
1689 "SELECT * FROM issues
1690 LEFT JOIN items ON issues.itemnumber=items.itemnumber
1692 issues.itemnumber=?");
1693 $sth->execute($itemnumber);
1694 my $data = $sth->fetchrow_hashref;
1695 my $datedue = $data->{'date_due'};
1697 if ( $datedue < $today ) {
1698 $data->{'overdue'} = 1;
1700 $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1707 $issue = GetOpenIssue( $itemnumber );
1709 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
1711 C<$itemnumber> is the item's itemnumber
1718 my ( $itemnumber ) = @_;
1720 my $dbh = C4::Context->dbh;
1721 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
1722 $sth->execute( $itemnumber );
1723 my $issue = $sth->fetchrow_hashref();
1727 =head2 GetItemIssues
1729 $issues = &GetItemIssues($itemnumber, $history);
1731 Returns patrons that have issued a book
1733 C<$itemnumber> is the itemnumber
1734 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1736 Returns an array of hashes
1741 my ( $itemnumber,$history ) = @_;
1742 my $dbh = C4::Context->dbh;
1746 my $today = POSIX::strftime("%Y%m%d", localtime);
1748 my $sql = "SELECT * FROM issues
1749 JOIN borrowers USING (borrowernumber)
1750 JOIN items USING (itemnumber)
1751 WHERE issues.itemnumber = ? ";
1754 SELECT * FROM old_issues
1755 LEFT JOIN borrowers USING (borrowernumber)
1756 JOIN items USING (itemnumber)
1757 WHERE old_issues.itemnumber = ? ";
1759 $sql .= "ORDER BY date_due DESC";
1760 my $sth = $dbh->prepare($sql);
1762 $sth->execute($itemnumber, $itemnumber);
1764 $sth->execute($itemnumber);
1766 while ( my $data = $sth->fetchrow_hashref ) {
1767 my $datedue = $data->{'date_due'};
1769 if ( $datedue < $today ) {
1770 $data->{'overdue'} = 1;
1772 my $itemnumber = $data->{'itemnumber'};
1773 push @GetItemIssues, $data;
1776 return ( \@GetItemIssues );
1779 =head2 GetBiblioIssues
1781 $issues = GetBiblioIssues($biblionumber);
1783 this function get all issues from a biblionumber.
1786 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1787 tables issues and the firstname,surname & cardnumber from borrowers.
1791 sub GetBiblioIssues {
1792 my $biblionumber = shift;
1793 return undef unless $biblionumber;
1794 my $dbh = C4::Context->dbh;
1796 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1798 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1799 LEFT JOIN items ON issues.itemnumber = items.itemnumber
1800 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1801 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1802 WHERE biblio.biblionumber = ?
1804 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1806 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1807 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1808 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1809 LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1810 WHERE biblio.biblionumber = ?
1813 my $sth = $dbh->prepare($query);
1814 $sth->execute($biblionumber, $biblionumber);
1817 while ( my $data = $sth->fetchrow_hashref ) {
1818 push @issues, $data;
1823 =head2 GetUpcomingDueIssues
1827 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
1833 sub GetUpcomingDueIssues {
1836 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
1837 my $dbh = C4::Context->dbh;
1839 my $statement = <<END_SQL;
1840 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due
1842 LEFT JOIN items USING (itemnumber)
1843 WhERE returndate is NULL
1844 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
1847 my @bind_parameters = ( $params->{'days_in_advance'} );
1849 my $sth = $dbh->prepare( $statement );
1850 $sth->execute( @bind_parameters );
1851 my $upcoming_dues = $sth->fetchall_arrayref({});
1854 return $upcoming_dues;
1857 =head2 CanBookBeRenewed
1859 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]);
1861 Find out whether a borrowed item may be renewed.
1863 C<$dbh> is a DBI handle to the Koha database.
1865 C<$borrowernumber> is the borrower number of the patron who currently
1866 has the item on loan.
1868 C<$itemnumber> is the number of the item to renew.
1870 C<$override_limit>, if supplied with a true value, causes
1871 the limit on the number of times that the loan can be renewed
1872 (as controlled by the item type) to be ignored.
1874 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1875 item must currently be on loan to the specified borrower; renewals
1876 must be allowed for the item's type; and the borrower must not have
1877 already renewed the loan. $error will contain the reason the renewal can not proceed
1881 sub CanBookBeRenewed {
1883 # check renewal status
1884 my ( $borrowernumber, $itemnumber, $override_limit ) = @_;
1885 my $dbh = C4::Context->dbh;
1890 # Look in the issues table for this item, lent to this borrower,
1891 # and not yet returned.
1893 # FIXME - I think this function could be redone to use only one SQL call.
1894 my $sth1 = $dbh->prepare(
1895 "SELECT * FROM issues
1896 WHERE borrowernumber = ?
1899 $sth1->execute( $borrowernumber, $itemnumber );
1900 if ( my $data1 = $sth1->fetchrow_hashref ) {
1902 # Found a matching item
1904 # See if this item may be renewed. This query is convoluted
1905 # because it's a bit messy: given the item number, we need to find
1906 # the biblioitem, which gives us the itemtype, which tells us
1907 # whether it may be renewed.
1908 my $query = "SELECT renewalsallowed FROM items ";
1909 $query .= (C4::Context->preference('item-level_itypes'))
1910 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1911 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1912 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1913 $query .= "WHERE items.itemnumber = ?";
1914 my $sth2 = $dbh->prepare($query);
1915 $sth2->execute($itemnumber);
1916 if ( my $data2 = $sth2->fetchrow_hashref ) {
1917 $renews = $data2->{'renewalsallowed'};
1919 if ( ( $renews && $renews > $data1->{'renewals'} ) || $override_limit ) {
1926 my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1934 return ($renewokay,$error);
1939 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
1943 C<$borrowernumber> is the borrower number of the patron who currently
1946 C<$itemnumber> is the number of the item to renew.
1948 C<$branch> is the library branch. Defaults to the homebranch of the ITEM.
1950 C<$datedue> can be a C4::Dates object used to set the due date.
1952 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
1953 this parameter is not supplied, lastreneweddate is set to the current date.
1955 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
1956 from the book's item type.
1961 my $borrowernumber = shift or return undef;
1962 my $itemnumber = shift or return undef;
1963 my $item = GetItem($itemnumber) or return undef;
1964 my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
1965 my $branch = (@_) ? shift : $item->{homebranch}; # opac-renew doesn't send branch
1966 my $datedue = shift;
1967 my $lastreneweddate = shift;
1969 # If the due date wasn't specified, calculate it by adding the
1970 # book's loan length to today's date.
1971 unless ($datedue && $datedue->output('iso')) {
1973 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
1974 my $loanlength = GetLoanLength(
1975 $borrower->{'categorycode'},
1976 (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
1977 $item->{homebranch} # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument?
1979 #FIXME -- use circControl?
1980 $datedue = CalcDateDue(C4::Dates->new(),$loanlength,$branch); # this branch is the transactional branch.
1981 # The question of whether to use item's homebranch calendar is open.
1984 # $lastreneweddate defaults to today.
1985 unless (defined $lastreneweddate) {
1986 $lastreneweddate = strftime( "%Y-%m-%d", localtime );
1989 my $dbh = C4::Context->dbh;
1990 # Find the issues record for this book
1992 $dbh->prepare("SELECT * FROM issues
1993 WHERE borrowernumber=?
1996 $sth->execute( $borrowernumber, $itemnumber );
1997 my $issuedata = $sth->fetchrow_hashref;
2000 # Update the issues record to have the new due date, and a new count
2001 # of how many times it has been renewed.
2002 my $renews = $issuedata->{'renewals'} + 1;
2003 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2004 WHERE borrowernumber=?
2007 $sth->execute( $datedue->output('iso'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2010 # Update the renewal count on the item, and tell zebra to reindex
2011 $renews = $biblio->{'renewals'} + 1;
2012 ModItem({ renewals => $renews }, $biblio->{'biblionumber'}, $itemnumber);
2014 # Charge a new rental fee, if applicable?
2015 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2016 if ( $charge > 0 ) {
2017 my $accountno = getnextacctno( $borrowernumber );
2018 my $item = GetBiblioFromItemNumber($itemnumber);
2019 $sth = $dbh->prepare(
2020 "INSERT INTO accountlines
2022 borrowernumber, accountno, amount,
2024 accounttype, amountoutstanding, itemnumber
2026 VALUES (now(),?,?,?,?,?,?,?)"
2028 $sth->execute( $borrowernumber, $accountno, $charge,
2029 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2030 'Rent', $charge, $itemnumber );
2034 UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2039 # check renewal status
2040 my ($bornum,$itemno)=@_;
2041 my $dbh = C4::Context->dbh;
2043 my $renewsallowed = 0;
2045 # Look in the issues table for this item, lent to this borrower,
2046 # and not yet returned.
2048 # FIXME - I think this function could be redone to use only one SQL call.
2049 my $sth = $dbh->prepare("select * from issues
2050 where (borrowernumber = ?)
2051 and (itemnumber = ?)");
2052 $sth->execute($bornum,$itemno);
2053 my $data = $sth->fetchrow_hashref;
2054 $renewcount = $data->{'renewals'} if $data->{'renewals'};
2056 my $query = "SELECT renewalsallowed FROM items ";
2057 $query .= (C4::Context->preference('item-level_itypes'))
2058 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2059 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
2060 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2061 $query .= "WHERE items.itemnumber = ?";
2062 my $sth2 = $dbh->prepare($query);
2063 $sth2->execute($itemno);
2064 my $data2 = $sth2->fetchrow_hashref();
2065 $renewsallowed = $data2->{'renewalsallowed'};
2066 $renewsleft = $renewsallowed - $renewcount;
2067 return ($renewcount,$renewsallowed,$renewsleft);
2070 =head2 GetIssuingCharges
2072 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2074 Calculate how much it would cost for a given patron to borrow a given
2075 item, including any applicable discounts.
2077 C<$itemnumber> is the item number of item the patron wishes to borrow.
2079 C<$borrowernumber> is the patron's borrower number.
2081 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2082 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2087 sub GetIssuingCharges {
2089 # calculate charges due
2090 my ( $itemnumber, $borrowernumber ) = @_;
2092 my $dbh = C4::Context->dbh;
2095 # Get the book's item type and rental charge (via its biblioitem).
2096 my $qcharge = "SELECT itemtypes.itemtype,rentalcharge FROM items
2097 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
2098 $qcharge .= (C4::Context->preference('item-level_itypes'))
2099 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2100 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2102 $qcharge .= "WHERE items.itemnumber =?";
2104 my $sth1 = $dbh->prepare($qcharge);
2105 $sth1->execute($itemnumber);
2106 if ( my $data1 = $sth1->fetchrow_hashref ) {
2107 $item_type = $data1->{'itemtype'};
2108 $charge = $data1->{'rentalcharge'};
2109 my $q2 = "SELECT rentaldiscount FROM borrowers
2110 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2111 WHERE borrowers.borrowernumber = ?
2112 AND issuingrules.itemtype = ?";
2113 my $sth2 = $dbh->prepare($q2);
2114 $sth2->execute( $borrowernumber, $item_type );
2115 if ( my $data2 = $sth2->fetchrow_hashref ) {
2116 my $discount = $data2->{'rentaldiscount'};
2117 if ( $discount eq 'NULL' ) {
2120 $charge = ( $charge * ( 100 - $discount ) ) / 100;
2126 return ( $charge, $item_type );
2129 =head2 AddIssuingCharge
2131 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2135 sub AddIssuingCharge {
2136 my ( $itemnumber, $borrowernumber, $charge ) = @_;
2137 my $dbh = C4::Context->dbh;
2138 my $nextaccntno = getnextacctno( $borrowernumber );
2140 INSERT INTO accountlines
2141 (borrowernumber, itemnumber, accountno,
2142 date, amount, description, accounttype,
2144 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
2146 my $sth = $dbh->prepare($query);
2147 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
2153 GetTransfers($itemnumber);
2158 my ($itemnumber) = @_;
2160 my $dbh = C4::Context->dbh;
2166 FROM branchtransfers
2167 WHERE itemnumber = ?
2168 AND datearrived IS NULL
2170 my $sth = $dbh->prepare($query);
2171 $sth->execute($itemnumber);
2172 my @row = $sth->fetchrow_array();
2178 =head2 GetTransfersFromTo
2180 @results = GetTransfersFromTo($frombranch,$tobranch);
2182 Returns the list of pending transfers between $from and $to branch
2186 sub GetTransfersFromTo {
2187 my ( $frombranch, $tobranch ) = @_;
2188 return unless ( $frombranch && $tobranch );
2189 my $dbh = C4::Context->dbh;
2191 SELECT itemnumber,datesent,frombranch
2192 FROM branchtransfers
2195 AND datearrived IS NULL
2197 my $sth = $dbh->prepare($query);
2198 $sth->execute( $frombranch, $tobranch );
2201 while ( my $data = $sth->fetchrow_hashref ) {
2202 push @gettransfers, $data;
2205 return (@gettransfers);
2208 =head2 DeleteTransfer
2210 &DeleteTransfer($itemnumber);
2214 sub DeleteTransfer {
2215 my ($itemnumber) = @_;
2216 my $dbh = C4::Context->dbh;
2217 my $sth = $dbh->prepare(
2218 "DELETE FROM branchtransfers
2220 AND datearrived IS NULL "
2222 $sth->execute($itemnumber);
2226 =head2 AnonymiseIssueHistory
2228 $rows = AnonymiseIssueHistory($borrowernumber,$date)
2230 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2231 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2233 return the number of affected rows.
2237 sub AnonymiseIssueHistory {
2239 my $borrowernumber = shift;
2240 my $dbh = C4::Context->dbh;
2243 SET borrowernumber = NULL
2244 WHERE returndate < '".$date."'
2245 AND borrowernumber IS NOT NULL
2247 $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2248 my $rows_affected = $dbh->do($query);
2249 return $rows_affected;
2252 =head2 updateWrongTransfer
2254 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2256 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
2260 sub updateWrongTransfer {
2261 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2262 my $dbh = C4::Context->dbh;
2263 # first step validate the actual line of transfert .
2266 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2268 $sth->execute($FromLibrary,$itemNumber);
2271 # second step create a new line of branchtransfer to the right location .
2272 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2274 #third step changing holdingbranch of item
2275 UpdateHoldingbranch($FromLibrary,$itemNumber);
2278 =head2 UpdateHoldingbranch
2280 $items = UpdateHoldingbranch($branch,$itmenumber);
2281 Simple methode for updating hodlingbranch in items BDD line
2285 sub UpdateHoldingbranch {
2286 my ( $branch,$itemnumber ) = @_;
2287 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2292 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2293 this function calculates the due date given the loan length ,
2294 checking against the holidays calendar as per the 'useDaysMode' syspref.
2295 C<$startdate> = C4::Dates object representing start date of loan period (assumed to be today)
2296 C<$branch> = location whose calendar to use
2297 C<$loanlength> = loan length prior to adjustment
2301 my ($startdate,$loanlength,$branch) = @_;
2302 if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar
2303 my $datedue = time + ($loanlength) * 86400;
2304 #FIXME - assumes now even though we take a startdate
2305 my @datearr = localtime($datedue);
2306 return C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2308 my $calendar = C4::Calendar->new( branchcode => $branch );
2309 my $datedue = $calendar->addDate($startdate, $loanlength);
2314 =head2 CheckValidDatedue
2315 This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2316 To be replaced by CalcDateDue() once C4::Calendar use is tested.
2318 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2319 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2320 C<$date_due> = returndate calculate with no day check
2321 C<$itemnumber> = itemnumber
2322 C<$branchcode> = location of issue (affected by 'CircControl' syspref)
2323 C<$loanlength> = loan length prior to adjustment
2326 sub CheckValidDatedue {
2327 my ($date_due,$itemnumber,$branchcode)=@_;
2328 my @datedue=split('-',$date_due->output('iso'));
2329 my $years=$datedue[0];
2330 my $month=$datedue[1];
2331 my $day=$datedue[2];
2332 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2334 for (my $i=0;$i<2;$i++){
2335 $dow=Day_of_Week($years,$month,$day);
2336 ($dow=0) if ($dow>6);
2337 my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2338 my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2339 my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2340 if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2342 (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2345 my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2350 =head2 CheckRepeatableHolidays
2352 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2353 this function checks if the date due is a repeatable holiday
2354 C<$date_due> = returndate calculate with no day check
2355 C<$itemnumber> = itemnumber
2356 C<$branchcode> = localisation of issue
2360 sub CheckRepeatableHolidays{
2361 my($itemnumber,$week_day,$branchcode)=@_;
2362 my $dbh = C4::Context->dbh;
2363 my $query = qq|SELECT count(*)
2364 FROM repeatable_holidays
2367 my $sth = $dbh->prepare($query);
2368 $sth->execute($branchcode,$week_day);
2369 my $result=$sth->fetchrow;
2375 =head2 CheckSpecialHolidays
2377 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2378 this function check if the date is a special holiday
2379 C<$years> = the years of datedue
2380 C<$month> = the month of datedue
2381 C<$day> = the day of datedue
2382 C<$itemnumber> = itemnumber
2383 C<$branchcode> = localisation of issue
2387 sub CheckSpecialHolidays{
2388 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2389 my $dbh = C4::Context->dbh;
2390 my $query=qq|SELECT count(*)
2391 FROM `special_holidays`
2397 my $sth = $dbh->prepare($query);
2398 $sth->execute($years,$month,$day,$branchcode);
2399 my $countspecial=$sth->fetchrow ;
2401 return $countspecial;
2404 =head2 CheckRepeatableSpecialHolidays
2406 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2407 this function check if the date is a repeatble special holidays
2408 C<$month> = the month of datedue
2409 C<$day> = the day of datedue
2410 C<$itemnumber> = itemnumber
2411 C<$branchcode> = localisation of issue
2415 sub CheckRepeatableSpecialHolidays{
2416 my ($month,$day,$itemnumber,$branchcode) = @_;
2417 my $dbh = C4::Context->dbh;
2418 my $query=qq|SELECT count(*)
2419 FROM `repeatable_holidays`
2424 my $sth = $dbh->prepare($query);
2425 $sth->execute($month,$day,$branchcode);
2426 my $countspecial=$sth->fetchrow ;
2428 return $countspecial;
2433 sub CheckValidBarcode{
2435 my $dbh = C4::Context->dbh;
2436 my $query=qq|SELECT count(*)
2440 my $sth = $dbh->prepare($query);
2441 $sth->execute($barcode);
2442 my $exist=$sth->fetchrow ;
2453 Koha Developement team <info@koha.org>