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, $before, $after, @category_code, $file, $confirm );
  15 GetOptions(
  16     'h|help'                           => \$help,
  17     'v|verbose+'                       => \$verbose,
  18     't|type:s'                         => \@type,
  19     'ab|added_before|added-before:s'   => \$before,
  20     'aa|added_after|added-after:s'     => \$after,
  21     'cc|category_code|category-code:s' => \@category_code,
  22     'f|file:s'                         => \$file,
  23     'c|confirm'                        => \$confirm,
  24 );
  25 @type = split( /,/, join( ',', @type ) );
  26
  27 pod2usage(1) if ( $help || !$confirm && !$verbose || !$file && !@type && !$before && !$after );
  28
  29 my $where = { 'amountoutstanding' => { '>' => 0 } };
  30 my $attr = {};
  31
  32 if ($file) {
  33     my @accounts_from_file;
  34     open( my $fh, '<:encoding(UTF-8)', $file )
  35       or die "Could not open file '$file' $!";
  36     while ( my $line = <$fh> ) {
  37         chomp($line);
  38         push @accounts_from_file, $line;
  39     }
  40     close($fh);
  41     $where->{accountlines_id} = { '-in' => \@accounts_from_file };
  42 }
  43
  44 if (@type) {
  45     $where->{debit_type_code} = \@type;
  46 }
  47
  48 my $dtf;
  49 if ($before||$after) {
  50     $dtf = Koha::Database->new->schema->storage->datetime_parser;
  51 }
  52
  53 if ($before) {
  54     my $added_before = dt_from_string( $before, 'iso' );
  55     $where->{date}->{'<'} = $dtf->format_datetime($added_before);
  56 }
  57
  58 if ($after) {
  59     my $added_after = dt_from_string( $after, 'iso' );
  60     $where->{date}->{'>'} = $dtf->format_datetime($added_after);
  61 }
  62
  63 if (@category_code) {
  64     $where->{'patron.categorycode'}->{'-in'} = \@category_code;
  65     push @{ $attr->{'join'} }, 'patron';
  66 }
  67
  68 my $lines = Koha::Account::Lines->search( $where, $attr );
  69 if ( $verbose ) {
  70     print "Attempting to write off " . $lines->count . " debts";
  71     print " of type " . join(',',@type) if @type;
  72     print " added before " . $before if $before;
  73     print " from the passed list" if $file;
  74     print "\n";
  75 }
  76
  77 while ( my $line = $lines->next ) {
  78     say "Skipping " . $line->accountlines_id . "; Not a debt" and next
  79       if $line->is_credit && $verbose > 1;
  80     say "Skipping " . $line->accountlines_id . "; Is a PAYOUT" and next
  81       if $line->debit_type_code eq 'PAYOUT' && $verbose > 1;
  82
  83     if ($confirm) {
  84         $line->_result->result_source->schema->txn_do(
  85             sub {
  86
  87                 # A 'writeoff' is a 'credit'
  88                 my $writeoff = Koha::Account::Line->new(
  89                     {
  90                         date              => \'NOW()',
  91                         amount            => 0 - $line->amountoutstanding,
  92                         credit_type_code  => 'WRITEOFF',
  93                         status            => 'ADDED',
  94                         amountoutstanding => 0 - $line->amountoutstanding,
  95                         manager_id        => undef,
  96                         borrowernumber    => $line->borrowernumber,
  97                         interface         => 'intranet',
  98                         branchcode        => undef,
  99                     }
 100                 )->store();
 101
 102                 my $writeoff_offset = Koha::Account::Offset->new(
 103                     {
 104                         credit_id => $writeoff->accountlines_id,
 105                         type      => 'WRITEOFF',
 106                         amount    => $line->amountoutstanding
 107                     }
 108                 )->store();
 109
 110                 # Link writeoff to charge
 111                 $writeoff->apply(
 112                     {
 113                         debits => [$line]
 114                     }
 115                 );
 116                 $writeoff->status('APPLIED')->store();
 117
 118                 # Update status of original debit
 119                 $line->status('FORGIVEN')->store;
 120             }
 121         );
 122     }
 123
 124     if ($verbose) {
 125         if ($confirm) {
 126             say "Accountline " . $line->accountlines_id . " written off";
 127         }
 128         else {
 129             say "Accountline " . $line->accountlines_id . " will be written off";
 130         }
 131     }
 132 }
 133
 134 exit(0);
 135
 136 __END__
 137
 138 =head1 NAME
 139
 140 writeoff_debts.pl
 141
 142 =head1 SYNOPSIS
 143
 144   ./writeoff_debts.pl --added_before DATE --type OVERDUE --file REPORT --confirm
 145
 146 This script batch waives debts.
 147
 148 The options to select the debt records to writeoff are cumulative. For
 149 example, supplying both --added_before and --type specifies that the
 150 accountline must meet both conditions to be selected for writeoff.
 151
 152 You must pass at least one of the filtering options for the script to run.
 153 This is to prevent an accidental 'writeoff all' operation. Please note that
 154 --category-code must be accompanied by another filter - the script will not
 155 run if this is the only filter provided.
 156
 157 =head1 OPTIONS
 158
 159 =over
 160
 161 =item B<-h|--help>
 162
 163 Prints this help message
 164
 165 =item B<--added-before>
 166
 167 Writeoff debts added before the date passed.
 168
 169 Dates should be in ISO format, e.g., 2013-07-19, and can be generated
 170 with `date -d '-3 month' --iso-8601`.
 171
 172 =item B<--added-after>
 173
 174 Writeoff debts added after the date passed.
 175
 176 Dates should be in ISO format, e.g., 2013-07-19, and can be generated
 177 with `date -d '-3 month' --iso-8601`.
 178
 179 =item B<--category-code>
 180
 181 Writeoff debts for patrons belonging to the passed categories.
 182
 183 Can be used multiple times for additional category codes.
 184
 185 This option cannot be used alone, it must be combined with another filter.
 186
 187 =item B<--type>
 188
 189 Writeoff debts of the passed type. Accepts a list of debit type codes.
 190
 191 =item B<--file>
 192
 193 Writeoff debts passed as one accountlines_id per line in this file. If other
 194 criteria are defined it will only writeoff those in the file that match those
 195 criteria.
 196
 197 =item B<-v|--verbose>
 198
 199 This flag set the script to output logging for the actions it will perform.
 200
 201 =item B<-c|--confirm>
 202
 203 This flag must be provided in order for the script to actually
 204 writeoff debts.  If it is not supplied, the script will
 205 only report on the accountline records it would have been written off.
 206
 207 =back
 208
 209 =head1 AUTHOR
 210
 211 Martin Renvoize <martin.renvoize@ptfs-europe.com>
 212
 213 =head1 COPYRIGHT
 214
 215 Copyright 2020 PTFS Europe
 216
 217 =head1 LICENSE
 218
 219 This file is part of Koha.
 220
 221 Koha is free software; you can redistribute it and/or modify it
 222 under the terms of the GNU General Public License as published by
 223 the Free Software Foundation; either version 3 of the License, or
 224 (at your option) any later version.
 225
 226 Koha is distributed in the hope that it will be useful, but
 227 WITHOUT ANY WARRANTY; without even the implied warranty of
 228 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
 229 GNU General Public License for more details.
 230
 231 You should have received a copy of the GNU General Public License
 232 along with Koha; if not, see <http://www.gnu.org/licenses>.
 233
 234 =head1 DISCLAIMER OF WARRANTY
 235
 236 Koha is distributed in the hope that it will be useful, but WITHOUT ANY
 237 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
 238 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 239
 240 =cut