From 812379bbc237e5c5fe6e954f666a7b1f0961a21c Mon Sep 17 00:00:00 2001 From: Jacek Ablewicz Date: Mon, 29 Aug 2016 12:51:21 +0200 Subject: [PATCH] Bug 17135 - Fine for the previous overdue may get overwritten by the next one External maintenace script for fixing unclosed (FU), non accruing fine records which may still need FU -> F correction post-Bug 15675. Signed-off-by: Chris Cormack Signed-off-by: Marcel de Rooy Signed-off-by: Kyle M Hall --- ...fix_unclosed_nonaccruing_fines_bug17135.pl | 216 ++++++++++++++++++ 1 file changed, 216 insertions(+) create mode 100755 misc/maintenance/fix_unclosed_nonaccruing_fines_bug17135.pl diff --git a/misc/maintenance/fix_unclosed_nonaccruing_fines_bug17135.pl b/misc/maintenance/fix_unclosed_nonaccruing_fines_bug17135.pl new file mode 100755 index 0000000000..785f650936 --- /dev/null +++ b/misc/maintenance/fix_unclosed_nonaccruing_fines_bug17135.pl @@ -0,0 +1,216 @@ +#!/usr/bin/perl + +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY 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, see . + + +use Modern::Perl; + +use C4::Context; +use C4::Overdues qw/CalcFine BorType/; +use C4::Log qw/logaction/; + +use Koha::DateUtils; +use Getopt::Long; + +my ($help, $verbose, $confirm, $log); + +GetOptions( + 'h|help' => \$help, + 'v|verbose' => \$verbose, + 'l|log' => \$log, + 'c|confirm' => \$confirm +); + +my $usage = << 'ENDUSAGE'; + +Script for fixing unclosed (FU), non accruing fine records, which +may still need FU -> F correction post-Bug 15675. For details, +see Bug 14390 & Bug 17135. + +This script has the following parameters : + -h --help: this message + -l --log: log changes to the system logs + -c --confirm: commit changes (test only mode if not present) + -v --verbose + +ENDUSAGE + +{ + if ($help) { + print $usage; + exit 0; + } + + Bug_17135_fix({ + 'verbose' => $verbose, 'log' => $log, 'confirm' => $confirm + }); + + exit 0; +} + +sub Bug_17135_fix { + my $params = shift; + + my $verbose = $params->{'verbose'}; + my $log = $params->{'log'}; + my $confirm = $params->{'confirm'}; + + my $control = C4::Context->preference('CircControl'); + my $mode = C4::Context->preference('finesMode'); + my $today = DateTime->now( time_zone => C4::Context->tz() ); + my $dbh = C4::Context->dbh; + + ## fetch the unclosed FU fines linked to the issues by issue_id + my $acclines = getFinesForChecking(); + + Warn("Got ".scalar(@$acclines)." FU accountlines to check") if $verbose; + + my $different_dates_cnt = 0; + my $not_due_not_accruning_cnt = 0; + my $due_not_accruning_cnt = 0; + my $forfixing = []; + my $old_date_pattern; + for my $fine (@$acclines) { + my $datedue = dt_from_string( $fine->{date_due} ); + my $due = output_pref($datedue); + $fine->{current_due_date} = $due; + my $due_qr = qr/$due/; + ## if the dates in fine description and in the issue record match, + ## this is a legit post-Bug Bug 15675 accruing overdue fine + ## which does not require any correction + next if ($fine->{description} =~ /$due_qr/); + + { + ## for extracting old due date from fine description + ## not used for fixing anything, logging/debug purposes only + last if $old_date_pattern; + $old_date_pattern = $due; + $old_date_pattern =~ s/[A-Za-z]/\[A-Za-z\]/g; + $old_date_pattern =~ s/[0-9]/\\d/g; + $old_date_pattern = qr/$old_date_pattern/; + } + if ($fine->{description} =~ / ($old_date_pattern)$/) { + my $old_date_due = $1; + $fine->{old_date_due} = $old_date_due; + ### Warn("'$due' vs '$old_date_due'") if $verbose; + } + $fine->{old_date_due} //= 'unknown'; + + $different_dates_cnt++; + ## after the last renewal, item is no longer due = it's not accruing, + ## fine still needs to be closed + unless ($fine->{item_is_due}) { + $fine->{log_entry} = 'item not due, fine not accruing'; + $not_due_not_accruning_cnt++; + push(@$forfixing, $fine); + next; + } + + my $is_not_accruing = 0; + ## item got due again after the last renewal, CalcFine() needs + ## to be called to establish if the fine is accruning or not + { + my $statement; + if ( C4::Context->preference('item-level_itypes') ) { + $statement = "SELECT issues.*, items.itype as itemtype, items.homebranch, items.barcode, items.itemlost, items.replacementprice + FROM issues + LEFT JOIN items USING (itemnumber) + WHERE date_due < NOW() AND issue_id = ? + "; + } else { + $statement = "SELECT issues.*, biblioitems.itemtype, items.itype, items.homebranch, items.barcode, items.itemlost, replacementprice + FROM issues + LEFT JOIN items USING (itemnumber) + LEFT JOIN biblioitems USING (biblioitemnumber) + WHERE date_due < NOW() AND issue_id = ? + "; + } + + my $sth = $dbh->prepare($statement); + $sth->execute($fine->{issue_id}); + my $overdues = $sth->fetchall_arrayref({}); + last if (@$overdues != 1); + my $overdue = $overdues->[0]; + + ### last if $overdue->{itemlost}; ## arguable + my $borrower = BorType( $overdue->{borrowernumber} ); + my $branchcode = + ( $control eq 'ItemHomeLibrary' ) ? $overdue->{homebranch} + : ( $control eq 'PatronLibrary' ) ? $borrower->{branchcode} + : $overdue->{branchcode}; + + my ($amount) = CalcFine( $overdue, $borrower->{categorycode}, $branchcode, $datedue, $today ); + ### Warn("CalcFine() returned '$amount'"); + last if ($amount > 0); ## accruing fine, skip closing + + ## If we are here: item is due again, but fine is not accruing + ## yet (overdue may be in the grace period, 1st charging period + ## is not over yet, all days beetwen due date and today are + ## holidays etc.). Old fine record needs to be closed + $is_not_accruing = 1; + } + + if ($is_not_accruing) { + $fine->{log_entry} = 'item due, fine not accruing yet'; + $due_not_accruning_cnt++; + push(@$forfixing, $fine); + }; + } + + Warn("Fine records with mismatched old vs current due dates: $different_dates_cnt") if $verbose; + Warn("Non-accruing accountlines FU records (item not due): ".$not_due_not_accruning_cnt); + Warn("Non-accruing accountlines FU records (item due): ".$due_not_accruning_cnt); + + my $update_sql = "UPDATE accountlines SET accounttype = 'F' WHERE accounttype = 'FU' AND accountlines_id = ? LIMIT 1"; + for my $fine (@$forfixing) { + my $logentry = "Closing old FU fine (Bug 17135); accountlines_id=".$fine->{accountlines_id}; + $logentry .= " issue_id=".$fine->{issue_id}." amount=".$fine->{amount}; + $logentry .= "; due dates (old, current): '".$fine->{old_date_due}."', '".$fine->{current_due_date}."'"; + $logentry .= "; reason: ".$fine->{log_entry}; + + unless ($mode eq 'production') { + print $logentry."\n"; ## FIXME? + next; + } + unless ($confirm) { + Warn("Dry run (test only mode), skipping database changes."); + last; + } + + $dbh->do($update_sql, undef, $fine->{accountlines_id}); + logaction("FINES", "FU", $fine->{borrowernumber}, $logentry) if ($log); + } +} + +sub getFinesForChecking { + my $dbh = C4::Context->dbh; + my $query = "SELECT acc.*, iss.date_due, + IF(iss.date_due < NOW(), 1, 0) AS item_is_due + FROM accountlines acc + LEFT JOIN issues iss USING (issue_id) + WHERE accounttype = 'FU' + AND iss.issue_id IS NOT NULL + ORDER BY acc.borrowernumber, acc.issue_id + "; + + my $sth = $dbh->prepare($query); + $sth->execute(); + return $sth->fetchall_arrayref({}); +} + +sub Warn { + print STDERR join("\n", @_, ''); +} -- 2.39.5