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 BorType/;
25 use C4
::Log qw
/logaction/;
30 my ($help, $verbose, $confirm, $log, $stdout_log);
34 'v|verbose' => \
$verbose,
36 'c|confirm' => \
$confirm,
37 'p|print' => \
$stdout_log
40 my $usage = << 'ENDUSAGE';
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.
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
62 'verbose' => $verbose, 'log' => $log,
63 'confirm' => $confirm, 'stdout_log' => $stdout_log
72 my $verbose = $params->{'verbose'};
73 my $log = $params->{'log'};
74 my $confirm = $params->{'confirm'};
75 my $stdout_log = $params->{'stdout_log'};
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;
82 ## fetch the unclosed FU fines linked to the issues by issue_id
83 my $acclines = getFinesForChecking
();
85 Warn
("Got ".scalar(@
$acclines)." FU accountlines to check") if $verbose;
87 my $different_dates_cnt = 0;
88 my $not_due_not_accruning_cnt = 0;
89 my $due_not_accruning_cnt = 0;
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/);
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/;
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;
115 $fine->{old_date_due
} //= 'unknown';
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);
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
132 if ( C4
::Context
->preference('item-level_itypes') ) {
133 $statement = "SELECT issues.*, items.itype as itemtype, items.homebranch, items.barcode, items.itemlost, items.replacementprice
135 LEFT JOIN items USING (itemnumber)
136 WHERE date_due < NOW() AND issue_id = ?
139 $statement = "SELECT issues.*, biblioitems.itemtype, items.itype, items.homebranch, items.barcode, items.itemlost, replacementprice
141 LEFT JOIN items USING (itemnumber)
142 LEFT JOIN biblioitems USING (biblioitemnumber)
143 WHERE date_due < NOW() AND issue_id = ?
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];
153 ### last if $overdue->{itemlost}; ## arguable
154 my $borrower = BorType
( $overdue->{borrowernumber
} );
156 ( $control eq 'ItemHomeLibrary' ) ?
$overdue->{homebranch
}
157 : ( $control eq 'PatronLibrary' ) ?
$borrower->{branchcode
}
158 : $overdue->{branchcode
};
160 my ($amount) = CalcFine
( $overdue, $borrower->{categorycode
}, $branchcode, $datedue, $today );
161 ### Warn("CalcFine() returned '$amount'");
162 last if ($amount > 0); ## accruing fine, skip closing
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;
171 if ($is_not_accruing) {
172 $fine->{log_entry
} = 'item due, fine not accruing yet';
173 $due_not_accruning_cnt++;
174 push(@
$forfixing, $fine);
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 );
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);
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);
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." );
206 Warn
( "Dry run (test only mode), skipping ". @
$forfixing.
210 Warn
( "No fine records needed to be fixed" );
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
227 my $sth = $dbh->prepare($query);
229 return $sth->fetchall_arrayref({});
233 print join("\n", @_, '');