if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
{
print "Attempting upgrade to $DBversion (Bug 17135) ...\n";
- my $maintenance_script = C4::Context->config("intranetdir") . "/misc/maintenance/fix_unclosed_nonaccruing_fines_bug17135.pl";
+ my $maintenance_script = C4::Context->config("intranetdir") . "/installer/data/mysql/fix_unclosed_nonaccruing_fines_bug17135.pl";
system("perl $maintenance_script --confirm");
print "Upgrade to $DBversion done (Bug 17135 - Fine for the previous overdue may get overwritten by the next one)\n";
unless ($original_version < TransformToNum("3.23.00.032")) { ## Bug 15675
print "WARNING: There is a possibility (= just a possibility, it's configuration dependent etc.) that - due to regression introduced by Bug 15675 - some old fine records for overdued items (items which got renewed 1+ time while being overdue) may have been overwritten in your production 16.05+ database. See Bugzilla reports for Bug 14390 and Bug 17135 for more details.\n";
- print "WARNING: Please note that this upgrade does not try to recover such overwitten old fine records (if any) - it's just an follow-up for Bug 14390, it's sole purpose is preventing eventuall further-on overwrites from happening in the future. Optional recovery of the overwritten fines (again, if any) is like, totally outside of the scope of this particular upgrade!\n";
+ print "WARNING: Please note that this upgrade does not try to recover such overwitten old fine records (if any) - it's just an follow-up for Bug 14390, its sole purpose is preventing eventual further-on overwrites from happening in the future. Optional recovery of the overwritten fines (again, if any) is like, totally outside of the scope of this particular upgrade!\n";
}
SetVersion ($DBversion);
}
--- /dev/null
+#!/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 <http://www.gnu.org/licenses>.
+
+
+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, $stdout_log);
+
+GetOptions(
+ 'h|help' => \$help,
+ 'v|verbose' => \$verbose,
+ 'l|log' => \$log,
+ 'c|confirm' => \$confirm,
+ 'p|print' => \$stdout_log
+);
+
+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)
+ -p --print: output affected fine records details to the STDOUT
+ -v --verbose
+
+ENDUSAGE
+
+{
+ if ($help) {
+ print $usage;
+ exit 0;
+ }
+
+ Bug_17135_fix({
+ 'verbose' => $verbose, 'log' => $log,
+ 'confirm' => $confirm, 'stdout_log' => $stdout_log
+ });
+
+ exit 0;
+}
+
+sub Bug_17135_fix {
+ my $params = shift;
+
+ my $verbose = $params->{'verbose'};
+ my $log = $params->{'log'};
+ my $confirm = $params->{'confirm'};
+ my $stdout_log = $params->{'stdout_log'};
+
+ 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);
+ };
+ }
+
+ if ($verbose) {
+ Warn("Fine records with mismatched old vs current due dates: $different_dates_cnt");
+ 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);
+ }
+
+ if (@$forfixing > 0) {
+ Warn("Dry run (test only mode), skipping ".scalar(@$forfixing)." database changes.") unless ($confirm);
+ }
+ my $updated_cnt = 0;
+ 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};
+ print($logentry."\n") if ($stdout_log);
+
+ next unless ($confirm && $mode eq 'production');
+ my $rows_affected = $dbh->do($update_sql, undef, $fine->{accountlines_id});
+ $updated_cnt += $rows_affected;
+ logaction("FINES", "FU", $fine->{borrowernumber}, $logentry) if ($log);
+ }
+ if (@$forfixing > 0 && $confirm && $mode eq 'production') {
+ Warn("Database update done, $updated_cnt".((@$forfixing == $updated_cnt)? "": "/".scalar(@$forfixing))." fine records closed successfully.");
+ }
+}
+
+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
+ AND iss.borrowernumber = acc.borrowernumber
+ AND iss.itemnumber = acc.itemnumber
+ ORDER BY acc.borrowernumber, acc.issue_id
+ ";
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ return $sth->fetchall_arrayref({});
+}
+
+sub Warn {
+ print join("\n", @_, '');
+}
+++ /dev/null
-#!/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 <http://www.gnu.org/licenses>.
-
-
-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, $stdout_log);
-
-GetOptions(
- 'h|help' => \$help,
- 'v|verbose' => \$verbose,
- 'l|log' => \$log,
- 'c|confirm' => \$confirm,
- 'p|print' => \$stdout_log
-);
-
-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)
- -p --print: output affected fine records details to the STDOUT
- -v --verbose
-
-ENDUSAGE
-
-{
- if ($help) {
- print $usage;
- exit 0;
- }
-
- Bug_17135_fix({
- 'verbose' => $verbose, 'log' => $log,
- 'confirm' => $confirm, 'stdout_log' => $stdout_log
- });
-
- exit 0;
-}
-
-sub Bug_17135_fix {
- my $params = shift;
-
- my $verbose = $params->{'verbose'};
- my $log = $params->{'log'};
- my $confirm = $params->{'confirm'};
- my $stdout_log = $params->{'stdout_log'};
-
- 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);
- };
- }
-
- if ($verbose) {
- Warn("Fine records with mismatched old vs current due dates: $different_dates_cnt");
- 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);
- }
-
- if (@$forfixing > 0) {
- Warn("Dry run (test only mode), skipping ".scalar(@$forfixing)." database changes.") unless ($confirm);
- }
- my $updated_cnt = 0;
- 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};
- print($logentry."\n") if ($stdout_log);
-
- next unless ($confirm && $mode eq 'production');
- my $rows_affected = $dbh->do($update_sql, undef, $fine->{accountlines_id});
- $updated_cnt += $rows_affected;
- logaction("FINES", "FU", $fine->{borrowernumber}, $logentry) if ($log);
- }
- if (@$forfixing > 0 && $confirm && $mode eq 'production') {
- Warn("Database update done, $updated_cnt".((@$forfixing == $updated_cnt)? "": "/".scalar(@$forfixing))." fine records closed successfully.");
- }
-}
-
-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
- AND iss.borrowernumber = acc.borrowernumber
- AND iss.itemnumber = acc.itemnumber
- ORDER BY acc.borrowernumber, acc.issue_id
- ";
-
- my $sth = $dbh->prepare($query);
- $sth->execute();
- return $sth->fetchall_arrayref({});
-}
-
-sub Warn {
- print join("\n", @_, '');
-}
projects / koha_ffzg / commitdiff