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 <= $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);
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<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1871 item must currently be on loan to the specified borrower; renewals
1872 must be allowed for the item's type; and the borrower must not have
1873 already renewed the loan. $error will contain the reason the renewal can not proceed
1877 sub CanBookBeRenewed {
1879 # check renewal status
1880 my ( $borrowernumber, $itemnumber ) = @_;
1881 my $dbh = C4::Context->dbh;
1886 # Look in the issues table for this item, lent to this borrower,
1887 # and not yet returned.
1889 # FIXME - I think this function could be redone to use only one SQL call.
1890 my $sth1 = $dbh->prepare(
1891 "SELECT * FROM issues
1892 WHERE borrowernumber = ?
1895 $sth1->execute( $borrowernumber, $itemnumber );
1896 if ( my $data1 = $sth1->fetchrow_hashref ) {
1898 # Found a matching item
1900 # See if this item may be renewed. This query is convoluted
1901 # because it's a bit messy: given the item number, we need to find
1902 # the biblioitem, which gives us the itemtype, which tells us
1903 # whether it may be renewed.
1904 my $query = "SELECT renewalsallowed FROM items ";
1905 $query .= (C4::Context->preference('item-level_itypes'))
1906 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1907 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1908 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1909 $query .= "WHERE items.itemnumber = ?";
1910 my $sth2 = $dbh->prepare($query);
1911 $sth2->execute($itemnumber);
1912 if ( my $data2 = $sth2->fetchrow_hashref ) {
1913 $renews = $data2->{'renewalsallowed'};
1915 if ( $renews && $renews > $data1->{'renewals'} ) {
1922 my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1930 return ($renewokay,$error);
1935 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]);
1939 C<$borrowernumber> is the borrower number of the patron who currently
1942 C<$itemnumber> is the number of the item to renew.
1944 C<$branch> is the library branch. Defaults to the homebranch of the ITEM.
1946 C<$datedue> can be a C4::Dates object used to set the due date.
1948 C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If
1949 this parameter is not supplied, lastreneweddate is set to the current date.
1951 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
1952 from the book's item type.
1957 my $borrowernumber = shift or return undef;
1958 my $itemnumber = shift or return undef;
1959 my $item = GetItem($itemnumber) or return undef;
1960 my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
1961 my $branch = (@_) ? shift : $item->{homebranch}; # opac-renew doesn't send branch
1962 my $datedue = shift;
1963 my $lastreneweddate = shift;
1965 # If the due date wasn't specified, calculate it by adding the
1966 # book's loan length to today's date.
1967 unless ($datedue && $datedue->output('iso')) {
1969 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
1970 my $loanlength = GetLoanLength(
1971 $borrower->{'categorycode'},
1972 (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
1973 $item->{homebranch} # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument?
1975 #FIXME -- use circControl?
1976 $datedue = CalcDateDue(C4::Dates->new(),$loanlength,$branch); # this branch is the transactional branch.
1977 # The question of whether to use item's homebranch calendar is open.
1980 # $lastreneweddate defaults to today.
1981 unless (defined $lastreneweddate) {
1982 $lastreneweddate = strftime( "%Y-%m-%d", localtime );
1985 my $dbh = C4::Context->dbh;
1986 # Find the issues record for this book
1988 $dbh->prepare("SELECT * FROM issues
1989 WHERE borrowernumber=?
1992 $sth->execute( $borrowernumber, $itemnumber );
1993 my $issuedata = $sth->fetchrow_hashref;
1996 # Update the issues record to have the new due date, and a new count
1997 # of how many times it has been renewed.
1998 my $renews = $issuedata->{'renewals'} + 1;
1999 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ?
2000 WHERE borrowernumber=?
2003 $sth->execute( $datedue->output('iso'), $renews, $lastreneweddate, $borrowernumber, $itemnumber );
2006 # Update the renewal count on the item, and tell zebra to reindex
2007 $renews = $biblio->{'renewals'} + 1;
2008 ModItem({ renewals => $renews }, $biblio->{'biblionumber'}, $itemnumber);
2010 # Charge a new rental fee, if applicable?
2011 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2012 if ( $charge > 0 ) {
2013 my $accountno = getnextacctno( $borrowernumber );
2014 my $item = GetBiblioFromItemNumber($itemnumber);
2015 $sth = $dbh->prepare(
2016 "INSERT INTO accountlines
2018 borrowernumber, accountno, amount,
2020 accounttype, amountoutstanding, itemnumber
2022 VALUES (now(),?,?,?,?,?,?,?)"
2024 $sth->execute( $borrowernumber, $accountno, $charge,
2025 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2026 'Rent', $charge, $itemnumber );
2030 UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2035 # check renewal status
2036 my ($bornum,$itemno)=@_;
2037 my $dbh = C4::Context->dbh;
2039 my $renewsallowed = 0;
2041 # Look in the issues table for this item, lent to this borrower,
2042 # and not yet returned.
2044 # FIXME - I think this function could be redone to use only one SQL call.
2045 my $sth = $dbh->prepare("select * from issues
2046 where (borrowernumber = ?)
2047 and (itemnumber = ?)");
2048 $sth->execute($bornum,$itemno);
2049 my $data = $sth->fetchrow_hashref;
2050 $renewcount = $data->{'renewals'} if $data->{'renewals'};
2052 my $query = "SELECT renewalsallowed FROM items ";
2053 $query .= (C4::Context->preference('item-level_itypes'))
2054 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2055 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
2056 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2057 $query .= "WHERE items.itemnumber = ?";
2058 my $sth2 = $dbh->prepare($query);
2059 $sth2->execute($itemno);
2060 my $data2 = $sth2->fetchrow_hashref();
2061 $renewsallowed = $data2->{'renewalsallowed'};
2062 $renewsleft = $renewsallowed - $renewcount;
2063 return ($renewcount,$renewsallowed,$renewsleft);
2066 =head2 GetIssuingCharges
2068 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2070 Calculate how much it would cost for a given patron to borrow a given
2071 item, including any applicable discounts.
2073 C<$itemnumber> is the item number of item the patron wishes to borrow.
2075 C<$borrowernumber> is the patron's borrower number.
2077 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2078 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2083 sub GetIssuingCharges {
2085 # calculate charges due
2086 my ( $itemnumber, $borrowernumber ) = @_;
2088 my $dbh = C4::Context->dbh;
2091 # Get the book's item type and rental charge (via its biblioitem).
2092 my $qcharge = "SELECT itemtypes.itemtype,rentalcharge FROM items
2093 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
2094 $qcharge .= (C4::Context->preference('item-level_itypes'))
2095 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2096 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2098 $qcharge .= "WHERE items.itemnumber =?";
2100 my $sth1 = $dbh->prepare($qcharge);
2101 $sth1->execute($itemnumber);
2102 if ( my $data1 = $sth1->fetchrow_hashref ) {
2103 $item_type = $data1->{'itemtype'};
2104 $charge = $data1->{'rentalcharge'};
2105 my $q2 = "SELECT rentaldiscount FROM borrowers
2106 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2107 WHERE borrowers.borrowernumber = ?
2108 AND issuingrules.itemtype = ?";
2109 my $sth2 = $dbh->prepare($q2);
2110 $sth2->execute( $borrowernumber, $item_type );
2111 if ( my $data2 = $sth2->fetchrow_hashref ) {
2112 my $discount = $data2->{'rentaldiscount'};
2113 if ( $discount eq 'NULL' ) {
2116 $charge = ( $charge * ( 100 - $discount ) ) / 100;
2122 return ( $charge, $item_type );
2125 =head2 AddIssuingCharge
2127 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2131 sub AddIssuingCharge {
2132 my ( $itemnumber, $borrowernumber, $charge ) = @_;
2133 my $dbh = C4::Context->dbh;
2134 my $nextaccntno = getnextacctno( $borrowernumber );
2136 INSERT INTO accountlines
2137 (borrowernumber, itemnumber, accountno,
2138 date, amount, description, accounttype,
2140 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
2142 my $sth = $dbh->prepare($query);
2143 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
2149 GetTransfers($itemnumber);
2154 my ($itemnumber) = @_;
2156 my $dbh = C4::Context->dbh;
2162 FROM branchtransfers
2163 WHERE itemnumber = ?
2164 AND datearrived IS NULL
2166 my $sth = $dbh->prepare($query);
2167 $sth->execute($itemnumber);
2168 my @row = $sth->fetchrow_array();
2174 =head2 GetTransfersFromTo
2176 @results = GetTransfersFromTo($frombranch,$tobranch);
2178 Returns the list of pending transfers between $from and $to branch
2182 sub GetTransfersFromTo {
2183 my ( $frombranch, $tobranch ) = @_;
2184 return unless ( $frombranch && $tobranch );
2185 my $dbh = C4::Context->dbh;
2187 SELECT itemnumber,datesent,frombranch
2188 FROM branchtransfers
2191 AND datearrived IS NULL
2193 my $sth = $dbh->prepare($query);
2194 $sth->execute( $frombranch, $tobranch );
2197 while ( my $data = $sth->fetchrow_hashref ) {
2198 push @gettransfers, $data;
2201 return (@gettransfers);
2204 =head2 DeleteTransfer
2206 &DeleteTransfer($itemnumber);
2210 sub DeleteTransfer {
2211 my ($itemnumber) = @_;
2212 my $dbh = C4::Context->dbh;
2213 my $sth = $dbh->prepare(
2214 "DELETE FROM branchtransfers
2216 AND datearrived IS NULL "
2218 $sth->execute($itemnumber);
2222 =head2 AnonymiseIssueHistory
2224 $rows = AnonymiseIssueHistory($borrowernumber,$date)
2226 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2227 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2229 return the number of affected rows.
2233 sub AnonymiseIssueHistory {
2235 my $borrowernumber = shift;
2236 my $dbh = C4::Context->dbh;
2239 SET borrowernumber = NULL
2240 WHERE returndate < '".$date."'
2241 AND borrowernumber IS NOT NULL
2243 $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2244 my $rows_affected = $dbh->do($query);
2245 return $rows_affected;
2248 =head2 updateWrongTransfer
2250 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2252 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
2256 sub updateWrongTransfer {
2257 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2258 my $dbh = C4::Context->dbh;
2259 # first step validate the actual line of transfert .
2262 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2264 $sth->execute($FromLibrary,$itemNumber);
2267 # second step create a new line of branchtransfer to the right location .
2268 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2270 #third step changing holdingbranch of item
2271 UpdateHoldingbranch($FromLibrary,$itemNumber);
2274 =head2 UpdateHoldingbranch
2276 $items = UpdateHoldingbranch($branch,$itmenumber);
2277 Simple methode for updating hodlingbranch in items BDD line
2281 sub UpdateHoldingbranch {
2282 my ( $branch,$itemnumber ) = @_;
2283 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2288 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2289 this function calculates the due date given the loan length ,
2290 checking against the holidays calendar as per the 'useDaysMode' syspref.
2291 C<$startdate> = C4::Dates object representing start date of loan period (assumed to be today)
2292 C<$branch> = location whose calendar to use
2293 C<$loanlength> = loan length prior to adjustment
2297 my ($startdate,$loanlength,$branch) = @_;
2298 if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar
2299 my $datedue = time + ($loanlength) * 86400;
2300 #FIXME - assumes now even though we take a startdate
2301 my @datearr = localtime($datedue);
2302 return C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2304 my $calendar = C4::Calendar->new( branchcode => $branch );
2305 my $datedue = $calendar->addDate($startdate, $loanlength);
2310 =head2 CheckValidDatedue
2311 This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2312 To be replaced by CalcDateDue() once C4::Calendar use is tested.
2314 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2315 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2316 C<$date_due> = returndate calculate with no day check
2317 C<$itemnumber> = itemnumber
2318 C<$branchcode> = location of issue (affected by 'CircControl' syspref)
2319 C<$loanlength> = loan length prior to adjustment
2322 sub CheckValidDatedue {
2323 my ($date_due,$itemnumber,$branchcode)=@_;
2324 my @datedue=split('-',$date_due->output('iso'));
2325 my $years=$datedue[0];
2326 my $month=$datedue[1];
2327 my $day=$datedue[2];
2328 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2330 for (my $i=0;$i<2;$i++){
2331 $dow=Day_of_Week($years,$month,$day);
2332 ($dow=0) if ($dow>6);
2333 my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2334 my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2335 my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2336 if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2338 (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2341 my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2346 =head2 CheckRepeatableHolidays
2348 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2349 this function checks if the date due is a repeatable holiday
2350 C<$date_due> = returndate calculate with no day check
2351 C<$itemnumber> = itemnumber
2352 C<$branchcode> = localisation of issue
2356 sub CheckRepeatableHolidays{
2357 my($itemnumber,$week_day,$branchcode)=@_;
2358 my $dbh = C4::Context->dbh;
2359 my $query = qq|SELECT count(*)
2360 FROM repeatable_holidays
2363 my $sth = $dbh->prepare($query);
2364 $sth->execute($branchcode,$week_day);
2365 my $result=$sth->fetchrow;
2371 =head2 CheckSpecialHolidays
2373 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2374 this function check if the date is a special holiday
2375 C<$years> = the years of datedue
2376 C<$month> = the month of datedue
2377 C<$day> = the day of datedue
2378 C<$itemnumber> = itemnumber
2379 C<$branchcode> = localisation of issue
2383 sub CheckSpecialHolidays{
2384 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2385 my $dbh = C4::Context->dbh;
2386 my $query=qq|SELECT count(*)
2387 FROM `special_holidays`
2393 my $sth = $dbh->prepare($query);
2394 $sth->execute($years,$month,$day,$branchcode);
2395 my $countspecial=$sth->fetchrow ;
2397 return $countspecial;
2400 =head2 CheckRepeatableSpecialHolidays
2402 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2403 this function check if the date is a repeatble special holidays
2404 C<$month> = the month of datedue
2405 C<$day> = the day of datedue
2406 C<$itemnumber> = itemnumber
2407 C<$branchcode> = localisation of issue
2411 sub CheckRepeatableSpecialHolidays{
2412 my ($month,$day,$itemnumber,$branchcode) = @_;
2413 my $dbh = C4::Context->dbh;
2414 my $query=qq|SELECT count(*)
2415 FROM `repeatable_holidays`
2420 my $sth = $dbh->prepare($query);
2421 $sth->execute($month,$day,$branchcode);
2422 my $countspecial=$sth->fetchrow ;
2424 return $countspecial;
2429 sub CheckValidBarcode{
2431 my $dbh = C4::Context->dbh;
2432 my $query=qq|SELECT count(*)
2436 my $sth = $dbh->prepare($query);
2437 $sth->execute($barcode);
2438 my $exist=$sth->fetchrow ;
2449 Koha Developement team <info@koha.org>