X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FOverdues.pm;h=8074411a9a0524648f677b00a477e56863efe6df;hb=297a07f5f876f819336cbed2f15cf53c573b2444;hp=485f4dd598f14a45db32d7817965d6105bc834eb;hpb=39cc13d070e1613b4a903ec5e0e2513ebd561285;p=koha-ffzg.git diff --git a/C4/Overdues.pm b/C4/Overdues.pm index 485f4dd598..8074411a9a 100644 --- a/C4/Overdues.pm +++ b/C4/Overdues.pm @@ -19,55 +19,42 @@ package C4::Overdues; # You should have received a copy of the GNU General Public License # along with Koha; if not, see . -use strict; -#use warnings; FIXME - Bug 2505 -use Date::Calc qw/Today Date_to_Days/; -use Date::Manip qw/UnixDate/; +use Modern::Perl; +use Date::Calc qw( Today ); +use Date::Manip qw( UnixDate ); use List::MoreUtils qw( uniq ); -use POSIX qw( floor ceil ); -use Locale::Currency::Format 1.28; -use Carp; +use POSIX qw( ceil floor ); +use Locale::Currency::Format 1.28 qw( currency_format FMT_SYMBOL ); +use Carp qw( carp ); -use C4::Circulation; -use C4::Context; use C4::Accounts; -use C4::Log; # logaction -use C4::Debug; -use Koha::DateUtils; +use C4::Context; use Koha::Account::Lines; use Koha::Account::Offsets; -use Koha::IssuingRules; +use Koha::DateUtils qw( output_pref ); use Koha::Libraries; +use Koha::Recalls; +use Koha::Logger; +use Koha::Patrons; -use vars qw(@ISA @EXPORT); - +our (@ISA, @EXPORT_OK); BEGIN { require Exporter; @ISA = qw(Exporter); # subs to rename (and maybe merge some...) - push @EXPORT, qw( - &CalcFine - &Getoverdues - &checkoverdues - &UpdateFine - &GetFine - &get_chargeable_units - &GetOverduesForBranch - &GetOverdueMessageTransportTypes - &parse_overdues_letter - ); - - # subs to remove - push @EXPORT, qw( - &BorType - ); - - # check that an equivalent don't exist already before moving - - # subs to move to Circulation.pm - push @EXPORT, qw( - &GetIssuesIteminfo + @EXPORT_OK = qw( + CalcFine + Getoverdues + checkoverdues + UpdateFine + GetFine + GetBranchcodesWithOverdueRules + get_chargeable_units + GetOverduesForBranch + GetOverdueMessageTransportTypes + parse_overdues_letter + GetIssuesIteminfo ); } @@ -105,14 +92,14 @@ sub Getoverdues { my $statement; if ( C4::Context->preference('item-level_itypes') ) { $statement = " - SELECT issues.*, items.itype as itemtype, items.homebranch, items.barcode, items.itemlost, items.replacementprice + SELECT issues.*, items.itype as itemtype, items.homebranch, items.barcode, items.itemlost, items.replacementprice, items.biblionumber, items.holdingbranch FROM issues LEFT JOIN items USING (itemnumber) WHERE date_due < NOW() "; } else { $statement = " - SELECT issues.*, biblioitems.itemtype, items.itype, items.homebranch, items.barcode, items.itemlost, replacementprice + SELECT issues.*, biblioitems.itemtype, items.itype, items.homebranch, items.barcode, items.itemlost, replacementprice, items.biblionumber, items.holdingbranch FROM issues LEFT JOIN items USING (itemnumber) LEFT JOIN biblioitems USING (biblioitemnumber) @@ -239,37 +226,72 @@ sub CalcFine { my $start_date = $due_dt->clone(); # get issuingrules (fines part will be used) my $itemtype = $item->{itemtype} || $item->{itype}; - my $issuing_rule = Koha::IssuingRules->get_effective_issuing_rule({ categorycode => $bortype, itemtype => $itemtype, branchcode => $branchcode }); + my $issuing_rule = Koha::CirculationRules->get_effective_rules( + { + categorycode => $bortype, + itemtype => $itemtype, + branchcode => $branchcode, + rules => [ + 'lengthunit', + 'firstremind', + 'chargeperiod', + 'chargeperiod_charge_at', + 'fine', + 'overduefinescap', + 'cap_fine_to_replacement_price', + 'recall_overdue_fine', + ] + } + ); $itemtype = Koha::ItemTypes->find($itemtype); return unless $issuing_rule; # If not rule exist, there is no fine - my $fine_unit = $issuing_rule->lengthunit || 'days'; + my $fine_unit = $issuing_rule->{lengthunit} || 'days'; my $chargeable_units = get_chargeable_units($fine_unit, $start_date, $end_date, $branchcode); - my $units_minus_grace = $chargeable_units - $issuing_rule->firstremind; + my $units_minus_grace = $chargeable_units - ($issuing_rule->{firstremind} || 0); my $amount = 0; - if ( $issuing_rule->chargeperiod && ( $units_minus_grace > 0 ) ) { + if ( $issuing_rule->{chargeperiod} && ( $units_minus_grace > 0 ) ) { my $units = C4::Context->preference('FinesIncludeGracePeriod') ? $chargeable_units : $units_minus_grace; - my $charge_periods = $units / $issuing_rule->chargeperiod; + my $charge_periods = $units / $issuing_rule->{chargeperiod}; # If chargeperiod_charge_at = 1, we charge a fine at the start of each charge period # if chargeperiod_charge_at = 0, we charge at the end of each charge period - $charge_periods = $issuing_rule->chargeperiod_charge_at == 1 ? ceil($charge_periods) : floor($charge_periods); - $amount = $charge_periods * $issuing_rule->fine; + $charge_periods = defined $issuing_rule->{chargeperiod_charge_at} && $issuing_rule->{chargeperiod_charge_at} == 1 ? ceil($charge_periods) : floor($charge_periods); + + # check if item has been recalled. recall should have been marked Overdue by cronjob, so only look at overdue recalls + # only charge using recall_overdue_fine if there is an item-level recall for this particular item, OR a biblio-level recall + my @recalls = Koha::Recalls->search({ biblio_id => $item->{biblionumber}, status => 'overdue' })->as_list; + my $bib_level_recall = 0; + $bib_level_recall = 1 if scalar @recalls > 0; + foreach my $recall ( @recalls ) { + if ( $recall->item_level and $recall->item_id == $item->{itemnumber} and $issuing_rule->{recall_overdue_fine} ) { + $bib_level_recall = 0; + $amount = $charge_periods * $issuing_rule->{recall_overdue_fine}; + last; + } + } + if ( $bib_level_recall and $issuing_rule->{recall_overdue_fine} ) { + # biblio-level recall + $amount = $charge_periods * $issuing_rule->{recall_overdue_fine}; + } + if ( scalar @recalls == 0 && $issuing_rule->{fine}) { + # no recall, use normal fine amount + $amount = $charge_periods * $issuing_rule->{fine}; + } } # else { # a zero (or null) chargeperiod or negative units_minus_grace value means no charge. } - $amount = $issuing_rule->overduefinescap if $issuing_rule->overduefinescap && $amount > $issuing_rule->overduefinescap; + $amount = $issuing_rule->{overduefinescap} if $issuing_rule->{overduefinescap} && $amount > $issuing_rule->{overduefinescap}; # This must be moved to Koha::Item (see also similar code in C4::Accounts::chargelostitem $item->{replacementprice} ||= $itemtype->defaultreplacecost if $itemtype - && $item->{replacementprice} == 0 + && ( ! defined $item->{replacementprice} || $item->{replacementprice} == 0 ) && C4::Context->preference("useDefaultReplacementCost"); - $amount = $item->{replacementprice} if ( $issuing_rule->cap_fine_to_replacement_price && $item->{replacementprice} && $amount > $item->{replacementprice} ); + $amount = $item->{replacementprice} if ( $issuing_rule->{cap_fine_to_replacement_price} && $item->{replacementprice} && $amount > $item->{replacementprice} ); - $debug and warn sprintf("CalcFine returning (%s, %s, %s)", $amount, $units_minus_grace, $chargeable_units); return ($amount, $units_minus_grace, $chargeable_units); } @@ -491,7 +513,7 @@ has the book on loan. C<$amount> is the current amount owed by the patron. -C<$due> is the due date formatted to the currently specified date format +C<$due> is the date C<&UpdateFine> looks up the amount currently owed on the given item and sets it to C<$amount>, creating, if necessary, a new entry in the @@ -514,9 +536,7 @@ sub UpdateFine { my $itemnum = $params->{itemnumber}; my $borrowernumber = $params->{borrowernumber}; my $amount = $params->{amount}; - my $due = $params->{due}; - - $debug and warn "UpdateFine({ itemnumber => $itemnum, borrowernumber => $borrowernumber, due => $due, issue_id => $issue_id})"; + my $due = $params->{due} // q{}; unless ( $issue_id ) { carp("No issue_id passed in!"); @@ -527,44 +547,47 @@ sub UpdateFine { my $overdues = Koha::Account::Lines->search( { borrowernumber => $borrowernumber, - debit_type_code => 'OVERDUE', - amountoutstanding => { '<>' => 0 } + debit_type_code => 'OVERDUE' } ); my $accountline; my $total_amount_other = 0.00; - my $due_qr = qr/$due/; # Cycle through the fines and # - find line that relates to the requested $itemnum # - accumulate fines for other items # so we can update $itemnum fine taking in account fine caps while (my $overdue = $overdues->next) { - if ( $overdue->issue_id == $issue_id && $overdue->status eq 'UNRETURNED' ) { + if ( defined $overdue->issue_id && $overdue->issue_id == $issue_id && $overdue->status eq 'UNRETURNED' ) { if ($accountline) { - $debug and warn "Not a unique accountlines record for issue_id $issue_id"; + Koha::Logger->get->debug("Not a unique accountlines record for issue_id $issue_id"); # FIXME Do we really need to log that? #FIXME Should we still count this one in total_amount ?? } else { $accountline = $overdue; - next; } } $total_amount_other += $overdue->amountoutstanding; } - if (my $maxfine = C4::Context->preference('MaxFine')) { - if ($total_amount_other + $amount > $maxfine) { - my $new_amount = $maxfine - $total_amount_other; - return if $new_amount <= 0.00; - $debug and warn "Reducing fine for item $itemnum borrower $borrowernumber from $amount to $new_amount - MaxFine reached"; - $amount = $new_amount; + if ( my $maxfine = C4::Context->preference('MaxFine') ) { + my $maxIncrease = $maxfine - $total_amount_other; + return if Koha::Number::Price->new($maxIncrease)->round <= 0.00; + if ($accountline) { + if ( ( $amount - $accountline->amount ) > $maxIncrease ) { + my $new_amount = $accountline->amount + $maxIncrease; + Koha::Logger->get->debug("Reducing fine for item $itemnum borrower $borrowernumber from $amount to $new_amount - MaxFine reached"); + $amount = $new_amount; + } + } + elsif ( $amount > $maxIncrease ) { + Koha::Logger->get->debug("Reducing fine for item $itemnum borrower $borrowernumber from $amount to $maxIncrease - MaxFine reached"); + $amount = $maxIncrease; } } - if ( $accountline ) { - if ( $accountline->amount != $amount ) { + if ( Koha::Number::Price->new($accountline->amount)->round != Koha::Number::Price->new($amount)->round ) { $accountline->adjust( { amount => $amount, @@ -575,12 +598,19 @@ sub UpdateFine { } } else { if ( $amount ) { # Don't add new fines with an amount of 0 - my $sth4 = $dbh->prepare( - "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?" - ); - $sth4->execute($itemnum); - my $title = $sth4->fetchrow; - my $desc = "$title $due"; + my $patron = Koha::Patrons->find( $borrowernumber ); + my $letter = eval { C4::Letters::GetPreparedLetter( + module => 'circulation', + letter_code => 'OVERDUE_FINE_DESC', + message_transport_type => 'print', + lang => $patron->lang, + tables => { + issues => $itemnum, + borrowers => $borrowernumber, + items => $itemnum, + }, + ) }; + my $desc = $letter ? $letter->{content} : sprintf("Item %s - due %s", $itemnum, output_pref($due) ); my $account = Koha::Account->new({ patron_id => $borrowernumber }); $accountline = $account->add_debit( @@ -600,31 +630,6 @@ sub UpdateFine { } } -=head2 BorType - - $borrower = &BorType($borrowernumber); - -Looks up a patron by borrower number. - -C<$borrower> is a reference-to-hash whose keys are all of the fields -from the borrowers and categories tables of the Koha database. Thus, -C<$borrower> contains all information about both the borrower and -category they belong to. - -=cut - -sub BorType { - my ($borrowernumber) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( - "SELECT * from borrowers - LEFT JOIN categories ON borrowers.categorycode=categories.categorycode - WHERE borrowernumber=?" - ); - $sth->execute($borrowernumber); - return $sth->fetchrow_hashref; -} - =head2 GetFine $data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber); @@ -677,7 +682,7 @@ sub GetBranchcodesWithOverdueRules { |); if ( $branchcodes->[0] eq '' ) { # If a default rule exists, all branches should be returned - return map { $_->branchcode } Koha::Libraries->search({}, { order_by => 'branchname' }); + return Koha::Libraries->search({}, { order_by => 'branchname' })->get_column('branchcode'); } return @$branchcodes; } @@ -774,7 +779,7 @@ sub GetOverdueMessageTransportTypes { # Put 'print' in first if exists # It avoid to sent a print notice with an email or sms template is no email or sms is defined @mtts = uniq( 'print', @mtts ) - if grep {/^print$/} @mtts; + if grep { $_ eq 'print' } @mtts; return \@mtts; }