X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FCirculation.pm;h=7c9fe8925b99f755de9343082d702d03dbe8c182;hb=ba72e844b5c5197a9bfe8ea89c92b76d94f7e7e2;hp=c18929c5866cde6f8f561a24fc18a8146e1c13bb;hpb=95889857c79aa5293911c95556740e201edab75e;p=koha.git diff --git a/C4/Circulation.pm b/C4/Circulation.pm index c18929c586..7c9fe8925b 100644 --- a/C4/Circulation.pm +++ b/C4/Circulation.pm @@ -19,7 +19,7 @@ package C4::Circulation; use strict; -require Exporter; +#use warnings; # soon! use C4::Context; use C4::Stats; use C4::Reserves; @@ -48,8 +48,8 @@ use Data::Dumper; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); BEGIN { - # set the version for version checking - $VERSION = 3.01; + require Exporter; + $VERSION = 3.02; # for version checking @ISA = qw(Exporter); # FIXME subs that should probably be elsewhere @@ -109,7 +109,7 @@ Also deals with stocktaking. =head2 barcodedecode -=head3 $str = &barcodedecode($barcode); +=head3 $str = &barcodedecode($barcode, [$filter]); =over 4 @@ -120,6 +120,10 @@ to circulation.pl that differs from the barcode stored for the item. For proper functioning of this filter, calling the function on the correct barcode string (items.barcode) should return an unaltered barcode. +The optional $filter argument is to allow for testing or explicit +behavior that ignores the System Pref. Valid values are the same as the +System Pref options. + =back =cut @@ -128,31 +132,27 @@ correct barcode string (items.barcode) should return an unaltered barcode. # FIXME -- these plugins should be moved out of Circulation.pm # sub barcodedecode { - my ($barcode) = @_; - my $filter = C4::Context->preference('itemBarcodeInputFilter'); - if($filter eq 'whitespace') { + my ($barcode, $filter) = @_; + $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter; + $filter or return $barcode; # ensure filter is defined, else return untouched barcode + if ($filter eq 'whitespace') { $barcode =~ s/\s//g; - return $barcode; - } elsif($filter eq 'cuecat') { + } elsif ($filter eq 'cuecat') { chomp($barcode); my @fields = split( /\./, $barcode ); my @results = map( decode($_), @fields[ 1 .. $#fields ] ); - if ( $#results == 2 ) { - return $results[2]; - } - else { - return $barcode; - } - } elsif($filter eq 'T-prefix') { - if ( $barcode =~ /^[Tt]/) { - if (substr($barcode,1,1) eq '0') { - return $barcode; - } else { - $barcode = substr($barcode,2) + 0 ; - } + ($#results == 2) and return $results[2]; + } elsif ($filter eq 'T-prefix') { + if ($barcode =~ /^[Tt](\d)/) { + (defined($1) and $1 eq '0') and return $barcode; + $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1) } - return sprintf( "T%07d",$barcode); + return sprintf("T%07d", $barcode); + # FIXME: $barcode could be "T1", causing warning: substr outside of string + # Why drop the nonzero digit after the T? + # Why pass non-digits (or empty string) to "T%07d"? } + return $barcode; # return barcode, modified or not } =head2 decode @@ -164,6 +164,9 @@ sub barcodedecode { =item Decodes a segment of a string emitted by a CueCat barcode scanner and returns it. +FIXME: Should be replaced with Barcode::Cuecat from CPAN +or Javascript based decoding on the client side. + =back =cut @@ -176,7 +179,7 @@ sub decode { my $l = ( $#s + 1 ) % 4; if ($l) { if ( $l == 1 ) { - warn "Error!"; + # warn "Error: Cuecat decode parsing failed!"; return; } $l = 4 - $l; @@ -306,94 +309,6 @@ sub transferbook { return ( $dotransfer, $messages, $biblio ); } -=head2 CanBookBeIssued - -Check if a book can be issued. - -my ($issuingimpossible,$needsconfirmation) = CanBookBeIssued($borrower,$barcode,$year,$month,$day); - -=over 4 - -=item C<$borrower> hash with borrower informations (from GetMemberDetails) - -=item C<$barcode> is the bar code of the book being issued. - -=item C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate". - -=back - -Returns : - -=over 4 - -=item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible. -Possible values are : - -=back - -=head3 INVALID_DATE - -sticky due date is invalid - -=head3 GNA - -borrower gone with no address - -=head3 CARD_LOST - -borrower declared it's card lost - -=head3 DEBARRED - -borrower debarred - -=head3 UNKNOWN_BARCODE - -barcode unknown - -=head3 NOT_FOR_LOAN - -item is not for loan - -=head3 WTHDRAWN - -item withdrawn. - -=head3 RESTRICTED - -item is restricted (set by ??) - -C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible. -Possible values are : - -=head3 DEBT - -borrower has debts. - -=head3 RENEW_ISSUE - -renewing, not issuing - -=head3 ISSUED_TO_ANOTHER - -issued to someone else. - -=head3 RESERVED - -reserved for someone else. - -=head3 INVALID_DATE - -sticky due date is invalid - -=head3 TOO_MANY - -if the borrower borrows to much things - -=cut - -# check if a book can be issued. - sub TooMany { my $borrower = shift; @@ -403,140 +318,111 @@ sub TooMany { my $dbh = C4::Context->dbh; my $branch; # Get which branchcode we need - if (C4::Context->preference('CircControl') eq 'PickupLibrary'){ - $branch = C4::Context->userenv->{'branch'}; - } - elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){ - $branch = $borrower->{'branchcode'}; - } - else { - # items home library - $branch = $item->{'homebranch'}; - } + $branch = _GetCircControlBranch($item,$borrower); my $type = (C4::Context->preference('item-level_itypes')) ? $item->{'itype'} # item-level : $item->{'itemtype'}; # biblio-level - - my $sth = - $dbh->prepare( - 'SELECT * FROM issuingrules - WHERE categorycode = ? - AND itemtype = ? - AND branchcode = ?' - ); - - my $query2 = "SELECT COUNT(*) FROM issues i, biblioitems s1, items s2 - WHERE i.borrowernumber = ? - AND i.itemnumber = s2.itemnumber - AND s1.biblioitemnumber = s2.biblioitemnumber"; - if (C4::Context->preference('item-level_itypes')){ - $query2.=" AND s2.itype=? "; - } else { - $query2.=" AND s1.itemtype= ? "; - } - my $sth2= $dbh->prepare($query2); - my $sth3 = - $dbh->prepare( - 'SELECT COUNT(*) FROM issues - WHERE borrowernumber = ?' - ); - my $alreadyissued; - - # check the 3 parameters (branch / itemtype / category code - $sth->execute( $cat_borrower, $type, $branch ); - my $result = $sth->fetchrow_hashref; -# warn "$cat_borrower, $type, $branch = ".Data::Dumper::Dumper($result); - if ( $result->{maxissueqty} ne '' ) { -# warn "checking on everything set"; - $sth2->execute( $borrower->{'borrowernumber'}, $type ); - my $alreadyissued = $sth2->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/itemtype failed)" ); - } - # now checking for total - $sth->execute( $cat_borrower, '*', $branch ); - my $result = $sth->fetchrow_hashref; - if ( $result->{maxissueqty} ne '' ) { - $sth3->execute( $borrower->{'borrowernumber'} ); - my $alreadyissued = $sth3->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/total failed)" ); + + # given branch, patron category, and item type, determine + # applicable issuing rule + my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch); + + # if a rule is found and has a loan limit set, count + # how many loans the patron already has that meet that + # rule + if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) { + my @bind_params; + my $count_query = "SELECT COUNT(*) FROM issues + JOIN items USING (itemnumber) "; + + my $rule_itemtype = $issuing_rule->{itemtype}; + if ($rule_itemtype eq "*") { + # matching rule has the default item type, so count only + # those existing loans that don't fall under a more + # specific rule + if (C4::Context->preference('item-level_itypes')) { + $count_query .= " WHERE items.itype NOT IN ( + SELECT itemtype FROM issuingrules + WHERE branchcode = ? + AND (categorycode = ? OR categorycode = ?) + AND itemtype <> '*' + ) "; + } else { + $count_query .= " JOIN biblioitems USING (biblionumber) + WHERE biblioitems.itemtype NOT IN ( + SELECT itemtype FROM issuingrules + WHERE branchcode = ? + AND (categorycode = ? OR categorycode = ?) + AND itemtype <> '*' + ) "; + } + push @bind_params, $issuing_rule->{branchcode}; + push @bind_params, $issuing_rule->{categorycode}; + push @bind_params, $cat_borrower; + } else { + # rule has specific item type, so count loans of that + # specific item type + if (C4::Context->preference('item-level_itypes')) { + $count_query .= " WHERE items.itype = ? "; + } else { + $count_query .= " JOIN biblioitems USING (biblionumber) + WHERE biblioitems.itemtype= ? "; } + push @bind_params, $type; } - } - # check the 2 parameters (branch / itemtype / default categorycode - $sth->execute( '*', $type, $branch ); - $result = $sth->fetchrow_hashref; -# warn "*, $type, $branch = ".Data::Dumper::Dumper($result); - - if ( $result->{maxissueqty} ne '' ) { -# warn "checking on 2 parameters (default categorycode)"; - $sth2->execute( $borrower->{'borrowernumber'}, $type ); - my $alreadyissued = $sth2->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / itemtype failed)" ); - } - # now checking for total - $sth->execute( '*', '*', $branch ); - my $result = $sth->fetchrow_hashref; - if ( $result->{maxissueqty} ne '' ) { - $sth3->execute( $borrower->{'borrowernumber'} ); - my $alreadyissued = $sth3->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / total failed)" ); + $count_query .= " AND borrowernumber = ? "; + push @bind_params, $borrower->{'borrowernumber'}; + my $rule_branch = $issuing_rule->{branchcode}; + if ($rule_branch ne "*") { + if (C4::Context->preference('CircControl') eq 'PickupLibrary') { + $count_query .= " AND issues.branchcode = ? "; + push @bind_params, $branch; + } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') { + ; # if branch is the patron's home branch, then count all loans by patron + } else { + $count_query .= " AND items.homebranch = ? "; + push @bind_params, $branch; } } - } - - # check the 1 parameters (default branch / itemtype / categorycode - $sth->execute( $cat_borrower, $type, '*' ); - $result = $sth->fetchrow_hashref; -# warn "$cat_borrower, $type, * = ".Data::Dumper::Dumper($result); - - if ( $result->{maxissueqty} ne '' ) { -# warn "checking on 1 parameter (default branch + categorycode)"; - $sth2->execute( $borrower->{'borrowernumber'}, $type ); - my $alreadyissued = $sth2->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch/category/itemtype failed)" ); - } - # now checking for total - $sth->execute( $cat_borrower, '*', '*' ); - my $result = $sth->fetchrow_hashref; - if ( $result->{maxissueqty} ne '' ) { - $sth3->execute( $borrower->{'borrowernumber'} ); - my $alreadyissued = $sth3->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / category / total failed)" ); - } + + my $count_sth = $dbh->prepare($count_query); + $count_sth->execute(@bind_params); + my ($current_loan_count) = $count_sth->fetchrow_array; + + my $max_loans_allowed = $issuing_rule->{'maxissueqty'}; + if ($current_loan_count >= $max_loans_allowed) { + return "$current_loan_count / $max_loans_allowed"; } } - # check the 0 parameters (default branch / itemtype / default categorycode - $sth->execute( '*', $type, '*' ); - $result = $sth->fetchrow_hashref; -# warn "*, $type, * = ".Data::Dumper::Dumper($result); - - if ( $result->{maxissueqty} ne '' ) { -# warn "checking on default branch and default categorycode"; - $sth2->execute( $borrower->{'borrowernumber'}, $type ); - my $alreadyissued = $sth2->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / itemtype failed)" ); + # Now count total loans against the limit for the branch + my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower); + if (defined($branch_borrower_circ_rule->{maxissueqty})) { + my @bind_params = (); + my $branch_count_query = "SELECT COUNT(*) FROM issues + JOIN items USING (itemnumber) + WHERE borrowernumber = ? "; + push @bind_params, $borrower->{borrowernumber}; + + if (C4::Context->preference('CircControl') eq 'PickupLibrary') { + $branch_count_query .= " AND issues.branchcode = ? "; + push @bind_params, $branch; + } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') { + ; # if branch is the patron's home branch, then count all loans by patron + } else { + $branch_count_query .= " AND items.homebranch = ? "; + push @bind_params, $branch; } - } - # now checking for total - $sth->execute( '*', '*', '*' ); - $result = $sth->fetchrow_hashref; - if ( $result->{maxissueqty} ne '' ) { - warn "checking total"; - $sth2->execute( $borrower->{'borrowernumber'}, $type ); - my $alreadyissued = $sth2->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / total failed)" ); - } - } + my $branch_count_sth = $dbh->prepare($branch_count_query); + $branch_count_sth->execute(@bind_params); + my ($current_loan_count) = $branch_count_sth->fetchrow_array; + + my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty}; + if ($current_loan_count >= $max_loans_allowed) { + return "$current_loan_count / $max_loans_allowed"; + } + } # OK, the patron can issue !!! return; @@ -655,11 +541,92 @@ sub itemissues { =head2 CanBookBeIssued -( $issuingimpossible, $needsconfirmation ) = - CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess ); -C<$duedatespec> is a C4::Dates object. +Check if a book can be issued. + +( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess ); + C<$issuingimpossible> and C<$needsconfirmation> are some hashref. +=over 4 + +=item C<$borrower> hash with borrower informations (from GetMemberDetails) + +=item C<$barcode> is the bar code of the book being issued. + +=item C<$duedatespec> is a C4::Dates object. + +=item C<$inprocess> + +=back + +Returns : + +=over 4 + +=item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible. +Possible values are : + +=back + +=head3 INVALID_DATE + +sticky due date is invalid + +=head3 GNA + +borrower gone with no address + +=head3 CARD_LOST + +borrower declared it's card lost + +=head3 DEBARRED + +borrower debarred + +=head3 UNKNOWN_BARCODE + +barcode unknown + +=head3 NOT_FOR_LOAN + +item is not for loan + +=head3 WTHDRAWN + +item withdrawn. + +=head3 RESTRICTED + +item is restricted (set by ??) + +C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible. +Possible values are : + +=head3 DEBT + +borrower has debts. + +=head3 RENEW_ISSUE + +renewing, not issuing + +=head3 ISSUED_TO_ANOTHER + +issued to someone else. + +=head3 RESERVED + +reserved for someone else. + +=head3 INVALID_DATE + +sticky due date is invalid + +=head3 TOO_MANY + +if the borrower borrows to much things + =cut sub CanBookBeIssued { @@ -672,10 +639,27 @@ sub CanBookBeIssued { $item->{'itemtype'}=$item->{'itype'}; my $dbh = C4::Context->dbh; + # MANDATORY CHECKS - unless item exists, nothing else matters + unless ( $item->{barcode} ) { + $issuingimpossible{UNKNOWN_BARCODE} = 1; + } + return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible; + # # DUE DATE is OK ? -- should already have checked. # - #$issuingimpossible{INVALID_DATE} = 1 unless ($duedate); + unless ( $duedate ) { + my $issuedate = strftime( "%Y-%m-%d", localtime ); + + my $branch = _GetCircControlBranch($item,$borrower); + my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'}; + my $loanlength = GetLoanLength( $borrower->{'categorycode'}, $itype, $branch ); + $duedate = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $loanlength, $branch, $borrower ); + + # Offline circ calls AddIssue directly, doesn't run through here + # So issuingimpossible should be ok. + } + $issuingimpossible{INVALID_DATE} = $duedate->output('syspref') unless ( $duedate && $duedate->output('iso') ge C4::Dates->today('iso') ); # # BORROWER STATUS @@ -715,21 +699,35 @@ sub CanBookBeIssued { if ( $amount > $amountlimit && !$inprocess ) { $issuingimpossible{DEBT} = sprintf( "%.2f", $amount ); } - elsif ( $amount <= $amountlimit && !$inprocess ) { + elsif ( $amount > 0 && $amount <= $amountlimit && !$inprocess ) { $needsconfirmation{DEBT} = sprintf( "%.2f", $amount ); } } else { if ( $amount > 0 ) { - $needsconfirmation{DEBT} = $amount; + $needsconfirmation{DEBT} = sprintf( "%.2f", $amount ); } } + my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'}); + if($blocktype == -1){ + ## remaining overdue documents + $needsconfirmation{USERBLOCKEDREMAINING} = $count; + }elsif($blocktype == 1){ + ## blocked because of overdue return + $issuingimpossible{USERBLOCKEDOVERDUE} = $count; + } + # # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS # my $toomany = TooMany( $borrower, $item->{biblionumber}, $item ); - $needsconfirmation{TOO_MANY} = $toomany if $toomany; + # if TooMany return / 0, then the user has no permission to check out this book + if ($toomany =~ /\/ 0/) { + $needsconfirmation{PATRON_CANT} = 1; + } else { + $needsconfirmation{TOO_MANY} = $toomany if $toomany; + } # # ITEM CHECKING @@ -740,24 +738,36 @@ sub CanBookBeIssued { if ( $item->{'notforloan'} && $item->{'notforloan'} > 0 ) { - $issuingimpossible{NOT_FOR_LOAN} = 1; + if(C4::Context->preference("AllowNotForLoanOverride")){ + $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1; + }else{ + $issuingimpossible{NOT_FOR_LOAN} = 1; + } + } + elsif ( !$item->{'notforloan'} ){ + # we have to check itemtypes.notforloan also + if (C4::Context->preference('item-level_itypes')){ + # this should probably be a subroutine + my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?"); + $sth->execute($item->{'itemtype'}); + my $notforloan=$sth->fetchrow_hashref(); + $sth->finish(); + if ($notforloan->{'notforloan'}) { + if (!C4::Context->preference("AllowNotForLoanOverride")) { + $issuingimpossible{NOT_FOR_LOAN} = 1; + } else { + $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1; + } + } + } + elsif ($biblioitem->{'notforloan'} == 1){ + if (!C4::Context->preference("AllowNotForLoanOverride")) { + $issuingimpossible{NOT_FOR_LOAN} = 1; + } else { + $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1; + } + } } - elsif ( !$item->{'notforloan'} ){ - # we have to check itemtypes.notforloan also - if (C4::Context->preference('item-level_itypes')){ - # this should probably be a subroutine - my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?"); - $sth->execute($item->{'itemtype'}); - my $notforloan=$sth->fetchrow_hashref(); - $sth->finish(); - if ($notforloan->{'notforloan'} == 1){ - $issuingimpossible{NOT_FOR_LOAN} = 1; - } - } - elsif ($biblioitem->{'notforloan'} == 1){ - $issuingimpossible{NOT_FOR_LOAN} = 1; - } - } if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 ) { $issuingimpossible{WTHDRAWN} = 1; @@ -797,7 +807,7 @@ sub CanBookBeIssued { elsif ($issue->{borrowernumber}) { # issued to someone else - my $currborinfo = GetMemberDetails( $issue->{borrowernumber} ); + my $currborinfo = C4::Members::GetMemberDetails( $issue->{borrowernumber} ); # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})"; $needsconfirmation{ISSUED_TO_ANOTHER} = @@ -808,7 +818,7 @@ sub CanBookBeIssued { my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} ); if ($restype) { my $resbor = $res->{'borrowernumber'}; - my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 ); + my ( $resborrower ) = C4::Members::GetMemberDetails( $resbor, 0 ); my $branches = GetBranches(); my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'}; if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" ) @@ -824,12 +834,6 @@ sub CanBookBeIssued { "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})"; } } - if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" ) { - if ( $borrower->{'categorycode'} eq 'W' ) { - my %emptyhash; - return ( \%emptyhash, \%needsconfirmation ); - } - } return ( \%issuingimpossible, \%needsconfirmation ); } @@ -837,15 +841,21 @@ sub CanBookBeIssued { Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed. -&AddIssue($borrower,$barcode,$date) +&AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate]) =over 4 -=item C<$borrower> hash with borrower informations (from GetMemberDetails) +=item C<$borrower> is a hash with borrower informations (from GetMemberDetails). -=item C<$barcode> is the bar code of the book being issued. +=item C<$barcode> is the barcode of the item being issued. + +=item C<$datedue> is a C4::Dates object for the max date of return, i.e. the date due (optional). +Calculated if empty. + +=item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional). -=item C<$date> contains the max date of return. calculated if empty. +=item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional). +Defaults to today. Unlike C<$datedue>, NOT a C4::Dates object, unfortunately. AddIssue does the following things : - step 01: check that there is a borrowernumber & a barcode provided @@ -865,26 +875,21 @@ AddIssue does the following things : =cut sub AddIssue { - my ( $borrower, $barcode, $date, $cancelreserve ) = @_; + my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_; my $dbh = C4::Context->dbh; my $barcodecheck=CheckValidBarcode($barcode); + + # $issuedate defaults to today. + if ( ! defined $issuedate ) { + $issuedate = strftime( "%Y-%m-%d", localtime ); + # TODO: for hourly circ, this will need to be a C4::Dates object + # and all calls to AddIssue including issuedate will need to pass a Dates object. + } if ($borrower and $barcode and $barcodecheck ne '0'){ # find which item we issue - my $item = GetItem('', $barcode); - my $datedue; - - my $branch; - # Get which branchcode we need - if (C4::Context->preference('CircControl') eq 'PickupLibrary'){ - $branch = C4::Context->userenv->{'branch'}; - } - elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){ - $branch = $borrower->{'branchcode'}; - } - else { - # items home library - $branch = $item->{'homebranch'}; - } + my $item = GetItem('', $barcode) or return undef; # if we don't get an Item, abort. + my $hbr = C4::Context->preference("HomeOrHoldingBranch")||"homebranch"; + my $branch = _GetCircControlBranch($item,$borrower); # get actual issuing if there is one my $actualissue = GetItemIssue( $item->{itemnumber}); @@ -895,14 +900,14 @@ sub AddIssue { # # check if we just renew the issue. # - if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) { - AddRenewal( + if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) { + $datedue = AddRenewal( $borrower->{'borrowernumber'}, $item->{'itemnumber'}, $branch, - $date + $datedue, + $issuedate, # here interpreted as the renewal date ); - } else { # it's NOT a renewal @@ -921,36 +926,23 @@ sub AddIssue { if ($restype) { my $resbor = $res->{'borrowernumber'}; if ( $resbor eq $borrower->{'borrowernumber'} ) { - # The item is reserved by the current patron ModReserveFill($res); } elsif ( $restype eq "Waiting" ) { - # warn "Waiting"; # The item is on reserve and waiting, but has been # reserved by some other patron. - my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 ); - my $branches = GetBranches(); - my $branchname = - $branches->{ $res->{'branchcode'} }->{'branchname'}; } elsif ( $restype eq "Reserved" ) { - # warn "Reserved"; # The item is reserved by someone else. - my ( $resborrower, $flags ) = - GetMemberDetails( $resbor, 0 ); - my $branches = GetBranches(); - my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'}; if ($cancelreserve) { # cancel reserves on this item - CancelReserve( 0, $res->{'itemnumber'}, - $res->{'borrowernumber'} ); + CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); } } if ($cancelreserve) { - CancelReserve( $res->{'biblionumber'}, 0, - $res->{'borrowernumber'} ); + CancelReserve($res->{'biblionumber'}, 0, $res->{'borrowernumber'}); } else { # set waiting reserve to first in reserve queue as book isn't waiting now @@ -965,8 +957,8 @@ sub AddIssue { # Starting process for transfer job (checking transfert and validate it if we have one) my ($datesent) = GetTransfers($item->{'itemnumber'}); if ($datesent) { - # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....) - my $sth = + # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....) + my $sth = $dbh->prepare( "UPDATE branchtransfers SET datearrived = now(), @@ -974,8 +966,7 @@ sub AddIssue { comments = 'Forced branchtransfer' WHERE itemnumber= ? AND datearrived IS NULL" ); - $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'}); - $sth->finish; + $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'}); } # Record in the database the fact that the book was issued. @@ -985,34 +976,29 @@ sub AddIssue { (borrowernumber, itemnumber,issuedate, date_due, branchcode) VALUES (?,?,?,?,?)" ); - my $dateduef; - if ($date) { - $dateduef = $date; - } else { - my $itype=(C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ; - my $loanlength = GetLoanLength( - $borrower->{'categorycode'}, - $itype, - $branch - ); - $dateduef = CalcDateDue(C4::Dates->new(),$loanlength,$branch); - # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate - if ( C4::Context->preference('ReturnBeforeExpiry') && $dateduef->output('iso') gt $borrower->{dateexpiry} ) { - $dateduef = C4::Dates->new($borrower->{dateexpiry},'iso'); - } - }; - $sth->execute( - $borrower->{'borrowernumber'}, - $item->{'itemnumber'}, - strftime( "%Y-%m-%d", localtime ),$dateduef->output('iso'), C4::Context->userenv->{'branch'} + unless ($datedue) { + my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'}; + my $loanlength = GetLoanLength( $borrower->{'categorycode'}, $itype, $branch ); + $datedue = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $loanlength, $branch, $borrower ); + + # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate + if ( C4::Context->preference('ReturnBeforeExpiry') && $datedue->output('iso') gt $borrower->{dateexpiry} ) { + $datedue = C4::Dates->new( $borrower->{dateexpiry}, 'iso' ); + } + } + $sth->execute( + $borrower->{'borrowernumber'}, # borrowernumber + $item->{'itemnumber'}, # itemnumber + $issuedate, # issuedate + $datedue->output('iso'), # date_due + $branch # branchcode ); - $sth->finish; $item->{'issues'}++; ModItem({ issues => $item->{'issues'}, - holdingbranch => C4::Context->userenv->{'branch'}, + holdingbranch => C4::Context->userenv->{branch}, itemlost => 0, datelastborrowed => C4::Dates->new()->output('iso'), - onloan => $dateduef->output('iso'), + onloan => $datedue->output('iso'), }, $item->{'biblionumber'}, $item->{'itemnumber'}); ModDateLastSeen( $item->{'itemnumber'} ); @@ -1032,16 +1018,16 @@ sub AddIssue { # Record the fact that this book was issued. &UpdateStats( C4::Context->userenv->{'branch'}, - 'issue', $charge, - '', $item->{'itemnumber'}, + 'issue', $charge, + ($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'}, $item->{'itype'}, $borrower->{'borrowernumber'} ); } logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'}) if C4::Context->preference("IssueLog"); - return ($datedue); } + return ($datedue); # not necessarily the same as when it came in! } =head2 GetLoanLength @@ -1255,13 +1241,22 @@ sub GetBranchBorrowerCircRule { Returns a book. -C<$barcode> is the bar code of the book being returned. C<$branch> is -the code of the branch where the book is being returned. C<$exemptfine> -indicates that overdue charges for the item will be removed. C<$dropbox> -indicates that the check-in date is assumed to be yesterday, or the last -non-holiday as defined in C4::Calendar . If overdue -charges are applied and C<$dropbox> is true, the last charge will be removed. -This assumes that the fines accrual script has run for _today_. +=over 4 + +=item C<$barcode> is the bar code of the book being returned. + +=item C<$branch> is the code of the branch where the book is being returned. + +=item C<$exemptfine> indicates that overdue charges for the item will be +removed. + +=item C<$dropbox> indicates that the check-in date is assumed to be +yesterday, or the last non-holiday as defined in C4::Calendar . If +overdue charges are applied and C<$dropbox> is true, the last charge +will be removed. This assumes that the fines accrual script has run +for _today_. + +=back C<&AddReturn> returns a list of four items: @@ -1298,6 +1293,9 @@ either C, C, or 0. =back +C<$iteminformation> is a reference-to-hash, giving information about the +returned item from the issues table. + C<$borrower> is a reference-to-hash, giving information about the patron who last borrowed the book. @@ -1311,26 +1309,30 @@ sub AddReturn { my $borrower; my $validTransfert = 0; my $reserveDone = 0; + $branch ||=C4::Context->userenv->{'branch'}; # get information on item - my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode)); + my $itemnumber = GetItemnumberFromBarcode($barcode); + my $iteminformation = GetItemIssue( $itemnumber ); my $biblio = GetBiblioItemData($iteminformation->{'biblioitemnumber'}); # use Data::Dumper;warn Data::Dumper::Dumper($iteminformation); - unless ($iteminformation->{'itemnumber'} ) { + unless ( $iteminformation->{'itemnumber'} or $itemnumber) { $messages->{'BadBarcode'} = $barcode; $doreturn = 0; } else { # find the borrower - if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) { + if ( not $iteminformation->{borrowernumber} ) { $messages->{'NotIssued'} = $barcode; - # even though item is not on loan, it may still - # be transferred; therefore, get current branch information - my $curr_iteminfo = GetItem($iteminformation->{'itemnumber'}); - $iteminformation->{'homebranch'} = $curr_iteminfo->{'homebranch'}; - $iteminformation->{'holdingbranch'} = $curr_iteminfo->{'holdingbranch'}; $doreturn = 0; } - + + # even though item is not on loan, it may still + # be transferred; therefore, get current branch information + my $curr_iteminfo = GetItem($itemnumber); + $iteminformation->{'homebranch'} = $curr_iteminfo->{'homebranch'}; + $iteminformation->{'holdingbranch'} = $curr_iteminfo->{'holdingbranch'}; + $iteminformation->{'itemlost'} = $curr_iteminfo->{'itemlost'}; + # check if the book is in a permanent collection.... my $hbr = $iteminformation->{C4::Context->preference("HomeOrHoldingBranch")}; my $branches = GetBranches(); @@ -1340,7 +1342,7 @@ sub AddReturn { } # if independent branches are on and returning to different branch, refuse the return - if ($hbr ne C4::Context->userenv->{'branch'} && C4::Context->preference("IndependantBranches")){ + if ($hbr ne $branch && C4::Context->preference("IndependantBranches") && $iteminformation->{borrowernumber}){ $messages->{'Wrongbranch'} = 1; $doreturn=0; } @@ -1351,6 +1353,7 @@ sub AddReturn { $doreturn = 0; } + # new op dev : if the book returned in an other branch update the holding branch # update issues, thereby returning book (should push this out into another subroutine @@ -1359,40 +1362,27 @@ sub AddReturn { # case of a return of document (deal with issues and holdingbranch) if ($doreturn) { - my $circControlBranch; + my $circControlBranch = _GetCircControlBranch($iteminformation,$borrower); if($dropbox) { # don't allow dropbox mode to create an invalid entry in issues (issuedate > returndate) FIXME: actually checks eq, not gt undef($dropbox) if ( $iteminformation->{'issuedate'} eq C4::Dates->today('iso') ); - if (C4::Context->preference('CircControl') eq 'ItemHomeBranch' ) { - $circControlBranch = $iteminformation->{homebranch}; - } elsif ( C4::Context->preference('CircControl') eq 'PatronLibrary') { - $circControlBranch = $borrower->{branchcode}; - } else { # CircControl must be PickupLibrary. - $circControlBranch = $iteminformation->{holdingbranch}; - # FIXME - is this right ? are we sure that the holdingbranch is still the pickup branch? - } } MarkIssueReturned($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'},$circControlBranch); - $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right? - } - - # continue to deal with returns cases, but not only if we have an issue - - # the holdingbranch is updated if the document is returned in an other location . - if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) { - UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'}); - # reload iteminformation holdingbranch with the userenv value - $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'}; - } - ModDateLastSeen( $iteminformation->{'itemnumber'} ); - ModItem({ onloan => undef }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'}); - - if ($iteminformation->{borrowernumber}){ - ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 ); - } - # fix up the accounts..... - if ( $iteminformation->{'itemlost'} ) { - $messages->{'WasLost'} = 1; + $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right? + # continue to deal with returns cases, but not only if we have an issue + + + # We update the holdingbranch from circControlBranch variable + UpdateHoldingbranch($branch,$iteminformation->{'itemnumber'}); + $iteminformation->{'holdingbranch'} = $branch; + + + ModDateLastSeen( $iteminformation->{'itemnumber'} ); + ModItem({ onloan => undef }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'}); + + if ($iteminformation->{borrowernumber}){ + ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 ); + } } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # @@ -1401,7 +1391,7 @@ sub AddReturn { # if we have a transfer to do, we update the line of transfers with the datearrived if ($datesent) { - if ( $tobranch eq C4::Context->userenv->{'branch'} ) { + if ( $tobranch eq $branch ) { my $sth = $dbh->prepare( "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL" @@ -1422,6 +1412,7 @@ sub AddReturn { # fix up the accounts..... if ($iteminformation->{'itemlost'}) { FixAccountForLostAndReturned($iteminformation, $borrower); + ModItem({ itemlost => '0' }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'}); $messages->{'WasLost'} = 1; } # fix up the overdues in accounts... @@ -1430,8 +1421,8 @@ sub AddReturn { # find reserves..... # if we don't have a reserve with the status W, we launch the Checkreserves routine - my ( $resfound, $resrec ) = - C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} ); + my ( $resfound, $resrec ) = + C4::Reserves::CheckReserves( $itemnumber, $barcode ); if ($resfound) { $resrec->{'ResFound'} = $resfound; $messages->{'ResFound'} = $resrec; @@ -1453,9 +1444,9 @@ sub AddReturn { #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch . - if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){ + if (($doreturn or $messages->{'NotIssued'}) and ($branch ne $iteminformation->{$hbr}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){ if (C4::Context->preference("AutomaticItemReturn") == 1) { - ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'}); + ModItemTransfer($iteminformation->{'itemnumber'}, $branch, $iteminformation->{$hbr}); $messages->{'WasTransfered'} = 1; } else { @@ -1470,7 +1461,7 @@ sub AddReturn { =over 4 -MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch); +MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate); =back @@ -1478,9 +1469,12 @@ Unconditionally marks an issue as being returned by moving the C row to C and setting C to the current date, or the last non-holiday date of the branccode specified in -C . Assumes you've already checked that +C . Assumes you've already checked that it's safe to do this, i.e. last non-holiday > issuedate. +if C<$returndate> is specified (in iso format), it is used as the date +of the return. It is ignored when a dropbox_branch is passed in. + Ideally, this function would be internal to C, not exported, but it is currently needed by one routine in C. @@ -1488,19 +1482,23 @@ routine in C. =cut sub MarkIssueReturned { - my ($borrowernumber, $itemnumber, $dropbox_branch ) = @_; - my $dbh = C4::Context->dbh; - my $query = "UPDATE issues SET returndate="; - my @bind = ($borrowernumber,$itemnumber); - if($dropbox_branch) { - my $calendar = C4::Calendar->new( branchcode => $dropbox_branch ); - my $dropboxdate = $calendar->addDate(C4::Dates->new(), -1 ); - unshift @bind, $dropboxdate->output('iso') ; - $query .= " ? " - } else { - $query .= " now() "; - } - $query .= " WHERE borrowernumber = ? AND itemnumber = ?"; + my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate ) = @_; + my $dbh = C4::Context->dbh; + my $query = "UPDATE issues SET returndate="; + my @bind; + if ($dropbox_branch) { + my $calendar = C4::Calendar->new( branchcode => $dropbox_branch ); + my $dropboxdate = $calendar->addDate( C4::Dates->new(), -1 ); + $query .= " ? "; + push @bind, $dropboxdate->output('iso'); + } elsif ($returndate) { + $query .= " ? "; + push @bind, $returndate; + } else { + $query .= " now() "; + } + $query .= " WHERE borrowernumber = ? AND itemnumber = ?"; + push @bind, $borrowernumber, $itemnumber; # FIXME transaction my $sth_upd = $dbh->prepare($query); $sth_upd->execute(@bind); @@ -1612,7 +1610,6 @@ sub FixAccountForLostAndReturned { WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accountno = ?) "); $usth->execute($data->{'borrowernumber'},$itm,$acctno); - $usth->finish; #check if any credit is left if so writeoff other accounts my $nextaccntno = getnextacctno($data->{'borrowernumber'}); if ($amountleft < 0){ @@ -1644,9 +1641,8 @@ sub FixAccountForLostAndReturned { VALUES (?,?,?,?)"); $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos); - $usth->finish; } - $msth->finish; + $msth->finish; # $msth might actually have data left } if ($amountleft > 0){ $amountleft*=-1; @@ -1656,53 +1652,74 @@ sub FixAccountForLostAndReturned { (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding) VALUES (?,?,now(),?,?,'CR',?)"); $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft); - $usth->finish; $usth = $dbh->prepare("INSERT INTO accountoffsets (borrowernumber, accountno, offsetaccount, offsetamount) VALUES (?,?,?,?)"); $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset); - $usth->finish; ModItem({ paidfor => '' }, undef, $itm); } $sth->finish; return; } +=head2 _GetCircControlBranch + + my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower); + +Internal function : + +Return the library code to be used to determine which circulation +policy applies to a transaction. Looks up the CircControl and +HomeOrHoldingBranch system preferences. + +C<$iteminfos> is a hashref to iteminfo. Only {itemnumber} is used. + +C<$borrower> is a hashref to borrower. Only {borrowernumber is used. + +=cut + +sub _GetCircControlBranch { + my ($iteminfos, $borrower) = @_; + my $circcontrol = C4::Context->preference('CircControl'); + my $branch; + + if ($circcontrol eq 'PickupLibrary') { + $branch= C4::Context->userenv->{'branch'}; + } elsif ($circcontrol eq 'PatronLibrary') { + $branch=$borrower->{branchcode}; + } else { + my $branchfield = C4::Context->preference('HomeOrHoldingBranch') || 'homebranch'; + $branch = $iteminfos->{$branchfield}; + } + return $branch; +} + =head2 GetItemIssue $issues = &GetItemIssue($itemnumber); -Returns patrons currently having a book. nothing if item is not issued atm +Returns patron currently having a book, or undef if not checked out. C<$itemnumber> is the itemnumber -Returns an array of hashes +C<$issues> is an array of hashes. =cut sub GetItemIssue { - my ( $itemnumber) = @_; + my ($itemnumber) = @_; return unless $itemnumber; - my $dbh = C4::Context->dbh; - my @GetItemIssues; - - # get today date - my $today = POSIX::strftime("%Y%m%d", localtime); - - my $sth = $dbh->prepare( - "SELECT * FROM issues + my $sth = C4::Context->dbh->prepare( + "SELECT * + FROM issues LEFT JOIN items ON issues.itemnumber=items.itemnumber - WHERE - issues.itemnumber=?"); + WHERE issues.itemnumber=?"); $sth->execute($itemnumber); my $data = $sth->fetchrow_hashref; - my $datedue = $data->{'date_due'}; - $datedue =~ s/-//g; - if ( $datedue < $today ) { - $data->{'overdue'} = 1; - } - $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue - $sth->finish; + return unless $data; + $data->{'overdue'} = ($data->{'date_due'} lt C4::Dates->today('iso')) ? 1 : 0; + $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue. + # FIXME: that would mean issues.itemnumber IS NULL and we didn't really match it. return ($data); } @@ -1713,23 +1730,20 @@ $issues = &GetItemIssues($itemnumber, $history); Returns patrons that have issued a book C<$itemnumber> is the itemnumber -C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history +C<$history> is false if you just want the current "issuer" (if any) +and true if you want issues history from old_issues also. -Returns an array of hashes +Returns reference to an array of hashes =cut sub GetItemIssues { - my ( $itemnumber,$history ) = @_; - my $dbh = C4::Context->dbh; - my @GetItemIssues; + my ( $itemnumber, $history ) = @_; - # get today date - my $today = POSIX::strftime("%Y%m%d", localtime); - + my $today = C4::Dates->today('iso'); # get today date my $sql = "SELECT * FROM issues JOIN borrowers USING (borrowernumber) - JOIN items USING (itemnumber) + JOIN items USING (itemnumber) WHERE issues.itemnumber = ? "; if ($history) { $sql .= "UNION ALL @@ -1739,23 +1753,17 @@ sub GetItemIssues { WHERE old_issues.itemnumber = ? "; } $sql .= "ORDER BY date_due DESC"; - my $sth = $dbh->prepare($sql); + my $sth = C4::Context->dbh->prepare($sql); if ($history) { $sth->execute($itemnumber, $itemnumber); } else { $sth->execute($itemnumber); } - while ( my $data = $sth->fetchrow_hashref ) { - my $datedue = $data->{'date_due'}; - $datedue =~ s/-//g; - if ( $datedue < $today ) { - $data->{'overdue'} = 1; - } - my $itemnumber = $data->{'itemnumber'}; - push @GetItemIssues, $data; + my $results = $sth->fetchall_arrayref({}); + foreach (@$results) { + $_->{'overdue'} = ($_->{'date_due'} lt $today) ? 1 : 0; } - $sth->finish; - return ( \@GetItemIssues ); + return $results; } =head2 GetBiblioIssues @@ -1780,7 +1788,7 @@ sub GetBiblioIssues { LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber LEFT JOIN items ON issues.itemnumber = items.itemnumber LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber - LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber + LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber WHERE biblio.biblionumber = ? UNION ALL SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname @@ -1788,7 +1796,7 @@ sub GetBiblioIssues { LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber LEFT JOIN items ON old_issues.itemnumber = items.itemnumber LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber - LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber + LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber WHERE biblio.biblionumber = ? ORDER BY timestamp "; @@ -1802,9 +1810,43 @@ sub GetBiblioIssues { return \@issues; } +=head2 GetUpcomingDueIssues + +=over 4 + +my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } ); + +=back + +=cut + +sub GetUpcomingDueIssues { + my $params = shift; + + $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'}; + my $dbh = C4::Context->dbh; + + my $statement = <{'days_in_advance'} ); + + my $sth = $dbh->prepare( $statement ); + $sth->execute( @bind_parameters ); + my $upcoming_dues = $sth->fetchall_arrayref({}); + $sth->finish; + + return $upcoming_dues; +} + =head2 CanBookBeRenewed -($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber); +($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]); Find out whether a borrowed item may be renewed. @@ -1815,6 +1857,10 @@ has the item on loan. C<$itemnumber> is the number of the item to renew. +C<$override_limit>, if supplied with a true value, causes +the limit on the number of times that the loan can be renewed +(as controlled by the item type) to be ignored. + C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The item must currently be on loan to the specified borrower; renewals must be allowed for the item's type; and the borrower must not have @@ -1825,7 +1871,7 @@ already renewed the loan. $error will contain the reason the renewal can not pro sub CanBookBeRenewed { # check renewal status - my ( $borrowernumber, $itemnumber ) = @_; + my ( $borrowernumber, $itemnumber, $override_limit ) = @_; my $dbh = C4::Context->dbh; my $renews = 1; my $renewokay = 0; @@ -1860,7 +1906,7 @@ sub CanBookBeRenewed { if ( my $data2 = $sth2->fetchrow_hashref ) { $renews = $data2->{'renewalsallowed'}; } - if ( $renews && $renews > $data1->{'renewals'} ) { + if ( ( $renews && $renews > $data1->{'renewals'} ) || $override_limit ) { $renewokay = 1; } else { @@ -1880,7 +1926,7 @@ sub CanBookBeRenewed { =head2 AddRenewal -&AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue]); +&AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]); Renews a loan. @@ -1889,25 +1935,34 @@ has the item. C<$itemnumber> is the number of the item to renew. -C<$branch> is the library branch. Defaults to the homebranch of the ITEM. +C<$branch> is the library where the renewal took place (if any). + The library that controls the circ policies for the renewal is retrieved from the issues record. C<$datedue> can be a C4::Dates object used to set the due date. +C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If +this parameter is not supplied, lastreneweddate is set to the current date. + If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically from the book's item type. =cut sub AddRenewal { - my $borrowernumber = shift or return undef; - my $itemnumber = shift or return undef; + + my $borrowernumber = shift or return undef; + my $itemnumber = shift or return undef; my $item = GetItem($itemnumber) or return undef; - my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef; my $branch = (@_) ? shift : $item->{homebranch}; # opac-renew doesn't send branch - my $datedue; + my $datedue = shift; + my $lastreneweddate = shift || C4::Dates->new()->output('iso'); + + + my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef; + # If the due date wasn't specified, calculate it by adding the # book's loan length to today's date. - unless (@_ and $datedue = shift and $datedue->output('iso')) { + unless ($datedue && $datedue->output('iso')) { my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef; my $loanlength = GetLoanLength( @@ -1916,10 +1971,15 @@ sub AddRenewal { $item->{homebranch} # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument? ); #FIXME -- use circControl? - $datedue = CalcDateDue(C4::Dates->new(),$loanlength,$branch); # this branch is the transactional branch. + $datedue = CalcDateDue(C4::Dates->new(),$loanlength,$branch,$borrower); # this branch is the transactional branch. # The question of whether to use item's homebranch calendar is open. } + # $lastreneweddate defaults to today. + unless (defined $lastreneweddate) { + $lastreneweddate = strftime( "%Y-%m-%d", localtime ); + } + my $dbh = C4::Context->dbh; # Find the issues record for this book my $sth = @@ -1930,20 +1990,40 @@ sub AddRenewal { $sth->execute( $borrowernumber, $itemnumber ); my $issuedata = $sth->fetchrow_hashref; $sth->finish; + if($datedue && ! $datedue->output('iso')){ + warn "Invalid date passed to AddRenewal."; + return undef; + } + # If the due date wasn't specified, calculate it by adding the + # book's loan length to today's date or the current due date + # based on the value of the RenewalPeriodBase syspref. + unless ($datedue) { + + my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef; + my $loanlength = GetLoanLength( + $borrower->{'categorycode'}, + (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} , + $issuedata->{'branchcode'} ); # that's the circ control branch. + + $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ? + C4::Dates->new($issuedata->{date_due}, 'iso') : + C4::Dates->new(); + $datedue = CalcDateDue($datedue,$loanlength,$issuedata->{'branchcode'},$borrower); + } # Update the issues record to have the new due date, and a new count # of how many times it has been renewed. my $renews = $issuedata->{'renewals'} + 1; - $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ? + $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ? WHERE borrowernumber=? AND itemnumber=?" ); - $sth->execute( $datedue->output('iso'), $renews, $borrowernumber, $itemnumber ); + $sth->execute( $datedue->output('iso'), $renews, $lastreneweddate, $borrowernumber, $itemnumber ); $sth->finish; # Update the renewal count on the item, and tell zebra to reindex $renews = $biblio->{'renewals'} + 1; - ModItem({ renewals => $renews }, $biblio->{'biblionumber'}, $itemnumber); + ModItem({ renewals => $renews, onloan => $datedue->output('iso') }, $biblio->{'biblionumber'}, $itemnumber); # Charge a new rental fee, if applicable? my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber ); @@ -1966,6 +2046,7 @@ sub AddRenewal { } # Log the renewal UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber); + return $datedue; } sub GetRenewCount { @@ -2231,17 +2312,32 @@ C<$loanlength> = loan length prior to adjustment =cut sub CalcDateDue { - my ($startdate,$loanlength,$branch) = @_; + my ($startdate,$loanlength,$branch,$borrower) = @_; + my $datedue; + if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar - my $datedue = time + ($loanlength) * 86400; + my $timedue = time + ($loanlength) * 86400; #FIXME - assumes now even though we take a startdate - my @datearr = localtime($datedue); - return C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso'); + my @datearr = localtime($timedue); + $datedue = C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso'); } else { my $calendar = C4::Calendar->new( branchcode => $branch ); - my $datedue = $calendar->addDate($startdate, $loanlength); - return $datedue; + $datedue = $calendar->addDate($startdate, $loanlength); } + + # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate + if ( C4::Context->preference('ReturnBeforeExpiry') && $datedue->output('iso') gt $borrower->{dateexpiry} ) { + $datedue = C4::Dates->new( $borrower->{dateexpiry}, 'iso' ); + } + + # if ceilingDueDate ON the datedue can't be after the ceiling date + if ( C4::Context->preference('ceilingDueDate') + && ( C4::Context->preference('ceilingDueDate') =~ C4::Dates->regexp('syspref') ) + && $datedue->output gt C4::Context->preference('ceilingDueDate') ) { + $datedue = C4::Dates->new( C4::Context->preference('ceilingDueDate') ); + } + + return $datedue; } =head2 CheckValidDatedue