3 # Copyright 2016 Jacek Ablewicz
5 # This file is part of Koha.
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.
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.
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>.
24 use C4::Overdues qw/CalcFine/;
25 use C4::Log qw/logaction/;
31 my ($help, $verbose, $confirm, $log, $stdout_log);
35 'v|verbose' => \$verbose,
37 'c|confirm' => \$confirm,
38 'p|print' => \$stdout_log
41 my $usage = << 'ENDUSAGE';
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.
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
63 'verbose' => $verbose, 'log' => $log,
64 'confirm' => $confirm, 'stdout_log' => $stdout_log
73 my $verbose = $params->{'verbose'};
74 my $log = $params->{'log'};
75 my $confirm = $params->{'confirm'};
76 my $stdout_log = $params->{'stdout_log'};
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;
83 ## fetch the unclosed FU fines linked to the issues by issue_id
84 my $acclines = getFinesForChecking();
86 Warn("Got ".scalar(@$acclines)." FU accountlines to check") if $verbose;
88 my $different_dates_cnt = 0;
89 my $not_due_not_accruning_cnt = 0;
90 my $due_not_accruning_cnt = 0;
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/);
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/;
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;
116 $fine->{old_date_due} //= 'unknown';
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);
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
133 if ( C4::Context->preference('item-level_itypes') ) {
134 $statement = "SELECT issues.*, items.itype as itemtype, items.homebranch, items.barcode, items.itemlost, items.replacementprice
136 LEFT JOIN items USING (itemnumber)
137 WHERE date_due < NOW() AND issue_id = ?
140 $statement = "SELECT issues.*, biblioitems.itemtype, items.itype, items.homebranch, items.barcode, items.itemlost, replacementprice
142 LEFT JOIN items USING (itemnumber)
143 LEFT JOIN biblioitems USING (biblioitemnumber)
144 WHERE date_due < NOW() AND issue_id = ?
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];
154 ### last if $overdue->{itemlost}; ## arguable
155 my $patron = Koha::Patron->find( $overdue->{borrowernumber} );
157 ( $control eq 'ItemHomeLibrary' ) ? $overdue->{homebranch}
158 : ( $control eq 'PatronLibrary' ) ? $patron->branchcode
159 : $overdue->{branchcode};
161 my ($amount) = CalcFine( $overdue, $patron->categorycode, $branchcode, $datedue, $today );
162 ### Warn("CalcFine() returned '$amount'");
163 last if ($amount > 0); ## accruing fine, skip closing
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;
172 if ($is_not_accruing) {
173 $fine->{log_entry} = 'item due, fine not accruing yet';
174 $due_not_accruning_cnt++;
175 push(@$forfixing, $fine);
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 );
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);
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);
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." );
207 Warn( "Dry run (test only mode), skipping ". @$forfixing.
211 Warn( "No fine records needed to be fixed" );
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
228 my $sth = $dbh->prepare($query);
230 return $sth->fetchall_arrayref({});
234 print join("\n", @_, '');