Line 0
Link Here
|
0 |
- |
1 |
#!/usr/bin/perl |
|
|
2 |
|
3 |
# Copyright 2014 ByWater Solutions |
4 |
# |
5 |
# This file is part of Koha. |
6 |
# |
7 |
# Koha is free software; you can redistribute it and/or modify it under the |
8 |
# terms of the GNU General Public License as published by the Free Software |
9 |
# Foundation; either version 2 of the License, or (at your option) any later |
10 |
# version. |
11 |
# |
12 |
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY |
13 |
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR |
14 |
# A PARTICULAR PURPOSE. See the GNU General Public License for more details. |
15 |
# |
16 |
# You should have received a copy of the GNU General Public License along |
17 |
# with Koha; if not, write to the Free Software Foundation, Inc., |
18 |
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
19 |
|
20 |
use Modern::Perl; |
21 |
|
22 |
use Getopt::Long; |
23 |
use File::Spec; |
24 |
use Text::CSV; |
25 |
|
26 |
use C4::Context; |
27 |
use Koha::Accounts qw(AddDebit); |
28 |
|
29 |
my $help; |
30 |
my $verbose; |
31 |
my $directory; |
32 |
|
33 |
my $minimum_balance = "0.01"; |
34 |
my $begin_date; |
35 |
my $end_date; |
36 |
my @exclude_fee_types; |
37 |
my @branchcodes; |
38 |
my @exclude_patron_types; |
39 |
my $processing_fee; |
40 |
my $processing_fee_type; |
41 |
my $processing_fee_description; |
42 |
my $can_collect_attribute_code; |
43 |
my $in_collections_attribute_code; |
44 |
my $last_updated_attribute_code; |
45 |
my $previous_balance_attribute_code; |
46 |
my $report_type; |
47 |
my @where; |
48 |
my $separator = ","; |
49 |
|
50 |
GetOptions( |
51 |
'h|help' => \$help, |
52 |
'v|verbose' => \$verbose, |
53 |
'd|dir:s' => \$directory, |
54 |
|
55 |
'f|fee:s' => \$processing_fee, |
56 |
'ft|fee-type:s' => \$processing_fee_type, |
57 |
'fd|fee-description:s' => \$processing_fee_description, |
58 |
|
59 |
'mb|min-balance:s' => \$minimum_balance, |
60 |
'bd|begin-date:s' => \$begin_date, |
61 |
'ed|end-date:s' => \$end_date, |
62 |
'et|exclude-fee-type:s' => \@exclude_fee_types, |
63 |
'b|branchcode:s' => \@branchcodes, |
64 |
'ep|exclude-patron-type:s' => \@exclude_patron_types, |
65 |
|
66 |
'c|can-collect-attribute-code:s' => \$can_collect_attribute_code, |
67 |
'i|in-collections-attribute-code:s' => \$in_collections_attribute_code, |
68 |
'l|last-updated-attribute-code:s' => \$last_updated_attribute_code, |
69 |
'p|previous-balance-attribute-code:s' => \$previous_balance_attribute_code, |
70 |
|
71 |
'r|report-type:s' => \$report_type, |
72 |
|
73 |
'w|where:s' => \@where, |
74 |
|
75 |
's|separator:s' => \$separator, |
76 |
); |
77 |
my $usage = << 'ENDUSAGE'; |
78 |
|
79 |
This script has the following parameters : |
80 |
-h --help: this message |
81 |
-d --dir: ouput directory (defaults to /tmp if !exist) |
82 |
-v --verbose |
83 |
|
84 |
The following parameters are required for the submission report |
85 |
-mb --min-balance: Minimum monetary value associated with a particular set of defined library branches |
86 |
-bd --begin-date: Date before which that unpaid fines DO NOT apply to the Minimum Balance criterion |
87 |
-ed --end-date: Date after which unpaid fines DO NOT apply to the Minimum Balance criterion |
88 |
-et --exclude-fee-type: Fine codes/types which should NOT apply to the Minimum Balance criterion, repeatable |
89 |
-b --branchcode: Only unpaid fines/fees of patrons associated with specified branches should be considered, repeatable |
90 |
-ep --exclude-patron-type: Patron or borrower types which should NOT be referred to the collections agency, repeatable |
91 |
-f --fee: Fee to charge patrons who enter into collections |
92 |
-ft --fee-type: Fee type to charge |
93 |
-fd --fee-description: Description to use for fee |
94 |
|
95 |
-c --can-collect-attribute-code: The patron attribute code that defines if a patron can be collected from ( YES_NO authorized value ) |
96 |
-i --in-collections-attribute-code: The patron attribute code that defines if a patron is currently in collecions ( YES_NO authorised value ) |
97 |
-l --last-updated-attribute-code: The patron attribute code that defines the date the patron was last updated for collections purposes |
98 |
-p --previous-balance-attribute-code: The patron balance of the last time the update report was run |
99 |
|
100 |
-r --report-type: The report type to execute: |
101 |
submission Output the submission report, new patrons that meet library defined criteria for referral to collection agency. |
102 |
update Output the update report, previously referred accounts that have had a change in balance (positive or negative) |
103 |
since the last time the update report was generated. |
104 |
sync Output the sync report, a list of all accounts currently referred to the collections agency |
105 |
|
106 |
-w --where: Additional clauses you want added to the WHERE statment, repeatable |
107 |
|
108 |
-s --separator: The character used for separating fields, default is a comma (,) |
109 |
|
110 |
ENDUSAGE |
111 |
|
112 |
if ( |
113 |
$help |
114 |
|| !( |
115 |
$report_type |
116 |
&& $can_collect_attribute_code |
117 |
&& $in_collections_attribute_code |
118 |
&& $last_updated_attribute_code |
119 |
&& $previous_balance_attribute_code |
120 |
) |
121 |
|| ( |
122 |
$report_type eq 'submission' |
123 |
&& !( |
124 |
$processing_fee |
125 |
&& $processing_fee_type |
126 |
&& $processing_fee_description |
127 |
&& $minimum_balance |
128 |
) |
129 |
) |
130 |
) |
131 |
{ |
132 |
print $usage; |
133 |
exit; |
134 |
} |
135 |
|
136 |
my $ymd = DateTime->now( time_zone => C4::Context->tz() )->ymd(); |
137 |
|
138 |
my $csv = Text::CSV->new( { sep_char => $separator } ) |
139 |
or die "Cannot use CSV: " . Text::CSV->error_diag(); |
140 |
$csv->eol("\r\n"); |
141 |
|
142 |
my $fh; |
143 |
$directory ||= File::Spec->tmpdir(); |
144 |
my $name = "$report_type-$ymd.csv"; |
145 |
my $file = File::Spec->catfile( $directory, $name ); |
146 |
say "Opening CSV file $file for writing..." if $verbose; |
147 |
open $fh, ">:encoding(utf8)", $file or die "$file: $!"; |
148 |
|
149 |
my $dbh = C4::Context->dbh(); |
150 |
|
151 |
my @parameters; |
152 |
my $insert_attribute_sql = q{ |
153 |
INSERT INTO borrower_attributes ( borrowernumber, code, attribute ) VALUES ( ?, ?, ? ) |
154 |
}; |
155 |
my $delete_attribute_sql = q{ |
156 |
DELETE FROM borrower_attributes WHERE borrowernumber = ? AND code = ? |
157 |
}; |
158 |
my $sql = q{ |
159 |
SELECT |
160 |
borrowers.*, |
161 |
guarantor.firstname AS guarantor_firstname, |
162 |
guarantor.surname AS guarantor_surname, |
163 |
DATE(account_debits.created_on) AS most_recent_unpaid_fine_date, |
164 |
SUM(account_debits.amount_outstanding) AS computed_account_balance, |
165 |
COALESCE( ba_c.attribute, 1 ) AS can_collect, |
166 |
COALESCE( ba_i.attribute, 0 ) AS in_collections, |
167 |
COALESCE( ba_l.attribute, 0 ) AS last_updated, |
168 |
COALESCE( ba_p.attribute, 0 ) AS previous_balance |
169 |
FROM borrowers |
170 |
LEFT JOIN account_debits USING ( borrowernumber ) |
171 |
LEFT JOIN borrower_attributes ba_c ON borrowers.borrowernumber = ba_c.borrowernumber AND ( ba_c.code = ? OR ba_c.code IS NULL ) |
172 |
LEFT JOIN borrower_attributes ba_i ON borrowers.borrowernumber = ba_i.borrowernumber AND ( ba_i.code = ? OR ba_i.code IS NULL ) |
173 |
LEFT JOIN borrower_attributes ba_l ON borrowers.borrowernumber = ba_l.borrowernumber AND ( ba_l.code = ? OR ba_l.code IS NULL ) |
174 |
LEFT JOIN borrower_attributes ba_p ON borrowers.borrowernumber = ba_p.borrowernumber AND ( ba_p.code = ? OR ba_p.code IS NULL ) |
175 |
LEFT JOIN borrowers guarantor ON ( borrowers.guarantorid = guarantor.borrowernumber ) |
176 |
WHERE |
177 |
COALESCE( ba_c.attribute, 1 ) != '0' |
178 |
}; |
179 |
|
180 |
push( @parameters, $can_collect_attribute_code ); |
181 |
push( @parameters, $in_collections_attribute_code ); |
182 |
push( @parameters, $last_updated_attribute_code ); |
183 |
push( @parameters, $previous_balance_attribute_code ); |
184 |
|
185 |
$sql .= join( ' AND ', @where ); |
186 |
|
187 |
if ( $report_type eq 'submission' ) |
188 |
{ # Don't select patrons who have already been sent to collections for submissions report |
189 |
$sql .= q{ AND COALESCE( ba_i.attribute, 0 ) != '1' }; |
190 |
} |
191 |
elsif ( $report_type eq 'update' ) |
192 |
{ # Select only patrons who have already been sent to collections and have had a change in balance for update report |
193 |
$sql .= q{ AND COALESCE( ba_i.attribute, 0 ) = '1' }; |
194 |
} |
195 |
elsif ( $report_type eq 'sync' ) |
196 |
{ # Select only patrons who have already been sent to collections and have owe a balance for sync report |
197 |
$sql .= q{ AND ba_i.attribute = '1' }; |
198 |
} |
199 |
|
200 |
if (@exclude_patron_types) { |
201 |
$sql .= ' AND borrowers.categorycode NOT IN ( ' |
202 |
. join( ',', ('?') x @exclude_patron_types ) . ' ) '; |
203 |
|
204 |
push( @parameters, @exclude_patron_types ); |
205 |
} |
206 |
|
207 |
if (@branchcodes) { |
208 |
$sql .= ' AND borrowers.branchcode IN ( ' |
209 |
. join( ',', ('?') x @branchcodes ) . ' ) '; |
210 |
|
211 |
push( @parameters, @branchcodes ); |
212 |
} |
213 |
|
214 |
if (@exclude_fee_types) { |
215 |
$sql .= ' AND account_debits.type NOT IN ( ' |
216 |
. join( ',', ('?') x @exclude_fee_types ) . ' ) '; |
217 |
|
218 |
push( @parameters, @exclude_fee_types ); |
219 |
} |
220 |
|
221 |
if ($begin_date) { |
222 |
$sql .= ' AND DATE(account_debits.created_on) >= DATE(?) '; |
223 |
push( @parameters, $begin_date ); |
224 |
} |
225 |
|
226 |
if ($end_date) { |
227 |
$sql .= ' AND DATE(account_debits.created_on) <= DATE(?) '; |
228 |
push( @parameters, $end_date ); |
229 |
} |
230 |
|
231 |
$sql .= q{ GROUP BY borrowernumber }; |
232 |
|
233 |
if ( $report_type eq 'submission' ) |
234 |
{ # Don't select patrons who have already been sent to collections for submissions report |
235 |
$sql .= ' HAVING SUM(account_debits.amount_outstanding) >= ? '; |
236 |
push( @parameters, $minimum_balance ); |
237 |
} |
238 |
elsif ( $report_type eq 'sync' ) |
239 |
{ # Select only patrons who have already been sent to collections and have owe a balance for sync report |
240 |
$sql .= q{ HAVING SUM(account_debits.amount_outstanding) > 0 }; |
241 |
} |
242 |
elsif ( $report_type eq 'update' ) { |
243 |
$sql .= |
244 |
q{ HAVING computed_account_balance != previous_balance }; |
245 |
} |
246 |
|
247 |
$sql .= q{ ORDER BY account_debits.created_on DESC }; |
248 |
|
249 |
my $sth = $dbh->prepare($sql); |
250 |
$sth->execute(@parameters); |
251 |
|
252 |
$csv->print( |
253 |
$fh, |
254 |
[ |
255 |
'firstname', 'surname', |
256 |
'address1', 'address2', |
257 |
'city', 'state', |
258 |
'zipcode', 'phone', |
259 |
'database_id', 'barcode', |
260 |
'date_of_birth', 'category', |
261 |
'account_balance', 'library', |
262 |
'most_recent_unpaid_fine_date', 'guarantor_firstname', |
263 |
'guarantor_surname', |
264 |
] |
265 |
); |
266 |
|
267 |
while ( my $r = $sth->fetchrow_hashref() ) { |
268 |
|
269 |
$csv->print( |
270 |
$fh, |
271 |
[ |
272 |
$r->{firstname}, $r->{surname}, |
273 |
$r->{address1}, $r->{address2}, |
274 |
$r->{city}, $r->{state}, |
275 |
$r->{zipcode}, $r->{phone}, |
276 |
$r->{database_id}, $r->{barcode}, |
277 |
$r->{dateofbirth}, $r->{categorycode}, |
278 |
$r->{computed_account_balance}, $r->{branchcode}, |
279 |
$r->{most_recent_unpaid_fine_date}, $r->{guarantor_firstname}, |
280 |
$r->{guarantor_surname}, |
281 |
] |
282 |
); |
283 |
|
284 |
if ( $report_type eq 'submission' ) { |
285 |
|
286 |
# Set patron as being in collections |
287 |
$dbh->do( $delete_attribute_sql, undef, |
288 |
( $r->{borrowernumber}, $in_collections_attribute_code ) ); |
289 |
$dbh->do( $insert_attribute_sql, undef, |
290 |
( $r->{borrowernumber}, $in_collections_attribute_code, '1' ) ); |
291 |
|
292 |
if ($processing_fee) { |
293 |
AddDebit( |
294 |
{ |
295 |
borrower => |
296 |
Koha::Database->new()->schema->resultset('Borrower') |
297 |
->find( $r->{borrowernumber} ), |
298 |
amount => $processing_fee, |
299 |
type => $processing_fee_type, |
300 |
description => $processing_fee_description, |
301 |
} |
302 |
); |
303 |
} |
304 |
|
305 |
} |
306 |
|
307 |
if ( $report_type eq 'submission' || $report_type eq 'update' ) { |
308 |
|
309 |
# Store patron's current account balance |
310 |
$dbh->do( $delete_attribute_sql, undef, |
311 |
( $r->{borrowernumber}, $previous_balance_attribute_code ) ); |
312 |
$dbh->do( |
313 |
$insert_attribute_sql, |
314 |
undef, |
315 |
( |
316 |
$r->{borrowernumber}, $previous_balance_attribute_code, |
317 |
$r->{computed_account_balance} |
318 |
) |
319 |
); |
320 |
|
321 |
# Store today's date as the date last updated for collections |
322 |
$dbh->do( $delete_attribute_sql, undef, |
323 |
( $r->{borrowernumber}, $last_updated_attribute_code ) ); |
324 |
$dbh->do( $insert_attribute_sql, undef, |
325 |
( $r->{borrowernumber}, $last_updated_attribute_code, $ymd ) ); |
326 |
|
327 |
} |
328 |
} |
329 |
|
330 |
close $fh or die "$file: $!"; |