From 2a9339f78335212624dde861bd4104068186cd38 Mon Sep 17 00:00:00 2001
From: Martin Renvoize <martin.renvoize@ptfs-europe.com>
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 <martin.renvoize@ptfs-europe.com>
+
+=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 <http://www.gnu.org/licenses>.
+
+=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