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.
 154
 155 =head1 OPTIONS
 156
 157 =over
 158
 159 =item B<-h|--help>
 160
 161 Prints this help message
 162
 163 =item B<--added-before>
 164
 165 Writeoff debts added before the date passed.
 166
 167 Dates should be in ISO format, e.g., 2013-07-19, and can be generated
 168 with `date -d '-3 month' --iso-8601`.
 169
 170 =item B<--added-after>
 171
 172 Writeoff debts added after the date passed.
 173
 174 Dates should be in ISO format, e.g., 2013-07-19, and can be generated
 175 with `date -d '-3 month' --iso-8601`.
 176
 177 =item B<--category-code>
 178
 179 Writeoff debts for patrons belonging to the passed categories.
 180
 181 Can be used multiple times for additional category codes.
 182
 183 =item B<--type>
 184
 185 Writeoff debts of the passed type. Accepts a list of debit type codes.
 186
 187 =item B<--file>
 188
 189 Writeoff debts passed as one accountlines_id per line in this file. If other
 190 criteria are defined it will only writeoff those in the file that match those
 191 criteria.
 192
 193 =item B<-v|--verbose>
 194
 195 This flag set the script to output logging for the actions it will perform.
 196
 197 =item B<-c|--confirm>
 198
 199 This flag must be provided in order for the script to actually
 200 writeoff debts.  If it is not supplied, the script will
 201 only report on the accountline records it would have been written off.
 202
 203 =back
 204
 205 =head1 AUTHOR
 206
 207 Martin Renvoize <martin.renvoize@ptfs-europe.com>
 208
 209 =head1 COPYRIGHT
 210
 211 Copyright 2020 PTFS Europe
 212
 213 =head1 LICENSE
 214
 215 This file is part of Koha.
 216
 217 Koha is free software; you can redistribute it and/or modify it
 218 under the terms of the GNU General Public License as published by
 219 the Free Software Foundation; either version 3 of the License, or
 220 (at your option) any later version.
 221
 222 Koha is distributed in the hope that it will be useful, but
 223 WITHOUT ANY WARRANTY; without even the implied warranty of
 224 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
 225 GNU General Public License for more details.
 226
 227 You should have received a copy of the GNU General Public License
 228 along with Koha; if not, see <http://www.gnu.org/licenses>.
 229
 230 =head1 DISCLAIMER OF WARRANTY
 231
 232 Koha is distributed in the hope that it will be useful, but WITHOUT ANY
 233 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
 234 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 235
 236 =cut