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); |
44 |
use C4::Overdues qw(GetFine); |
43 |
use C4::Budgets qw(GetCurrency); |
45 |
use C4::Budgets qw(GetCurrency); |
|
|
46 |
use Koha::DateUtils; |
44 |
|
47 |
|
45 |
=head1 NAME |
48 |
=head1 NAME |
46 |
|
49 |
|
Lines 276-282
my $listall = 0;
Link Here
|
276 |
my $itemscontent = join( ',', qw( date_due title barcode author itemnumber ) ); |
279 |
my $itemscontent = join( ',', qw( date_due title barcode author itemnumber ) ); |
277 |
my @myborcat; |
280 |
my @myborcat; |
278 |
my @myborcatout; |
281 |
my @myborcatout; |
279 |
my $date; |
282 |
my ( $date_input, $today ); |
280 |
|
283 |
|
281 |
GetOptions( |
284 |
GetOptions( |
282 |
'help|?' => \$help, |
285 |
'help|?' => \$help, |
Lines 290-296
GetOptions(
Link Here
|
290 |
'itemscontent=s' => \$itemscontent, |
293 |
'itemscontent=s' => \$itemscontent, |
291 |
'list-all' => \$listall, |
294 |
'list-all' => \$listall, |
292 |
't|triggered' => \$triggered, |
295 |
't|triggered' => \$triggered, |
293 |
'date' => \$date, |
296 |
'date=s' => \$date_input, |
294 |
'borcat=s' => \@myborcat, |
297 |
'borcat=s' => \@myborcat, |
295 |
'borcatout=s' => \@myborcatout, |
298 |
'borcatout=s' => \@myborcatout, |
296 |
'email=s' => \@emails, |
299 |
'email=s' => \@emails, |
Lines 340-350
if (@branchcodes) {
Link Here
|
340 |
} |
343 |
} |
341 |
} |
344 |
} |
342 |
|
345 |
|
343 |
if ($date){ |
346 |
if ( $date_input ){ |
344 |
$date=$dbh->quote($date); |
347 |
eval { |
|
|
348 |
$today = dt_from_string( $date_input ); |
349 |
}; |
350 |
die "$date_input is not a valid date, aborting!" |
351 |
if $@ or not $today; |
352 |
|
345 |
} |
353 |
} |
346 |
else { |
354 |
else { |
347 |
$date="NOW()"; |
355 |
$today = dt_from_string; |
348 |
} |
356 |
} |
349 |
|
357 |
|
350 |
# these are the fields that will be substituted into <<item.content>> |
358 |
# these are the fields that will be substituted into <<item.content>> |
Lines 377-383
if ( defined $htmlfilename ) {
Link Here
|
377 |
if ( $htmlfilename eq '' ) { |
385 |
if ( $htmlfilename eq '' ) { |
378 |
$html_fh = *STDOUT; |
386 |
$html_fh = *STDOUT; |
379 |
} else { |
387 |
} else { |
380 |
my $today = DateTime->now(time_zone => C4::Context->tz ); |
|
|
381 |
open $html_fh, ">",File::Spec->catdir ($htmlfilename,"notices-".$today->ymd().".html"); |
388 |
open $html_fh, ">",File::Spec->catdir ($htmlfilename,"notices-".$today->ymd().".html"); |
382 |
} |
389 |
} |
383 |
|
390 |
|
Lines 403-415
foreach my $branchcode (@branches) {
Link Here
|
403 |
$verbose and warn sprintf "branchcode : '%s' using %s\n", $branchcode, $admin_email_address; |
410 |
$verbose and warn sprintf "branchcode : '%s' using %s\n", $branchcode, $admin_email_address; |
404 |
|
411 |
|
405 |
my $sth2 = $dbh->prepare( <<"END_SQL" ); |
412 |
my $sth2 = $dbh->prepare( <<"END_SQL" ); |
406 |
SELECT biblio.*, items.*, issues.*, biblioitems.itemtype, TO_DAYS($date)-TO_DAYS(date_due) AS days_overdue |
413 |
SELECT biblio.*, items.*, issues.*, biblioitems.itemtype |
407 |
FROM issues,items,biblio, biblioitems |
414 |
FROM issues,items,biblio, biblioitems |
408 |
WHERE items.itemnumber=issues.itemnumber |
415 |
WHERE items.itemnumber=issues.itemnumber |
409 |
AND biblio.biblionumber = items.biblionumber |
416 |
AND biblio.biblionumber = items.biblionumber |
410 |
AND biblio.biblionumber = biblioitems.biblionumber |
417 |
AND biblio.biblionumber = biblioitems.biblionumber |
411 |
AND issues.borrowernumber = ? |
418 |
AND issues.borrowernumber = ? |
412 |
AND TO_DAYS($date)-TO_DAYS(date_due) BETWEEN ? and ? |
419 |
AND CAST(date_due AS date) BETWEEN ? and ? |
413 |
END_SQL |
420 |
END_SQL |
414 |
|
421 |
|
415 |
my $query = "SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? "; |
422 |
my $query = "SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? "; |
Lines 433-439
END_SQL
Link Here
|
433 |
while ( my $overdue_rules = $rqoverduerules->fetchrow_hashref ) { |
440 |
while ( my $overdue_rules = $rqoverduerules->fetchrow_hashref ) { |
434 |
PERIOD: foreach my $i ( 1 .. 3 ) { |
441 |
PERIOD: foreach my $i ( 1 .. 3 ) { |
435 |
|
442 |
|
436 |
$verbose and warn "branch '$branchcode', pass $i\n"; |
443 |
$verbose and warn "branch '$branchcode', categorycode = $overdue_rules->{categorycode} pass $i\n"; |
|
|
444 |
|
437 |
my $mindays = $overdue_rules->{"delay$i"}; # the notice will be sent after mindays days (grace period) |
445 |
my $mindays = $overdue_rules->{"delay$i"}; # the notice will be sent after mindays days (grace period) |
438 |
my $maxdays = ( |
446 |
my $maxdays = ( |
439 |
$overdue_rules->{ "delay" . ( $i + 1 ) } |
447 |
$overdue_rules->{ "delay" . ( $i + 1 ) } |
Lines 441-446
END_SQL
Link Here
|
441 |
: ($MAX) |
449 |
: ($MAX) |
442 |
); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended) |
450 |
); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended) |
443 |
|
451 |
|
|
|
452 |
next unless defined $mindays; |
453 |
|
454 |
my $range_end = output_pref({ |
455 |
dt => $today->clone->subtract_duration( DateTime::Duration->new( days => $mindays ) ), |
456 |
dateformat => 'sql', |
457 |
dateonly => 1, |
458 |
}); |
459 |
my $range_begin = $triggered |
460 |
? $range_end |
461 |
: output_pref({ |
462 |
dt => $today->clone->subtract_duration( DateTime::Duration->new( days => $maxdays ) ), |
463 |
dateformat => 'sql', |
464 |
date_only => 1, |
465 |
}); |
466 |
|
467 |
|
444 |
if ( !$overdue_rules->{"letter$i"} ) { |
468 |
if ( !$overdue_rules->{"letter$i"} ) { |
445 |
$verbose and warn "No letter$i code for branch '$branchcode'"; |
469 |
$verbose and warn "No letter$i code for branch '$branchcode'"; |
446 |
next PERIOD; |
470 |
next PERIOD; |
Lines 468-485
END_SQL
Link Here
|
468 |
push @borrower_parameters, $overdue_rules->{categorycode}; |
492 |
push @borrower_parameters, $overdue_rules->{categorycode}; |
469 |
} |
493 |
} |
470 |
$borrower_sql .= ' AND categories.overduenoticerequired=1 '; |
494 |
$borrower_sql .= ' AND categories.overduenoticerequired=1 '; |
471 |
if($triggered) { |
495 |
|
472 |
$borrower_sql .= " AND TO_DAYS($date)-TO_DAYS(date_due) = ?"; |
496 |
$borrower_sql .= " AND CAST(date_due AS date) BETWEEN ? and ? " ; |
473 |
push @borrower_parameters, $mindays; |
497 |
push @borrower_parameters, $range_begin, $range_end; |
474 |
} else { |
|
|
475 |
$borrower_sql .= " AND TO_DAYS($date)-TO_DAYS(date_due) BETWEEN ? and ? " ; |
476 |
push @borrower_parameters, $mindays, $maxdays; |
477 |
} |
478 |
|
498 |
|
479 |
# $sth gets borrower info iff at least one overdue item has triggered the overdue action. |
499 |
# $sth gets borrower info iff at least one overdue item has triggered the overdue action. |
480 |
my $sth = $dbh->prepare($borrower_sql); |
500 |
my $sth = $dbh->prepare($borrower_sql); |
481 |
$sth->execute(@borrower_parameters); |
501 |
$sth->execute(@borrower_parameters); |
482 |
$verbose and warn $borrower_sql . "\n $branchcode | " . $overdue_rules->{'categorycode'} . "\n ($mindays, $maxdays)\nreturns " . $sth->rows . " rows"; |
502 |
$verbose and warn $borrower_sql . "\n $branchcode | " . $overdue_rules->{'categorycode'} . "\n ($range_begin, $range_end)\nreturns " . $sth->rows . " rows"; |
483 |
|
503 |
|
484 |
while ( my $data = $sth->fetchrow_hashref ) { |
504 |
while ( my $data = $sth->fetchrow_hashref ) { |
485 |
my $borrowernumber = $data->{'borrowernumber'}; |
505 |
my $borrowernumber = $data->{'borrowernumber'}; |
Lines 507-513
END_SQL
Link Here
|
507 |
my $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"}, $branchcode ); |
527 |
my $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"}, $branchcode ); |
508 |
|
528 |
|
509 |
unless ($letter) { |
529 |
unless ($letter) { |
510 |
$verbose and warn "Message '$overdue_rules->{letter$i}' content not found"; |
530 |
$verbose and warn qq|Message '$overdue_rules->{"letter$i"}' content not found|; |
511 |
|
531 |
|
512 |
# might as well skip while PERIOD, no other borrowers are going to work. |
532 |
# might as well skip while PERIOD, no other borrowers are going to work. |
513 |
# FIXME : Does this mean a letter must be defined in order to trigger a debar ? |
533 |
# FIXME : Does this mean a letter must be defined in order to trigger a debar ? |
Lines 520-527
END_SQL
Link Here
|
520 |
C4::Members::DebarMember($borrowernumber, '9999-12-31'); |
540 |
C4::Members::DebarMember($borrowernumber, '9999-12-31'); |
521 |
$verbose and warn "debarring $borr\n"; |
541 |
$verbose and warn "debarring $borr\n"; |
522 |
} |
542 |
} |
523 |
my @params = ($listall ? ( $borrowernumber , 1 , $MAX ) : ( $borrowernumber, $mindays, $maxdays )); |
543 |
|
524 |
$verbose and warn "STH2 PARAMS: borrowernumber = $borrowernumber, mindays = $mindays, maxdays = $maxdays"; |
544 |
my @params = ( $listall |
|
|
545 |
? ( $borrowernumber , output_pref({ |
546 |
dt => $today->clone->subtract_duration( days => 1 ), |
547 |
dateformat => 'sql', |
548 |
date_only => 1 |
549 |
}), |
550 |
output_pref({ |
551 |
dt => $today->clone->subtract_duration( days => $maxdays ), |
552 |
dateformat => 'sql', |
553 |
date_only => 1 |
554 |
}) |
555 |
) |
556 |
: ( $borrowernumber, $range_begin, $range_end ) |
557 |
); |
558 |
$verbose and warn $listall |
559 |
? "STH2 PARAMS: borrowernumber = $borrowernumber, from = NOW - 1, to = NOW - $maxdays, maxdays = $maxdays" |
560 |
: "STH2 PARAMS: borrowernumber = $borrowernumber, from = $range_begin, to = $range_end, maxdays = $maxdays"; |
561 |
|
525 |
$sth2->execute(@params); |
562 |
$sth2->execute(@params); |
526 |
my $itemcount = 0; |
563 |
my $itemcount = 0; |
527 |
my $titles = ""; |
564 |
my $titles = ""; |
Lines 555-561
END_SQL
Link Here
|
555 |
} |
592 |
} |
556 |
); |
593 |
); |
557 |
unless ($letter) { |
594 |
unless ($letter) { |
558 |
$verbose and warn "Message '$overdue_rules->{letter$i}' content not found"; |
595 |
$verbose and warn qq|Message '$overdue_rules->{"letter$i"}' content not found|; |
559 |
|
596 |
|
560 |
# might as well skip while PERIOD, no other borrowers are going to work. |
597 |
# might as well skip while PERIOD, no other borrowers are going to work. |
561 |
# FIXME : Does this mean a letter must be defined in order to trigger a debar ? |
598 |
# FIXME : Does this mean a letter must be defined in order to trigger a debar ? |
562 |
- |
|
|