|
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 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 SUM(account_debits.amount_outstanding) != 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 |
$csv->print( |
| 269 |
$fh, |
| 270 |
[ |
| 271 |
$r->{firstname}, $r->{surname}, |
| 272 |
$r->{address1}, $r->{address2}, |
| 273 |
$r->{city}, $r->{state}, |
| 274 |
$r->{zipcode}, $r->{phone}, |
| 275 |
$r->{database_id}, $r->{barcode}, |
| 276 |
$r->{dateofbirth}, $r->{categorycode}, |
| 277 |
$r->{account_balance}, $r->{branchcode}, |
| 278 |
$r->{most_recent_unpaid_fine_date}, $r->{guarantor_firstname}, |
| 279 |
$r->{guarantor_surname}, |
| 280 |
] |
| 281 |
); |
| 282 |
|
| 283 |
if ( $report_type eq 'submission' ) { |
| 284 |
|
| 285 |
# Set patron as being in collections |
| 286 |
$dbh->do( $delete_attribute_sql, undef, |
| 287 |
( $r->{borrowernumber}, $in_collections_attribute_code ) ); |
| 288 |
$dbh->do( $insert_attribute_sql, undef, |
| 289 |
( $r->{borrowernumber}, $in_collections_attribute_code, '1' ) ); |
| 290 |
|
| 291 |
# Store patron's current account balance |
| 292 |
$dbh->do( $delete_attribute_sql, undef, |
| 293 |
( $r->{borrowernumber}, $previous_balance_attribute_code ) ); |
| 294 |
$dbh->do( |
| 295 |
$insert_attribute_sql, |
| 296 |
undef, |
| 297 |
( |
| 298 |
$r->{borrowernumber}, $previous_balance_attribute_code, |
| 299 |
$r->{account_balance} |
| 300 |
) |
| 301 |
); |
| 302 |
|
| 303 |
if ($processing_fee) { |
| 304 |
AddDebit( |
| 305 |
{ |
| 306 |
borrower => |
| 307 |
Koha::Database->new()->schema->resultset('Borrower') |
| 308 |
->find( $r->{borrowernumber} ), |
| 309 |
amount => $processing_fee, |
| 310 |
type => $processing_fee_type, |
| 311 |
description => $processing_fee_description, |
| 312 |
} |
| 313 |
); |
| 314 |
} |
| 315 |
} |
| 316 |
|
| 317 |
if ( $report_type eq 'submission' || $report_type eq 'update' ) { |
| 318 |
|
| 319 |
# Store today's date as the date last updated for collections |
| 320 |
$dbh->do( $delete_attribute_sql, undef, |
| 321 |
( $r->{borrowernumber}, $last_updated_attribute_code ) ); |
| 322 |
$dbh->do( $insert_attribute_sql, undef, |
| 323 |
( $r->{borrowernumber}, $last_updated_attribute_code, $ymd ) ); |
| 324 |
} |
| 325 |
} |
| 326 |
|
| 327 |
close $fh or die "$file: $!"; |