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