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 );
313 =head2 CanBookBeIssued
315 Check if a book can be issued.
317 my ($issuingimpossible,$needsconfirmation) = CanBookBeIssued($borrower,$barcode,$year,$month,$day);
321 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
323 =item C<$barcode> is the bar code of the book being issued.
325 =item C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate".
333 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
334 Possible values are :
340 sticky due date is invalid
344 borrower gone with no address
348 borrower declared it's card lost
354 =head3 UNKNOWN_BARCODE
368 item is restricted (set by ??)
370 C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
371 Possible values are :
379 renewing, not issuing
381 =head3 ISSUED_TO_ANOTHER
383 issued to someone else.
387 reserved for someone else.
391 sticky due date is invalid
395 if the borrower borrows to much things
399 # check if a book can be issued.
403 my $borrower = shift;
404 my $biblionumber = shift;
406 my $cat_borrower = $borrower->{'categorycode'};
407 my $dbh = C4::Context->dbh;
409 # Get which branchcode we need
410 if (C4::Context->preference('CircControl') eq 'PickupLibrary'){
411 $branch = C4::Context->userenv->{'branch'};
413 elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){
414 $branch = $borrower->{'branchcode'};
418 $branch = $item->{'homebranch'};
420 my $type = (C4::Context->preference('item-level_itypes'))
421 ? $item->{'itype'} # item-level
422 : $item->{'itemtype'}; # biblio-level
424 # given branch, patron category, and item type, determine
425 # applicable issuing rule
426 my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch);
428 # if a rule is found and has a loan limit set, count
429 # how many loans the patron already has that meet that
431 if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) {
433 my $count_query = "SELECT COUNT(*) FROM issues
434 JOIN items USING (itemnumber) ";
436 my $rule_itemtype = $issuing_rule->{itemtype};
437 if ($rule_itemtype eq "*") {
438 # matching rule has the default item type, so count only
439 # those existing loans that don't fall under a more
441 if (C4::Context->preference('item-level_itypes')) {
442 $count_query .= " WHERE items.itype NOT IN (
443 SELECT itemtype FROM issuingrules
445 AND (categorycode = ? OR categorycode = ?)
449 $count_query .= " JOIN biblioitems USING (biblionumber)
450 WHERE biblioitems.itemtype NOT IN (
451 SELECT itemtype FROM issuingrules
453 AND (categorycode = ? OR categorycode = ?)
457 push @bind_params, $issuing_rule->{branchcode};
458 push @bind_params, $issuing_rule->{categorycode};
459 push @bind_params, $cat_borrower;
461 # rule has specific item type, so count loans of that
463 if (C4::Context->preference('item-level_itypes')) {
464 $count_query .= " WHERE items.itype = ? ";
466 $count_query .= " JOIN biblioitems USING (biblionumber)
467 WHERE biblioitems.itemtype= ? ";
469 push @bind_params, $type;
472 $count_query .= " AND borrowernumber = ? ";
473 push @bind_params, $borrower->{'borrowernumber'};
474 my $rule_branch = $issuing_rule->{branchcode};
475 if ($rule_branch ne "*") {
476 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
477 $count_query .= " AND issues.branchcode = ? ";
478 push @bind_params, $branch;
479 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
480 ; # if branch is the patron's home branch, then count all loans by patron
482 $count_query .= " AND items.homebranch = ? ";
483 push @bind_params, $branch;
487 my $count_sth = $dbh->prepare($count_query);
488 $count_sth->execute(@bind_params);
489 my ($current_loan_count) = $count_sth->fetchrow_array;
491 my $max_loans_allowed = $issuing_rule->{'maxissueqty'};
492 if ($current_loan_count >= $max_loans_allowed) {
493 return "$current_loan_count / $max_loans_allowed";
497 # Now count total loans against the limit for the branch
498 my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower);
499 if (defined($branch_borrower_circ_rule->{maxissueqty})) {
500 my @bind_params = ();
501 my $branch_count_query = "SELECT COUNT(*) FROM issues
502 JOIN items USING (itemnumber)
503 WHERE borrowernumber = ? ";
504 push @bind_params, $borrower->{borrowernumber};
506 if (C4::Context->preference('CircControl') eq 'PickupLibrary') {
507 $branch_count_query .= " AND issues.branchcode = ? ";
508 push @bind_params, $branch;
509 } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') {
510 ; # if branch is the patron's home branch, then count all loans by patron
512 $branch_count_query .= " AND items.homebranch = ? ";
513 push @bind_params, $branch;
515 my $branch_count_sth = $dbh->prepare($branch_count_query);
516 $branch_count_sth->execute(@bind_params);
517 my ($current_loan_count) = $branch_count_sth->fetchrow_array;
519 my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty};
520 if ($current_loan_count >= $max_loans_allowed) {
521 return "$current_loan_count / $max_loans_allowed";
525 # OK, the patron can issue !!!
531 @issues = &itemissues($biblioitemnumber, $biblio);
533 Looks up information about who has borrowed the bookZ<>(s) with the
534 given biblioitemnumber.
536 C<$biblio> is ignored.
538 C<&itemissues> returns an array of references-to-hash. The keys
539 include the fields from the C<items> table in the Koha database.
540 Additional keys include:
546 If the item is currently on loan, this gives the due date.
548 If the item is not on loan, then this is either "Available" or
549 "Cancelled", if the item has been withdrawn.
553 If the item is currently on loan, this gives the card number of the
554 patron who currently has the item.
556 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
558 These give the timestamp for the last three times the item was
561 =item C<card0>, C<card1>, C<card2>
563 The card number of the last three patrons who borrowed this item.
565 =item C<borrower0>, C<borrower1>, C<borrower2>
567 The borrower number of the last three patrons who borrowed this item.
575 my ( $bibitem, $biblio ) = @_;
576 my $dbh = C4::Context->dbh;
578 $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
583 $sth->execute($bibitem) || die $sth->errstr;
585 while ( my $data = $sth->fetchrow_hashref ) {
587 # Find out who currently has this item.
588 # FIXME - Wouldn't it be better to do this as a left join of
589 # some sort? Currently, this code assumes that if
590 # fetchrow_hashref() fails, then the book is on the shelf.
591 # fetchrow_hashref() can fail for any number of reasons (e.g.,
592 # database server crash), not just because no items match the
594 my $sth2 = $dbh->prepare(
595 "SELECT * FROM issues
596 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
601 $sth2->execute( $data->{'itemnumber'} );
602 if ( my $data2 = $sth2->fetchrow_hashref ) {
603 $data->{'date_due'} = $data2->{'date_due'};
604 $data->{'card'} = $data2->{'cardnumber'};
605 $data->{'borrower'} = $data2->{'borrowernumber'};
608 $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available';
613 # Find the last 3 people who borrowed this item.
614 $sth2 = $dbh->prepare(
615 "SELECT * FROM old_issues
616 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
618 ORDER BY returndate DESC,timestamp DESC"
621 $sth2->execute( $data->{'itemnumber'} );
622 for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
623 { # FIXME : error if there is less than 3 pple borrowing this item
624 if ( my $data2 = $sth2->fetchrow_hashref ) {
625 $data->{"timestamp$i2"} = $data2->{'timestamp'};
626 $data->{"card$i2"} = $data2->{'cardnumber'};
627 $data->{"borrower$i2"} = $data2->{'borrowernumber'};
632 $results[$i] = $data;
640 =head2 CanBookBeIssued
642 ( $issuingimpossible, $needsconfirmation ) =
643 CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess );
644 C<$duedatespec> is a C4::Dates object.
645 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
649 sub CanBookBeIssued {
650 my ( $borrower, $barcode, $duedate, $inprocess ) = @_;
651 my %needsconfirmation; # filled with problems that needs confirmations
652 my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
653 my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
654 my $issue = GetItemIssue($item->{itemnumber});
655 my $biblioitem = GetBiblioItemData($item->{biblioitemnumber});
656 $item->{'itemtype'}=$item->{'itype'};
657 my $dbh = C4::Context->dbh;
660 # DUE DATE is OK ? -- should already have checked.
662 #$issuingimpossible{INVALID_DATE} = 1 unless ($duedate);
667 if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) {
668 # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 .
669 &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'});
670 return( { STATS => 1 }, {});
672 if ( $borrower->{flags}->{GNA} ) {
673 $issuingimpossible{GNA} = 1;
675 if ( $borrower->{flags}->{'LOST'} ) {
676 $issuingimpossible{CARD_LOST} = 1;
678 if ( $borrower->{flags}->{'DBARRED'} ) {
679 $issuingimpossible{DEBARRED} = 1;
681 if ( $borrower->{'dateexpiry'} eq '0000-00-00') {
682 $issuingimpossible{EXPIRED} = 1;
684 my @expirydate= split /-/,$borrower->{'dateexpiry'};
685 if($expirydate[0]==0 || $expirydate[1]==0|| $expirydate[2]==0 ||
686 Date_to_Days(Today) > Date_to_Days( @expirydate )) {
687 $issuingimpossible{EXPIRED} = 1;
696 C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->output('iso') );
697 if ( C4::Context->preference("IssuingInProcess") ) {
698 my $amountlimit = C4::Context->preference("noissuescharge");
699 if ( $amount > $amountlimit && !$inprocess ) {
700 $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
702 elsif ( $amount <= $amountlimit && !$inprocess ) {
703 $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
708 $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
713 # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
715 my $toomany = TooMany( $borrower, $item->{biblionumber}, $item );
716 $needsconfirmation{TOO_MANY} = $toomany if $toomany;
721 unless ( $item->{barcode} ) {
722 $issuingimpossible{UNKNOWN_BARCODE} = 1;
724 if ( $item->{'notforloan'}
725 && $item->{'notforloan'} > 0 )
727 $issuingimpossible{NOT_FOR_LOAN} = 1;
729 elsif ( !$item->{'notforloan'} ){
730 # we have to check itemtypes.notforloan also
731 if (C4::Context->preference('item-level_itypes')){
732 # this should probably be a subroutine
733 my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?");
734 $sth->execute($item->{'itemtype'});
735 my $notforloan=$sth->fetchrow_hashref();
737 if ($notforloan->{'notforloan'} == 1){
738 $issuingimpossible{NOT_FOR_LOAN} = 1;
741 elsif ($biblioitem->{'notforloan'} == 1){
742 $issuingimpossible{NOT_FOR_LOAN} = 1;
745 if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
747 $issuingimpossible{WTHDRAWN} = 1;
749 if ( $item->{'restricted'}
750 && $item->{'restricted'} == 1 )
752 $issuingimpossible{RESTRICTED} = 1;
754 if ( C4::Context->preference("IndependantBranches") ) {
755 my $userenv = C4::Context->userenv;
756 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
757 $issuingimpossible{NOTSAMEBRANCH} = 1
758 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} );
763 # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
765 if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
768 # Already issued to current borrower. Ask whether the loan should
770 my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed(
771 $borrower->{'borrowernumber'},
772 $item->{'itemnumber'}
774 if ( $CanBookBeRenewed == 0 ) { # no more renewals allowed
775 $issuingimpossible{NO_MORE_RENEWALS} = 1;
778 $needsconfirmation{RENEW_ISSUE} = 1;
781 elsif ($issue->{borrowernumber}) {
783 # issued to someone else
784 my $currborinfo = GetMemberDetails( $issue->{borrowernumber} );
786 # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
787 $needsconfirmation{ISSUED_TO_ANOTHER} =
788 "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
791 # See if the item is on reserve.
792 my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} );
794 my $resbor = $res->{'borrowernumber'};
795 my ( $resborrower ) = GetMemberDetails( $resbor, 0 );
796 my $branches = GetBranches();
797 my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
798 if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
800 # The item is on reserve and waiting, but has been
801 # reserved by some other patron.
802 $needsconfirmation{RESERVE_WAITING} =
803 "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
805 elsif ( $restype eq "Reserved" ) {
806 # The item is on reserve for someone else.
807 $needsconfirmation{RESERVED} =
808 "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
811 if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" ) {
812 if ( $borrower->{'categorycode'} eq 'W' ) {
814 return ( \%emptyhash, \%needsconfirmation );
817 return ( \%issuingimpossible, \%needsconfirmation );
822 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
824 &AddIssue($borrower,$barcode,$date)
828 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
830 =item C<$barcode> is the bar code of the book being issued.
832 =item C<$date> contains the max date of return. calculated if empty.
834 AddIssue does the following things :
835 - step 01: check that there is a borrowernumber & a barcode provided
836 - check for RENEWAL (book issued & being issued to the same patron)
837 - renewal YES = Calculate Charge & renew
839 * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
841 - fill reserve if reserve to this patron
842 - cancel reserve or not, otherwise
843 * TRANSFERT PENDING ?
844 - complete the transfert
852 my ( $borrower, $barcode, $date, $cancelreserve ) = @_;
853 my $dbh = C4::Context->dbh;
854 my $barcodecheck=CheckValidBarcode($barcode);
855 if ($borrower and $barcode and $barcodecheck ne '0'){
856 # find which item we issue
857 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'} ) {
883 $borrower->{'borrowernumber'},
884 $item->{'itemnumber'},
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)
967 my $itype=(C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ;
968 my $loanlength = GetLoanLength(
969 $borrower->{'categorycode'},
973 $dateduef = CalcDateDue(C4::Dates->new(),$loanlength,$branch);
974 # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
975 if ( C4::Context->preference('ReturnBeforeExpiry') && $dateduef->output('iso') gt $borrower->{dateexpiry} ) {
976 $dateduef = C4::Dates->new($borrower->{dateexpiry},'iso');
980 $borrower->{'borrowernumber'},
981 $item->{'itemnumber'},
982 strftime( "%Y-%m-%d", localtime ),$dateduef->output('iso'), C4::Context->userenv->{'branch'}
986 ModItem({ issues => $item->{'issues'},
987 holdingbranch => C4::Context->userenv->{'branch'},
989 datelastborrowed => C4::Dates->new()->output('iso'),
990 onloan => $dateduef->output('iso'),
991 }, $item->{'biblionumber'}, $item->{'itemnumber'});
992 ModDateLastSeen( $item->{'itemnumber'} );
994 # If it costs to borrow this book, charge it to the patron's account.
995 my ( $charge, $itemtype ) = GetIssuingCharges(
996 $item->{'itemnumber'},
997 $borrower->{'borrowernumber'}
1001 $item->{'itemnumber'},
1002 $borrower->{'borrowernumber'}, $charge
1004 $item->{'charge'} = $charge;
1007 # Record the fact that this book was issued.
1009 C4::Context->userenv->{'branch'},
1011 '', $item->{'itemnumber'},
1012 $item->{'itype'}, $borrower->{'borrowernumber'}
1016 logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'})
1017 if C4::Context->preference("IssueLog");
1026 Issues an item to a member, ignoring any problems that would normally dissallow the issue.
1031 my ( $borrowernumber, $itemnumber, $date_due, $branchcode, $date ) = @_;
1032 warn "ForceIssue( $borrowernumber, $itemnumber, $date_due, $branchcode, $date );";
1033 my $dbh = C4::Context->dbh;
1034 my $sth = $dbh->prepare( "INSERT INTO `issues` ( `borrowernumber`, `itemnumber`, `date_due`, `branchcode`, `issuingbranch`, `returndate`, `lastreneweddate`, `return`, `renewals`, `timestamp`, `issuedate` )
1035 VALUES ( ?, ?, ?, ?, ?, NULL, NULL, NULL, NULL, NOW(), ? )" );
1036 $sth->execute( $borrowernumber, $itemnumber, $date_due, $branchcode, $branchcode, $date );
1039 my $item = GetBiblioFromItemNumber( $itemnumber );
1041 UpdateStats( $branchcode, 'issue', undef, undef, $itemnumber, $item->{ 'itemtype' }, $borrowernumber );
1045 =head2 GetLoanLength
1047 Get loan length for an itemtype, a borrower type and a branch
1049 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1054 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1055 my $dbh = C4::Context->dbh;
1058 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null"
1060 # warn "in get loan lenght $borrowertype $itemtype $branchcode ";
1061 # try to find issuelength & return the 1st available.
1062 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1063 $sth->execute( $borrowertype, $itemtype, $branchcode );
1064 my $loanlength = $sth->fetchrow_hashref;
1065 return $loanlength->{issuelength}
1066 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1068 $sth->execute( $borrowertype, "*", $branchcode );
1069 $loanlength = $sth->fetchrow_hashref;
1070 return $loanlength->{issuelength}
1071 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1073 $sth->execute( "*", $itemtype, $branchcode );
1074 $loanlength = $sth->fetchrow_hashref;
1075 return $loanlength->{issuelength}
1076 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1078 $sth->execute( "*", "*", $branchcode );
1079 $loanlength = $sth->fetchrow_hashref;
1080 return $loanlength->{issuelength}
1081 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1083 $sth->execute( $borrowertype, $itemtype, "*" );
1084 $loanlength = $sth->fetchrow_hashref;
1085 return $loanlength->{issuelength}
1086 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1088 $sth->execute( $borrowertype, "*", "*" );
1089 $loanlength = $sth->fetchrow_hashref;
1090 return $loanlength->{issuelength}
1091 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1093 $sth->execute( "*", $itemtype, "*" );
1094 $loanlength = $sth->fetchrow_hashref;
1095 return $loanlength->{issuelength}
1096 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1098 $sth->execute( "*", "*", "*" );
1099 $loanlength = $sth->fetchrow_hashref;
1100 return $loanlength->{issuelength}
1101 if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1103 # if no rule is set => 21 days (hardcoded)
1107 =head2 GetIssuingRule
1109 FIXME - This is a copy-paste of GetLoanLength
1110 as a stop-gap. Do not wish to change API for GetLoanLength
1111 this close to release, however, Overdues::GetIssuingRules is broken.
1113 Get the issuing rule for an itemtype, a borrower type and a branch
1114 Returns a hashref from the issuingrules table.
1116 my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode)
1120 sub GetIssuingRule {
1121 my ( $borrowertype, $itemtype, $branchcode ) = @_;
1122 my $dbh = C4::Context->dbh;
1123 my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null" );
1126 $sth->execute( $borrowertype, $itemtype, $branchcode );
1127 $irule = $sth->fetchrow_hashref;
1128 return $irule if defined($irule) ;
1130 $sth->execute( $borrowertype, "*", $branchcode );
1131 $irule = $sth->fetchrow_hashref;
1132 return $irule if defined($irule) ;
1134 $sth->execute( "*", $itemtype, $branchcode );
1135 $irule = $sth->fetchrow_hashref;
1136 return $irule if defined($irule) ;
1138 $sth->execute( "*", "*", $branchcode );
1139 $irule = $sth->fetchrow_hashref;
1140 return $irule if defined($irule) ;
1142 $sth->execute( $borrowertype, $itemtype, "*" );
1143 $irule = $sth->fetchrow_hashref;
1144 return $irule if defined($irule) ;
1146 $sth->execute( $borrowertype, "*", "*" );
1147 $irule = $sth->fetchrow_hashref;
1148 return $irule if defined($irule) ;
1150 $sth->execute( "*", $itemtype, "*" );
1151 $irule = $sth->fetchrow_hashref;
1152 return $irule if defined($irule) ;
1154 $sth->execute( "*", "*", "*" );
1155 $irule = $sth->fetchrow_hashref;
1156 return $irule if defined($irule) ;
1158 # if no rule matches,
1162 =head2 GetBranchBorrowerCircRule
1166 my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode);
1170 Retrieves circulation rule attributes that apply to the given
1171 branch and patron category, regardless of item type.
1172 The return value is a hashref containing the following key:
1174 maxissueqty - maximum number of loans that a
1175 patron of the given category can have at the given
1176 branch. If the value is undef, no limit.
1178 This will first check for a specific branch and
1179 category match from branch_borrower_circ_rules.
1181 If no rule is found, it will then check default_branch_circ_rules
1182 (same branch, default category). If no rule is found,
1183 it will then check default_borrower_circ_rules (default
1184 branch, same category), then failing that, default_circ_rules
1185 (default branch, default category).
1187 If no rule has been found in the database, it will default to
1192 C<$branchcode> and C<$categorycode> should contain the
1193 literal branch code and patron category code, respectively - no
1198 sub GetBranchBorrowerCircRule {
1199 my $branchcode = shift;
1200 my $categorycode = shift;
1202 my $branch_cat_query = "SELECT maxissueqty
1203 FROM branch_borrower_circ_rules
1204 WHERE branchcode = ?
1205 AND categorycode = ?";
1206 my $dbh = C4::Context->dbh();
1207 my $sth = $dbh->prepare($branch_cat_query);
1208 $sth->execute($branchcode, $categorycode);
1210 if ($result = $sth->fetchrow_hashref()) {
1214 # try same branch, default borrower category
1215 my $branch_query = "SELECT maxissueqty
1216 FROM default_branch_circ_rules
1217 WHERE branchcode = ?";
1218 $sth = $dbh->prepare($branch_query);
1219 $sth->execute($branchcode);
1220 if ($result = $sth->fetchrow_hashref()) {
1224 # try default branch, same borrower category
1225 my $category_query = "SELECT maxissueqty
1226 FROM default_borrower_circ_rules
1227 WHERE categorycode = ?";
1228 $sth = $dbh->prepare($category_query);
1229 $sth->execute($categorycode);
1230 if ($result = $sth->fetchrow_hashref()) {
1234 # try default branch, default borrower category
1235 my $default_query = "SELECT maxissueqty
1236 FROM default_circ_rules";
1237 $sth = $dbh->prepare($default_query);
1239 if ($result = $sth->fetchrow_hashref()) {
1243 # built-in default circulation rule
1245 maxissueqty => undef,
1251 ($doreturn, $messages, $iteminformation, $borrower) =
1252 &AddReturn($barcode, $branch, $exemptfine, $dropbox);
1256 C<$barcode> is the bar code of the book being returned. C<$branch> is
1257 the code of the branch where the book is being returned. C<$exemptfine>
1258 indicates that overdue charges for the item will be removed. C<$dropbox>
1259 indicates that the check-in date is assumed to be yesterday, or the last
1260 non-holiday as defined in C4::Calendar . If overdue
1261 charges are applied and C<$dropbox> is true, the last charge will be removed.
1262 This assumes that the fines accrual script has run for _today_.
1264 C<&AddReturn> returns a list of four items:
1266 C<$doreturn> is true iff the return succeeded.
1268 C<$messages> is a reference-to-hash giving the reason for failure:
1274 No item with this barcode exists. The value is C<$barcode>.
1278 The book is not currently on loan. The value is C<$barcode>.
1280 =item C<IsPermanent>
1282 The book's home branch is a permanent collection. If you have borrowed
1283 this book, you are not allowed to return it. The value is the code for
1284 the book's home branch.
1288 This book has been withdrawn/cancelled. The value should be ignored.
1292 The item was reserved. The value is a reference-to-hash whose keys are
1293 fields from the reserves table of the Koha database, and
1294 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1295 either C<Waiting>, C<Reserved>, or 0.
1299 C<$borrower> is a reference-to-hash, giving information about the
1300 patron who last borrowed the book.
1305 my ( $barcode, $branch, $exemptfine, $dropbox ) = @_;
1306 my $dbh = C4::Context->dbh;
1310 my $validTransfert = 0;
1311 my $reserveDone = 0;
1313 # get information on item
1314 my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
1315 my $biblio = GetBiblioItemData($iteminformation->{'biblioitemnumber'});
1316 # use Data::Dumper;warn Data::Dumper::Dumper($iteminformation);
1317 unless ($iteminformation->{'itemnumber'} ) {
1318 $messages->{'BadBarcode'} = $barcode;
1322 if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1323 $messages->{'NotIssued'} = $barcode;
1324 # even though item is not on loan, it may still
1325 # be transferred; therefore, get current branch information
1326 my $curr_iteminfo = GetItem($iteminformation->{'itemnumber'});
1327 $iteminformation->{'homebranch'} = $curr_iteminfo->{'homebranch'};
1328 $iteminformation->{'holdingbranch'} = $curr_iteminfo->{'holdingbranch'};
1332 # check if the book is in a permanent collection....
1333 my $hbr = $iteminformation->{C4::Context->preference("HomeOrHoldingBranch")};
1334 my $branches = GetBranches();
1335 # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality.
1336 if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1337 $messages->{'IsPermanent'} = $hbr;
1340 # if independent branches are on and returning to different branch, refuse the return
1341 if ($hbr ne C4::Context->userenv->{'branch'} && C4::Context->preference("IndependantBranches")){
1342 $messages->{'Wrongbranch'} = 1;
1346 # check that the book has been cancelled
1347 if ( $iteminformation->{'wthdrawn'} ) {
1348 $messages->{'wthdrawn'} = 1;
1352 # new op dev : if the book returned in an other branch update the holding branch
1354 # update issues, thereby returning book (should push this out into another subroutine
1355 $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1357 # case of a return of document (deal with issues and holdingbranch)
1360 my $circControlBranch;
1362 # don't allow dropbox mode to create an invalid entry in issues (issuedate > returndate) FIXME: actually checks eq, not gt
1363 undef($dropbox) if ( $iteminformation->{'issuedate'} eq C4::Dates->today('iso') );
1364 if (C4::Context->preference('CircControl') eq 'ItemHomeBranch' ) {
1365 $circControlBranch = $iteminformation->{homebranch};
1366 } elsif ( C4::Context->preference('CircControl') eq 'PatronLibrary') {
1367 $circControlBranch = $borrower->{branchcode};
1368 } else { # CircControl must be PickupLibrary.
1369 $circControlBranch = $iteminformation->{holdingbranch};
1370 # FIXME - is this right ? are we sure that the holdingbranch is still the pickup branch?
1373 MarkIssueReturned($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'},$circControlBranch);
1374 $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
1377 # continue to deal with returns cases, but not only if we have an issue
1379 # the holdingbranch is updated if the document is returned in an other location .
1380 if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) {
1381 UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
1382 # reload iteminformation holdingbranch with the userenv value
1383 $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1385 ModDateLastSeen( $iteminformation->{'itemnumber'} );
1386 ModItem({ onloan => undef }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'});
1388 if ($iteminformation->{borrowernumber}){
1389 ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1391 # fix up the accounts.....
1392 if ( $iteminformation->{'itemlost'} ) {
1393 $messages->{'WasLost'} = 1;
1396 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1397 # check if we have a transfer for this document
1398 my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1400 # if we have a transfer to do, we update the line of transfers with the datearrived
1402 if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1405 "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1407 $sth->execute( $iteminformation->{'itemnumber'} );
1409 # 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'
1410 C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1413 $messages->{'WrongTransfer'} = $tobranch;
1414 $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1416 $validTransfert = 1;
1419 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1420 # fix up the accounts.....
1421 if ($iteminformation->{'itemlost'}) {
1422 FixAccountForLostAndReturned($iteminformation, $borrower);
1423 $messages->{'WasLost'} = 1;
1425 # fix up the overdues in accounts...
1426 FixOverduesOnReturn( $borrower->{'borrowernumber'},
1427 $iteminformation->{'itemnumber'}, $exemptfine, $dropbox );
1429 # find reserves.....
1430 # if we don't have a reserve with the status W, we launch the Checkreserves routine
1431 my ( $resfound, $resrec ) =
1432 C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1434 $resrec->{'ResFound'} = $resfound;
1435 $messages->{'ResFound'} = $resrec;
1440 # Record the fact that this book was returned.
1442 $branch, 'return', '0', '',
1443 $iteminformation->{'itemnumber'},
1444 $biblio->{'itemtype'},
1445 $borrower->{'borrowernumber'}
1448 logaction("CIRCULATION", "RETURN", $iteminformation->{borrowernumber}, $iteminformation->{'biblionumber'})
1449 if C4::Context->preference("ReturnLog");
1451 #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1452 #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1454 if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1455 if (C4::Context->preference("AutomaticItemReturn") == 1) {
1456 ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1457 $messages->{'WasTransfered'} = 1;
1460 $messages->{'NeedsTransfer'} = 1;
1464 return ( $doreturn, $messages, $iteminformation, $borrower );
1469 ForceReturn( $barcode, $date, $branchcode );
1471 Returns an item is if it were returned on C<$date>.
1473 This function is non-interactive and does not check for reserves.
1475 C<$barcode> is the barcode of the item being returned.
1477 C<$date> is the date of the actual return, in the format YYYY-MM-DD.
1479 C<$branchcode> is the branchcode for the library the item was returned to.
1484 my ( $barcode, $date, $branchcode ) = @_;
1485 my $dbh = C4::Context->dbh;
1487 my $item = GetBiblioFromItemNumber( undef, $barcode );
1489 ## FIXME: Is there a way to get the borrower of an item through the Koha API?
1490 my $sth=$dbh->prepare( "SELECT borrowernumber FROM issues WHERE itemnumber = ? AND returndate IS NULL");
1491 $sth->execute( $item->{'itemnumber'} );
1492 my ( $borrowernumber ) = $sth->fetchrow;
1495 ## Move the issue from issues to old_issues
1496 $sth = $dbh->prepare( "INSERT INTO old_issues ( SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL )" );
1497 $sth->execute( $item->{'itemnumber'} );
1499 ## Delete the row in issues
1500 $sth = $dbh->prepare( "DELETE FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
1501 $sth->execute( $item->{'itemnumber'} );
1503 ## Now set the returndate
1504 $sth = $dbh->prepare( 'UPDATE old_issues SET returndate = ? WHERE itemnumber = ? AND returndate IS NULL' );
1505 $sth->execute( $date, $item->{'itemnumber'} );
1508 UpdateStats( $branchcode, 'return', my $amount, my $other, $item->{ 'itemnumber' }, $item->{ 'itemtype' }, $borrowernumber );
1512 =head2 MarkIssueReturned
1516 MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch);
1520 Unconditionally marks an issue as being returned by
1521 moving the C<issues> row to C<old_issues> and
1522 setting C<returndate> to the current date, or
1523 the last non-holiday date of the branccode specified in
1524 C<dropbox> . Assumes you've already checked that
1525 it's safe to do this, i.e. last non-holiday > issuedate.
1527 Ideally, this function would be internal to C<C4::Circulation>,
1528 not exported, but it is currently needed by one
1529 routine in C<C4::Accounts>.
1533 sub MarkIssueReturned {
1534 my ($borrowernumber, $itemnumber, $dropbox_branch ) = @_;
1535 my $dbh = C4::Context->dbh;
1536 my $query = "UPDATE issues SET returndate=";
1537 my @bind = ($borrowernumber,$itemnumber);
1538 if($dropbox_branch) {
1539 my $calendar = C4::Calendar->new( branchcode => $dropbox_branch );
1540 my $dropboxdate = $calendar->addDate(C4::Dates->new(), -1 );
1541 unshift @bind, $dropboxdate->output('iso') ;
1544 $query .= " now() ";
1546 $query .= " WHERE borrowernumber = ? AND itemnumber = ?";
1548 my $sth_upd = $dbh->prepare($query);
1549 $sth_upd->execute(@bind);
1550 my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues
1551 WHERE borrowernumber = ?
1552 AND itemnumber = ?");
1553 $sth_copy->execute($borrowernumber, $itemnumber);
1554 my $sth_del = $dbh->prepare("DELETE FROM issues
1555 WHERE borrowernumber = ?
1556 AND itemnumber = ?");
1557 $sth_del->execute($borrowernumber, $itemnumber);
1560 =head2 FixOverduesOnReturn
1562 &FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode);
1564 C<$brn> borrowernumber
1568 C<$exemptfine> BOOL -- remove overdue charge associated with this issue.
1569 C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue.
1571 internal function, called only by AddReturn
1575 sub FixOverduesOnReturn {
1576 my ( $borrowernumber, $item, $exemptfine, $dropbox ) = @_;
1577 my $dbh = C4::Context->dbh;
1579 # check for overdue fine
1582 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1584 $sth->execute( $borrowernumber, $item );
1586 # alter fine to show that the book has been returned
1588 if ($data = $sth->fetchrow_hashref) {
1590 my @bind = ($borrowernumber,$item ,$data->{'accountno'});
1592 $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0";
1593 if (C4::Context->preference("FinesLog")) {
1594 &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item");
1596 } elsif ($dropbox && $data->{lastincrement}) {
1597 my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ;
1598 my $amt = $data->{amount} - $data->{lastincrement} ;
1599 if (C4::Context->preference("FinesLog")) {
1600 &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item");
1602 $uquery = "update accountlines set accounttype='F' ";
1603 if($outstanding >= 0 && $amt >=0) {
1604 $uquery .= ", amount = ? , amountoutstanding=? ";
1605 unshift @bind, ($amt, $outstanding) ;
1608 $uquery = "update accountlines set accounttype='F' ";
1610 $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)";
1611 my $usth = $dbh->prepare($uquery);
1612 $usth->execute(@bind);
1620 =head2 FixAccountForLostAndReturned
1622 &FixAccountForLostAndReturned($iteminfo,$borrower);
1624 Calculates the charge for a book lost and returned (Not exported & used only once)
1626 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1628 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1630 Internal function, called by AddReturn
1634 sub FixAccountForLostAndReturned {
1635 my ($iteminfo, $borrower) = @_;
1636 my $dbh = C4::Context->dbh;
1637 my $itm = $iteminfo->{'itemnumber'};
1638 # check for charge made for lost book
1639 my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1640 $sth->execute($itm);
1641 if (my $data = $sth->fetchrow_hashref) {
1642 # writeoff this amount
1644 my $amount = $data->{'amount'};
1645 my $acctno = $data->{'accountno'};
1647 if ($data->{'amountoutstanding'} == $amount) {
1648 $offset = $data->{'amount'};
1651 $offset = $amount - $data->{'amountoutstanding'};
1652 $amountleft = $data->{'amountoutstanding'} - $amount;
1654 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1655 WHERE (borrowernumber = ?)
1656 AND (itemnumber = ?) AND (accountno = ?) ");
1657 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1659 #check if any credit is left if so writeoff other accounts
1660 my $nextaccntno = getnextacctno($data->{'borrowernumber'});
1661 if ($amountleft < 0){
1664 if ($amountleft > 0){
1665 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1666 AND (amountoutstanding >0) ORDER BY date");
1667 $msth->execute($data->{'borrowernumber'});
1668 # offset transactions
1671 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1672 if ($accdata->{'amountoutstanding'} < $amountleft) {
1674 $amountleft -= $accdata->{'amountoutstanding'};
1676 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1679 my $thisacct = $accdata->{'accountno'};
1680 my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1681 WHERE (borrowernumber = ?)
1682 AND (accountno=?)");
1683 $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1685 $usth = $dbh->prepare("INSERT INTO accountoffsets
1686 (borrowernumber, accountno, offsetaccount, offsetamount)
1689 $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1694 if ($amountleft > 0){
1697 my $desc="Item Returned ".$iteminfo->{'barcode'};
1698 $usth = $dbh->prepare("INSERT INTO accountlines
1699 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1700 VALUES (?,?,now(),?,?,'CR',?)");
1701 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1703 $usth = $dbh->prepare("INSERT INTO accountoffsets
1704 (borrowernumber, accountno, offsetaccount, offsetamount)
1706 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1708 ModItem({ paidfor => '' }, undef, $itm);
1716 $issues = &GetItemIssue($itemnumber);
1718 Returns patrons currently having a book. nothing if item is not issued atm
1720 C<$itemnumber> is the itemnumber
1722 Returns an array of hashes
1727 my ( $itemnumber) = @_;
1728 return unless $itemnumber;
1729 my $dbh = C4::Context->dbh;
1733 my $today = POSIX::strftime("%Y%m%d", localtime);
1735 my $sth = $dbh->prepare(
1736 "SELECT * FROM issues
1737 LEFT JOIN items ON issues.itemnumber=items.itemnumber
1739 issues.itemnumber=?");
1740 $sth->execute($itemnumber);
1741 my $data = $sth->fetchrow_hashref;
1742 my $datedue = $data->{'date_due'};
1744 if ( $datedue < $today ) {
1745 $data->{'overdue'} = 1;
1747 $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1754 $issue = GetOpenIssue( $itemnumber );
1756 Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued
1758 C<$itemnumber> is the item's itemnumber
1765 my ( $itemnumber ) = @_;
1767 my $dbh = C4::Context->dbh;
1768 my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" );
1769 $sth->execute( $itemnumber );
1770 my $issue = $sth->fetchrow_hashref();
1774 =head2 GetItemIssues
1776 $issues = &GetItemIssues($itemnumber, $history);
1778 Returns patrons that have issued a book
1780 C<$itemnumber> is the itemnumber
1781 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1783 Returns an array of hashes
1788 my ( $itemnumber,$history ) = @_;
1789 my $dbh = C4::Context->dbh;
1793 my $today = POSIX::strftime("%Y%m%d", localtime);
1795 my $sql = "SELECT * FROM issues
1796 JOIN borrowers USING (borrowernumber)
1797 JOIN items USING (itemnumber)
1798 WHERE issues.itemnumber = ? ";
1801 SELECT * FROM old_issues
1802 LEFT JOIN borrowers USING (borrowernumber)
1803 JOIN items USING (itemnumber)
1804 WHERE old_issues.itemnumber = ? ";
1806 $sql .= "ORDER BY date_due DESC";
1807 my $sth = $dbh->prepare($sql);
1809 $sth->execute($itemnumber, $itemnumber);
1811 $sth->execute($itemnumber);
1813 while ( my $data = $sth->fetchrow_hashref ) {
1814 my $datedue = $data->{'date_due'};
1816 if ( $datedue < $today ) {
1817 $data->{'overdue'} = 1;
1819 my $itemnumber = $data->{'itemnumber'};
1820 push @GetItemIssues, $data;
1823 return ( \@GetItemIssues );
1826 =head2 GetBiblioIssues
1828 $issues = GetBiblioIssues($biblionumber);
1830 this function get all issues from a biblionumber.
1833 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1834 tables issues and the firstname,surname & cardnumber from borrowers.
1838 sub GetBiblioIssues {
1839 my $biblionumber = shift;
1840 return undef unless $biblionumber;
1841 my $dbh = C4::Context->dbh;
1843 SELECT issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1845 LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1846 LEFT JOIN items ON issues.itemnumber = items.itemnumber
1847 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1848 LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1849 WHERE biblio.biblionumber = ?
1851 SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1853 LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber
1854 LEFT JOIN items ON old_issues.itemnumber = items.itemnumber
1855 LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1856 LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1857 WHERE biblio.biblionumber = ?
1860 my $sth = $dbh->prepare($query);
1861 $sth->execute($biblionumber, $biblionumber);
1864 while ( my $data = $sth->fetchrow_hashref ) {
1865 push @issues, $data;
1870 =head2 GetUpcomingDueIssues
1874 my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
1880 sub GetUpcomingDueIssues {
1883 $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
1884 my $dbh = C4::Context->dbh;
1886 my $statement = <<END_SQL;
1887 SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due
1889 LEFT JOIN items USING (itemnumber)
1890 WhERE returndate is NULL
1891 AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
1894 my @bind_parameters = ( $params->{'days_in_advance'} );
1896 my $sth = $dbh->prepare( $statement );
1897 $sth->execute( @bind_parameters );
1898 my $upcoming_dues = $sth->fetchall_arrayref({});
1901 return $upcoming_dues;
1904 =head2 CanBookBeRenewed
1906 ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber);
1908 Find out whether a borrowed item may be renewed.
1910 C<$dbh> is a DBI handle to the Koha database.
1912 C<$borrowernumber> is the borrower number of the patron who currently
1913 has the item on loan.
1915 C<$itemnumber> is the number of the item to renew.
1917 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1918 item must currently be on loan to the specified borrower; renewals
1919 must be allowed for the item's type; and the borrower must not have
1920 already renewed the loan. $error will contain the reason the renewal can not proceed
1924 sub CanBookBeRenewed {
1926 # check renewal status
1927 my ( $borrowernumber, $itemnumber ) = @_;
1928 my $dbh = C4::Context->dbh;
1933 # Look in the issues table for this item, lent to this borrower,
1934 # and not yet returned.
1936 # FIXME - I think this function could be redone to use only one SQL call.
1937 my $sth1 = $dbh->prepare(
1938 "SELECT * FROM issues
1939 WHERE borrowernumber = ?
1942 $sth1->execute( $borrowernumber, $itemnumber );
1943 if ( my $data1 = $sth1->fetchrow_hashref ) {
1945 # Found a matching item
1947 # See if this item may be renewed. This query is convoluted
1948 # because it's a bit messy: given the item number, we need to find
1949 # the biblioitem, which gives us the itemtype, which tells us
1950 # whether it may be renewed.
1951 my $query = "SELECT renewalsallowed FROM items ";
1952 $query .= (C4::Context->preference('item-level_itypes'))
1953 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
1954 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1955 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
1956 $query .= "WHERE items.itemnumber = ?";
1957 my $sth2 = $dbh->prepare($query);
1958 $sth2->execute($itemnumber);
1959 if ( my $data2 = $sth2->fetchrow_hashref ) {
1960 $renews = $data2->{'renewalsallowed'};
1962 if ( $renews && $renews > $data1->{'renewals'} ) {
1969 my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1977 return ($renewokay,$error);
1982 &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue]);
1986 C<$borrowernumber> is the borrower number of the patron who currently
1989 C<$itemnumber> is the number of the item to renew.
1991 C<$branch> is the library branch. Defaults to the homebranch of the ITEM.
1993 C<$datedue> can be a C4::Dates object used to set the due date.
1995 If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically
1996 from the book's item type.
2001 my $borrowernumber = shift or return undef;
2002 my $itemnumber = shift or return undef;
2003 my $item = GetItem($itemnumber) or return undef;
2004 my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef;
2005 my $branch = (@_) ? shift : $item->{homebranch}; # opac-renew doesn't send branch
2007 # If the due date wasn't specified, calculate it by adding the
2008 # book's loan length to today's date.
2009 unless (@_ and $datedue = shift and $datedue->output('iso')) {
2011 my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef;
2012 my $loanlength = GetLoanLength(
2013 $borrower->{'categorycode'},
2014 (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ,
2015 $item->{homebranch} # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument?
2017 #FIXME -- use circControl?
2018 $datedue = CalcDateDue(C4::Dates->new(),$loanlength,$branch); # this branch is the transactional branch.
2019 # The question of whether to use item's homebranch calendar is open.
2022 my $dbh = C4::Context->dbh;
2023 # Find the issues record for this book
2025 $dbh->prepare("SELECT * FROM issues
2026 WHERE borrowernumber=?
2029 $sth->execute( $borrowernumber, $itemnumber );
2030 my $issuedata = $sth->fetchrow_hashref;
2033 # Update the issues record to have the new due date, and a new count
2034 # of how many times it has been renewed.
2035 my $renews = $issuedata->{'renewals'} + 1;
2036 $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = CURRENT_DATE
2037 WHERE borrowernumber=?
2040 $sth->execute( $datedue->output('iso'), $renews, $borrowernumber, $itemnumber );
2043 # Update the renewal count on the item, and tell zebra to reindex
2044 $renews = $biblio->{'renewals'} + 1;
2045 ModItem({ renewals => $renews }, $biblio->{'biblionumber'}, $itemnumber);
2047 # Charge a new rental fee, if applicable?
2048 my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
2049 if ( $charge > 0 ) {
2050 my $accountno = getnextacctno( $borrowernumber );
2051 my $item = GetBiblioFromItemNumber($itemnumber);
2052 $sth = $dbh->prepare(
2053 "INSERT INTO accountlines
2055 borrowernumber, accountno, amount,
2057 accounttype, amountoutstanding, itemnumber
2059 VALUES (now(),?,?,?,?,?,?,?)"
2061 $sth->execute( $borrowernumber, $accountno, $charge,
2062 "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
2063 'Rent', $charge, $itemnumber );
2067 UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber);
2073 ForRenewal( $itemnumber, $date, $date_due );
2075 Renews an item for the given date. This function should only be used to update renewals that have occurred in the past.
2077 C<$itemnumber> is the itemnumber of the item being renewed.
2079 C<$date> is the date the renewal took place, in the format YYYY-MM-DD
2081 C<$date_due> is the date the item is now due to be returned, in the format YYYY-MM-DD
2086 my ( $itemnumber, $date, $date_due ) = @_;
2087 my $dbh = C4::Context->dbh;
2089 my $sth = $dbh->prepare("SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL");
2090 $sth->execute( $itemnumber );
2091 my $issue = $sth->fetchrow_hashref();
2095 $sth = $dbh->prepare('UPDATE issues SET renewals = ?, lastreneweddate = ?, date_due = ? WHERE itemnumber = ? AND returndate IS NULL');
2096 $sth->execute( $issue->{'renewals'} + 1, $date, $date_due, $itemnumber );
2099 my $item = GetBiblioFromItemNumber( $itemnumber );
2100 UpdateStats( $issue->{'branchcode'}, 'renew', undef, undef, $itemnumber, $item->{ 'itemtype' }, $issue->{'borrowernumber'} );
2105 # check renewal status
2106 my ($bornum,$itemno)=@_;
2107 my $dbh = C4::Context->dbh;
2109 my $renewsallowed = 0;
2111 # Look in the issues table for this item, lent to this borrower,
2112 # and not yet returned.
2114 # FIXME - I think this function could be redone to use only one SQL call.
2115 my $sth = $dbh->prepare("select * from issues
2116 where (borrowernumber = ?)
2117 and (itemnumber = ?)");
2118 $sth->execute($bornum,$itemno);
2119 my $data = $sth->fetchrow_hashref;
2120 $renewcount = $data->{'renewals'} if $data->{'renewals'};
2122 my $query = "SELECT renewalsallowed FROM items ";
2123 $query .= (C4::Context->preference('item-level_itypes'))
2124 ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2125 : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
2126 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2127 $query .= "WHERE items.itemnumber = ?";
2128 my $sth2 = $dbh->prepare($query);
2129 $sth2->execute($itemno);
2130 my $data2 = $sth2->fetchrow_hashref();
2131 $renewsallowed = $data2->{'renewalsallowed'};
2132 $renewsleft = $renewsallowed - $renewcount;
2133 return ($renewcount,$renewsallowed,$renewsleft);
2136 =head2 GetIssuingCharges
2138 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
2140 Calculate how much it would cost for a given patron to borrow a given
2141 item, including any applicable discounts.
2143 C<$itemnumber> is the item number of item the patron wishes to borrow.
2145 C<$borrowernumber> is the patron's borrower number.
2147 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
2148 and C<$item_type> is the code for the item's item type (e.g., C<VID>
2153 sub GetIssuingCharges {
2155 # calculate charges due
2156 my ( $itemnumber, $borrowernumber ) = @_;
2158 my $dbh = C4::Context->dbh;
2161 # Get the book's item type and rental charge (via its biblioitem).
2162 my $qcharge = "SELECT itemtypes.itemtype,rentalcharge FROM items
2163 LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
2164 $qcharge .= (C4::Context->preference('item-level_itypes'))
2165 ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype "
2166 : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype ";
2168 $qcharge .= "WHERE items.itemnumber =?";
2170 my $sth1 = $dbh->prepare($qcharge);
2171 $sth1->execute($itemnumber);
2172 if ( my $data1 = $sth1->fetchrow_hashref ) {
2173 $item_type = $data1->{'itemtype'};
2174 $charge = $data1->{'rentalcharge'};
2175 my $q2 = "SELECT rentaldiscount FROM borrowers
2176 LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
2177 WHERE borrowers.borrowernumber = ?
2178 AND issuingrules.itemtype = ?";
2179 my $sth2 = $dbh->prepare($q2);
2180 $sth2->execute( $borrowernumber, $item_type );
2181 if ( my $data2 = $sth2->fetchrow_hashref ) {
2182 my $discount = $data2->{'rentaldiscount'};
2183 if ( $discount eq 'NULL' ) {
2186 $charge = ( $charge * ( 100 - $discount ) ) / 100;
2192 return ( $charge, $item_type );
2195 =head2 AddIssuingCharge
2197 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
2201 sub AddIssuingCharge {
2202 my ( $itemnumber, $borrowernumber, $charge ) = @_;
2203 my $dbh = C4::Context->dbh;
2204 my $nextaccntno = getnextacctno( $borrowernumber );
2206 INSERT INTO accountlines
2207 (borrowernumber, itemnumber, accountno,
2208 date, amount, description, accounttype,
2210 VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
2212 my $sth = $dbh->prepare($query);
2213 $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
2219 GetTransfers($itemnumber);
2224 my ($itemnumber) = @_;
2226 my $dbh = C4::Context->dbh;
2232 FROM branchtransfers
2233 WHERE itemnumber = ?
2234 AND datearrived IS NULL
2236 my $sth = $dbh->prepare($query);
2237 $sth->execute($itemnumber);
2238 my @row = $sth->fetchrow_array();
2244 =head2 GetTransfersFromTo
2246 @results = GetTransfersFromTo($frombranch,$tobranch);
2248 Returns the list of pending transfers between $from and $to branch
2252 sub GetTransfersFromTo {
2253 my ( $frombranch, $tobranch ) = @_;
2254 return unless ( $frombranch && $tobranch );
2255 my $dbh = C4::Context->dbh;
2257 SELECT itemnumber,datesent,frombranch
2258 FROM branchtransfers
2261 AND datearrived IS NULL
2263 my $sth = $dbh->prepare($query);
2264 $sth->execute( $frombranch, $tobranch );
2267 while ( my $data = $sth->fetchrow_hashref ) {
2268 push @gettransfers, $data;
2271 return (@gettransfers);
2274 =head2 DeleteTransfer
2276 &DeleteTransfer($itemnumber);
2280 sub DeleteTransfer {
2281 my ($itemnumber) = @_;
2282 my $dbh = C4::Context->dbh;
2283 my $sth = $dbh->prepare(
2284 "DELETE FROM branchtransfers
2286 AND datearrived IS NULL "
2288 $sth->execute($itemnumber);
2292 =head2 AnonymiseIssueHistory
2294 $rows = AnonymiseIssueHistory($borrowernumber,$date)
2296 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
2297 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
2299 return the number of affected rows.
2303 sub AnonymiseIssueHistory {
2305 my $borrowernumber = shift;
2306 my $dbh = C4::Context->dbh;
2309 SET borrowernumber = NULL
2310 WHERE returndate < '".$date."'
2311 AND borrowernumber IS NOT NULL
2313 $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
2314 my $rows_affected = $dbh->do($query);
2315 return $rows_affected;
2318 =head2 updateWrongTransfer
2320 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
2322 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
2326 sub updateWrongTransfer {
2327 my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
2328 my $dbh = C4::Context->dbh;
2329 # first step validate the actual line of transfert .
2332 "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
2334 $sth->execute($FromLibrary,$itemNumber);
2337 # second step create a new line of branchtransfer to the right location .
2338 ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
2340 #third step changing holdingbranch of item
2341 UpdateHoldingbranch($FromLibrary,$itemNumber);
2344 =head2 UpdateHoldingbranch
2346 $items = UpdateHoldingbranch($branch,$itmenumber);
2347 Simple methode for updating hodlingbranch in items BDD line
2351 sub UpdateHoldingbranch {
2352 my ( $branch,$itemnumber ) = @_;
2353 ModItem({ holdingbranch => $branch }, undef, $itemnumber);
2358 $newdatedue = CalcDateDue($startdate,$loanlength,$branchcode);
2359 this function calculates the due date given the loan length ,
2360 checking against the holidays calendar as per the 'useDaysMode' syspref.
2361 C<$startdate> = C4::Dates object representing start date of loan period (assumed to be today)
2362 C<$branch> = location whose calendar to use
2363 C<$loanlength> = loan length prior to adjustment
2367 my ($startdate,$loanlength,$branch) = @_;
2368 if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar
2369 my $datedue = time + ($loanlength) * 86400;
2370 #FIXME - assumes now even though we take a startdate
2371 my @datearr = localtime($datedue);
2372 return C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso');
2374 my $calendar = C4::Calendar->new( branchcode => $branch );
2375 my $datedue = $calendar->addDate($startdate, $loanlength);
2380 =head2 CheckValidDatedue
2381 This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref .
2382 To be replaced by CalcDateDue() once C4::Calendar use is tested.
2384 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
2385 this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref.
2386 C<$date_due> = returndate calculate with no day check
2387 C<$itemnumber> = itemnumber
2388 C<$branchcode> = location of issue (affected by 'CircControl' syspref)
2389 C<$loanlength> = loan length prior to adjustment
2392 sub CheckValidDatedue {
2393 my ($date_due,$itemnumber,$branchcode)=@_;
2394 my @datedue=split('-',$date_due->output('iso'));
2395 my $years=$datedue[0];
2396 my $month=$datedue[1];
2397 my $day=$datedue[2];
2398 # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)":
2400 for (my $i=0;$i<2;$i++){
2401 $dow=Day_of_Week($years,$month,$day);
2402 ($dow=0) if ($dow>6);
2403 my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
2404 my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2405 my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2406 if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
2408 (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
2411 my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso');
2416 =head2 CheckRepeatableHolidays
2418 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
2419 this function checks if the date due is a repeatable holiday
2420 C<$date_due> = returndate calculate with no day check
2421 C<$itemnumber> = itemnumber
2422 C<$branchcode> = localisation of issue
2426 sub CheckRepeatableHolidays{
2427 my($itemnumber,$week_day,$branchcode)=@_;
2428 my $dbh = C4::Context->dbh;
2429 my $query = qq|SELECT count(*)
2430 FROM repeatable_holidays
2433 my $sth = $dbh->prepare($query);
2434 $sth->execute($branchcode,$week_day);
2435 my $result=$sth->fetchrow;
2441 =head2 CheckSpecialHolidays
2443 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
2444 this function check if the date is a special holiday
2445 C<$years> = the years of datedue
2446 C<$month> = the month of datedue
2447 C<$day> = the day of datedue
2448 C<$itemnumber> = itemnumber
2449 C<$branchcode> = localisation of issue
2453 sub CheckSpecialHolidays{
2454 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
2455 my $dbh = C4::Context->dbh;
2456 my $query=qq|SELECT count(*)
2457 FROM `special_holidays`
2463 my $sth = $dbh->prepare($query);
2464 $sth->execute($years,$month,$day,$branchcode);
2465 my $countspecial=$sth->fetchrow ;
2467 return $countspecial;
2470 =head2 CheckRepeatableSpecialHolidays
2472 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2473 this function check if the date is a repeatble special holidays
2474 C<$month> = the month of datedue
2475 C<$day> = the day of datedue
2476 C<$itemnumber> = itemnumber
2477 C<$branchcode> = localisation of issue
2481 sub CheckRepeatableSpecialHolidays{
2482 my ($month,$day,$itemnumber,$branchcode) = @_;
2483 my $dbh = C4::Context->dbh;
2484 my $query=qq|SELECT count(*)
2485 FROM `repeatable_holidays`
2490 my $sth = $dbh->prepare($query);
2491 $sth->execute($month,$day,$branchcode);
2492 my $countspecial=$sth->fetchrow ;
2494 return $countspecial;
2499 sub CheckValidBarcode{
2501 my $dbh = C4::Context->dbh;
2502 my $query=qq|SELECT count(*)
2506 my $sth = $dbh->prepare($query);
2507 $sth->execute($barcode);
2508 my $exist=$sth->fetchrow ;
2519 Koha Developement team <info@koha.org>