misc/cronjobs/writeoff_debts.pl

   1 #!/usr/bin/perl
   2
   3 use Modern::Perl;
   4 use feature 'say';
   5
   6 use Getopt::Long qw( GetOptions );
   7 use Pod::Usage qw( pod2usage );
   8
   9 use Koha::Account::Lines;
  10 use Koha::DateUtils qw( dt_from_string );
  11
  12 use Koha::Script -cron;
  13
  14 my ( $help, $verbose, @type, $added, $file, $confirm );
  15 GetOptions(
  16     'h|help'            => \$help,
  17     'v|verbose+'        => \$verbose,
  18     't|type:s'          => \@type,
  19     'ab|added_before:s' => \$added,
  20     'f|file:s'          => \$file,
  21     'c|confirm'         => \$confirm,
  22 );
  23 @type = split( /,/, join( ',', @type ) );
  24
  25 pod2usage(1) if ( $help || !$confirm && !$verbose || !$file && !@type && !$added );
  26
  27 my $where = { 'amountoutstanding' => { '>' => 0 } };
  28 my $attr = {};
  29
  30 if ($file) {
  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> ) {
  35         chomp($line);
  36         push @accounts_from_file, $line;
  37     }
  38     close($fh);
  39     $where->{accountlines_id} = { '-in' => \@accounts_from_file };
  40 }
  41
  42 if (@type) {
  43     $where->{debit_type_code} = \@type;
  44 }
  45
  46 if ($added) {
  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) };
  50 }
  51
  52 my $lines = Koha::Account::Lines->search( $where, $attr );
  53 if ( $verbose ) {
  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;
  58     print "\n";
  59 }
  60
  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;
  66
  67     if ($confirm) {
  68         $line->_result->result_source->schema->txn_do(
  69             sub {
  70
  71                 # A 'writeoff' is a 'credit'
  72                 my $writeoff = Koha::Account::Line->new(
  73                     {
  74                         date              => \'NOW()',
  75                         amount            => 0 - $line->amountoutstanding,
  76                         credit_type_code  => 'WRITEOFF',
  77                         status            => 'ADDED',
  78                         amountoutstanding => 0 - $line->amountoutstanding,
  79                         manager_id        => undef,
  80                         borrowernumber    => $line->borrowernumber,
  81                         interface         => 'intranet',
  82                         branchcode        => undef,
  83                     }
  84                 )->store();
  85
  86                 my $writeoff_offset = Koha::Account::Offset->new(
  87                     {
  88                         credit_id => $writeoff->accountlines_id,
  89                         type      => 'WRITEOFF',
  90                         amount    => $line->amountoutstanding
  91                     }
  92                 )->store();
  93
  94                 # Link writeoff to charge
  95                 $writeoff->apply(
  96                     {
  97                         debits => [$line]
  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             say "Accountline " . $line->accountlines_id . " written off";
 111         }
 112         else {
 113             say "Accountline " . $line->accountlines_id . " will be written off";
 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