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