misc/cronjobs/writeoff_debts.pl

   1 #!/usr/bin/perl
   2
   3 use Modern::Perl;
   4 use feature 'say';
   5
   6 use Getopt::Long;
   7 use Pod::Usage;
   8
   9 use Koha::Account::Lines;
  10 use Koha::DateUtils;
  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->amount,
  76                         credit_type_code  => 'WRITEOFF',
  77                         status            => 'ADDED',
  78                         amountoutstanding => 0 - $line->amount,
  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->amount
  91                     }
  92                 )->store();
  93
  94                 # Link writeoff to charge
  95                 $writeoff->apply(
  96                     {
  97                         debits      => [$line],
  98                         offset_type => 'WRITEOFF'
  99                     }
 100                 );
 101                 $writeoff->status('APPLIED')->store();
 102
 103                 # Update status of original debit
 104                 $line->status('FORGIVEN')->store;
 105             }
 106         );
 107     }
 108
 109     if ($verbose) {
 110         if ($confirm) {
 111             say "Accountline " . $line->accountlines_id . " written off";
 112         }
 113         else {
 114             say "Accountline " . $line->accountlines_id . " will be written off";
 115         }
 116     }
 117 }
 118
 119 exit(0);
 120
 121 __END__
 122
 123 =head1 NAME
 124
 125 writeoff_debts.pl
 126
 127 =head1 SYNOPSIS
 128
 129   ./writeoff_debts.pl --added_before DATE --type OVERDUE --file REPORT --confirm
 130
 131 This script batch waives debts.
 132
 133 The options to select the debt records to writeoff are cumulative. For
 134 example, supplying both --added_before and --type specifies that the
 135 accountline must meet both conditions to be selected for writeoff.
 136
 137 You must pass at least one of the filtering options for the script to run.
 138 This is to prevent an accidental 'writeoff all' operation.
 139
 140 =head1 OPTIONS
 141
 142 =over
 143
 144 =item B<-h|--help>
 145
 146 Prints this help message
 147
 148 =item B<--added_before>
 149
 150 Writeoff debts added before the date passed.
 151
 152 Dates should be in ISO format, e.g., 2013-07-19, and can be generated
 153 with `date -d '-3 month' --iso-8601`.
 154
 155 =item B<--type>
 156
 157 Writeoff debts of the passed type. Accepts a list of CREDIT_TYPE_CODEs.
 158
 159 =item B<--file>
 160
 161 Writeoff debts passed as one accountlines_id per line in this file. If other
 162 criteria are defined it will only writeoff those in the file that match those
 163 criteria.
 164
 165 =item B<-v|--verbose>
 166
 167 This flag set the script to output logging for the actions it will perform.
 168
 169 =item B<-c|--confirm>
 170
 171 This flag must be provided in order for the script to actually
 172 writeoff debts.  If it is not supplied, the script will
 173 only report on the accountline records it would have been written off.
 174
 175 =back
 176
 177 =head1 AUTHOR
 178
 179 Martin Renvoize <martin.renvoize@ptfs-europe.com>
 180
 181 =head1 COPYRIGHT
 182
 183 Copyright 2020 PTFS Europe
 184
 185 =head1 LICENSE
 186
 187 This file is part of Koha.
 188
 189 Koha is free software; you can redistribute it and/or modify it
 190 under the terms of the GNU General Public License as published by
 191 the Free Software Foundation; either version 3 of the License, or
 192 (at your option) any later version.
 193
 194 Koha is distributed in the hope that it will be useful, but
 195 WITHOUT ANY WARRANTY; without even the implied warranty of
 196 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
 197 GNU General Public License for more details.
 198
 199 You should have received a copy of the GNU General Public License
 200 along with Koha; if not, see <http://www.gnu.org/licenses>.
 201
 202 =head1 DISCLAIMER OF WARRANTY
 203
 204 Koha is distributed in the hope that it will be useful, but WITHOUT ANY
 205 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
 206 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 207
 208 =cut