X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FCirculation.pm;h=15613a185dfcaf91b1991055a4f2fc8d8b925f64;hb=284cfbc234397379dcda98b3f2238e09d9614631;hp=f218a8e7b4daa9933feba6c67f8b5035eb983ee0;hpb=fa848a66f05a7bfa7c65b65b78eb9d01e9cd4357;p=koha_gimpoz diff --git a/C4/Circulation.pm b/C4/Circulation.pm index f218a8e7b4..15613a185d 100644 --- a/C4/Circulation.pm +++ b/C4/Circulation.pm @@ -1,6 +1,7 @@ package C4::Circulation; # Copyright 2000-2002 Katipo Communications +# copyright 2010 BibLibre # # This file is part of Koha. # @@ -13,13 +14,13 @@ package C4::Circulation; # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR # A PARTICULAR PURPOSE. See the GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. use strict; -#use warnings; # soon! +#use warnings; FIXME - Bug 2505 use C4::Context; use C4::Stats; use C4::Reserves; @@ -31,7 +32,9 @@ use C4::Dates; use C4::Calendar; use C4::Accounts; use C4::ItemCirculationAlertPreference; +use C4::Dates qw(format_date); use C4::Message; +use C4::Debug; use Date::Calc qw( Today Today_and_Now @@ -68,7 +71,6 @@ BEGIN { &AddRenewal &GetRenewCount &GetItemIssue - &GetOpenIssue &GetItemIssues &GetBorrowerIssues &GetIssuingCharges @@ -76,6 +78,7 @@ BEGIN { &GetBranchBorrowerCircRule &GetBranchItemRule &GetBiblioIssues + &GetOpenIssue &AnonymiseIssueHistory ); @@ -116,11 +119,9 @@ Also deals with stocktaking. =head2 barcodedecode -=head3 $str = &barcodedecode($barcode, [$filter]); + $str = &barcodedecode($barcode, [$filter]); -=over 4 - -=item Generic filter function for barcode string. +Generic filter function for barcode string. Called on every circ if the System Pref itemBarcodeInputFilter is set. Will do some manipulation of the barcode for systems that deliver a barcode to circulation.pl that differs from the barcode stored for the item. @@ -131,8 +132,6 @@ 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 # FIXME -- the &decode fcn below should be wrapped into this one. @@ -140,6 +139,7 @@ System Pref options. # sub barcodedecode { my ($barcode, $filter) = @_; + my $branch = C4::Branch::mybranch(); $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter; $filter or return $barcode; # ensure filter is defined, else return untouched barcode if ($filter eq 'whitespace') { @@ -158,24 +158,28 @@ sub barcodedecode { # 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"? + } elsif ($filter eq 'libsuite8') { + unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it. + if($barcode =~ m/^(\d)/i){ #Some barcodes even start with 0's & numbers and are assumed to have b as the item type in the libsuite8 software + $barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i; + }else{ + $barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i; + } + } } return $barcode; # return barcode, modified or not } =head2 decode -=head3 $str = &decode($chunk); + $str = &decode($chunk); -=over 4 - -=item Decodes a segment of a string emitted by a CueCat barcode scanner and +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 sub decode { @@ -207,7 +211,8 @@ sub decode { =head2 transferbook -($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, $barcode, $ignore_reserves); + ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, + $barcode, $ignore_reserves); Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer. @@ -220,15 +225,17 @@ Otherwise, if an item is reserved, the transfer fails. Returns three values: -=head3 $dotransfer +=over + +=item $dotransfer is true if the transfer was successful. -=head3 $messages +=item $messages is a reference-to-hash which may have any of the following keys: -=over 4 +=over =item C @@ -256,6 +263,8 @@ The item was eligible to be transferred. Barring problems communicating with the =back +=back + =cut sub transferbook { @@ -325,8 +334,9 @@ sub transferbook { # don't need to update MARC anymore, we do it in batch now $messages->{'WasTransfered'} = 1; - ModDateLastSeen( $itemnumber ); + } + ModDateLastSeen( $itemnumber ); return ( $dotransfer, $messages, $biblio ); } @@ -339,16 +349,7 @@ 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 @@ -422,7 +423,7 @@ sub TooMany { my $max_loans_allowed = $issuing_rule->{'maxissueqty'}; if ($current_loan_count >= $max_loans_allowed) { - return "$current_loan_count / $max_loans_allowed"; + return ($current_loan_count, $max_loans_allowed); } } @@ -450,7 +451,7 @@ sub TooMany { my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty}; if ($current_loan_count >= $max_loans_allowed) { - return "$current_loan_count / $max_loans_allowed"; + return ($current_loan_count, $max_loans_allowed); } } @@ -540,7 +541,6 @@ sub itemissues { $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available'; } - $sth2->finish; # Find the last 3 people who borrowed this item. $sth2 = $dbh->prepare( @@ -560,20 +560,19 @@ sub itemissues { } # if } # for - $sth2->finish; $results[$i] = $data; $i++; } - $sth->finish; return (@results); } =head2 CanBookBeIssued -Check if a book can be issued. + ( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, + $barcode, $duedatespec, $inprocess ); -( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess ); +Check if a book can be issued. C<$issuingimpossible> and C<$needsconfirmation> are some hashref. @@ -630,7 +629,9 @@ item withdrawn. item is restricted (set by ??) -C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible. +C<$needsconfirmation> a reference to a hash. It contains reasons why the loan +could be prevented, but ones that can be overriden by the operator. + Possible values are : =head3 DEBT @@ -651,7 +652,7 @@ reserved for someone else. =head3 INVALID_DATE -sticky due date is invalid +sticky due date is invalid or due date in the past =head3 TOO_MANY @@ -669,10 +670,31 @@ 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'}; + $duedate = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $itype, $branch, $borrower ); + + # Offline circ calls AddIssue directly, doesn't run through here + # So issuingimpossible should be ok. + } + if ($duedate) { + $needsconfirmation{INVALID_DATE} = $duedate->output('syspref') + unless $duedate->output('iso') ge C4::Dates->today('iso'); + } else { + $issuingimpossible{INVALID_DATE} = $duedate->output('syspref'); + } # # BORROWER STATUS @@ -680,6 +702,7 @@ sub CanBookBeIssued { if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) { # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 . &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'}); + ModDateLastSeen( $item->{'itemnumber'} ); return( { STATS => 1 }, {}); } if ( $borrower->{flags}->{GNA} ) { @@ -707,34 +730,60 @@ sub CanBookBeIssued { # DEBTS my ($amount) = C4::Members::GetMemberAccountRecords( $borrower->{'borrowernumber'}, '' && $duedate->output('iso') ); + my $amountlimit = C4::Context->preference("noissuescharge"); + my $allowfineoverride = C4::Context->preference("AllowFineOverride"); + my $allfinesneedoverride = C4::Context->preference("AllFinesNeedOverride"); if ( C4::Context->preference("IssuingInProcess") ) { - my $amountlimit = C4::Context->preference("noissuescharge"); - if ( $amount > $amountlimit && !$inprocess ) { + if ( $amount > $amountlimit && !$inprocess && !$allowfineoverride) { $issuingimpossible{DEBT} = sprintf( "%.2f", $amount ); - } - elsif ( $amount > 0 && $amount <= $amountlimit && !$inprocess ) { + } elsif ( $amount > $amountlimit && !$inprocess && $allowfineoverride) { + $needsconfirmation{DEBT} = sprintf( "%.2f", $amount ); + } elsif ( $allfinesneedoverride && $amount > 0 && $amount <= $amountlimit && !$inprocess ) { $needsconfirmation{DEBT} = sprintf( "%.2f", $amount ); } } else { - if ( $amount > 0 ) { + if ( $amount > $amountlimit && $allowfineoverride ) { + $needsconfirmation{DEBT} = sprintf( "%.2f", $amount ); + } elsif ( $amount > $amountlimit && !$allowfineoverride) { + $issuingimpossible{DEBT} = sprintf( "%.2f", $amount ); + } elsif ( $amount > 0 && $allfinesneedoverride ) { $needsconfirmation{DEBT} = sprintf( "%.2f", $amount ); } } - # + my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'}); + if ($blocktype == -1) { + ## patron has outstanding overdue loans + if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){ + $issuingimpossible{USERBLOCKEDOVERDUE} = $count; + } + elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){ + $needsconfirmation{USERBLOCKEDOVERDUE} = $count; + } + } elsif($blocktype == 1) { + # patron has accrued fine days + $issuingimpossible{USERBLOCKEDREMAINING} = $count; + } + +# # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS # - my $toomany = TooMany( $borrower, $item->{biblionumber}, $item ); - $needsconfirmation{TOO_MANY} = $toomany if $toomany; + my ($current_loan_count, $max_loans_allowed) = TooMany( $borrower, $item->{biblionumber}, $item ); + # if TooMany max_loans_allowed returns 0 the user doesn't have permission to check out this book + if ($max_loans_allowed eq 0) { + $needsconfirmation{PATRON_CANT} = 1; + } else { + if($max_loans_allowed){ + $needsconfirmation{TOO_MANY} = 1; + $needsconfirmation{current_loan_count} = $current_loan_count; + $needsconfirmation{max_loans_allowed} = $max_loans_allowed; + } + } # # ITEM CHECKING # - unless ( $item->{barcode} ) { - $issuingimpossible{UNKNOWN_BARCODE} = 1; - } - if ( $item->{'notforloan'} && $item->{'notforloan'} > 0 ) { @@ -752,12 +801,20 @@ sub CanBookBeIssued { $sth->execute($item->{'itemtype'}); my $notforloan=$sth->fetchrow_hashref(); $sth->finish(); - if ($notforloan->{'notforloan'} == 1){ - $issuingimpossible{NOT_FOR_LOAN} = 1; + if ($notforloan->{'notforloan'}) { + if (!C4::Context->preference("AllowNotForLoanOverride")) { + $issuingimpossible{NOT_FOR_LOAN} = 1; + } else { + $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1; + } } } elsif ($biblioitem->{'notforloan'} == 1){ - $issuingimpossible{NOT_FOR_LOAN} = 1; + if (!C4::Context->preference("AllowNotForLoanOverride")) { + $issuingimpossible{NOT_FOR_LOAN} = 1; + } else { + $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1; + } } } if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 ) @@ -771,9 +828,11 @@ sub CanBookBeIssued { } if ( C4::Context->preference("IndependantBranches") ) { my $userenv = C4::Context->userenv; - if ( ($userenv) && ( $userenv->{flags} != 1 ) ) { - $issuingimpossible{NOTSAMEBRANCH} = 1 + if ( ($userenv) && ( $userenv->{flags} % 2 != 1 ) ) { + $issuingimpossible{ITEMNOTSAMEBRANCH} = 1 if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ); + $needsconfirmation{BORRNOTSAMEBRANCH} = GetBranchName( $borrower->{'branchcode'} ) + if ( $borrower->{'branchcode'} ne $userenv->{branch} ); } } @@ -802,8 +861,11 @@ sub CanBookBeIssued { my $currborinfo = C4::Members::GetMemberDetails( $issue->{borrowernumber} ); # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})"; - $needsconfirmation{ISSUED_TO_ANOTHER} = -"$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})"; + $needsconfirmation{ISSUED_TO_ANOTHER} = 1; + $needsconfirmation{issued_firstname} = $currborinfo->{'firstname'}; + $needsconfirmation{issued_surname} = $currborinfo->{'surname'}; + $needsconfirmation{issued_cardnumber} = $currborinfo->{'cardnumber'}; + $needsconfirmation{issued_borrowernumber} = $currborinfo->{'borrowernumber'}; } # See if the item is on reserve. @@ -817,29 +879,33 @@ sub CanBookBeIssued { { # The item is on reserve and waiting, but has been # reserved by some other patron. - $needsconfirmation{RESERVE_WAITING} = -"$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)"; + $needsconfirmation{RESERVE_WAITING} = 1; + $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'}; + $needsconfirmation{'ressurname'} = $resborrower->{'surname'}; + $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'}; + $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'}; + $needsconfirmation{'resbranchname'} = $branchname; + $needsconfirmation{'reswaitingdate'} = format_date($res->{'waitingdate'}); } elsif ( $restype eq "Reserved" ) { # The item is on reserve for someone else. - $needsconfirmation{RESERVED} = -"$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})"; + $needsconfirmation{RESERVED} = 1; + $needsconfirmation{'resfirstname'} = $resborrower->{'firstname'}; + $needsconfirmation{'ressurname'} = $resborrower->{'surname'}; + $needsconfirmation{'rescardnumber'} = $resborrower->{'cardnumber'}; + $needsconfirmation{'resborrowernumber'} = $resborrower->{'borrowernumber'}; + $needsconfirmation{'resbranchname'} = $branchname; + $needsconfirmation{'resreservedate'} = format_date($res->{'reservedate'}); } } - if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" ) { - if ( $borrower->{'categorycode'} eq 'W' ) { - my %emptyhash; - return ( \%emptyhash, \%needsconfirmation ); - } - } return ( \%issuingimpossible, \%needsconfirmation ); } =head2 AddIssue -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, [$datedue], [$cancelreserve], [$issuedate]) -&AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate]) +Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed. =over 4 @@ -877,7 +943,6 @@ sub AddIssue { 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 ); @@ -887,9 +952,7 @@ sub AddIssue { if ($borrower and $barcode and $barcodecheck ne '0'){ # find which item we issue my $item = GetItem('', $barcode) or return undef; # if we don't get an Item, abort. - my $branch = (C4::Context->preference('CircControl') eq 'PickupLibrary') ? C4::Context->userenv->{'branch'} : - (C4::Context->preference('CircControl') eq 'PatronLibrary') ? $borrower->{'branchcode'} : - $item->{'homebranch'}; # fallback to item's homebranch + my $branch = _GetCircControlBranch($item,$borrower); # get actual issuing if there is one my $actualissue = GetItemIssue( $item->{itemnumber}); @@ -978,20 +1041,8 @@ sub AddIssue { ); 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 ); + $datedue = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $itype, $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' ); - } - - # 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') ); - } } $sth->execute( $borrower->{'borrowernumber'}, # borrowernumber @@ -1001,6 +1052,9 @@ sub AddIssue { C4::Context->userenv->{'branch'} # branchcode ); $sth->finish; + if ( C4::Context->preference('ReturnToShelvingCart') ) { ## ReturnToShelvingCart is on, anything issued should be taken off the cart. + CartToShelf( $item->{'itemnumber'} ); + } $item->{'issues'}++; ModItem({ issues => $item->{'issues'}, holdingbranch => C4::Context->userenv->{'branch'}, @@ -1049,7 +1103,7 @@ sub AddIssue { } } - logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'}) + logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'}) if C4::Context->preference("IssueLog"); } return ($datedue); # not necessarily the same as when it came in! @@ -1057,9 +1111,9 @@ sub AddIssue { =head2 GetLoanLength -Get loan length for an itemtype, a borrower type and a branch + my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode) -my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode) +Get loan length for an itemtype, a borrower type and a branch =cut @@ -1117,17 +1171,77 @@ sub GetLoanLength { return 21; } + +=head2 GetHardDueDate + + my ($hardduedate,$hardduedatecompare) = &GetHardDueDate($borrowertype,$itemtype,branchcode) + +Get the Hard Due Date and it's comparison for an itemtype, a borrower type and a branch + +=cut + +sub GetHardDueDate { + my ( $borrowertype, $itemtype, $branchcode ) = @_; + my $dbh = C4::Context->dbh; + my $sth = + $dbh->prepare( +"select hardduedate, hardduedatecompare from issuingrules where categorycode=? and itemtype=? and branchcode=?" + ); + $sth->execute( $borrowertype, $itemtype, $branchcode ); + my $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + $sth->execute( $borrowertype, "*", $branchcode ); + $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + $sth->execute( "*", $itemtype, $branchcode ); + $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + $sth->execute( "*", "*", $branchcode ); + $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + $sth->execute( $borrowertype, $itemtype, "*" ); + $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + $sth->execute( $borrowertype, "*", "*" ); + $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + $sth->execute( "*", $itemtype, "*" ); + $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + $sth->execute( "*", "*", "*" ); + $results = $sth->fetchrow_hashref; + return (C4::Dates->new($results->{hardduedate}, 'iso'),$results->{hardduedatecompare}) + if defined($results) && $results->{hardduedate} ne 'NULL'; + + # if no rule is set => return undefined + return (undef, undef); +} + =head2 GetIssuingRule -FIXME - This is a copy-paste of GetLoanLength + my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode) + +FIXME - This is a copy-paste of GetLoanLength as a stop-gap. Do not wish to change API for GetLoanLength this close to release, however, Overdues::GetIssuingRules is broken. Get the issuing rule for an itemtype, a borrower type and a branch Returns a hashref from the issuingrules table. -my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode) - =cut sub GetIssuingRule { @@ -1174,11 +1288,7 @@ sub GetIssuingRule { =head2 GetBranchBorrowerCircRule -=over 4 - -my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode); - -=back + my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode); Retrieves circulation rule attributes that apply to the given branch and patron category, regardless of item type. @@ -1261,11 +1371,7 @@ sub GetBranchBorrowerCircRule { =head2 GetBranchItemRule -=over 4 - -my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype); - -=back + my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype); Retrieves circulation rule attributes that apply to the given branch and item type, regardless of patron category. @@ -1325,8 +1431,8 @@ sub GetBranchItemRule { =head2 AddReturn -($doreturn, $messages, $iteminformation, $borrower) = - &AddReturn($barcode, $branch, $exemptfine, $dropbox); + ($doreturn, $messages, $iteminformation, $borrower) = + &AddReturn($barcode, $branch, $exemptfine, $dropbox); Returns a book. @@ -1351,7 +1457,8 @@ C<&AddReturn> returns a list of four items: C<$doreturn> is true iff the return succeeded. -C<$messages> is a reference-to-hash giving the reason for failure: +C<$messages> is a reference-to-hash giving feedback on the operation. +The keys of the hash are: =over 4 @@ -1373,6 +1480,12 @@ the book's home branch. This book has been withdrawn/cancelled. The value should be ignored. +=item C + +This book has was returned to the wrong branch. The value is a hashref +so that C<$messages->{Wrongbranch}->{Wrongbranch}> and C<$messages->{Wrongbranch}->{Rightbranch}> +contain the branchcode of the incorrect and correct return library, respectively. + =item C The item was reserved. The value is a reference-to-hash whose keys are @@ -1382,6 +1495,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. @@ -1389,198 +1505,189 @@ patron who last borrowed the book. sub AddReturn { my ( $barcode, $branch, $exemptfine, $dropbox ) = @_; - my $dbh = C4::Context->dbh; + if ($branch and not GetBranchDetail($branch)) { + warn "AddReturn error: branch '$branch' not found. Reverting to " . C4::Context->userenv->{'branch'}; + undef $branch; + } + $branch = C4::Context->userenv->{'branch'} unless $branch; # we trust userenv to be a safe fallback/default my $messages; - my $doreturn = 1; my $borrower; + my $biblio; + my $doreturn = 1; my $validTransfert = 0; - my $reserveDone = 0; # get information on item - my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode)); - my $biblio = GetBiblioItemData($iteminformation->{'biblioitemnumber'}); -# use Data::Dumper;warn Data::Dumper::Dumper($iteminformation); - unless ($iteminformation->{'itemnumber'} ) { - $messages->{'BadBarcode'} = $barcode; - $doreturn = 0; + my $itemnumber = GetItemnumberFromBarcode( $barcode ); + unless ($itemnumber) { + return (0, { BadBarcode => $barcode }); # no barcode means no item or borrower. bail out. + } + my $issue = GetItemIssue($itemnumber); +# warn Dumper($iteminformation); + if ($issue and $issue->{borrowernumber}) { + $borrower = C4::Members::GetMemberDetails($issue->{borrowernumber}) + or die "Data inconsistency: barcode $barcode (itemnumber:$itemnumber) claims to be issued to non-existant borrowernumber '$issue->{borrowernumber}'\n" + . Dumper($issue) . "\n"; } else { - # find the borrower - if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) { - $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'}; - $iteminformation->{'itemlost'} = $curr_iteminfo->{'itemlost'}; - $doreturn = 0; - } - - # check if the book is in a permanent collection.... - my $hbr = $iteminformation->{C4::Context->preference("HomeOrHoldingBranch")}; - my $branches = GetBranches(); - # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality. - if ( $hbr && $branches->{$hbr}->{'PE'} ) { - $messages->{'IsPermanent'} = $hbr; - } - - # if independent branches are on and returning to different branch, refuse the return - if ($hbr ne C4::Context->userenv->{'branch'} && C4::Context->preference("IndependantBranches")){ - $messages->{'Wrongbranch'} = 1; - $doreturn=0; - } - - # check that the book has been cancelled - if ( $iteminformation->{'wthdrawn'} ) { - $messages->{'wthdrawn'} = 1; - $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 - $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 ); - - # case of a return of document (deal with issues and holdingbranch) - - if ($doreturn) { - my $circControlBranch; - 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? + $messages->{'NotIssued'} = $barcode; + # even though item is not on loan, it may still be transferred; therefore, get current branch info + $doreturn = 0; + # No issue, no borrowernumber. ONLY if $doreturn, *might* you have a $borrower later. + } - - # 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 ); - } + my $item = GetItem($itemnumber) or die "GetItem($itemnumber) failed"; + # full item data, but no borrowernumber or checkout info (no issue) + # we know GetItem should work because GetItemnumberFromBarcode worked + my $hbr = C4::Context->preference("HomeOrHoldingBranchReturn") || "homebranch"; + $hbr = $item->{$hbr} || ''; + # item must be from items table -- issues table has branchcode and issuingbranch, not homebranch nor holdingbranch + + my $borrowernumber = $borrower->{'borrowernumber'} || undef; # we don't know if we had a borrower or not + + # check if the book is in a permanent collection.... + # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality. + if ( $hbr ) { + my $branches = GetBranches(); # a potentially expensive call for a non-feature. + $branches->{$hbr}->{PE} and $messages->{'IsPermanent'} = $hbr; + } + + # if indy branches and returning to different branch, refuse the return + if ($hbr ne $branch && C4::Context->preference("IndependantBranches")){ + $messages->{'Wrongbranch'} = { + Wrongbranch => $branch, + Rightbranch => $hbr, + }; + $doreturn = 0; + # bailing out here - in this case, current desired behavior + # is to act as if no return ever happened at all. + # FIXME - even in an indy branches situation, there should + # still be an option for the library to accept the item + # and transfer it to its owning library. + return ( $doreturn, $messages, $issue, $borrower ); + } + + if ( $item->{'wthdrawn'} ) { # book has been cancelled + $messages->{'wthdrawn'} = 1; + $doreturn = 0; + } + + # case of a return of document (deal with issues and holdingbranch) + if ($doreturn) { + $borrower or warn "AddReturn without current borrower"; + my $circControlBranch; + if ($dropbox) { + # define circControlBranch only if dropbox mode is set + # don't allow dropbox mode to create an invalid entry in issues (issuedate > today) + # FIXME: check issuedate > returndate, factoring in holidays + $circControlBranch = _GetCircControlBranch($item,$borrower) unless ( $item->{'issuedate'} eq C4::Dates->today('iso') );; } - # fix up the accounts..... - if ( $iteminformation->{'itemlost'} ) { - $messages->{'WasLost'} = 1; + + if ($borrowernumber) { + MarkIssueReturned($borrowernumber, $item->{'itemnumber'}, $circControlBranch, '', $borrower->{'privacy'}); + $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right? This could be the borrower hash. } - - # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # - # check if we have a transfer for this document - my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} ); - - # 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'} ) { - my $sth = - $dbh->prepare( - "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL" - ); - $sth->execute( $iteminformation->{'itemnumber'} ); - $sth->finish; - # 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' - C4::Reserves::ModReserveStatus( $iteminformation->{'itemnumber'},'W' ); - } - else { - $messages->{'WrongTransfer'} = $tobranch; - $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'}; + + ModItem({ onloan => undef }, $issue->{'biblionumber'}, $item->{'itemnumber'}); + } + + # the holdingbranch is updated if the document is returned to another location. + # this is always done regardless of whether the item was on loan or not + if ($item->{'holdingbranch'} ne $branch) { + UpdateHoldingbranch($branch, $item->{'itemnumber'}); + $item->{'holdingbranch'} = $branch; # update item data holdingbranch too + } + ModDateLastSeen( $item->{'itemnumber'} ); + + # check if we have a transfer for this document + my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->{'itemnumber'} ); + + # if we have a transfer to do, we update the line of transfers with the datearrived + if ($datesent) { + if ( $tobranch eq $branch ) { + my $sth = C4::Context->dbh->prepare( + "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL" + ); + $sth->execute( $item->{'itemnumber'} ); + # if we have a reservation with valid transfer, we can set it's status to 'W' + C4::Reserves::ModReserveStatus($item->{'itemnumber'}, 'W'); + } else { + $messages->{'WrongTransfer'} = $tobranch; + $messages->{'WrongTransferItem'} = $item->{'itemnumber'}; } $validTransfert = 1; - } - - # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # - # fix up the accounts..... - if ($iteminformation->{'itemlost'}) { - FixAccountForLostAndReturned($iteminformation, $borrower); - $messages->{'WasLost'} = 1; - } - # fix up the overdues in accounts... - FixOverduesOnReturn( $borrower->{'borrowernumber'}, - $iteminformation->{'itemnumber'}, $exemptfine, $dropbox ); - + } + + # fix up the accounts..... + if ($item->{'itemlost'}) { + _FixAccountForLostAndReturned($item->{'itemnumber'}, $borrowernumber, $barcode); # can tolerate undef $borrowernumber + $messages->{'WasLost'} = 1; + } + + # fix up the overdues in accounts... + if ($borrowernumber) { + my $fix = _FixOverduesOnReturn($borrowernumber, $item->{itemnumber}, $exemptfine, $dropbox); + defined($fix) or warn "_FixOverduesOnReturn($borrowernumber, $item->{itemnumber}...) failed!"; # zero is OK, check defined + } + # 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'} ); - if ($resfound) { - $resrec->{'ResFound'} = $resfound; - $messages->{'ResFound'} = $resrec; - $reserveDone = 1; - } - - # update stats? - # Record the fact that this book was returned. - UpdateStats( - $branch, 'return', '0', '', - $iteminformation->{'itemnumber'}, - $biblio->{'itemtype'}, - $borrower->{'borrowernumber'} - ); + # if we don't have a reserve with the status W, we launch the Checkreserves routine + my ($resfound, $resrec) = C4::Reserves::CheckReserves( $item->{'itemnumber'} ); + if ($resfound) { + $resrec->{'ResFound'} = $resfound; + $messages->{'ResFound'} = $resrec; + } - # Send a check-in slip. - my $circulation_alert = 'C4::ItemCirculationAlertPreference'; - my %conditions = ( - branchcode => $branch, - categorycode => $borrower->{categorycode}, - item_type => $iteminformation->{itype}, - notification => 'CHECKIN', - ); - if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) { - SendCirculationAlert({ - type => 'CHECKIN', - item => $iteminformation, - borrower => $borrower, - branch => $branch, - }); - } - - logaction("CIRCULATION", "RETURN", $iteminformation->{borrowernumber}, $iteminformation->{'biblionumber'}) - if C4::Context->preference("ReturnLog"); - - #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 ($doreturn and ($branch ne $iteminformation->{'homebranch'}) 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'}); - $messages->{'WasTransfered'} = 1; - } elsif ( C4::Context->preference("UseBranchTransferLimits") == 1 - && ! IsBranchTransferAllowed( $branch, $iteminformation->{'homebranch'}, $iteminformation->{ C4::Context->preference("BranchTransferLimitsType") } ) - ) { - ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'}); - $messages->{'WasTransfered'} = 1; - } - else { - $messages->{'NeedsTransfer'} = 1; - } + # update stats? + # Record the fact that this book was returned. + UpdateStats( + $branch, 'return', '0', '', + $item->{'itemnumber'}, + $biblio->{'itemtype'}, + $borrowernumber + ); + + # Send a check-in slip. # NOTE: borrower may be undef. probably shouldn't try to send messages then. + my $circulation_alert = 'C4::ItemCirculationAlertPreference'; + my %conditions = ( + branchcode => $branch, + categorycode => $borrower->{categorycode}, + item_type => $item->{itype}, + notification => 'CHECKIN', + ); + if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) { + SendCirculationAlert({ + type => 'CHECKIN', + item => $item, + borrower => $borrower, + branch => $branch, + }); + } + + logaction("CIRCULATION", "RETURN", $borrowernumber, $item->{'biblionumber'}) + if C4::Context->preference("ReturnLog"); + + # FIXME: make this comment intelligible. + #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 (($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $hbr) and not $messages->{'WrongTransfer'}){ + if ( C4::Context->preference("AutomaticItemReturn" ) or + (C4::Context->preference("UseBranchTransferLimits") and + ! IsBranchTransferAllowed($branch, $hbr, $item->{C4::Context->preference("BranchTransferLimitsType")} ) + )) { + $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s)", $item->{'itemnumber'},$branch, $hbr; + $debug and warn "item: " . Dumper($item); + ModItemTransfer($item->{'itemnumber'}, $branch, $hbr); + $messages->{'WasTransfered'} = 1; + } else { + $messages->{'NeedsTransfer'} = 1; # TODO: instead of 1, specify branchcode that the transfer SHOULD go to, $item->{homebranch} } } - return ( $doreturn, $messages, $iteminformation, $borrower ); + return ( $doreturn, $messages, $issue, $borrower ); } =head2 MarkIssueReturned -=over 4 - -MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate); - -=back + MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy); Unconditionally marks an issue as being returned by moving the C row to C and @@ -1592,6 +1699,9 @@ 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. +C<$privacy> contains the privacy parameter. If the patron has set privacy to 2, +the old_issue is immediately anonymised + Ideally, this function would be internal to C, not exported, but it is currently needed by one routine in C. @@ -1599,7 +1709,7 @@ routine in C. =cut sub MarkIssueReturned { - my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate ) = @_; + my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate, $privacy ) = @_; my $dbh = C4::Context->dbh; my $query = "UPDATE issues SET returndate="; my @bind; @@ -1623,15 +1733,25 @@ sub MarkIssueReturned { WHERE borrowernumber = ? AND itemnumber = ?"); $sth_copy->execute($borrowernumber, $itemnumber); + # anonymise patron checkout immediately if $privacy set to 2 and AnonymousPatron is set to a valid borrowernumber + if ( $privacy == 2) { + # The default of 0 does not work due to foreign key constraints + # The anonymisation will fail quietly if AnonymousPatron is not a valid entry + my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0; + my $sth_ano = $dbh->prepare("UPDATE old_issues SET borrowernumber=? + WHERE borrowernumber = ? + AND itemnumber = ?"); + $sth_ano->execute($anonymouspatron, $borrowernumber, $itemnumber); + } my $sth_del = $dbh->prepare("DELETE FROM issues WHERE borrowernumber = ? AND itemnumber = ?"); $sth_del->execute($borrowernumber, $itemnumber); } -=head2 FixOverduesOnReturn +=head2 _FixOverduesOnReturn - &FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode); + &_FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode); C<$brn> borrowernumber @@ -1640,199 +1760,220 @@ C<$itm> itemnumber C<$exemptfine> BOOL -- remove overdue charge associated with this issue. C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue. -internal function, called only by AddReturn +Internal function, called only by AddReturn =cut -sub FixOverduesOnReturn { - my ( $borrowernumber, $item, $exemptfine, $dropbox ) = @_; +sub _FixOverduesOnReturn { + my ($borrowernumber, $item); + unless ($borrowernumber = shift) { + warn "_FixOverduesOnReturn() not supplied valid borrowernumber"; + return; + } + unless ($item = shift) { + warn "_FixOverduesOnReturn() not supplied valid itemnumber"; + return; + } + my ($exemptfine, $dropbox) = @_; my $dbh = C4::Context->dbh; # check for overdue fine - my $sth = - $dbh->prepare( + my $sth = $dbh->prepare( "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')" - ); + ); $sth->execute( $borrowernumber, $item ); # alter fine to show that the book has been returned - my $data; - if ($data = $sth->fetchrow_hashref) { - my $uquery; - my @bind = ($borrowernumber,$item ,$data->{'accountno'}); - if ($exemptfine) { - $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0"; - if (C4::Context->preference("FinesLog")) { - &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item"); - } - } elsif ($dropbox && $data->{lastincrement}) { - my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ; - my $amt = $data->{amount} - $data->{lastincrement} ; - if (C4::Context->preference("FinesLog")) { - &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item"); - } - $uquery = "update accountlines set accounttype='F' "; - if($outstanding >= 0 && $amt >=0) { - $uquery .= ", amount = ? , amountoutstanding=? "; - unshift @bind, ($amt, $outstanding) ; - } - } else { - $uquery = "update accountlines set accounttype='F' "; - } - $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)"; - my $usth = $dbh->prepare($uquery); - $usth->execute(@bind); - $usth->finish(); + my $data = $sth->fetchrow_hashref; + return 0 unless $data; # no warning, there's just nothing to fix + + my $uquery; + my @bind = ($borrowernumber, $item, $data->{'accountno'}); + if ($exemptfine) { + $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0"; + if (C4::Context->preference("FinesLog")) { + &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item"); + } + } elsif ($dropbox && $data->{lastincrement}) { + my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ; + my $amt = $data->{amount} - $data->{lastincrement} ; + if (C4::Context->preference("FinesLog")) { + &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item"); + } + $uquery = "update accountlines set accounttype='F' "; + if($outstanding >= 0 && $amt >=0) { + $uquery .= ", amount = ? , amountoutstanding=? "; + unshift @bind, ($amt, $outstanding) ; + } + } else { + $uquery = "update accountlines set accounttype='F' "; } + $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)"; + my $usth = $dbh->prepare($uquery); + return $usth->execute(@bind); +} + +=head2 _FixAccountForLostAndReturned + + &_FixAccountForLostAndReturned($itemnumber, [$borrowernumber, $barcode]); + +Calculates the charge for a book lost and returned. + +Internal function, not exported, called only by AddReturn. + +FIXME: This function reflects how inscrutable fines logic is. Fix both. +FIXME: Give a positive return value on success. It might be the $borrowernumber who received credit, or the amount forgiven. + +=cut - $sth->finish(); +sub _FixAccountForLostAndReturned { + my $itemnumber = shift or return; + my $borrowernumber = @_ ? shift : undef; + my $item_id = @_ ? shift : $itemnumber; # Send the barcode if you want that logged in the description + my $dbh = C4::Context->dbh; + # check for charge made for lost book + my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC"); + $sth->execute($itemnumber); + my $data = $sth->fetchrow_hashref; + $data or return; # bail if there is nothing to do + + # writeoff this amount + my $offset; + my $amount = $data->{'amount'}; + my $acctno = $data->{'accountno'}; + my $amountleft; # Starts off undef/zero. + if ($data->{'amountoutstanding'} == $amount) { + $offset = $data->{'amount'}; + $amountleft = 0; # Hey, it's zero here, too. + } else { + $offset = $amount - $data->{'amountoutstanding'}; # Um, isn't this the same as ZERO? We just tested those two things are == + $amountleft = $data->{'amountoutstanding'} - $amount; # Um, isn't this the same as ZERO? We just tested those two things are == + } + my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0' + WHERE (borrowernumber = ?) + AND (itemnumber = ?) AND (accountno = ?) "); + $usth->execute($data->{'borrowernumber'},$itemnumber,$acctno); # We might be adjusting an account for some OTHER borrowernumber now. Not the one we passed in. + #check if any credit is left if so writeoff other accounts + my $nextaccntno = getnextacctno($data->{'borrowernumber'}); + $amountleft *= -1 if ($amountleft < 0); + if ($amountleft > 0) { + my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?) + AND (amountoutstanding >0) ORDER BY date"); # might want to order by amountoustanding ASC (pay smallest first) + $msth->execute($data->{'borrowernumber'}); + # offset transactions + my $newamtos; + my $accdata; + while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){ + if ($accdata->{'amountoutstanding'} < $amountleft) { + $newamtos = 0; + $amountleft -= $accdata->{'amountoutstanding'}; + } else { + $newamtos = $accdata->{'amountoutstanding'} - $amountleft; + $amountleft = 0; + } + my $thisacct = $accdata->{'accountno'}; + # FIXME: move prepares outside while loop! + my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ? + WHERE (borrowernumber = ?) + AND (accountno=?)"); + $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct'); # FIXME: '$thisacct' is a string literal! + $usth = $dbh->prepare("INSERT INTO accountoffsets + (borrowernumber, accountno, offsetaccount, offsetamount) + VALUES + (?,?,?,?)"); + $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos); + } + $msth->finish; # $msth might actually have data left + } + $amountleft *= -1 if ($amountleft > 0); + my $desc = "Item Returned " . $item_id; + $usth = $dbh->prepare("INSERT INTO accountlines + (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding) + VALUES (?,?,now(),?,?,'CR',?)"); + $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft); + if ($borrowernumber) { + # FIXME: same as query above. use 1 sth for both + $usth = $dbh->prepare("INSERT INTO accountoffsets + (borrowernumber, accountno, offsetaccount, offsetamount) + VALUES (?,?,?,?)"); + $usth->execute($borrowernumber, $data->{'accountno'}, $nextaccntno, $offset); + } + ModItem({ paidfor => '' }, undef, $itemnumber); return; } -=head2 FixAccountForLostAndReturned +=head2 _GetCircControlBranch - &FixAccountForLostAndReturned($iteminfo,$borrower); + my $circ_control_branch = _GetCircControlBranch($iteminfos, $borrower); -Calculates the charge for a book lost and returned (Not exported & used only once) +Internal function : -C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used. +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<$borrower> is a hashref to borrower. Only {borrowernumber is used. +C<$iteminfos> is a hashref to iteminfo. Only {homebranch or holdingbranch} is used. -Internal function, called by AddReturn +C<$borrower> is a hashref to borrower. Only {branchcode} is used. =cut -sub FixAccountForLostAndReturned { - my ($iteminfo, $borrower) = @_; - my $dbh = C4::Context->dbh; - my $itm = $iteminfo->{'itemnumber'}; - # check for charge made for lost book - my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC"); - $sth->execute($itm); - if (my $data = $sth->fetchrow_hashref) { - # writeoff this amount - my $offset; - my $amount = $data->{'amount'}; - my $acctno = $data->{'accountno'}; - my $amountleft; - if ($data->{'amountoutstanding'} == $amount) { - $offset = $data->{'amount'}; - $amountleft = 0; - } else { - $offset = $amount - $data->{'amountoutstanding'}; - $amountleft = $data->{'amountoutstanding'} - $amount; - } - my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0' - 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){ - $amountleft*=-1; - } - if ($amountleft > 0){ - my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?) - AND (amountoutstanding >0) ORDER BY date"); - $msth->execute($data->{'borrowernumber'}); - # offset transactions - my $newamtos; - my $accdata; - while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){ - if ($accdata->{'amountoutstanding'} < $amountleft) { - $newamtos = 0; - $amountleft -= $accdata->{'amountoutstanding'}; - } else { - $newamtos = $accdata->{'amountoutstanding'} - $amountleft; - $amountleft = 0; - } - my $thisacct = $accdata->{'accountno'}; - my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ? - WHERE (borrowernumber = ?) - AND (accountno=?)"); - $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct'); - $usth->finish; - $usth = $dbh->prepare("INSERT INTO accountoffsets - (borrowernumber, accountno, offsetaccount, offsetamount) - VALUES - (?,?,?,?)"); - $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos); - $usth->finish; - } - $msth->finish; - } - if ($amountleft > 0){ - $amountleft*=-1; - } - my $desc="Item Returned ".$iteminfo->{'barcode'}; - $usth = $dbh->prepare("INSERT INTO accountlines - (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; +sub _GetCircControlBranch { + my ($item, $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 = $item->{$branchfield}; + # default to item home branch if holdingbranch is used + # and is not defined + if (!defined($branch) && $branchfield eq 'holdingbranch') { + $branch = $item->{homebranch}; + } + } + return $branch; } -=head2 GetItemIssue -$issues = &GetItemIssue($itemnumber); -Returns patrons currently having a book. nothing if item is not issued atm -C<$itemnumber> is the itemnumber -Returns an array of hashes -FIXME: Though the above says that this function returns nothing if the -item is not issued, this actually returns a hasref that looks like -this: - { - itemnumber => 1, - overdue => 1 - } +=head2 GetItemIssue + $issue = &GetItemIssue($itemnumber); + +Returns patron currently having a book, or undef if not checked out. + +C<$itemnumber> is the itemnumber. + +C<$issue> is a hashref of the row from the issues table. =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; return ($data); } =head2 GetOpenIssue -$issue = GetOpenIssue( $itemnumber ); + $issue = GetOpenIssue( $itemnumber ); Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued @@ -1854,28 +1995,25 @@ sub GetOpenIssue { =head2 GetItemIssues -$issues = &GetItemIssues($itemnumber, $history); + $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 @@ -1885,28 +2023,22 @@ 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 -$issues = GetBiblioIssues($biblionumber); + $issues = GetBiblioIssues($biblionumber); this function get all issues from a biblionumber. @@ -1950,11 +2082,7 @@ sub GetBiblioIssues { =head2 GetUpcomingDueIssues -=over 4 - -my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } ); - -=back + my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } ); =cut @@ -1984,7 +2112,7 @@ END_SQL =head2 CanBookBeRenewed -($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]); + ($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]); Find out whether a borrowed item may be renewed. @@ -2018,39 +2146,52 @@ sub CanBookBeRenewed { # Look in the issues table for this item, lent to this borrower, # and not yet returned. - # FIXME - I think this function could be redone to use only one SQL call. - my $sth1 = $dbh->prepare( - "SELECT * FROM issues - WHERE borrowernumber = ? - AND itemnumber = ?" - ); - $sth1->execute( $borrowernumber, $itemnumber ); - if ( my $data1 = $sth1->fetchrow_hashref ) { - - # Found a matching item - - # See if this item may be renewed. This query is convoluted - # because it's a bit messy: given the item number, we need to find - # the biblioitem, which gives us the itemtype, which tells us - # whether it may be renewed. - my $query = "SELECT renewalsallowed FROM items "; - $query .= (C4::Context->preference('item-level_itypes')) - ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype " - : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber - LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype "; - $query .= "WHERE items.itemnumber = ?"; - my $sth2 = $dbh->prepare($query); - $sth2->execute($itemnumber); - if ( my $data2 = $sth2->fetchrow_hashref ) { - $renews = $data2->{'renewalsallowed'}; - } - if ( ( $renews && $renews > $data1->{'renewals'} ) || $override_limit ) { + # Look in the issues table for this item, lent to this borrower, + # and not yet returned. + my %branch = ( + 'ItemHomeLibrary' => 'items.homebranch', + 'PickupLibrary' => 'items.holdingbranch', + 'PatronLibrary' => 'borrowers.branchcode' + ); + my $controlbranch = $branch{C4::Context->preference('CircControl')}; + my $itype = C4::Context->preference('item-level_itypes') ? 'items.itype' : 'biblioitems.itemtype'; + + my $sthcount = $dbh->prepare(" + SELECT + borrowers.categorycode, biblioitems.itemtype, issues.renewals, renewalsallowed, $controlbranch + FROM issuingrules, + issues + LEFT JOIN items USING (itemnumber) + LEFT JOIN borrowers USING (borrowernumber) + LEFT JOIN biblioitems USING (biblioitemnumber) + + WHERE + (issuingrules.categorycode = borrowers.categorycode OR issuingrules.categorycode = '*') + AND + (issuingrules.itemtype = $itype OR issuingrules.itemtype = '*') + AND + (issuingrules.branchcode = $controlbranch OR issuingrules.branchcode = '*') + AND + borrowernumber = ? + AND + itemnumber = ? + ORDER BY + issuingrules.categorycode desc, + issuingrules.itemtype desc, + issuingrules.branchcode desc + LIMIT 1; + "); + + $sthcount->execute( $borrowernumber, $itemnumber ); + if ( my $data1 = $sthcount->fetchrow_hashref ) { + + if ( ( $data1->{renewalsallowed} && $data1->{renewalsallowed} > $data1->{renewals} ) || $override_limit ) { $renewokay = 1; } else { $error="too_many"; } - $sth2->finish; + my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber); if ($resfound) { $renewokay = 0; @@ -2058,13 +2199,12 @@ sub CanBookBeRenewed { } } - $sth1->finish; return ($renewokay,$error); } =head2 AddRenewal -&AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]); + &AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]); Renews a loan. @@ -2073,7 +2213,8 @@ 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. @@ -2086,33 +2227,13 @@ 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 $branch = shift; + my $datedue = shift; + my $lastreneweddate = shift || C4::Dates->new()->output('iso'); 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 = shift; - my $lastreneweddate = shift; - - # If the due date wasn't specified, calculate it by adding the - # book's loan length to today's date. - unless ($datedue && $datedue->output('iso')) { - - 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'} , - $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. - # 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 @@ -2124,6 +2245,23 @@ 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 $itemtype = (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} , + + $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ? + C4::Dates->new($issuedata->{date_due}, 'iso') : + C4::Dates->new(); + $datedue = CalcDateDue($datedue,$itemtype,$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. @@ -2165,39 +2303,42 @@ sub AddRenewal { sub GetRenewCount { # check renewal status - my ($bornum,$itemno)=@_; - my $dbh = C4::Context->dbh; - my $renewcount = 0; - my $renewsallowed = 0; - my $renewsleft = 0; + my ( $bornum, $itemno ) = @_; + my $dbh = C4::Context->dbh; + my $renewcount = 0; + my $renewsallowed = 0; + my $renewsleft = 0; + + my $borrower = C4::Members::GetMemberDetails($bornum); + my $item = GetItem($itemno); + # Look in the issues table for this item, lent to this borrower, # and not yet returned. # FIXME - I think this function could be redone to use only one SQL call. - my $sth = $dbh->prepare("select * from issues + my $sth = $dbh->prepare( + "select * from issues where (borrowernumber = ?) - and (itemnumber = ?)"); - $sth->execute($bornum,$itemno); + and (itemnumber = ?)" + ); + $sth->execute( $bornum, $itemno ); my $data = $sth->fetchrow_hashref; $renewcount = $data->{'renewals'} if $data->{'renewals'}; $sth->finish; - my $query = "SELECT renewalsallowed FROM items "; - $query .= (C4::Context->preference('item-level_itypes')) - ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype " - : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber - LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype "; - $query .= "WHERE items.itemnumber = ?"; - my $sth2 = $dbh->prepare($query); - $sth2->execute($itemno); - my $data2 = $sth2->fetchrow_hashref(); - $renewsallowed = $data2->{'renewalsallowed'}; - $renewsleft = $renewsallowed - $renewcount; - return ($renewcount,$renewsallowed,$renewsleft); + # $item and $borrower should be calculated + my $branchcode = _GetCircControlBranch($item, $borrower); + + my $issuingrule = GetIssuingRule($borrower->{categorycode}, $item->{itype}, $branchcode); + + $renewsallowed = $issuingrule->{'renewalsallowed'}; + $renewsleft = $renewsallowed - $renewcount; + if($renewsleft < 0){ $renewsleft = 0; } + return ( $renewcount, $renewsallowed, $renewsleft ); } =head2 GetIssuingCharges -($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber); + ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber); Calculate how much it would cost for a given patron to borrow a given item, including any applicable discounts. @@ -2221,42 +2362,81 @@ sub GetIssuingCharges { my $item_type; # Get the book's item type and rental charge (via its biblioitem). - my $qcharge = "SELECT itemtypes.itemtype,rentalcharge FROM items - LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber"; - $qcharge .= (C4::Context->preference('item-level_itypes')) - ? " LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype " - : " LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype "; - - $qcharge .= "WHERE items.itemnumber =?"; - - my $sth1 = $dbh->prepare($qcharge); - $sth1->execute($itemnumber); - if ( my $data1 = $sth1->fetchrow_hashref ) { - $item_type = $data1->{'itemtype'}; - $charge = $data1->{'rentalcharge'}; - my $q2 = "SELECT rentaldiscount FROM borrowers + my $charge_query = 'SELECT itemtypes.itemtype,rentalcharge FROM items + LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber'; + $charge_query .= (C4::Context->preference('item-level_itypes')) + ? ' LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype' + : ' LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype'; + + $charge_query .= ' WHERE items.itemnumber =?'; + + my $sth = $dbh->prepare($charge_query); + $sth->execute($itemnumber); + if ( my $item_data = $sth->fetchrow_hashref ) { + $item_type = $item_data->{itemtype}; + $charge = $item_data->{rentalcharge}; + my $branch = C4::Branch::mybranch(); + my $discount_query = q|SELECT rentaldiscount, + issuingrules.itemtype, issuingrules.branchcode + FROM borrowers LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode WHERE borrowers.borrowernumber = ? - AND issuingrules.itemtype = ?"; - my $sth2 = $dbh->prepare($q2); - $sth2->execute( $borrowernumber, $item_type ); - if ( my $data2 = $sth2->fetchrow_hashref ) { - my $discount = $data2->{'rentaldiscount'}; - if ( $discount eq 'NULL' ) { - $discount = 0; - } + AND (issuingrules.itemtype = ? OR issuingrules.itemtype = '*') + AND (issuingrules.branchcode = ? OR issuingrules.branchcode = '*')|; + my $discount_sth = $dbh->prepare($discount_query); + $discount_sth->execute( $borrowernumber, $item_type, $branch ); + my $discount_rules = $discount_sth->fetchall_arrayref({}); + if (@{$discount_rules}) { + # We may have multiple rules so get the most specific + my $discount = _get_discount_from_rule($discount_rules, $branch, $item_type); $charge = ( $charge * ( 100 - $discount ) ) / 100; } - $sth2->finish; } - $sth1->finish; + $sth->finish; # we havent _explicitly_ fetched all rows return ( $charge, $item_type ); } +# Select most appropriate discount rule from those returned +sub _get_discount_from_rule { + my ($rules_ref, $branch, $itemtype) = @_; + my $discount; + + if (@{$rules_ref} == 1) { # only 1 applicable rule use it + $discount = $rules_ref->[0]->{rentaldiscount}; + return (defined $discount) ? $discount : 0; + } + # could have up to 4 does one match $branch and $itemtype + my @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq $itemtype } @{$rules_ref}; + if (@d) { + $discount = $d[0]->{rentaldiscount}; + return (defined $discount) ? $discount : 0; + } + # do we have item type + all branches + @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq $itemtype } @{$rules_ref}; + if (@d) { + $discount = $d[0]->{rentaldiscount}; + return (defined $discount) ? $discount : 0; + } + # do we all item types + this branch + @d = grep { $_->{branchcode} eq $branch && $_->{itemtype} eq q{*} } @{$rules_ref}; + if (@d) { + $discount = $d[0]->{rentaldiscount}; + return (defined $discount) ? $discount : 0; + } + # so all and all (surely we wont get here) + @d = grep { $_->{branchcode} eq q{*} && $_->{itemtype} eq q{*} } @{$rules_ref}; + if (@d) { + $discount = $d[0]->{rentaldiscount}; + return (defined $discount) ? $discount : 0; + } + # none of the above + return 0; +} + =head2 AddIssuingCharge -&AddIssuingCharge( $itemno, $borrowernumber, $charge ) + &AddIssuingCharge( $itemno, $borrowernumber, $charge ) =cut @@ -2278,7 +2458,7 @@ sub AddIssuingCharge { =head2 GetTransfers -GetTransfers($itemnumber); + GetTransfers($itemnumber); =cut @@ -2304,7 +2484,7 @@ sub GetTransfers { =head2 GetTransfersFromTo -@results = GetTransfersFromTo($frombranch,$tobranch); + @results = GetTransfersFromTo($frombranch,$tobranch); Returns the list of pending transfers between $from and $to branch @@ -2334,7 +2514,7 @@ sub GetTransfersFromTo { =head2 DeleteTransfer -&DeleteTransfer($itemnumber); + &DeleteTransfer($itemnumber); =cut @@ -2352,11 +2532,14 @@ sub DeleteTransfer { =head2 AnonymiseIssueHistory -$rows = AnonymiseIssueHistory($borrowernumber,$date) + $rows = AnonymiseIssueHistory($date,$borrowernumber) This function write NULL instead of C<$borrowernumber> given on input arg into the table issues. if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>. +If c<$borrowernumber> is set, it will delete issue history for only that borrower, regardless of their opac privacy +setting (force delete). + return the number of affected rows. =cut @@ -2367,12 +2550,24 @@ sub AnonymiseIssueHistory { my $dbh = C4::Context->dbh; my $query = " UPDATE old_issues - SET borrowernumber = NULL - WHERE returndate < '".$date."' + SET borrowernumber = ? + WHERE returndate < ? AND borrowernumber IS NOT NULL "; - $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber; - my $rows_affected = $dbh->do($query); + + # The default of 0 does not work due to foreign key constraints + # The anonymisation will fail quietly if AnonymousPatron is not a valid entry + my $anonymouspatron = (C4::Context->preference('AnonymousPatron')) ? C4::Context->preference('AnonymousPatron') : 0; + my @bind_params = ($anonymouspatron, $date); + if (defined $borrowernumber) { + $query .= " AND borrowernumber = ?"; + push @bind_params, $borrowernumber; + } else { + $query .= " AND (SELECT privacy FROM borrowers WHERE borrowers.borrowernumber=old_issues.borrowernumber) <> 0"; + } + my $sth = $dbh->prepare($query); + $sth->execute(@bind_params); + my $rows_affected = $sth->rows; ### doublecheck row count return function return $rows_affected; } @@ -2449,7 +2644,7 @@ sub SendCirculationAlert { =head2 updateWrongTransfer -$items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary); + $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary); 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 @@ -2475,7 +2670,8 @@ sub updateWrongTransfer { =head2 UpdateHoldingbranch -$items = UpdateHoldingbranch($branch,$itmenumber); + $items = UpdateHoldingbranch($branch,$itmenumber); + Simple methode for updating hodlingbranch in items BDD line =cut @@ -2487,38 +2683,76 @@ sub UpdateHoldingbranch { =head2 CalcDateDue -$newdatedue = CalcDateDue($startdate,$loanlength,$branchcode); -this function calculates the due date given the loan length , +$newdatedue = CalcDateDue($startdate,$itemtype,$branchcode,$borrower); + +this function calculates the due date given the start date and configured circulation rules, checking against the holidays calendar as per the 'useDaysMode' syspref. C<$startdate> = C4::Dates object representing start date of loan period (assumed to be today) +C<$itemtype> = itemtype code of item in question C<$branch> = location whose calendar to use -C<$loanlength> = loan length prior to adjustment +C<$borrower> = Borrower object + =cut sub CalcDateDue { - my ($startdate,$loanlength,$branch) = @_; - if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar - my $datedue = 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 ($startdate,$itemtype,$branch,$borrower) = @_; + my $datedue; + my $loanlength = GetLoanLength($borrower->{'categorycode'},$itemtype, $branch); + + # if globalDueDate ON the datedue is set to that date + if ( C4::Context->preference('globalDueDate') + && ( C4::Context->preference('globalDueDate') =~ C4::Dates->regexp('syspref') ) ) { + $datedue = C4::Dates->new( C4::Context->preference('globalDueDate') ); } else { - my $calendar = C4::Calendar->new( branchcode => $branch ); - my $datedue = $calendar->addDate($startdate, $loanlength); - return $datedue; + # otherwise, calculate the datedue as normal + if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar + my $timedue = time + ($loanlength) * 86400; + #FIXME - assumes now even though we take a startdate + 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 ); + $datedue = $calendar->addDate($startdate, $loanlength); + } } + + # if Hard Due Dates are used, retreive them and apply as necessary + my ($hardduedate, $hardduedatecompare) = GetHardDueDate($borrower->{'categorycode'},$itemtype, $branch); + if ( $hardduedate && $hardduedate->output('iso') ne '0000-00-00') { + # if the calculated due date is after the 'before' Hard Due Date (ceiling), override + if ( $datedue->output( 'iso' ) gt $hardduedate->output( 'iso' ) && $hardduedatecompare == -1) { + $datedue = $hardduedate; + # if the calculated date is before the 'after' Hard Due Date (floor), override + } elsif ( $datedue->output( 'iso' ) lt $hardduedate->output( 'iso' ) && $hardduedatecompare == 1) { + $datedue = $hardduedate; + # if the hard due date is set to 'exactly', overrride + } elsif ( $hardduedatecompare == 0) { + $datedue = $hardduedate; + } + # in all other cases, keep the date due as it is + } + + # 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' ); + } + + return $datedue; } =head2 CheckValidDatedue - This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref . - To be replaced by CalcDateDue() once C4::Calendar use is tested. -$newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode); + $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode); + +This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref . +To be replaced by CalcDateDue() once C4::Calendar use is tested. + this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref. C<$date_due> = returndate calculate with no day check C<$itemnumber> = itemnumber C<$branchcode> = location of issue (affected by 'CircControl' syspref) C<$loanlength> = loan length prior to adjustment + =cut sub CheckValidDatedue { @@ -2547,8 +2781,10 @@ return $newdatedue; =head2 CheckRepeatableHolidays -$countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode); -this function checks if the date due is a repeatable holiday + $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode); + +This function checks if the date due is a repeatable holiday + C<$date_due> = returndate calculate with no day check C<$itemnumber> = itemnumber C<$branchcode> = localisation of issue @@ -2572,8 +2808,10 @@ return $result; =head2 CheckSpecialHolidays -$countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode); -this function check if the date is a special holiday + $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode); + +This function check if the date is a special holiday + C<$years> = the years of datedue C<$month> = the month of datedue C<$day> = the day of datedue @@ -2601,8 +2839,10 @@ return $countspecial; =head2 CheckRepeatableSpecialHolidays -$countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode); -this function check if the date is a repeatble special holidays + $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode); + +This function check if the date is a repeatble special holidays + C<$month> = the month of datedue C<$day> = the day of datedue C<$itemnumber> = itemnumber @@ -2644,7 +2884,7 @@ return $exist; =head2 IsBranchTransferAllowed -$allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code ); + $allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code ); Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType @@ -2672,7 +2912,7 @@ sub IsBranchTransferAllowed { =head2 CreateBranchTransferLimit -CreateBranchTransferLimit( $toBranch, $fromBranch, $code ); + CreateBranchTransferLimit( $toBranch, $fromBranch, $code ); $code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to. @@ -2691,7 +2931,7 @@ sub CreateBranchTransferLimit { =head2 DeleteBranchTransferLimits -DeleteBranchTransferLimits(); + DeleteBranchTransferLimits(); =cut @@ -2708,7 +2948,7 @@ __END__ =head1 AUTHOR -Koha Developement team +Koha Development Team =cut