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

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

Return to bug 27049