1 package C4::Circulation;
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
42 use POSIX qw(strftime);
43 use C4::Branch; # GetBranches
44 use C4::Log; # logaction
48 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
51 # set the version for version checking
55 # FIXME subs that should probably be elsewhere
61 # subs to deal with issuing a book
76 &GetBranchBorrowerCircRule
78 &AnonymiseIssueHistory
81 # subs to deal with returns
88 # subs to deal with transfers
100 C4::Circulation - Koha circulation module
108 The functions in this module deal with circulation, issues, and
109 returns, as well as general information about the library.
110 Also deals with stocktaking.
116 =head3 $str = &barcodedecode($barcode);
120 =item Generic filter function for barcode string.
121 Called on every circ if the System Pref itemBarcodeInputFilter is set.
122 Will do some manipulation of the barcode for systems that deliver a barcode
123 to circulation.pl that differs from the barcode stored for the item.
124 For proper functioning of this filter, calling the function on the
125 correct barcode string (items.barcode) should return an unaltered barcode.
131 # FIXME -- the &decode fcn below should be wrapped into this one.
132 # FIXME -- these plugins should be moved out of Circulation.pm
136 my $filter = C4::Context->preference('itemBarcodeInputFilter');
137 if($filter eq 'whitespace') {
140 } elsif($filter eq 'cuecat') {
142 my @fields = split( /\./, $barcode );
143 my @results = map( decode($_), @fields[ 1 .. $#fields ] );
144 if ( $#results == 2 ) {
150 } elsif($filter eq 'T-prefix') {
151 if ( $barcode =~ /^[Tt]/) {
152 if (substr($barcode,1,1) eq '0') {
155 $barcode = substr($barcode,2) + 0 ;
158 return sprintf( "T%07d",$barcode);
164 =head3 $str = &decode($chunk);
168 =item Decodes a segment of a string emitted by a CueCat barcode scanner and
178 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
179 my @s = map { index( $seq, $_ ); } split( //, $encoded );
180 my $l = ( $#s + 1 ) % 4;
191 my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
193 chr( ( $n >> 16 ) ^ 67 )
194 .chr( ( $n >> 8 & 255 ) ^ 67 )
195 .chr( ( $n & 255 ) ^ 67 );
198 $r = substr( $r, 0, length($r) - $l );
204 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, $barcode, $ignore_reserves);
206 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
208 C<$newbranch> is the code for the branch to which the item should be transferred.
210 C<$barcode> is the barcode of the item to be transferred.
212 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
213 Otherwise, if an item is reserved, the transfer fails.
215 Returns three values:
219 is true if the transfer was successful.
223 is a reference-to-hash which may have any of the following keys:
229 There is no item in the catalog with the given barcode. The value is C<$barcode>.
233 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.
235 =item C<DestinationEqualsHolding>
237 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.
241 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.
245 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>.
247 =item C<WasTransferred>
249 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
256 my ( $tbr, $barcode, $ignoreRs ) = @_;
259 my $branches = GetBranches();
260 my $itemnumber = GetItemnumberFromBarcode( $barcode );
261 my $issue = GetItemIssue($itemnumber);
262 my $biblio = GetBiblioFromItemNumber($itemnumber);
265 if ( not $itemnumber ) {
266 $messages->{'BadBarcode'} = $barcode;
270 # get branches of book...
271 my $hbr = $biblio->{'homebranch'};
272 my $fbr = $biblio->{'holdingbranch'};
275 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
276 $messages->{'IsPermanent'} = $hbr;
279 # can't transfer book if is already there....
280 if ( $fbr eq $tbr ) {
281 $messages->{'DestinationEqualsHolding'} = 1;
285 # check if it is still issued to someone, return it...
286 if ($issue->{borrowernumber}) {
287 AddReturn( $barcode, $fbr );
288 $messages->{'WasReturned'} = $issue->{borrowernumber};
292 # That'll save a database query.
293 my ( $resfound, $resrec ) =
294 CheckReserves( $itemnumber );
295 if ( $resfound and not $ignoreRs ) {
296 $resrec->{'ResFound'} = $resfound;
298 # $messages->{'ResFound'} = $resrec;
302 #actually do the transfer....
304 ModItemTransfer( $itemnumber, $fbr, $tbr );
306 # don't need to update MARC anymore, we do it in batch now
307 $messages->{'WasTransfered'} = 1;
308 ModDateLastSeen( $itemnumber );
310 return ( $dotransfer, $messages, $biblio );
315 my $borrower = shift;
316 my $biblionumber = shift;
318 my $cat_borrower = $borrower->{'categorycode'};
319 my $dbh = C4::Context->dbh;
321 # Get which branchcode we need
322 if (C4::Context->preference('CircControl') eq 'PickupLibrary'){
323 $branch = C4::Context->userenv->{'branch'};
325 elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){
326 $branch = $borrower->{'branchcode'};
330 $branch = $item->{'homebranch'};
332 my $type = (C4::Context->preference('item-level_itypes'))
333 ? $item->{'itype'} # item-level
334 : $item->{'itemtype'}; # biblio-level
336 # given branch, patron category, and item type, determine
337 # applicable issuing rule
338 my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
340 # if a rule is found and has a loan limit set, count
341 # how many loans the patron already has that meet that
343 if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
345 my $count_query = "SELECT COUNT(*) FROM issues
346 JOIN items USING (itemnumber) ";
348 my $rule_itemtype = $issuing_rule->{itemtype};
349 if ($rule_itemtype eq "*") {
350 # matching rule has the default item type, so count only
351 # those existing loans that don't fall under a more
353 if (C4::Context->preference('item-level_itypes')) {
354 $count_query .= " WHERE items.itype NOT IN (
355 SELECT itemtype FROM issuingrules
357 AND (categorycode = ? OR categorycode = ?)
361 $count_query .= " JOIN biblioitems USING (biblionumber)
362 WHERE biblioitems.itemtype NOT IN (
363 SELECT itemtype FROM issuingrules
365 AND (categorycode = ? OR categorycode = ?)
369 push @bind_params, $issuing_rule->{branchcode};
370 push @bind_params, $issuing_rule->{categorycode};
371 push @bind_params, $cat_borrower;
373 # rule has specific item type, so count loans of that
375 if (C4::Context->preference('item-level_itypes')) {
376 $count_query .= " WHERE items.itype = ? ";
378 $count_query .= " JOIN biblioitems USING (biblionumber)
379 WHERE biblioitems.itemtype= ? ";
381 push @bind_params, $type;
384 $count_query .= " AND borrowernumber = ? ";
385 push @bind_params, $borrower->{'borrowernumber'};
386 my $rule_branch = $issuing_rule->{branchcode};
387 if ($rule_branch ne "*") {
388 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
389 $count_query .= " AND issues.branchcode = ? ";
390 push @bind_params, $branch;
391 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
392 ; # if branch is the patron's home branch, then count all loans by patron
394 $count_query .= " AND items.homebranch = ? ";
395 push @bind_params, $branch;
399 my $count_sth = $dbh->prepare($count_query);
400 $count_sth->execute(@bind_params);
401 my ($current_loan_count) = $count_sth->fetchrow_array;
403 my $max_loans_allowed = $issuing_rule->{'maxissueqty'};
404 if ($current_loan_count >= $max_loans_allowed) {
405 return "$current_loan_count / $max_loans_allowed";
409 # Now count total loans against the limit for the branch
410 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
411 if (defined($branch_borrower_circ_rule->{maxissueqty})) {
412 my @bind_params = ();
413 my $branch_count_query = "SELECT COUNT(*) FROM issues
414 JOIN items USING (itemnumber)
415 WHERE borrowernumber = ? ";
416 push @bind_params, $borrower->{borrowernumber};
418 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
419 $branch_count_query .= " AND issues.branchcode = ? ";
420 push @bind_params, $branch;
421 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
422 ; # if branch is the patron's home branch, then count all loans by patron
424 $branch_count_query .= " AND items.homebranch = ? ";
425 push @bind_params, $branch;
427 my $branch_count_sth = $dbh->prepare($branch_count_query);
428 $branch_count_sth->execute(@bind_params);
429 my ($current_loan_count) = $branch_count_sth->fetchrow_array;
431 my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty};
432 if ($current_loan_count >= $max_loans_allowed) {
433 return "$current_loan_count / $max_loans_allowed";
437 # OK, the patron can issue !!!
443 @issues = &itemissues($biblioitemnumber, $biblio);
445 Looks up information about who has borrowed the bookZ<>(s) with the
446 given biblioitemnumber.
448 C<$biblio> is ignored.
450 C<&itemissues> returns an array of references-to-hash. The keys
451 include the fields from the C<items> table in the Koha database.
452 Additional keys include:
458 If the item is currently on loan, this gives the due date.
460 If the item is not on loan, then this is either "Available" or
461 "Cancelled", if the item has been withdrawn.
465 If the item is currently on loan, this gives the card number of the
466 patron who currently has the item.
468 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
470 These give the timestamp for the last three times the item was
473 =item C<card0>, C<card1>, C<card2>
475 The card number of the last three patrons who borrowed this item.
477 =item C<borrower0>, C<borrower1>, C<borrower2>
479 The borrower number of the last three patrons who borrowed this item.
487 my ( $bibitem, $biblio ) = @_;
488 my $dbh = C4::Context->dbh;
490 $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
495 $sth->execute($bibitem) || die $sth->errstr;
497 while ( my $data = $sth->fetchrow_hashref ) {
499 # Find out who currently has this item.
500 # FIXME - Wouldn't it be better to do this as a left join of
501 # some sort? Currently, this code assumes that if
502 # fetchrow_hashref() fails, then the book is on the shelf.
503 # fetchrow_hashref() can fail for any number of reasons (e.g.,
504 # database server crash), not just because no items match the
506 my $sth2 = $dbh->prepare(
507 "SELECT * FROM issues
508 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
513 $sth2->execute( $data->{'itemnumber'} );
514 if ( my $data2 = $sth2->fetchrow_hashref ) {
515 $data->{'date_due'} = $data2->{'date_due'};
516 $data->{'card'} = $data2->{'cardnumber'};
517 $data->{'borrower'} = $data2->{'borrowernumber'};
520 $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available';
525 # Find the last 3 people who borrowed this item.
526 $sth2 = $dbh->prepare(
527 "SELECT * FROM old_issues
528 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
530 ORDER BY returndate DESC,timestamp DESC"
533 $sth2->execute( $data->{'itemnumber'} );
534 for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
535 { # FIXME : error if there is less than 3 pple borrowing this item
536 if ( my $data2 = $sth2->fetchrow_hashref ) {
537 $data->{"timestamp$i2"} = $data2->{'timestamp'};
538 $data->{"card$i2"} = $data2->{'cardnumber'};
539 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
544 $results[$i] = $data;
552 =head2 CanBookBeIssued
554 Check if a book can be issued.
556 ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess );
558 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
562 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
564 =item C<$barcode> is the bar code of the book being issued.
566 =item C<$duedatespec> is a C4::Dates object.
576 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
577 Possible values are :
583 sticky due date is invalid
587 borrower gone with no address
591 borrower declared it's card lost
597 =head3 UNKNOWN_BARCODE
611 item is restricted (set by ??)
613 C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
614 Possible values are :
622 renewing, not issuing
624 =head3 ISSUED_TO_ANOTHER
626 issued to someone else.
630 reserved for someone else.
634 sticky due date is invalid
638 if the borrower borrows to much things
642 sub CanBookBeIssued {
643 my ( $borrower, $barcode, $duedate, $inprocess ) = @_;
644 my %needsconfirmation; # filled with problems that needs confirmations
645 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
646 my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
647 my $issue = GetItemIssue($item->{itemnumber});
648 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
649 $item->{'itemtype'}=$item->{'itype'};
650 my $dbh = C4::Context->dbh;
653 # DUE DATE is OK ? -- should already have checked.
655 #$issuingimpossible{INVALID_DATE} = 1 unless ($duedate);
660 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
661 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
662 &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'});
663 return( { STATS => 1 }, {});
665 if ( $borrower->{flags}->{GNA} ) {
666 $issuingimpossible{GNA} = 1;
668 if ( $borrower->{flags}->{'LOST'} ) {
669 $issuingimpossible{CARD_LOST} = 1;
671 if ( $borrower->{flags}->{'DBARRED'} ) {
672 $issuingimpossible{DEBARRED} = 1;
674 if ( $borrower->{'dateexpiry'} eq '0000-00-00') {
675 $issuingimpossible{EXPIRED} = 1;
677 my @expirydate= split /-/,$borrower->{'dateexpiry'};
678 if($expirydate[0]==0 || $expirydate[1]==0|| $expirydate[2]==0 ||
679 Date_to_Days(Today) > Date_to_Days( @expirydate )) {
680 $issuingimpossible{EXPIRED} = 1;
689 C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->output('iso') );
690 if ( C4::Context->preference("IssuingInProcess") ) {
691 my $amountlimit = C4::Context->preference("noissuescharge");
692 if ( $amount > $amountlimit && !$inprocess ) {
693 $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
695 elsif ( $amount <= $amountlimit && !$inprocess ) {
696 $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
701 $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
706 # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
708 my $toomany = TooMany( $borrower, $item->{biblionumber}, $item );
709 $needsconfirmation{TOO_MANY} = $toomany if $toomany;
714 unless ( $item->{barcode} ) {
715 $issuingimpossible{UNKNOWN_BARCODE} = 1;
717 if ( $item->{'notforloan'}
718 && $item->{'notforloan'} > 0 )
720 $issuingimpossible{NOT_FOR_LOAN} = 1;
722 elsif ( !$item->{'notforloan'} ){
723 # we have to check itemtypes.notforloan also
724 if (C4::Context->preference('item-level_itypes')){
725 # this should probably be a subroutine
726 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
727 $sth->execute($item->{'itemtype'});
728 my $notforloan=$sth->fetchrow_hashref();
730 if ($notforloan->{'notforloan'} == 1){
731 $issuingimpossible{NOT_FOR_LOAN} = 1;
734 elsif ($biblioitem->{'notforloan'} == 1){
735 $issuingimpossible{NOT_FOR_LOAN} = 1;
738 if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
740 $issuingimpossible{WTHDRAWN} = 1;
742 if ( $item->{'restricted'}
743 && $item->{'restricted'} == 1 )
745 $issuingimpossible{RESTRICTED} = 1;
747 if ( C4::Context->preference("IndependantBranches") ) {
748 my $userenv = C4::Context->userenv;
749 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
750 $issuingimpossible{NOTSAMEBRANCH} = 1
751 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
756 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
758 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
761 # Already issued to current borrower. Ask whether the loan should
763 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
764 $borrower->{'borrowernumber'},
765 $item->{'itemnumber'}
767 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
768 $issuingimpossible{NO_MORE_RENEWALS} = 1;
771 $needsconfirmation{RENEW_ISSUE} = 1;
774 elsif ($issue->{borrowernumber}) {
776 # issued to someone else
777 my $currborinfo = GetMemberDetails( $issue->{borrowernumber} );
779 # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
780 $needsconfirmation{ISSUED_TO_ANOTHER} =
781 "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
784 # See if the item is on reserve.
785 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
787 my $resbor = $res->{'borrowernumber'};
788 my ( $resborrower ) = GetMemberDetails( $resbor, 0 );
789 my $branches = GetBranches();
790 my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
791 if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
793 # The item is on reserve and waiting, but has been
794 # reserved by some other patron.
795 $needsconfirmation{RESERVE_WAITING} =
796 "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
798 elsif ( $restype eq "Reserved" ) {
799 # The item is on reserve for someone else.
800 $needsconfirmation{RESERVED} =
801 "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
804 if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" ) {
805 if ( $borrower->{'categorycode'} eq 'W' ) {
807 return ( \%emptyhash, \%needsconfirmation );
810 return ( \%issuingimpossible, \%needsconfirmation );
815 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
817 &AddIssue($borrower,$barcode,$date)
821 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
823 =item C<$barcode> is the bar code of the book being issued.
825 =item C<$date> contains the max date of return. calculated if empty.
827 =item C<$cancelreserve>
829 AddIssue does the following things :
830 - step 01: check that there is a borrowernumber & a barcode provided
831 - check for RENEWAL (book issued & being issued to the same patron)
832 - renewal YES = Calculate Charge & renew
834 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
836 - fill reserve if reserve to this patron
837 - cancel reserve or not, otherwise
838 * TRANSFERT PENDING ?
839 - complete the transfert
847 my ( $borrower, $barcode, $date, $cancelreserve ) = @_;
848 my $dbh = C4::Context->dbh;
849 my $barcodecheck=CheckValidBarcode($barcode);
850 if ($borrower and $barcode and $barcodecheck ne '0'){
851 # find which item we issue
852 my $item = GetItem('', $barcode) or return undef; # if we don't get an Item, abort.
855 # Get which branchcode we need
856 if (C4::Context->preference('CircControl') eq 'PickupLibrary'){
857 $branch = C4::Context->userenv->{'branch'};
859 elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){
860 $branch = $borrower->{'branchcode'};
864 $branch = $item->{'homebranch'};
867 # get actual issuing if there is one
868 my $actualissue = GetItemIssue( $item->{itemnumber});
870 # get biblioinformation for this item
871 my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
874 # check if we just renew the issue.
876 if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) {
878 $borrower->{'borrowernumber'},
879 $item->{'itemnumber'},
887 if ( $actualissue->{borrowernumber}) {
888 # This book is currently on loan, but not to the person
889 # who wants to borrow it now. mark it returned before issuing to the new borrower
892 C4::Context->userenv->{'branch'}
896 # See if the item is on reserve.
897 my ( $restype, $res ) =
898 C4::Reserves::CheckReserves( $item->{'itemnumber'} );
900 my $resbor = $res->{'borrowernumber'};
901 if ( $resbor eq $borrower->{'borrowernumber'} ) {
903 # The item is reserved by the current patron
904 ModReserveFill($res);
906 elsif ( $restype eq "Waiting" ) {
909 # The item is on reserve and waiting, but has been
910 # reserved by some other patron.
912 elsif ( $restype eq "Reserved" ) {
915 # The item is reserved by someone else.
916 if ($cancelreserve) { # cancel reserves on this item
917 CancelReserve( 0, $res->{'itemnumber'},
918 $res->{'borrowernumber'} );
921 if ($cancelreserve) {
922 CancelReserve( $res->{'biblionumber'}, 0,
923 $res->{'borrowernumber'} );
926 # set waiting reserve to first in reserve queue as book isn't waiting now
928 $res->{'biblionumber'},
929 $res->{'borrowernumber'},
935 # Starting process for transfer job (checking transfert and validate it if we have one)
936 my ($datesent) = GetTransfers($item->{'itemnumber'});
938 # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....)
941 "UPDATE branchtransfers
942 SET datearrived = now(),
944 comments = 'Forced branchtransfer'
945 WHERE itemnumber= ? AND datearrived IS NULL"
947 $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
951 # Record in the database the fact that the book was issued.
955 (borrowernumber, itemnumber,issuedate, date_due, branchcode)
962 my $itype=(C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ;
963 my $loanlength = GetLoanLength(
964 $borrower->{'categorycode'},
968 $dateduef = CalcDateDue(C4::Dates->new(),$loanlength,$branch);
969 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
970 if ( C4::Context->preference('ReturnBeforeExpiry') && $dateduef->output('iso') gt $borrower->{dateexpiry} ) {
971 $dateduef = C4::Dates->new($borrower->{dateexpiry},'iso');
975 $borrower->{'borrowernumber'},
976 $item->{'itemnumber'},
977 strftime( "%Y-%m-%d", localtime ),$dateduef->output('iso'), C4::Context->userenv->{'branch'}
981 ModItem({ issues => $item->{'issues'},
982 holdingbranch => C4::Context->userenv->{'branch'},
984 datelastborrowed => C4::Dates->new()->output('iso'),
985 onloan => $dateduef->output('iso'),
986 }, $item->{'biblionumber'}, $item->{'itemnumber'});
987 ModDateLastSeen( $item->{'itemnumber'} );
989 # If it costs to borrow this book, charge it to the patron's account.
990 my ( $charge, $itemtype ) = GetIssuingCharges(
991 $item->{'itemnumber'},
992 $borrower->{'borrowernumber'}
996 $item->{'itemnumber'},
997 $borrower->{'borrowernumber'}, $charge
999 $item->{'charge'} = $charge;
1002 # Record the fact that this book was issued.
1004 C4::Context->userenv->{'branch'},
1006 '', $item->{'itemnumber'},
1007 $item->{'itype'}, $borrower->{'borrowernumber'}
1011 logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
1012 if C4::Context->preference("IssueLog");
1021 Issues an item to a member, ignoring any problems that would normally dissallow the issue.
1026 my ( $borrowernumber, $itemnumber, $date_due, $branchcode, $date ) = @_;
1027 warn "ForceIssue( $borrowernumber, $itemnumber, $date_due, $branchcode, $date );";
1028 my $dbh = C4::Context->dbh;
1029 my $sth = $dbh->prepare( "INSERT INTO `issues` ( `borrowernumber`, `itemnumber`, `date_due`, `branchcode`, `issuingbranch`, `returndate`, `lastreneweddate`, `return`, `renewals`, `timestamp`, `issuedate` )
1030 VALUES ( ?, ?, ?, ?, ?, NULL, NULL, NULL, NULL, NOW(), ? )" );
1031 $sth->execute( $borrowernumber, $itemnumber, $date_due, $branchcode, $branchcode, $date );
1034 my $item = GetBiblioFromItemNumber( $itemnumber );
1036 UpdateStats( $branchcode, 'issue', undef, undef, $itemnumber, $item->{ 'itemtype' }, $borrowernumber );
1040 =head2 GetLoanLength
1042 Get loan length for an itemtype, a borrower type and a branch
1044 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1049 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1050 my $dbh = C4::Context->dbh;
1053 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"
1055 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1056 # try to find issuelength & return the 1st available.
1057 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1058 $sth->execute( $borrowertype, $itemtype, $branchcode );
1059 my $loanlength = $sth->fetchrow_hashref;
1060 return $loanlength->{issuelength}
1061 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1063 $sth->execute( $borrowertype, "*", $branchcode );
1064 $loanlength = $sth->fetchrow_hashref;
1065 return $loanlength->{issuelength}
1066 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1068 $sth->execute( "*", $itemtype, $branchcode );
1069 $loanlength = $sth->fetchrow_hashref;
1070 return $loanlength->{issuelength}
1071 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1073 $sth->execute( "*", "*", $branchcode );
1074 $loanlength = $sth->fetchrow_hashref;
1075 return $loanlength->{issuelength}
1076 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1078 $sth->execute( $borrowertype, $itemtype, "*" );
1079 $loanlength = $sth->fetchrow_hashref;
1080 return $loanlength->{issuelength}
1081 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1083 $sth->execute( $borrowertype, "*", "*" );
1084 $loanlength = $sth->fetchrow_hashref;
1085 return $loanlength->{issuelength}
1086 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1088 $sth->execute( "*", $itemtype, "*" );
1089 $loanlength = $sth->fetchrow_hashref;
1090 return $loanlength->{issuelength}
1091 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1093 $sth->execute( "*", "*", "*" );
1094 $loanlength = $sth->fetchrow_hashref;
1095 return $loanlength->{issuelength}
1096 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1098 # if no rule is set => 21 days (hardcoded)
1102 =head2 GetIssuingRule
1104 FIXME - This is a copy-paste of GetLoanLength
1105 as a stop-gap. Do not wish to change API for GetLoanLength
1106 this close to release, however, Overdues::GetIssuingRules is broken.
1108 Get the issuing rule for an itemtype, a borrower type and a branch
1109 Returns a hashref from the issuingrules table.
1111 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1115 sub GetIssuingRule {
1116 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1117 my $dbh = C4::Context->dbh;
1118 my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null" );
1121 $sth->execute( $borrowertype, $itemtype, $branchcode );
1122 $irule = $sth->fetchrow_hashref;
1123 return $irule if defined($irule) ;
1125 $sth->execute( $borrowertype, "*", $branchcode );
1126 $irule = $sth->fetchrow_hashref;
1127 return $irule if defined($irule) ;
1129 $sth->execute( "*", $itemtype, $branchcode );
1130 $irule = $sth->fetchrow_hashref;
1131 return $irule if defined($irule) ;
1133 $sth->execute( "*", "*", $branchcode );
1134 $irule = $sth->fetchrow_hashref;
1135 return $irule if defined($irule) ;
1137 $sth->execute( $borrowertype, $itemtype, "*" );
1138 $irule = $sth->fetchrow_hashref;
1139 return $irule if defined($irule) ;
1141 $sth->execute( $borrowertype, "*", "*" );
1142 $irule = $sth->fetchrow_hashref;
1143 return $irule if defined($irule) ;
1145 $sth->execute( "*", $itemtype, "*" );
1146 $irule = $sth->fetchrow_hashref;
1147 return $irule if defined($irule) ;
1149 $sth->execute( "*", "*", "*" );
1150 $irule = $sth->fetchrow_hashref;
1151 return $irule if defined($irule) ;
1153 # if no rule matches,
1157 =head2 GetBranchBorrowerCircRule
1161 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1165 Retrieves circulation rule attributes that apply to the given
1166 branch and patron category, regardless of item type.
1167 The return value is a hashref containing the following key:
1169 maxissueqty - maximum number of loans that a
1170 patron of the given category can have at the given
1171 branch. If the value is undef, no limit.
1173 This will first check for a specific branch and
1174 category match from branch_borrower_circ_rules.
1176 If no rule is found, it will then check default_branch_circ_rules
1177 (same branch, default category). If no rule is found,
1178 it will then check default_borrower_circ_rules (default
1179 branch, same category), then failing that, default_circ_rules
1180 (default branch, default category).
1182 If no rule has been found in the database, it will default to
1187 C<$branchcode> and C<$categorycode> should contain the
1188 literal branch code and patron category code, respectively - no
1193 sub GetBranchBorrowerCircRule {
1194 my $branchcode = shift;
1195 my $categorycode = shift;
1197 my $branch_cat_query = "SELECT maxissueqty
1198 FROM branch_borrower_circ_rules
1199 WHERE branchcode = ?
1200 AND categorycode = ?";
1201 my $dbh = C4::Context->dbh();
1202 my $sth = $dbh->prepare($branch_cat_query);
1203 $sth->execute($branchcode, $categorycode);
1205 if ($result = $sth->fetchrow_hashref()) {
1209 # try same branch, default borrower category
1210 my $branch_query = "SELECT maxissueqty
1211 FROM default_branch_circ_rules
1212 WHERE branchcode = ?";
1213 $sth = $dbh->prepare($branch_query);
1214 $sth->execute($branchcode);
1215 if ($result = $sth->fetchrow_hashref()) {
1219 # try default branch, same borrower category
1220 my $category_query = "SELECT maxissueqty
1221 FROM default_borrower_circ_rules
1222 WHERE categorycode = ?";
1223 $sth = $dbh->prepare($category_query);
1224 $sth->execute($categorycode);
1225 if ($result = $sth->fetchrow_hashref()) {
1229 # try default branch, default borrower category
1230 my $default_query = "SELECT maxissueqty
1231 FROM default_circ_rules";
1232 $sth = $dbh->prepare($default_query);
1234 if ($result = $sth->fetchrow_hashref()) {
1238 # built-in default circulation rule
1240 maxissueqty => undef,
1246 ($doreturn, $messages, $iteminformation, $borrower) =
1247 &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1253 =item C<$barcode> is the bar code of the book being returned.
1255 =item C<$branch> is the code of the branch where the book is being returned.
1257 =item C<$exemptfine> indicates that overdue charges for the item will be
1260 =item C<$dropbox> indicates that the check-in date is assumed to be
1261 yesterday, or the last non-holiday as defined in C4::Calendar . If
1262 overdue charges are applied and C<$dropbox> is true, the last charge
1263 will be removed. This assumes that the fines accrual script has run
1268 C<&AddReturn> returns a list of four items:
1270 C<$doreturn> is true iff the return succeeded.
1272 C<$messages> is a reference-to-hash giving the reason for failure:
1278 No item with this barcode exists. The value is C<$barcode>.
1282 The book is not currently on loan. The value is C<$barcode>.
1284 =item C<IsPermanent>
1286 The book's home branch is a permanent collection. If you have borrowed
1287 this book, you are not allowed to return it. The value is the code for
1288 the book's home branch.
1292 This book has been withdrawn/cancelled. The value should be ignored.
1296 The item was reserved. The value is a reference-to-hash whose keys are
1297 fields from the reserves table of the Koha database, and
1298 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1299 either C<Waiting>, C<Reserved>, or 0.
1303 C<$borrower> is a reference-to-hash, giving information about the
1304 patron who last borrowed the book.
1309 my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1310 my $dbh = C4::Context->dbh;
1314 my $validTransfert = 0;
1315 my $reserveDone = 0;
1317 # get information on item
1318 my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
1319 my $biblio = GetBiblioItemData($iteminformation->{'biblioitemnumber'});
1320 # use Data::Dumper;warn Data::Dumper::Dumper($iteminformation);
1321 unless ($iteminformation->{'itemnumber'} ) {
1322 $messages->{'BadBarcode'} = $barcode;
1326 if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1327 $messages->{'NotIssued'} = $barcode;
1328 # even though item is not on loan, it may still
1329 # be transferred; therefore, get current branch information
1330 my $curr_iteminfo = GetItem($iteminformation->{'itemnumber'});
1331 $iteminformation->{'homebranch'} = $curr_iteminfo->{'homebranch'};
1332 $iteminformation->{'holdingbranch'} = $curr_iteminfo->{'holdingbranch'};
1336 # check if the book is in a permanent collection....
1337 my $hbr = $iteminformation->{C4::Context->preference("HomeOrHoldingBranch")};
1338 my $branches = GetBranches();
1339 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1340 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1341 $messages->{'IsPermanent'} = $hbr;
1344 # if independent branches are on and returning to different branch, refuse the return
1345 if ($hbr ne C4::Context->userenv->{'branch'} && C4::Context->preference("IndependantBranches")){
1346 $messages->{'Wrongbranch'} = 1;
1350 # check that the book has been cancelled
1351 if ( $iteminformation->{'wthdrawn'} ) {
1352 $messages->{'wthdrawn'} = 1;
1356 # new op dev : if the book returned in an other branch update the holding branch
1358 # update issues, thereby returning book (should push this out into another subroutine
1359 $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1361 # case of a return of document (deal with issues and holdingbranch)
1364 my $circControlBranch;
1366 # don't allow dropbox mode to create an invalid entry in issues (issuedate > returndate) FIXME: actually checks eq, not gt
1367 undef($dropbox) if ( $iteminformation->{'issuedate'} eq C4::Dates->today('iso') );
1368 if (C4::Context->preference('CircControl') eq 'ItemHomeBranch' ) {
1369 $circControlBranch = $iteminformation->{homebranch};
1370 } elsif ( C4::Context->preference('CircControl') eq 'PatronLibrary') {
1371 $circControlBranch = $borrower->{branchcode};
1372 } else { # CircControl must be PickupLibrary.
1373 $circControlBranch = $iteminformation->{holdingbranch};
1374 # FIXME - is this right ? are we sure that the holdingbranch is still the pickup branch?
1377 MarkIssueReturned($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'},$circControlBranch);
1378 $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
1381 # continue to deal with returns cases, but not only if we have an issue
1383 # the holdingbranch is updated if the document is returned in an other location .
1384 if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) {
1385 UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
1386 # reload iteminformation holdingbranch with the userenv value
1387 $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1389 ModDateLastSeen( $iteminformation->{'itemnumber'} );
1390 ModItem({ onloan => undef }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'});
1392 if ($iteminformation->{borrowernumber}){
1393 ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1395 # fix up the accounts.....
1396 if ( $iteminformation->{'itemlost'} ) {
1397 $messages->{'WasLost'} = 1;
1400 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1401 # check if we have a transfer for this document
1402 my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1404 # if we have a transfer to do, we update the line of transfers with the datearrived
1406 if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1409 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1411 $sth->execute( $iteminformation->{'itemnumber'} );
1413 # 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'
1414 C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1417 $messages->{'WrongTransfer'} = $tobranch;
1418 $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1420 $validTransfert = 1;
1423 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1424 # fix up the accounts.....
1425 if ($iteminformation->{'itemlost'}) {
1426 FixAccountForLostAndReturned($iteminformation, $borrower);
1427 $messages->{'WasLost'} = 1;
1429 # fix up the overdues in accounts...
1430 FixOverduesOnReturn( $borrower->{'borrowernumber'},
1431 $iteminformation->{'itemnumber'}, $exemptfine, $dropbox );
1433 # find reserves.....
1434 # if we don't have a reserve with the status W, we launch the Checkreserves routine
1435 my ( $resfound, $resrec ) =
1436 C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1438 $resrec->{'ResFound'} = $resfound;
1439 $messages->{'ResFound'} = $resrec;
1444 # Record the fact that this book was returned.
1446 $branch, 'return', '0', '',
1447 $iteminformation->{'itemnumber'},
1448 $biblio->{'itemtype'},
1449 $borrower->{'borrowernumber'}
1452 logaction("CIRCULATION", "RETURN", $iteminformation->{borrowernumber}, $iteminformation->{'biblionumber'})
1453 if C4::Context->preference("ReturnLog");
1455 #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1456 #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1458 if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1459 if (C4::Context->preference("AutomaticItemReturn") == 1) {
1460 ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1461 $messages->{'WasTransfered'} = 1;
1464 $messages->{'NeedsTransfer'} = 1;
1468 return ( $doreturn, $messages, $iteminformation, $borrower );
1473 ForceReturn( $barcode, $date, $branchcode );
1475 Returns an item is if it were returned on C<$date>.
1477 This function is non-interactive and does not check for reserves.
1479 C<$barcode> is the barcode of the item being returned.
1481 C<$date> is the date of the actual return, in the format YYYY-MM-DD.
1483 C<$branchcode> is the branchcode for the library the item was returned to.
1488 my ( $barcode, $date, $branchcode ) = @_;
1489 my $dbh = C4::Context->dbh;
1491 my $item = GetBiblioFromItemNumber( undef, $barcode );
1493 ## FIXME: Is there a way to get the borrower of an item through the Koha API?
1494 my $sth=$dbh->prepare( "SELECT borrowernumber FROM issues WHERE itemnumber = ? AND returndate IS NULL");
1495 $sth->execute( $item->{'itemnumber'} );
1496 my ( $borrowernumber ) = $sth->fetchrow;
1499 ## Move the issue from issues to old_issues
1500 $sth = $dbh->prepare( "INSERT INTO old_issues ( SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL )" );
1501 $sth->execute( $item->{'itemnumber'} );
1503 ## Delete the row in issues
1504 $sth = $dbh->prepare( "DELETE FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
1505 $sth->execute( $item->{'itemnumber'} );
1507 ## Now set the returndate
1508 $sth = $dbh->prepare( 'UPDATE old_issues SET returndate = ? WHERE itemnumber = ? AND returndate IS NULL' );
1509 $sth->execute( $date, $item->{'itemnumber'} );
1512 UpdateStats( $branchcode, 'return', my $amount, my $other, $item->{ 'itemnumber' }, $item->{ 'itemtype' }, $borrowernumber );
1516 =head2 MarkIssueReturned
1520 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch);
1524 Unconditionally marks an issue as being returned by
1525 moving the C<issues> row to C<old_issues> and
1526 setting C<returndate> to the current date, or
1527 the last non-holiday date of the branccode specified in
1528 C<dropbox> . Assumes you've already checked that
1529 it's safe to do this, i.e. last non-holiday > issuedate.
1531 Ideally, this function would be internal to C<C4::Circulation>,
1532 not exported, but it is currently needed by one
1533 routine in C<C4::Accounts>.
1537 sub MarkIssueReturned {
1538 my ($borrowernumber, $itemnumber, $dropbox_branch ) = @_;
1539 my $dbh = C4::Context->dbh;
1540 my $query = "UPDATE issues SET returndate=";
1541 my @bind = ($borrowernumber,$itemnumber);
1542 if($dropbox_branch) {
1543 my $calendar = C4::Calendar->new( branchcode => $dropbox_branch );
1544 my $dropboxdate = $calendar->addDate(C4::Dates->new(), -1 );
1545 unshift @bind, $dropboxdate->output('iso') ;
1548 $query .= " now() ";
1550 $query .= " WHERE borrowernumber = ? AND itemnumber = ?";
1552 my $sth_upd = $dbh->prepare($query);
1553 $sth_upd->execute(@bind);
1554 my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1555 WHERE borrowernumber = ?
1556 AND itemnumber = ?");
1557 $sth_copy->execute($borrowernumber, $itemnumber);
1558 my $sth_del = $dbh->prepare("DELETE FROM issues
1559 WHERE borrowernumber = ?
1560 AND itemnumber = ?");
1561 $sth_del->execute($borrowernumber, $itemnumber);
1564 =head2 FixOverduesOnReturn
1566 &FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1568 C<$brn> borrowernumber
1572 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1573 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1575 internal function, called only by AddReturn
1579 sub FixOverduesOnReturn {
1580 my ( $borrowernumber, $item, $exemptfine, $dropbox ) = @_;
1581 my $dbh = C4::Context->dbh;
1583 # check for overdue fine
1586 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1588 $sth->execute( $borrowernumber, $item );
1590 # alter fine to show that the book has been returned
1592 if ($data = $sth->fetchrow_hashref) {
1594 my @bind = ($borrowernumber,$item ,$data->{'accountno'});
1596 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1597 if (C4::Context->preference("FinesLog")) {
1598 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1600 } elsif ($dropbox && $data->{lastincrement}) {
1601 my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1602 my $amt = $data->{amount} - $data->{lastincrement} ;
1603 if (C4::Context->preference("FinesLog")) {
1604 &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1606 $uquery = "update accountlines set accounttype='F' ";
1607 if($outstanding >= 0 && $amt >=0) {
1608 $uquery .= ", amount = ? , amountoutstanding=? ";
1609 unshift @bind, ($amt, $outstanding) ;
1612 $uquery = "update accountlines set accounttype='F' ";
1614 $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1615 my $usth = $dbh->prepare($uquery);
1616 $usth->execute(@bind);
1624 =head2 FixAccountForLostAndReturned
1626 &FixAccountForLostAndReturned($iteminfo,$borrower);
1628 Calculates the charge for a book lost and returned (Not exported & used only once)
1630 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1632 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1634 Internal function, called by AddReturn
1638 sub FixAccountForLostAndReturned {
1639 my ($iteminfo, $borrower) = @_;
1640 my $dbh = C4::Context->dbh;
1641 my $itm = $iteminfo->{'itemnumber'};
1642 # check for charge made for lost book
1643 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1644 $sth->execute($itm);
1645 if (my $data = $sth->fetchrow_hashref) {
1646 # writeoff this amount
1648 my $amount = $data->{'amount'};
1649 my $acctno = $data->{'accountno'};
1651 if ($data->{'amountoutstanding'} == $amount) {
1652 $offset = $data->{'amount'};
1655 $offset = $amount - $data->{'amountoutstanding'};
1656 $amountleft = $data->{'amountoutstanding'} - $amount;
1658 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1659 WHERE (borrowernumber = ?)
1660 AND (itemnumber = ?) AND (accountno = ?) ");
1661 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1663 #check if any credit is left if so writeoff other accounts
1664 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1665 if ($amountleft < 0){
1668 if ($amountleft > 0){
1669 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1670 AND (amountoutstanding >0) ORDER BY date");
1671 $msth->execute($data->{'borrowernumber'});
1672 # offset transactions
1675 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1676 if ($accdata->{'amountoutstanding'} < $amountleft) {
1678 $amountleft -= $accdata->{'amountoutstanding'};
1680 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1683 my $thisacct = $accdata->{'accountno'};
1684 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1685 WHERE (borrowernumber = ?)
1686 AND (accountno=?)");
1687 $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1689 $usth = $dbh->prepare("INSERT INTO accountoffsets
1690 (borrowernumber, accountno, offsetaccount, offsetamount)
1693 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1698 if ($amountleft > 0){
1701 my $desc="Item Returned ".$iteminfo->{'barcode'};
1702 $usth = $dbh->prepare("INSERT INTO accountlines
1703 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1704 VALUES (?,?,now(),?,?,'CR',?)");
1705 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1707 $usth = $dbh->prepare("INSERT INTO accountoffsets
1708 (borrowernumber, accountno, offsetaccount, offsetamount)
1710 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1712 ModItem({ paidfor => '' }, undef, $itm);
1720 $issues = &GetItemIssue($itemnumber);
1722 Returns patrons currently having a book. nothing if item is not issued atm
1724 C<$itemnumber> is the itemnumber
1726 Returns an array of hashes
1728 FIXME: Though the above says that this function returns nothing if the
1729 item is not issued, this actually returns a hasref that looks like
1740 my ( $itemnumber) = @_;
1741 return unless $itemnumber;
1742 my $dbh = C4::Context->dbh;
1746 my $today = POSIX::strftime("%Y%m%d", localtime);
1748 my $sth = $dbh->prepare(
1749 "SELECT * FROM issues
1750 LEFT JOIN items ON issues.itemnumber=items.itemnumber
1752 issues.itemnumber=?");
1753 $sth->execute($itemnumber);
1754 my $data = $sth->fetchrow_hashref;
1755 my $datedue = $data->{'date_due'};
1757 if ( $datedue < $today ) {
1758 $data->{'overdue'} = 1;
1760 $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1767 $issue = GetOpenIssue( $itemnumber );
1769 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
1771 C<$itemnumber> is the item's itemnumber
1778 my ( $itemnumber ) = @_;
1780 my $dbh = C4::Context->dbh;
1781 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
1782 $sth->execute( $itemnumber );
1783 my $issue = $sth->fetchrow_hashref();
1787 =head2 GetItemIssues
1789 $issues = &GetItemIssues($itemnumber, $history);
1791 Returns patrons that have issued a book
1793 C<$itemnumber> is the itemnumber
1794 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1796 Returns an array of hashes
1801 my ( $itemnumber,$history ) = @_;
1802 my $dbh = C4::Context->dbh;
1806 my $today = POSIX::strftime("%Y%m%d", localtime);
1808 my $sql = "SELECT * FROM issues
1809 JOIN borrowers USING (borrowernumber)
1810 JOIN items USING (itemnumber)
1811 WHERE issues.itemnumber = ? ";
1814 SELECT * FROM old_issues
1815 LEFT JOIN borrowers USING (borrowernumber)
1816 JOIN items USING (itemnumber)
1817 WHERE old_issues.itemnumber = ? ";
1819 $sql .= "ORDER BY date_due DESC";
1820 my $sth = $dbh->prepare($sql);
1822 $sth->execute($itemnumber, $itemnumber);
1824 $sth->execute($itemnumber);
1826 while ( my $data = $sth->fetchrow_hashref ) {
1827 my $datedue = $data->{'date_due'};
1829 if ( $datedue < $today ) {
1830 $data->{'overdue'} = 1;
1832 my $itemnumber = $data->{'itemnumber'};
1833 push @GetItemIssues, $data;
1836 return ( \@GetItemIssues );
1839 =head2 GetBiblioIssues
1841 $issues = GetBiblioIssues($biblionumber);
1843 this function get all issues from a biblionumber.
1846 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1847 tables issues and the firstname,surname & cardnumber from borrowers.
1851 sub GetBiblioIssues {
1852 my $biblionumber = shift;
1853 return undef unless $biblionumber;
1854 my $dbh = C4::Context->dbh;
1856 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1858 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1859 LEFT JOIN items ON issues.itemnumber = items.itemnumber
1860 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1861 LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1862 WHERE biblio.biblionumber = ?
1864 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1866 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1867 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1868 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1869 LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1870 WHERE biblio.biblionumber = ?
1873 my $sth = $dbh->prepare($query);
1874 $sth->execute($biblionumber, $biblionumber);
1877 while ( my $data = $sth->fetchrow_hashref ) {
1878 push @issues, $data;
1883 =head2 GetUpcomingDueIssues
1887 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
1893 sub GetUpcomingDueIssues {
1896 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
1897 my $dbh = C4::Context->dbh;
1899 my $statement = <<END_SQL;
1900 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due
1902 LEFT JOIN items USING (itemnumber)
1903 WhERE returndate is NULL
1904 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
1907 my @bind_parameters = ( $params->{'days_in_advance'} );
1909 my $sth = $dbh->prepare( $statement );
1910 $sth->execute( @bind_parameters );
1911 my $upcoming_dues = $sth->fetchall_arrayref({});
1914 return $upcoming_dues;
1917 =head2 CanBookBeRenewed
1919 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber);
1921 Find out whether a borrowed item may be renewed.
1923 C<$dbh> is a DBI handle to the Koha database.
1925 C<$borrowernumber> is the borrower number of the patron who currently
1926 has the item on loan.
1928 C<$itemnumber> is the number of the item to renew.
1930 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1931 item must currently be on loan to the specified borrower; renewals
1932 must be allowed for the item's type; and the borrower must not have
1933 already renewed the loan. $error will contain the reason the renewal can not proceed
1937 sub CanBookBeRenewed {
1939 # check renewal status
1940 my ( $borrowernumber, $itemnumber ) = @_;
1941 my $dbh = C4::Context->dbh;
1946 # Look in the issues table for this item, lent to this borrower,
1947 # and not yet returned.
1949 # FIXME - I think this function could be redone to use only one SQL call.
1950 my $sth1 = $dbh->prepare(
1951 "SELECT * FROM issues
1952 WHERE borrowernumber = ?
1955 $sth1->execute( $borrowernumber, $itemnumber );
1956 if ( my $data1 = $sth1->fetchrow_hashref ) {
1958 # Found a matching item
1960 # See if this item may be renewed. This query is convoluted
1961 # because it's a bit messy: given the item number, we need to find
1962 # the biblioitem, which gives us the itemtype, which tells us
1963 # whether it may be renewed.
1964 my $query = "SELECT renewalsallowed FROM items ";
1965 $query .= (C4::Context->preference('item-level_itypes'))
1966 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1967 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1968 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1969 $query .= "WHERE items.itemnumber = ?";
1970 my $sth2 = $dbh->prepare($query);
1971 $sth2->execute($itemnumber);
1972 if ( my $data2 = $sth2->fetchrow_hashref ) {
1973 $renews = $data2->{'renewalsallowed'};
1975 if ( $renews && $renews > $data1->{'renewals'} ) {
1982 my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1990 return ($renewokay,$error);
1995 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue]);
1999 C<$borrowernumber> is the borrower number of the patron who currently
2002 C<$itemnumber> is the number of the item to renew.
2004 C<$branch> is the library branch. Defaults to the homebranch of the ITEM.
2006 C<$datedue> can be a C4::Dates object used to set the due date.
2008 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
2009 from the book's item type.
2014 my $borrowernumber = shift or return undef;
2015 my $itemnumber = shift or return undef;
2016 my $item = GetItem($itemnumber) or return undef;
2017 my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
2018 my $branch = (@_) ? shift : $item->{homebranch}; # opac-renew doesn't send branch
2020 # If the due date wasn't specified, calculate it by adding the
2021 # book's loan length to today's date.
2022 unless (@_ and $datedue = shift and $datedue->output('iso')) {
2024 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
2025 my $loanlength = GetLoanLength(
2026 $borrower->{'categorycode'},
2027 (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
2028 $item->{homebranch} # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument?
2030 #FIXME -- use circControl?
2031 $datedue = CalcDateDue(C4::Dates->new(),$loanlength,$branch); # this branch is the transactional branch.
2032 # The question of whether to use item's homebranch calendar is open.
2035 my $dbh = C4::Context->dbh;
2036 # Find the issues record for this book
2038 $dbh->prepare("SELECT * FROM issues
2039 WHERE borrowernumber=?
2042 $sth->execute( $borrowernumber, $itemnumber );
2043 my $issuedata = $sth->fetchrow_hashref;
2046 # Update the issues record to have the new due date, and a new count
2047 # of how many times it has been renewed.
2048 my $renews = $issuedata->{'renewals'} + 1;
2049 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = CURRENT_DATE
2050 WHERE borrowernumber=?
2053 $sth->execute( $datedue->output('iso'), $renews, $borrowernumber, $itemnumber );
2056 # Update the renewal count on the item, and tell zebra to reindex
2057 $renews = $biblio->{'renewals'} + 1;
2058 ModItem({ renewals => $renews }, $biblio->{'biblionumber'}, $itemnumber);
2060 # Charge a new rental fee, if applicable?
2061 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2062 if ( $charge > 0 ) {
2063 my $accountno = getnextacctno( $borrowernumber );
2064 my $item = GetBiblioFromItemNumber($itemnumber);
2065 $sth = $dbh->prepare(
2066 "INSERT INTO accountlines
2068 borrowernumber, accountno, amount,
2070 accounttype, amountoutstanding, itemnumber
2072 VALUES (now(),?,?,?,?,?,?,?)"
2074 $sth->execute( $borrowernumber, $accountno, $charge,
2075 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2076 'Rent', $charge, $itemnumber );
2080 UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2086 ForRenewal( $itemnumber, $date, $date_due );
2088 Renews an item for the given date. This function should only be used to update renewals that have occurred in the past.
2090 C<$itemnumber> is the itemnumber of the item being renewed.
2092 C<$date> is the date the renewal took place, in the format YYYY-MM-DD
2094 C<$date_due> is the date the item is now due to be returned, in the format YYYY-MM-DD
2099 my ( $itemnumber, $date, $date_due ) = @_;
2100 my $dbh = C4::Context->dbh;
2102 my $sth = $dbh->prepare("SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL");
2103 $sth->execute( $itemnumber );
2104 my $issue = $sth->fetchrow_hashref();
2108 $sth = $dbh->prepare('UPDATE issues SET renewals = ?, lastreneweddate = ?, date_due = ? WHERE itemnumber = ? AND returndate IS NULL');
2109 $sth->execute( $issue->{'renewals'} + 1, $date, $date_due, $itemnumber );
2112 my $item = GetBiblioFromItemNumber( $itemnumber );
2113 UpdateStats( $issue->{'branchcode'}, 'renew', undef, undef, $itemnumber, $item->{ 'itemtype' }, $issue->{'borrowernumber'} );
2118 # check renewal status
2119 my ($bornum,$itemno)=@_;
2120 my $dbh = C4::Context->dbh;
2122 my $renewsallowed = 0;
2124 # Look in the issues table for this item, lent to this borrower,
2125 # and not yet returned.
2127 # FIXME - I think this function could be redone to use only one SQL call.
2128 my $sth = $dbh->prepare("select * from issues
2129 where (borrowernumber = ?)
2130 and (itemnumber = ?)");
2131 $sth->execute($bornum,$itemno);
2132 my $data = $sth->fetchrow_hashref;
2133 $renewcount = $data->{'renewals'} if $data->{'renewals'};
2135 my $query = "SELECT renewalsallowed FROM items ";
2136 $query .= (C4::Context->preference('item-level_itypes'))
2137 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2138 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
2139 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2140 $query .= "WHERE items.itemnumber = ?";
2141 my $sth2 = $dbh->prepare($query);
2142 $sth2->execute($itemno);
2143 my $data2 = $sth2->fetchrow_hashref();
2144 $renewsallowed = $data2->{'renewalsallowed'};
2145 $renewsleft = $renewsallowed - $renewcount;
2146 return ($renewcount,$renewsallowed,$renewsleft);
2149 =head2 GetIssuingCharges
2151 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2153 Calculate how much it would cost for a given patron to borrow a given
2154 item, including any applicable discounts.
2156 C<$itemnumber> is the item number of item the patron wishes to borrow.
2158 C<$borrowernumber> is the patron's borrower number.
2160 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2161 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2166 sub GetIssuingCharges {
2168 # calculate charges due
2169 my ( $itemnumber, $borrowernumber ) = @_;
2171 my $dbh = C4::Context->dbh;
2174 # Get the book's item type and rental charge (via its biblioitem).
2175 my $qcharge = "SELECT itemtypes.itemtype,rentalcharge FROM items
2176 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
2177 $qcharge .= (C4::Context->preference('item-level_itypes'))
2178 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2179 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2181 $qcharge .= "WHERE items.itemnumber =?";
2183 my $sth1 = $dbh->prepare($qcharge);
2184 $sth1->execute($itemnumber);
2185 if ( my $data1 = $sth1->fetchrow_hashref ) {
2186 $item_type = $data1->{'itemtype'};
2187 $charge = $data1->{'rentalcharge'};
2188 my $q2 = "SELECT rentaldiscount FROM borrowers
2189 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2190 WHERE borrowers.borrowernumber = ?
2191 AND issuingrules.itemtype = ?";
2192 my $sth2 = $dbh->prepare($q2);
2193 $sth2->execute( $borrowernumber, $item_type );
2194 if ( my $data2 = $sth2->fetchrow_hashref ) {
2195 my $discount = $data2->{'rentaldiscount'};
2196 if ( $discount eq 'NULL' ) {
2199 $charge = ( $charge * ( 100 - $discount ) ) / 100;
2205 return ( $charge, $item_type );
2208 =head2 AddIssuingCharge
2210 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2214 sub AddIssuingCharge {
2215 my ( $itemnumber, $borrowernumber, $charge ) = @_;
2216 my $dbh = C4::Context->dbh;
2217 my $nextaccntno = getnextacctno( $borrowernumber );
2219 INSERT INTO accountlines
2220 (borrowernumber, itemnumber, accountno,
2221 date, amount, description, accounttype,
2223 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
2225 my $sth = $dbh->prepare($query);
2226 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
2232 GetTransfers($itemnumber);
2237 my ($itemnumber) = @_;
2239 my $dbh = C4::Context->dbh;
2245 FROM branchtransfers
2246 WHERE itemnumber = ?
2247 AND datearrived IS NULL
2249 my $sth = $dbh->prepare($query);
2250 $sth->execute($itemnumber);
2251 my @row = $sth->fetchrow_array();
2257 =head2 GetTransfersFromTo
2259 @results = GetTransfersFromTo($frombranch,$tobranch);
2261 Returns the list of pending transfers between $from and $to branch
2265 sub GetTransfersFromTo {
2266 my ( $frombranch, $tobranch ) = @_;
2267 return unless ( $frombranch && $tobranch );
2268 my $dbh = C4::Context->dbh;
2270 SELECT itemnumber,datesent,frombranch
2271 FROM branchtransfers
2274 AND datearrived IS NULL
2276 my $sth = $dbh->prepare($query);
2277 $sth->execute( $frombranch, $tobranch );
2280 while ( my $data = $sth->fetchrow_hashref ) {
2281 push @gettransfers, $data;
2284 return (@gettransfers);
2287 =head2 DeleteTransfer
2289 &DeleteTransfer($itemnumber);
2293 sub DeleteTransfer {
2294 my ($itemnumber) = @_;
2295 my $dbh = C4::Context->dbh;
2296 my $sth = $dbh->prepare(
2297 "DELETE FROM branchtransfers
2299 AND datearrived IS NULL "
2301 $sth->execute($itemnumber);
2305 =head2 AnonymiseIssueHistory
2307 $rows = AnonymiseIssueHistory($borrowernumber,$date)
2309 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2310 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2312 return the number of affected rows.
2316 sub AnonymiseIssueHistory {
2318 my $borrowernumber = shift;
2319 my $dbh = C4::Context->dbh;
2322 SET borrowernumber = NULL
2323 WHERE returndate < '".$date."'
2324 AND borrowernumber IS NOT NULL
2326 $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2327 my $rows_affected = $dbh->do($query);
2328 return $rows_affected;
2331 =head2 updateWrongTransfer
2333 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2335 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
2339 sub updateWrongTransfer {
2340 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2341 my $dbh = C4::Context->dbh;
2342 # first step validate the actual line of transfert .
2345 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2347 $sth->execute($FromLibrary,$itemNumber);
2350 # second step create a new line of branchtransfer to the right location .
2351 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2353 #third step changing holdingbranch of item
2354 UpdateHoldingbranch($FromLibrary,$itemNumber);
2357 =head2 UpdateHoldingbranch
2359 $items = UpdateHoldingbranch($branch,$itmenumber);
2360 Simple methode for updating hodlingbranch in items BDD line
2364 sub UpdateHoldingbranch {
2365 my ( $branch,$itemnumber ) = @_;
2366 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2371 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2372 this function calculates the due date given the loan length ,
2373 checking against the holidays calendar as per the 'useDaysMode' syspref.
2374 C<$startdate> = C4::Dates object representing start date of loan period (assumed to be today)
2375 C<$branch> = location whose calendar to use
2376 C<$loanlength> = loan length prior to adjustment
2380 my ($startdate,$loanlength,$branch) = @_;
2381 if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar
2382 my $datedue = time + ($loanlength) * 86400;
2383 #FIXME - assumes now even though we take a startdate
2384 my @datearr = localtime($datedue);
2385 return C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2387 my $calendar = C4::Calendar->new( branchcode => $branch );
2388 my $datedue = $calendar->addDate($startdate, $loanlength);
2393 =head2 CheckValidDatedue
2394 This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2395 To be replaced by CalcDateDue() once C4::Calendar use is tested.
2397 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2398 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2399 C<$date_due> = returndate calculate with no day check
2400 C<$itemnumber> = itemnumber
2401 C<$branchcode> = location of issue (affected by 'CircControl' syspref)
2402 C<$loanlength> = loan length prior to adjustment
2405 sub CheckValidDatedue {
2406 my ($date_due,$itemnumber,$branchcode)=@_;
2407 my @datedue=split('-',$date_due->output('iso'));
2408 my $years=$datedue[0];
2409 my $month=$datedue[1];
2410 my $day=$datedue[2];
2411 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2413 for (my $i=0;$i<2;$i++){
2414 $dow=Day_of_Week($years,$month,$day);
2415 ($dow=0) if ($dow>6);
2416 my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2417 my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2418 my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2419 if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2421 (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2424 my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2429 =head2 CheckRepeatableHolidays
2431 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2432 this function checks if the date due is a repeatable holiday
2433 C<$date_due> = returndate calculate with no day check
2434 C<$itemnumber> = itemnumber
2435 C<$branchcode> = localisation of issue
2439 sub CheckRepeatableHolidays{
2440 my($itemnumber,$week_day,$branchcode)=@_;
2441 my $dbh = C4::Context->dbh;
2442 my $query = qq|SELECT count(*)
2443 FROM repeatable_holidays
2446 my $sth = $dbh->prepare($query);
2447 $sth->execute($branchcode,$week_day);
2448 my $result=$sth->fetchrow;
2454 =head2 CheckSpecialHolidays
2456 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2457 this function check if the date is a special holiday
2458 C<$years> = the years of datedue
2459 C<$month> = the month of datedue
2460 C<$day> = the day of datedue
2461 C<$itemnumber> = itemnumber
2462 C<$branchcode> = localisation of issue
2466 sub CheckSpecialHolidays{
2467 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2468 my $dbh = C4::Context->dbh;
2469 my $query=qq|SELECT count(*)
2470 FROM `special_holidays`
2476 my $sth = $dbh->prepare($query);
2477 $sth->execute($years,$month,$day,$branchcode);
2478 my $countspecial=$sth->fetchrow ;
2480 return $countspecial;
2483 =head2 CheckRepeatableSpecialHolidays
2485 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2486 this function check if the date is a repeatble special holidays
2487 C<$month> = the month of datedue
2488 C<$day> = the day of datedue
2489 C<$itemnumber> = itemnumber
2490 C<$branchcode> = localisation of issue
2494 sub CheckRepeatableSpecialHolidays{
2495 my ($month,$day,$itemnumber,$branchcode) = @_;
2496 my $dbh = C4::Context->dbh;
2497 my $query=qq|SELECT count(*)
2498 FROM `repeatable_holidays`
2503 my $sth = $dbh->prepare($query);
2504 $sth->execute($month,$day,$branchcode);
2505 my $countspecial=$sth->fetchrow ;
2507 return $countspecial;
2512 sub CheckValidBarcode{
2514 my $dbh = C4::Context->dbh;
2515 my $query=qq|SELECT count(*)
2519 my $sth = $dbh->prepare($query);
2520 $sth->execute($barcode);
2521 my $exist=$sth->fetchrow ;
2532 Koha Developement team <info@koha.org>