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

(-)a/misc/cronjobs/writeoff_debts.pl (-1 / +207 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
use Modern::Perl;
4
5
use Getopt::Long;
6
use Pod::Usage;
7
8
use Koha::Account::Lines;
9
use Koha::DateUtils;
10
11
use Koha::Script -cron;
12
13
my ( $help, $verbose, @type, $added, $file, $confirm );
14
GetOptions(
15
    'h|help'         => \$help,
16
    'v|verbose'      => \$verbose,
17
    'type:s'         => \@type,
18
    'added_before:s' => \$added,
19
    'f|file:s'       => \$file,
20
    'c|confirm'      => \$confirm,
21
);
22
@type = split( /,/, join( ',', @type ) );
23
24
pod2usage(1) if ( $help || !$confirm && !$verbose || !$file && !@type && !$added );
25
26
my $where = { 'amountoutstanding' => { '>' => 0 } };
27
my $attr = {};
28
29
if ($file) {
30
    my @accounts_from_file;
31
    open( my $fh, '<:encoding(UTF-8)', $file )
32
      or die "Could not open file '$file' $!";
33
    while ( my $line = <$fh> ) {
34
        chomp($line);
35
        push @accounts_from_file, $line;
36
    }
37
    close($fh);
38
    $where->{accountlines_id} = { '-in' => \@accounts_from_file };
39
}
40
41
if (@type) {
42
    $where->{debit_type_code} = \@type;
43
}
44
45
if ($added) {
46
    my $added_before = dt_from_string( $added, 'iso' );
47
    my $dtf = Koha::Database->new->schema->storage->datetime_parser;
48
    $where->{date} = { '<' => $dtf->format_datetime($added_before) };
49
}
50
51
my $lines = Koha::Account::Lines->search( $where, $attr );
52
if ( $verbose ) {
53
    print "Attempting to write off " . $lines->count . " debts";
54
    print " of type " . join(',',@type) if @type;
55
    print " added before " . $added if $added;
56
    print " from the passed list" if $file;
57
    print "\n";
58
}
59
60
while ( my $line = $lines->next ) {
61
    warn "Skipping " . $line->accountlines_id . "; Not a debt" and next
62
      if $line->is_credit;
63
    warn "Skipping " . $line->accountlines_id . "; Is a PAYOUT" and next
64
      if $line->debit_type_code eq 'PAYOUT';
65
66
    if ($confirm) {
67
        $line->_result->result_source->schema->txn_do(
68
            sub {
69
70
                # A 'writeoff' is a 'credit'
71
                my $writeoff = Koha::Account::Line->new(
72
                    {
73
                        date              => \'NOW()',
74
                        amount            => 0 - $line->amount,
75
                        credit_type_code  => 'WRITEOFF',
76
                        status            => 'ADDED',
77
                        amountoutstanding => 0 - $line->amount,
78
                        manager_id        => undef,
79
                        borrowernumber    => $line->borrowernumber,
80
                        interface         => 'intranet',
81
                        branchcode        => undef,
82
                    }
83
                )->store();
84
85
                my $writeoff_offset = Koha::Account::Offset->new(
86
                    {
87
                        credit_id => $writeoff->accountlines_id,
88
                        type      => 'WRITEOFF',
89
                        amount    => $line->amount
90
                    }
91
                )->store();
92
93
                # Link writeoff to charge
94
                $writeoff->apply(
95
                    {
96
                        debits      => [$line],
97
                        offset_type => 'WRITEOFF'
98
                    }
99
                );
100
                $writeoff->status('APPLIED')->store();
101
102
                # Update status of original debit
103
                $line->status('FORGIVEN')->store;
104
            }
105
        );
106
    }
107
108
    if ($verbose) {
109
        if ($confirm) {
110
            print "Accountline " . $line->accountlines_id . " written off\n";
111
        }
112
        else {
113
            print "Accountline " . $line->accountlines_id . " will be written off\n";
114
        }
115
    }
116
}
117
118
exit(0);
119
120
__END__
121
122
=head1 NAME
123
124
writeoff_debts.pl
125
126
=head1 SYNOPSIS
127
128
  ./writeoff_debts.pl --added_before DATE --type OVERDUE --file REPORT --confirm
129
130
This script batch waives debts.
131
132
The options to select the debt records to writeoff are cumulative. For
133
example, supplying both --added_before and --type specifies that the
134
accountline must meet both conditions to be selected for writeoff.
135
136
You must pass at least one of the filtering options for the script to run.
137
This is to prevent an accidental 'writeoff all' operation.
138
139
=head1 OPTIONS
140
141
=over
142
143
=item B<-h|--help>
144
145
Prints this help message
146
147
=item B<--added_before>
148
149
Writeoff debts added before the date passed.
150
151
Dates should be in ISO format, e.g., 2013-07-19, and can be generated
152
with `date -d '-3 month' --iso-8601`.
153
154
=item B<--type>
155
156
Writeoff debts of the passed type. Accepts a list of CREDIT_TYPE_CODEs.
157
158
=item B<--file>
159
160
Writeoff debts passed as one accountlines_id per line in this file. If other
161
criteria are defined it will only writeoff those in the file that match those
162
criteria.
163
164
=item B<-v|--verbose>
165
166
This flag set the script to output logging for the actions it will perform.
167
168
=item B<-c|--confirm>
169
170
This flag must be provided in order for the script to actually
171
writeoff debts.  If it is not supplied, the script will
172
only report on the accountline records it would have been written off.
173
174
=back
175
176
=head1 AUTHOR
177
178
Martin Renvoize <martin.renvoize@ptfs-europe.com>
179
180
=head1 COPYRIGHT
181
182
Copyright 2020 PTFS Europe
183
184
=head1 LICENSE
185
186
This file is part of Koha.
187
188
Koha is free software; you can redistribute it and/or modify it
189
under the terms of the GNU General Public License as published by
190
the Free Software Foundation; either version 3 of the License, or
191
(at your option) any later version.
192
193
Koha is distributed in the hope that it will be useful, but
194
WITHOUT ANY WARRANTY; without even the implied warranty of
195
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
196
GNU General Public License for more details.
197
198
You should have received a copy of the GNU General Public License
199
along with Koha; if not, see <http://www.gnu.org/licenses>.
200
201
=head1 DISCLAIMER OF WARRANTY
202
203
Koha is distributed in the hope that it will be useful, but WITHOUT ANY
204
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
205
A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
206
207
=cut

Return to bug 27049