installer/data/mysql/fix_unclosed_nonaccruing_fines_bug17135.pl

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