|
Lines 34-39
use Pod::Usage;
Link Here
|
| 34 |
use Text::CSV_XS; |
34 |
use Text::CSV_XS; |
| 35 |
use Locale::Currency::Format 1.28; |
35 |
use Locale::Currency::Format 1.28; |
| 36 |
use Encode; |
36 |
use Encode; |
|
|
37 |
use DateTime; |
| 38 |
use DateTime::Duration; |
| 37 |
|
39 |
|
| 38 |
use C4::Context; |
40 |
use C4::Context; |
| 39 |
use C4::Dates qw/format_date/; |
41 |
use C4::Dates qw/format_date/; |
|
Lines 41-46
use C4::Debug;
Link Here
|
| 41 |
use C4::Letters; |
43 |
use C4::Letters; |
| 42 |
use C4::Overdues qw(GetFine GetOverdueMessageTransportTypes); |
44 |
use C4::Overdues qw(GetFine GetOverdueMessageTransportTypes); |
| 43 |
use C4::Budgets qw(GetCurrency); |
45 |
use C4::Budgets qw(GetCurrency); |
|
|
46 |
use Koha::DateUtils; |
| 44 |
|
47 |
|
| 45 |
use Koha::Borrower::Debarments qw(AddUniqueDebarment); |
48 |
use Koha::Borrower::Debarments qw(AddUniqueDebarment); |
| 46 |
use Koha::DateUtils; |
49 |
use Koha::DateUtils; |
|
Lines 289-295
my $listall = 0;
Link Here
|
| 289 |
my $itemscontent = join( ',', qw( date_due title barcode author itemnumber ) ); |
292 |
my $itemscontent = join( ',', qw( date_due title barcode author itemnumber ) ); |
| 290 |
my @myborcat; |
293 |
my @myborcat; |
| 291 |
my @myborcatout; |
294 |
my @myborcatout; |
| 292 |
my $date; |
295 |
my ( $date_input, $today ); |
| 293 |
|
296 |
|
| 294 |
GetOptions( |
297 |
GetOptions( |
| 295 |
'help|?' => \$help, |
298 |
'help|?' => \$help, |
|
Lines 304-310
GetOptions(
Link Here
|
| 304 |
'itemscontent=s' => \$itemscontent, |
307 |
'itemscontent=s' => \$itemscontent, |
| 305 |
'list-all' => \$listall, |
308 |
'list-all' => \$listall, |
| 306 |
't|triggered' => \$triggered, |
309 |
't|triggered' => \$triggered, |
| 307 |
'date' => \$date, |
310 |
'date=s' => \$date_input, |
| 308 |
'borcat=s' => \@myborcat, |
311 |
'borcat=s' => \@myborcat, |
| 309 |
'borcatout=s' => \@myborcatout, |
312 |
'borcatout=s' => \@myborcatout, |
| 310 |
'email=s' => \@emails, |
313 |
'email=s' => \@emails, |
|
Lines 354-364
if (@branchcodes) {
Link Here
|
| 354 |
} |
357 |
} |
| 355 |
} |
358 |
} |
| 356 |
|
359 |
|
| 357 |
if ($date){ |
360 |
if ( $date_input ){ |
| 358 |
$date=$dbh->quote($date); |
361 |
eval { |
|
|
362 |
$today = dt_from_string( $date_input ); |
| 363 |
}; |
| 364 |
die "$date_input is not a valid date, aborting!" |
| 365 |
if $@ or not $today; |
| 366 |
|
| 359 |
} |
367 |
} |
| 360 |
else { |
368 |
else { |
| 361 |
$date="NOW()"; |
369 |
$today = dt_from_string; |
| 362 |
} |
370 |
} |
| 363 |
|
371 |
|
| 364 |
# these are the fields that will be substituted into <<item.content>> |
372 |
# these are the fields that will be substituted into <<item.content>> |
|
Lines 391-397
if ( defined $htmlfilename ) {
Link Here
|
| 391 |
if ( $htmlfilename eq '' ) { |
399 |
if ( $htmlfilename eq '' ) { |
| 392 |
$fh = *STDOUT; |
400 |
$fh = *STDOUT; |
| 393 |
} else { |
401 |
} else { |
| 394 |
my $today = DateTime->now(time_zone => C4::Context->tz ); |
|
|
| 395 |
open $fh, ">",File::Spec->catdir ($htmlfilename,"notices-".$today->ymd().".html"); |
402 |
open $fh, ">",File::Spec->catdir ($htmlfilename,"notices-".$today->ymd().".html"); |
| 396 |
} |
403 |
} |
| 397 |
|
404 |
|
|
Lines 425-437
foreach my $branchcode (@branches) {
Link Here
|
| 425 |
$verbose and warn sprintf "branchcode : '%s' using %s\n", $branchcode, $admin_email_address; |
432 |
$verbose and warn sprintf "branchcode : '%s' using %s\n", $branchcode, $admin_email_address; |
| 426 |
|
433 |
|
| 427 |
my $sth2 = $dbh->prepare( <<"END_SQL" ); |
434 |
my $sth2 = $dbh->prepare( <<"END_SQL" ); |
| 428 |
SELECT biblio.*, items.*, issues.*, biblioitems.itemtype, TO_DAYS($date)-TO_DAYS(date_due) AS days_overdue |
435 |
SELECT biblio.*, items.*, issues.*, biblioitems.itemtype |
| 429 |
FROM issues,items,biblio, biblioitems |
436 |
FROM issues,items,biblio, biblioitems |
| 430 |
WHERE items.itemnumber=issues.itemnumber |
437 |
WHERE items.itemnumber=issues.itemnumber |
| 431 |
AND biblio.biblionumber = items.biblionumber |
438 |
AND biblio.biblionumber = items.biblionumber |
| 432 |
AND biblio.biblionumber = biblioitems.biblionumber |
439 |
AND biblio.biblionumber = biblioitems.biblionumber |
| 433 |
AND issues.borrowernumber = ? |
440 |
AND issues.borrowernumber = ? |
| 434 |
AND TO_DAYS($date)-TO_DAYS(date_due) BETWEEN ? and ? |
441 |
AND CAST(date_due AS date) BETWEEN ? and ? |
| 435 |
END_SQL |
442 |
END_SQL |
| 436 |
|
443 |
|
| 437 |
my $query = "SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? "; |
444 |
my $query = "SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? "; |
|
Lines 454-460
END_SQL
Link Here
|
| 454 |
# my $outfile = 'overdues_' . ( $mybranch || $branchcode || 'default' ); |
461 |
# my $outfile = 'overdues_' . ( $mybranch || $branchcode || 'default' ); |
| 455 |
while ( my $overdue_rules = $rqoverduerules->fetchrow_hashref ) { |
462 |
while ( my $overdue_rules = $rqoverduerules->fetchrow_hashref ) { |
| 456 |
PERIOD: foreach my $i ( 1 .. 3 ) { |
463 |
PERIOD: foreach my $i ( 1 .. 3 ) { |
| 457 |
$verbose and warn "branch '$branchcode', pass $i\n"; |
464 |
|
|
|
465 |
$verbose and warn "branch '$branchcode', categorycode = $overdue_rules->{categorycode} pass $i\n"; |
| 466 |
|
| 458 |
my $mindays = $overdue_rules->{"delay$i"}; # the notice will be sent after mindays days (grace period) |
467 |
my $mindays = $overdue_rules->{"delay$i"}; # the notice will be sent after mindays days (grace period) |
| 459 |
my $maxdays = ( |
468 |
my $maxdays = ( |
| 460 |
$overdue_rules->{ "delay" . ( $i + 1 ) } |
469 |
$overdue_rules->{ "delay" . ( $i + 1 ) } |
|
Lines 462-467
END_SQL
Link Here
|
| 462 |
: ($MAX) |
471 |
: ($MAX) |
| 463 |
); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended) |
472 |
); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended) |
| 464 |
|
473 |
|
|
|
474 |
next unless defined $mindays; |
| 475 |
|
| 476 |
my $range_end = output_pref({ |
| 477 |
dt => $today->clone->subtract_duration( DateTime::Duration->new( days => $mindays ) ), |
| 478 |
dateformat => 'sql', |
| 479 |
dateonly => 1, |
| 480 |
}); |
| 481 |
my $range_begin = $triggered |
| 482 |
? $range_end |
| 483 |
: output_pref({ |
| 484 |
dt => $today->clone->subtract_duration( DateTime::Duration->new( days => $maxdays ) ), |
| 485 |
dateformat => 'sql', |
| 486 |
date_only => 1, |
| 487 |
}); |
| 488 |
|
| 489 |
|
| 465 |
if ( !$overdue_rules->{"letter$i"} ) { |
490 |
if ( !$overdue_rules->{"letter$i"} ) { |
| 466 |
$verbose and warn "No letter$i code for branch '$branchcode'"; |
491 |
$verbose and warn "No letter$i code for branch '$branchcode'"; |
| 467 |
next PERIOD; |
492 |
next PERIOD; |
|
Lines 489-506
END_SQL
Link Here
|
| 489 |
push @borrower_parameters, $overdue_rules->{categorycode}; |
514 |
push @borrower_parameters, $overdue_rules->{categorycode}; |
| 490 |
} |
515 |
} |
| 491 |
$borrower_sql .= ' AND categories.overduenoticerequired=1 '; |
516 |
$borrower_sql .= ' AND categories.overduenoticerequired=1 '; |
| 492 |
if($triggered) { |
517 |
|
| 493 |
$borrower_sql .= " AND TO_DAYS($date)-TO_DAYS(date_due) = ?"; |
518 |
$borrower_sql .= " AND CAST(date_due AS date) BETWEEN ? and ? " ; |
| 494 |
push @borrower_parameters, $mindays; |
519 |
push @borrower_parameters, $range_begin, $range_end; |
| 495 |
} else { |
|
|
| 496 |
$borrower_sql .= " AND TO_DAYS($date)-TO_DAYS(date_due) BETWEEN ? and ? " ; |
| 497 |
push @borrower_parameters, $mindays, $maxdays; |
| 498 |
} |
| 499 |
|
520 |
|
| 500 |
# $sth gets borrower info iff at least one overdue item has triggered the overdue action. |
521 |
# $sth gets borrower info iff at least one overdue item has triggered the overdue action. |
| 501 |
my $sth = $dbh->prepare($borrower_sql); |
522 |
my $sth = $dbh->prepare($borrower_sql); |
| 502 |
$sth->execute(@borrower_parameters); |
523 |
$sth->execute(@borrower_parameters); |
| 503 |
$verbose and warn $borrower_sql . "\n $branchcode | " . $overdue_rules->{'categorycode'} . "\n ($mindays, $maxdays)\nreturns " . $sth->rows . " rows"; |
524 |
$verbose and warn $borrower_sql . "\n $branchcode | " . $overdue_rules->{'categorycode'} . "\n ($range_begin, $range_end)\nreturns " . $sth->rows . " rows"; |
| 504 |
|
525 |
|
| 505 |
while ( my $data = $sth->fetchrow_hashref ) { |
526 |
while ( my $data = $sth->fetchrow_hashref ) { |
| 506 |
my $borrowernumber = $data->{'borrowernumber'}; |
527 |
my $borrowernumber = $data->{'borrowernumber'}; |
|
Lines 528-534
END_SQL
Link Here
|
| 528 |
my $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"}, $branchcode ); |
549 |
my $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"}, $branchcode ); |
| 529 |
|
550 |
|
| 530 |
unless ($letter) { |
551 |
unless ($letter) { |
| 531 |
$verbose and warn "Message '$overdue_rules->{letter$i}' content not found"; |
552 |
$verbose and warn qq|Message '$overdue_rules->{"letter$i"}' content not found|; |
| 532 |
|
553 |
|
| 533 |
# might as well skip while PERIOD, no other borrowers are going to work. |
554 |
# might as well skip while PERIOD, no other borrowers are going to work. |
| 534 |
# FIXME : Does this mean a letter must be defined in order to trigger a debar ? |
555 |
# FIXME : Does this mean a letter must be defined in order to trigger a debar ? |
|
Lines 548-555
END_SQL
Link Here
|
| 548 |
); |
569 |
); |
| 549 |
$verbose and warn "debarring $borr\n"; |
570 |
$verbose and warn "debarring $borr\n"; |
| 550 |
} |
571 |
} |
| 551 |
my @params = ($listall ? ( $borrowernumber , 1 , $MAX ) : ( $borrowernumber, $mindays, $maxdays )); |
572 |
|
| 552 |
$verbose and warn "STH2 PARAMS: borrowernumber = $borrowernumber, mindays = $mindays, maxdays = $maxdays"; |
573 |
my @params = ( $listall |
|
|
574 |
? ( $borrowernumber , output_pref({ |
| 575 |
dt => $today->clone->subtract_duration( days => 1 ), |
| 576 |
dateformat => 'sql', |
| 577 |
date_only => 1 |
| 578 |
}), |
| 579 |
output_pref({ |
| 580 |
dt => $today->clone->subtract_duration( days => $maxdays ), |
| 581 |
dateformat => 'sql', |
| 582 |
date_only => 1 |
| 583 |
}) |
| 584 |
) |
| 585 |
: ( $borrowernumber, $range_begin, $range_end ) |
| 586 |
); |
| 587 |
$verbose and warn $listall |
| 588 |
? "STH2 PARAMS: borrowernumber = $borrowernumber, from = NOW - 1, to = NOW - $maxdays, maxdays = $maxdays" |
| 589 |
: "STH2 PARAMS: borrowernumber = $borrowernumber, from = $range_begin, to = $range_end, maxdays = $maxdays"; |
| 590 |
|
| 553 |
$sth2->execute(@params); |
591 |
$sth2->execute(@params); |
| 554 |
my $itemcount = 0; |
592 |
my $itemcount = 0; |
| 555 |
my $titles = ""; |
593 |
my $titles = ""; |
|
Lines 592-598
END_SQL
Link Here
|
| 592 |
} |
630 |
} |
| 593 |
); |
631 |
); |
| 594 |
unless ($letter) { |
632 |
unless ($letter) { |
| 595 |
$verbose and warn "Message '$overdue_rules->{letter$i}' content not found"; |
633 |
$verbose and warn qq|Message '$overdue_rules->{"letter$i"}' content not found|; |
| 596 |
# this transport doesn't have a configured notice, so try another |
634 |
# this transport doesn't have a configured notice, so try another |
| 597 |
next; |
635 |
next; |
| 598 |
} |
636 |
} |
| 599 |
- |
|
|