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

(-)a/misc/batchwaiveaccounts.pl (-1 / +135 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
use Modern::Perl;
4
use Getopt::Long;
5
use Pod::Usage;
6
use IO::File;
7
8
use Koha::Script;
9
10
my ( $help, $confirm );
11
GetOptions(
12
    'c|confirm' => \$confirm,
13
    'h|help'    => \$help,
14
);
15
16
pod2usage(1) if ( $help || !$confirm );
17
18
for my $file (@ARGV) {
19
    say "Finding accountnumbers in file $file";
20
    my $fh;
21
    open( $fh, '<', $file ) or say "Error: '$file' $!" and next;
22
23
    while (<$fh>) {
24
        my $accountline_id = $_;
25
        $accountline_id =~ s/$1/\n/g if $accountline_id =~ m/(\r\n?|\n\r?)/;
26
        chomp $accountline_id;
27
        my $debt = Koha::Account::Lines->find($accountline_id);
28
29
        next and warn "Skipping $accountline_id; Not a debt"
30
          if $debt->is_credit;
31
        next and warn "Skipping $accountline_id; Is a PAYOUT"
32
          if $debt->debit_type_code eq 'PAYOUT';
33
        next and warn "Skipping $accountline_id; Debit is paid"
34
          if $debt->amount != $debt->amountoutstanding;
35
36
        my $writeoff;
37
        $debt->_result->result_source->schema->txn_do(
38
            sub {
39
40
                # A 'writeoff' is a 'credit'
41
                $writeoff = Koha::Account::Line->new(
42
                    {
43
                        date              => \'NOW()',
44
                        amount            => 0 - $debt->amount,
45
                        credit_type_code  => 'WRITEOFF',
46
                        status            => 'ADDED',
47
                        amountoutstanding => 0 - $debt->amount,
48
                        manager_id        => undef,
49
                        borrowernumber    => $debt->borrowernumber,
50
                        interface         => 'intranet',
51
                        branchcode        => undef,
52
                    }
53
                )->store();
54
55
                my $writeoff_offset = Koha::Account::Offset->new(
56
                    {
57
                        credit_id => $writeoff->accountlines_id,
58
                        type      => 'WRITEOFF',
59
                        amount    => $debt->amount
60
                    }
61
                )->store();
62
63
                # Link writeoff to charge
64
                $writeoff->apply(
65
                    {
66
                        debits      => [$debt],
67
                        offset_type => 'WRITEOFF'
68
                    }
69
                );
70
                $writeoff->status('APPLIED')->store();
71
72
                # Update status of original debit
73
                $debt->status('FORGIVEN')->store;
74
            }
75
        );
76
77
        print "$accountline_id written off\n";
78
    }
79
}
80
81
exit(0);
82
83
__END__
84
85
=head1 NAME
86
87
batchwaiveaccounts.pl
88
89
=head1 SYNOPSIS
90
91
    ./batchwaiveaccounts.pl --confirm file1 [file2 ... fileN]
92
93
This script batch waives accounts.
94
95
=head1 OPTIONS
96
97
=over 8
98
99
=item B<-h|--help>
100
101
prints this help message
102
103
=back
104
105
=head1 AUTHOR
106
107
Martin Renvoize <martin.renvoize@ptfs-europe.com>
108
109
=head1 COPYRIGHT
110
111
Copyright 2020 PTFS Europe
112
113
=head1 LICENSE
114
115
This file is part of Koha.
116
117
Koha is free software; you can redistribute it and/or modify it
118
under the terms of the GNU General Public License as published by
119
the Free Software Foundation; either version 3 of the License, or
120
(at your option) any later version.
121
122
Koha is distributed in the hope that it will be useful, but
123
WITHOUT ANY WARRANTY; without even the implied warranty of
124
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
125
GNU General Public License for more details.
126
127
You should have received a copy of the GNU General Public License
128
along with Koha; if not, see <http://www.gnu.org/licenses>.
129
130
=head1 DISCLAIMER OF WARRANTY
131
132
Koha is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
133
A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
134
135
=cut

Return to bug 27049