From 2a9339f78335212624dde861bd4104068186cd38 Mon Sep 17 00:00:00 2001 From: Martin Renvoize Date: Wed, 18 Nov 2020 13:21:05 +0000 Subject: [PATCH] Bug 27049: Add /misc/cronjobs/writeoff_debts.pl This patch adds a new misc/cronjobs/writeoff_debts.pl script to allow the bulk waiver of debts from the system. The script accepts some filter parameters, including the option to pass a line delimited file of accountline_ids, and will apply a WRITEOFF account against them for the amount of the outstanding debt. Examples: ./writeoff_debts.pl --added_before $(date -d '-18 month' --iso-8601) --confirm ./writeoff_debts.pl --type COPY --verbose --confirm ./writeoff_debts.pl --file path/to/file --verbose Test plan 1/ Add some debts to the system for various users. 2/ Output a line delimited report for accountlines for those debts. 3/ Run the script with the --file parameter and confirm those debts were written off. 4/ Repeat steps 1-3 above but add in a step to partially pay some debts prior to running the script. 5/ Repeat steps 1-3 above but pay of some of the debts prior to running the script. 6/ Repeat steps 1-2 above, but instead of passing --file use a combination of the other parameters to limit your list of debts to writeoff. --- misc/cronjobs/writeoff_debts.pl | 202 ++++++++++++++++++++++++++++++++ 1 file changed, 202 insertions(+) create mode 100755 misc/cronjobs/writeoff_debts.pl diff --git a/misc/cronjobs/writeoff_debts.pl b/misc/cronjobs/writeoff_debts.pl new file mode 100755 index 0000000000..e1fd5fb66e --- /dev/null +++ b/misc/cronjobs/writeoff_debts.pl @@ -0,0 +1,202 @@ +#!/usr/bin/perl + +use Modern::Perl; + +use Getopt::Long; +use Pod::Usage; + +use Koha::Account::Lines; +use Koha::DateUtils; + +use Koha::Script -cron; + +my ( $help, $verbose, @type, $added, $file, $confirm ); +GetOptions( + 'h|help' => \$help, + 'v|verbose' => \$verbose, + 'type:s' => \@type, + 'added_before:s' => \$added, + 'f|file:s' => \$file, + 'c|confirm' => \$confirm, +); +@type = split( /,/, join( ',', @type ) ); + +pod2usage(1) if ( $help || !$confirm && !$verbose ); + +my $where = { 'amountoutstanding' => { '>' => 0 } }; +my $attr = {}; + +if ($file) { + my @accounts_from_file; + for my $file (@ARGV) { + open( my $fh, '<:encoding(UTF-8)', $file ) + or die "Could not open file '$file' $!"; + while ( my $line = <$fh> ) { + chomp($line); + push @accounts_from_file, $line; + } + close($fh); + } + $where->{accountlines_id} = { '-in' => \@accounts_from_file }; +} + +if (@type) { + $where->{debit_type_code} = \@type; +} + +if ($added) { + my $added_before = dt_from_string( $added, 'iso' ); + my $dtf = Koha::Database->new->schema->storage->datetime_parser; + $where->{date} = { '<' => $dtf->format_datetime($added_before) }; +} + +my $lines = Koha::Account::Lines->search( $where, $attr ); +if ( $verbose ) { + print "Attempting to write off " . $lines->count . " debts"; + print " of type " . join(',',@type) if @type; + print " added before " . $added if $added; + print " from the passed list" if $file; + print "\n"; +} + +while ( my $line = $lines->next ) { + warn "Skipping " . $line->accountlines_id . "; Not a debt" and next + if $line->is_credit; + warn "Skipping " . $line->accountlines_id . "; Is a PAYOUT" and next + if $line->debit_type_code eq 'PAYOUT'; + + if ($confirm) { + $line->_result->result_source->schema->txn_do( + sub { + + # A 'writeoff' is a 'credit' + my $writeoff = Koha::Account::Line->new( + { + date => \'NOW()', + amount => 0 - $line->amount, + credit_type_code => 'WRITEOFF', + status => 'ADDED', + amountoutstanding => 0 - $line->amount, + manager_id => undef, + borrowernumber => $line->borrowernumber, + interface => 'intranet', + branchcode => undef, + } + )->store(); + + my $writeoff_offset = Koha::Account::Offset->new( + { + credit_id => $writeoff->accountlines_id, + type => 'WRITEOFF', + amount => $line->amount + } + )->store(); + + # Link writeoff to charge + $writeoff->apply( + { + debits => [$line], + offset_type => 'WRITEOFF' + } + ); + $writeoff->status('APPLIED')->store(); + + # Update status of original debit + $line->status('FORGIVEN')->store; + } + ); + } + + if ($verbose) { + if ($confirm) { + print "Accountline " . $line->accountlines_id . " written off\n"; + } + else { + print "Accountline " . $line->accountlines_id . " will be written off\n"; + } + } +} + +exit(0); + +__END__ + +=head1 NAME + +writeoff_debts.pl + +=head1 SYNOPSIS + + ./writeoff_debts.pl --added_before DATE --type OVERDUE --file REPORT --confirm + +This script batch waives debts. + +The options to select the debt records to writeoff are cumulative. For +example, supplying both --added_before and --type specifies that the +accountline must meet both conditions to be selected for writeoff. + +=head1 OPTIONS + +=over + +=item B<-h|--help> + +Prints this help message + +=item B<--added_before> + +Writeoff debts added before the date passed. + +Dates should be in ISO format, e.g., 2013-07-19, and can be generated +with `date -d '-3 month' --iso-8601`. + +=item B<--type> + +Writeoff debts of the passed type. Accepts a list of CREDIT_TYPE_CODEs. + +=item B<--file> + +Writeoff debts passed as one accountlines_id per line in this file. If other +criteria are defined it will only writeoff those in the file that match those +criteria. + +=item B<-c|--confirm> + +This flag must be provided in order for the script to actually +writeoff debts. If it is not supplied, the script will +only report on the accountline records it would have been written off. + +=back + +=head1 AUTHOR + +Martin Renvoize + +=head1 COPYRIGHT + +Copyright 2020 PTFS Europe + +=head1 LICENSE + +This file is part of Koha. + +Koha is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3 of the License, or +(at your option) any later version. + +Koha is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with Koha; if not, see . + +=head1 DISCLAIMER OF WARRANTY + +Koha is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +A PARTICULAR PURPOSE. See the GNU General Public License for more details. + +=cut -- 2.20.1