misc/maintenance/fix_unclosed_nonaccruing_fines_bug17135.pl

   1 #!/usr/bin/perl
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  17
  18
  19 use Modern::Perl;
  20
  21 use C4::Context;
  22 use C4::Overdues qw/CalcFine BorType/;
  23 use C4::Log qw/logaction/;
  24
  25 use Koha::DateUtils;
  26 use Getopt::Long;
  27
  28 my ($help, $verbose, $confirm, $log);
  29
  30 GetOptions(
  31     'h|help'    => \$help,
  32     'v|verbose' => \$verbose,
  33     'l|log'     => \$log,
  34     'c|confirm' => \$confirm
  35 );
  36
  37 my $usage = << 'ENDUSAGE';
  38
  39 Script for fixing unclosed (FU), non accruing fine records, which
  40 may still need FU -> F correction post-Bug 15675. For details,
  41 see Bug 14390 & Bug 17135.
  42
  43 This script has the following parameters :
  44     -h --help: this message
  45     -l --log: log changes to the system logs
  46     -c --confirm: commit changes (test only mode if not present)
  47     -v --verbose
  48
  49 ENDUSAGE
  50
  51 {
  52     if ($help) {
  53         print $usage;
  54         exit 0;
  55     }
  56
  57     Bug_17135_fix({
  58         'verbose' => $verbose, 'log' => $log, 'confirm' => $confirm
  59     });
  60
  61     exit 0;
  62 }
  63
  64 sub Bug_17135_fix {
  65     my $params = shift;
  66
  67     my $verbose = $params->{'verbose'};
  68     my $log = $params->{'log'};
  69     my $confirm = $params->{'confirm'};
  70
  71     my $control = C4::Context->preference('CircControl');
  72     my $mode = C4::Context->preference('finesMode');
  73     my $today = DateTime->now( time_zone => C4::Context->tz() );
  74     my $dbh = C4::Context->dbh;
  75
  76     ## fetch the unclosed FU fines linked to the issues by issue_id
  77     my $acclines = getFinesForChecking();
  78
  79     Warn("Got ".scalar(@$acclines)." FU accountlines to check") if $verbose;
  80
  81     my $different_dates_cnt = 0;
  82     my $not_due_not_accruning_cnt = 0;
  83     my $due_not_accruning_cnt = 0;
  84     my $forfixing = [];
  85     my $old_date_pattern;
  86     for my $fine (@$acclines) {
  87         my $datedue = dt_from_string( $fine->{date_due} );
  88         my $due = output_pref($datedue);
  89         $fine->{current_due_date} = $due;
  90         my $due_qr = qr/$due/;
  91         ## if the dates in fine description and in the issue record match,
  92         ## this is a legit post-Bug Bug 15675 accruing overdue fine
  93         ## which does not require any correction
  94         next if ($fine->{description} =~ /$due_qr/);
  95
  96         {
  97             ## for extracting old due date from fine description
  98             ## not used for fixing anything, logging/debug purposes only
  99             last if $old_date_pattern;
 100             $old_date_pattern = $due;
 101             $old_date_pattern =~ s/[A-Za-z]/\[A-Za-z\]/g;
 102             $old_date_pattern =~ s/[0-9]/\\d/g;
 103             $old_date_pattern = qr/$old_date_pattern/;
 104         }
 105         if ($fine->{description} =~ / ($old_date_pattern)$/) {
 106             my $old_date_due = $1;
 107             $fine->{old_date_due} = $old_date_due;
 108             ### Warn("'$due' vs '$old_date_due'") if $verbose;
 109         }
 110         $fine->{old_date_due} //= 'unknown';
 111
 112         $different_dates_cnt++;
 113         ## after the last renewal, item is no longer due = it's not accruing,
 114         ## fine still needs to be closed
 115         unless ($fine->{item_is_due}) {
 116             $fine->{log_entry} = 'item not due, fine not accruing';
 117             $not_due_not_accruning_cnt++;
 118             push(@$forfixing, $fine);
 119             next;
 120         }
 121
 122         my $is_not_accruing = 0;
 123         ## item got due again after the last renewal, CalcFine() needs
 124         ## to be called to establish if the fine is accruning or not
 125         {
 126             my $statement;
 127             if ( C4::Context->preference('item-level_itypes') ) {
 128                 $statement = "SELECT issues.*, items.itype as itemtype, items.homebranch, items.barcode, items.itemlost, items.replacementprice
 129                     FROM issues
 130                     LEFT JOIN items USING (itemnumber)
 131                     WHERE date_due < NOW() AND issue_id = ?
 132                 ";
 133             } else {
 134                 $statement = "SELECT issues.*, biblioitems.itemtype, items.itype, items.homebranch, items.barcode, items.itemlost, replacementprice
 135                     FROM issues
 136                     LEFT JOIN items USING (itemnumber)
 137                     LEFT JOIN biblioitems USING (biblioitemnumber)
 138                     WHERE date_due < NOW() AND issue_id = ?
 139                ";
 140             }
 141
 142             my $sth = $dbh->prepare($statement);
 143             $sth->execute($fine->{issue_id});
 144             my $overdues = $sth->fetchall_arrayref({});
 145             last if (@$overdues != 1);
 146             my $overdue = $overdues->[0];
 147
 148             ### last if $overdue->{itemlost}; ## arguable
 149             my $borrower = BorType( $overdue->{borrowernumber} );
 150             my $branchcode =
 151              ( $control eq 'ItemHomeLibrary' ) ? $overdue->{homebranch}
 152              : ( $control eq 'PatronLibrary' )   ? $borrower->{branchcode}
 153              :                                     $overdue->{branchcode};
 154
 155             my ($amount) = CalcFine( $overdue, $borrower->{categorycode}, $branchcode, $datedue, $today );
 156             ### Warn("CalcFine() returned '$amount'");
 157             last if ($amount > 0); ## accruing fine, skip closing
 158
 159             ## If we are here: item is due again, but fine is not accruing
 160             ## yet (overdue may be in the grace period, 1st charging period
 161             ## is not over yet, all days beetwen due date and today are
 162             ## holidays etc.). Old fine record needs to be closed
 163             $is_not_accruing = 1;
 164         }
 165
 166         if ($is_not_accruing) {
 167             $fine->{log_entry} = 'item due, fine not accruing yet';
 168             $due_not_accruning_cnt++;
 169             push(@$forfixing, $fine);
 170         };
 171     }
 172
 173     Warn("Fine records with mismatched old vs current due dates: $different_dates_cnt") if $verbose;
 174     Warn("Non-accruing accountlines FU records (item not due): ".$not_due_not_accruning_cnt);
 175     Warn("Non-accruing accountlines FU records (item due): ".$due_not_accruning_cnt);
 176
 177     my $update_sql = "UPDATE accountlines SET accounttype = 'F' WHERE accounttype = 'FU' AND accountlines_id = ? LIMIT 1";
 178     for my $fine (@$forfixing) {
 179         my $logentry = "Closing old FU fine (Bug 17135); accountlines_id=".$fine->{accountlines_id};
 180         $logentry .= " issue_id=".$fine->{issue_id}." amount=".$fine->{amount};
 181         $logentry .= "; due dates (old, current): '".$fine->{old_date_due}."', '".$fine->{current_due_date}."'";
 182         $logentry .= "; reason: ".$fine->{log_entry};
 183
 184         unless ($mode eq 'production') {
 185             print $logentry."\n"; ## FIXME?
 186             next;
 187         }
 188         unless ($confirm) {
 189             Warn("Dry run (test only mode), skipping database changes.");
 190             last;
 191         }
 192
 193         $dbh->do($update_sql, undef, $fine->{accountlines_id});
 194         logaction("FINES", "FU", $fine->{borrowernumber}, $logentry) if ($log);
 195     }
 196 }
 197
 198 sub getFinesForChecking {
 199     my $dbh = C4::Context->dbh;
 200     my $query = "SELECT acc.*, iss.date_due,
 201         IF(iss.date_due < NOW(), 1, 0) AS item_is_due
 202         FROM accountlines acc
 203         LEFT JOIN issues iss USING (issue_id)
 204         WHERE accounttype = 'FU'
 205         AND iss.issue_id IS NOT NULL
 206         ORDER BY acc.borrowernumber, acc.issue_id
 207     ";
 208
 209     my $sth = $dbh->prepare($query);
 210     $sth->execute();
 211     return $sth->fetchall_arrayref({});
 212 }
 213
 214 sub Warn {
 215     print STDERR join("\n", @_, '');
 216 }