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

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

Return to bug 27049