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

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

Return to bug 27049