6 use Getopt::Long qw( GetOptions );
7 use Pod::Usage qw( pod2usage );
9 use Koha::Account::Lines;
10 use Koha::DateUtils qw( dt_from_string );
12 use Koha::Script -cron;
14 my ( $help, $verbose, @type, $before, $after, $file, $confirm );
17 'v|verbose+' => \$verbose,
19 'ab|added_before|added-before:s' => \$before,
20 'aa|added_after|added-after:s' => \$after,
22 'c|confirm' => \$confirm,
24 @type = split( /,/, join( ',', @type ) );
26 pod2usage(1) if ( $help || !$confirm && !$verbose || !$file && !@type && !$before && !$after );
28 my $where = { 'amountoutstanding' => { '>' => 0 } };
32 my @accounts_from_file;
33 open( my $fh, '<:encoding(UTF-8)', $file )
34 or die "Could not open file '$file' $!";
35 while ( my $line = <$fh> ) {
37 push @accounts_from_file, $line;
40 $where->{accountlines_id} = { '-in' => \@accounts_from_file };
44 $where->{debit_type_code} = \@type;
48 if ($before||$after) {
49 $dtf = Koha::Database->new->schema->storage->datetime_parser;
53 my $added_before = dt_from_string( $before, 'iso' );
54 $where->{date}->{'<'} = $dtf->format_datetime($added_before);
58 my $added_after = dt_from_string( $after, 'iso' );
59 $where->{date}->{'>'} = $dtf->format_datetime($added_after);
62 my $lines = Koha::Account::Lines->search( $where, $attr );
64 print "Attempting to write off " . $lines->count . " debts";
65 print " of type " . join(',',@type) if @type;
66 print " added before " . $before if $before;
67 print " from the passed list" if $file;
71 while ( my $line = $lines->next ) {
72 say "Skipping " . $line->accountlines_id . "; Not a debt" and next
73 if $line->is_credit && $verbose > 1;
74 say "Skipping " . $line->accountlines_id . "; Is a PAYOUT" and next
75 if $line->debit_type_code eq 'PAYOUT' && $verbose > 1;
78 $line->_result->result_source->schema->txn_do(
81 # A 'writeoff' is a 'credit'
82 my $writeoff = Koha::Account::Line->new(
85 amount => 0 - $line->amountoutstanding,
86 credit_type_code => 'WRITEOFF',
88 amountoutstanding => 0 - $line->amountoutstanding,
90 borrowernumber => $line->borrowernumber,
91 interface => 'intranet',
96 my $writeoff_offset = Koha::Account::Offset->new(
98 credit_id => $writeoff->accountlines_id,
100 amount => $line->amountoutstanding
104 # Link writeoff to charge
110 $writeoff->status('APPLIED')->store();
112 # Update status of original debit
113 $line->status('FORGIVEN')->store;
120 say "Accountline " . $line->accountlines_id . " written off";
123 say "Accountline " . $line->accountlines_id . " will be written off";
138 ./writeoff_debts.pl --added_before DATE --type OVERDUE --file REPORT --confirm
140 This script batch waives debts.
142 The options to select the debt records to writeoff are cumulative. For
143 example, supplying both --added_before and --type specifies that the
144 accountline must meet both conditions to be selected for writeoff.
146 You must pass at least one of the filtering options for the script to run.
147 This is to prevent an accidental 'writeoff all' operation.
155 Prints this help message
157 =item B<--added-before>
159 Writeoff debts added before the date passed.
161 Dates should be in ISO format, e.g., 2013-07-19, and can be generated
162 with `date -d '-3 month' --iso-8601`.
164 =item B<--added-after>
166 Writeoff debts added after the date passed.
168 Dates should be in ISO format, e.g., 2013-07-19, and can be generated
169 with `date -d '-3 month' --iso-8601`.
173 Writeoff debts of the passed type. Accepts a list of CREDIT_TYPE_CODEs.
177 Writeoff debts passed as one accountlines_id per line in this file. If other
178 criteria are defined it will only writeoff those in the file that match those
181 =item B<-v|--verbose>
183 This flag set the script to output logging for the actions it will perform.
185 =item B<-c|--confirm>
187 This flag must be provided in order for the script to actually
188 writeoff debts. If it is not supplied, the script will
189 only report on the accountline records it would have been written off.
195 Martin Renvoize <martin.renvoize@ptfs-europe.com>
199 Copyright 2020 PTFS Europe
203 This file is part of Koha.
205 Koha is free software; you can redistribute it and/or modify it
206 under the terms of the GNU General Public License as published by
207 the Free Software Foundation; either version 3 of the License, or
208 (at your option) any later version.
210 Koha is distributed in the hope that it will be useful, but
211 WITHOUT ANY WARRANTY; without even the implied warranty of
212 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
213 GNU General Public License for more details.
215 You should have received a copy of the GNU General Public License
216 along with Koha; if not, see <http://www.gnu.org/licenses>.
218 =head1 DISCLAIMER OF WARRANTY
220 Koha is distributed in the hope that it will be useful, but WITHOUT ANY
221 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
222 A PARTICULAR PURPOSE. See the GNU General Public License for more details.