View | Details | Raw Unified | Return to bug 27049
Collapse All | Expand All

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

Return to bug 27049