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, $added, $file, $confirm );
17 'v|verbose+' => \$verbose,
19 'ab|added_before:s' => \$added,
21 'c|confirm' => \$confirm,
23 @type = split( /,/, join( ',', @type ) );
25 pod2usage(1) if ( $help || !$confirm && !$verbose || !$file && !@type && !$added );
27 my $where = { 'amountoutstanding' => { '>' => 0 } };
31 my @accounts_from_file;
32 open( my $fh, '<:encoding(UTF-8)', $file )
33 or die "Could not open file '$file' $!";
34 while ( my $line = <$fh> ) {
36 push @accounts_from_file, $line;
39 $where->{accountlines_id} = { '-in' => \@accounts_from_file };
43 $where->{debit_type_code} = \@type;
47 my $added_before = dt_from_string( $added, 'iso' );
48 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
49 $where->{date} = { '<' => $dtf->format_datetime($added_before) };
52 my $lines = Koha::Account::Lines->search( $where, $attr );
54 print "Attempting to write off " . $lines->count . " debts";
55 print " of type " . join(',',@type) if @type;
56 print " added before " . $added if $added;
57 print " from the passed list" if $file;
61 while ( my $line = $lines->next ) {
62 say "Skipping " . $line->accountlines_id . "; Not a debt" and next
63 if $line->is_credit && $verbose > 1;
64 say "Skipping " . $line->accountlines_id . "; Is a PAYOUT" and next
65 if $line->debit_type_code eq 'PAYOUT' && $verbose > 1;
68 $line->_result->result_source->schema->txn_do(
71 # A 'writeoff' is a 'credit'
72 my $writeoff = Koha::Account::Line->new(
75 amount => 0 - $line->amountoutstanding,
76 credit_type_code => 'WRITEOFF',
78 amountoutstanding => 0 - $line->amountoutstanding,
80 borrowernumber => $line->borrowernumber,
81 interface => 'intranet',
86 my $writeoff_offset = Koha::Account::Offset->new(
88 credit_id => $writeoff->accountlines_id,
90 amount => $line->amountoutstanding
94 # Link writeoff to charge
100 $writeoff->status('APPLIED')->store();
102 # Update status of original debit
103 $line->status('FORGIVEN')->store;
110 say "Accountline " . $line->accountlines_id . " written off";
113 say "Accountline " . $line->accountlines_id . " will be written off";
128 ./writeoff_debts.pl --added_before DATE --type OVERDUE --file REPORT --confirm
130 This script batch waives debts.
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.
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.
145 Prints this help message
147 =item B<--added_before>
149 Writeoff debts added before the date passed.
151 Dates should be in ISO format, e.g., 2013-07-19, and can be generated
152 with `date -d '-3 month' --iso-8601`.
156 Writeoff debts of the passed type. Accepts a list of CREDIT_TYPE_CODEs.
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
164 =item B<-v|--verbose>
166 This flag set the script to output logging for the actions it will perform.
168 =item B<-c|--confirm>
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.
178 Martin Renvoize <martin.renvoize@ptfs-europe.com>
182 Copyright 2020 PTFS Europe
186 This file is part of Koha.
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.
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.
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>.
201 =head1 DISCLAIMER OF WARRANTY
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.