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 |