View | Details | Raw Unified | Return to bug 17135
Collapse All | Expand All

(-)a/misc/maintenance/fix_unclosed_nonaccruing_fines_bug17135.pl (-1 / +216 lines)
Line 0 Link Here
0
- 
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
}

Return to bug 17135