|
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 290-296
my $listall = 0;
Link Here
|
| 290 |
my $itemscontent = join( ',', qw( date_due title barcode author itemnumber ) ); |
293 |
my $itemscontent = join( ',', qw( date_due title barcode author itemnumber ) ); |
| 291 |
my @myborcat; |
294 |
my @myborcat; |
| 292 |
my @myborcatout; |
295 |
my @myborcatout; |
| 293 |
my $date; |
296 |
my ( $date_input, $today ); |
| 294 |
|
297 |
|
| 295 |
GetOptions( |
298 |
GetOptions( |
| 296 |
'help|?' => \$help, |
299 |
'help|?' => \$help, |
|
Lines 305-311
GetOptions(
Link Here
|
| 305 |
'itemscontent=s' => \$itemscontent, |
308 |
'itemscontent=s' => \$itemscontent, |
| 306 |
'list-all' => \$listall, |
309 |
'list-all' => \$listall, |
| 307 |
't|triggered' => \$triggered, |
310 |
't|triggered' => \$triggered, |
| 308 |
'date' => \$date, |
311 |
'date=s' => \$date_input, |
| 309 |
'borcat=s' => \@myborcat, |
312 |
'borcat=s' => \@myborcat, |
| 310 |
'borcatout=s' => \@myborcatout, |
313 |
'borcatout=s' => \@myborcatout, |
| 311 |
'email=s' => \@emails, |
314 |
'email=s' => \@emails, |
|
Lines 355-367
if (@branchcodes) {
Link Here
|
| 355 |
} |
358 |
} |
| 356 |
} |
359 |
} |
| 357 |
my $date_to_run; |
360 |
my $date_to_run; |
| 358 |
if ($date){ |
361 |
my $date; |
| 359 |
$date=$dbh->quote($date); |
362 |
if ( $date_input ){ |
| 360 |
$date_to_run = dt_from_string($date); |
363 |
$date = $dbh->quote($date); |
|
|
364 |
eval { |
| 365 |
$date_to_run = dt_from_string( $date_input ); |
| 366 |
}; |
| 367 |
die "$date_input is not a valid date, aborting!" |
| 368 |
if $@ or not $date_to_run; |
| 369 |
|
| 361 |
} |
370 |
} |
| 362 |
else { |
371 |
else { |
| 363 |
$date="NOW()"; |
372 |
$date="NOW()"; |
| 364 |
$date_to_run = DateTime->now( time_zone => C4::Context->tz() ); |
373 |
$date_to_run = dt_from_string(); |
| 365 |
} |
374 |
} |
| 366 |
|
375 |
|
| 367 |
# these are the fields that will be substituted into <<item.content>> |
376 |
# these are the fields that will be substituted into <<item.content>> |
|
Lines 466-472
END_SQL
Link Here
|
| 466 |
while ( my $overdue_rules = $rqoverduerules->fetchrow_hashref ) { |
475 |
while ( my $overdue_rules = $rqoverduerules->fetchrow_hashref ) { |
| 467 |
PERIOD: foreach my $i ( 1 .. 3 ) { |
476 |
PERIOD: foreach my $i ( 1 .. 3 ) { |
| 468 |
|
477 |
|
| 469 |
$verbose and warn "branch '$branchcode', pass $i\n"; |
478 |
$verbose and warn "branch '$branchcode', categorycode = $overdue_rules->{categorycode} pass $i\n"; |
|
|
479 |
|
| 470 |
my $mindays = $overdue_rules->{"delay$i"}; # the notice will be sent after mindays days (grace period) |
480 |
my $mindays = $overdue_rules->{"delay$i"}; # the notice will be sent after mindays days (grace period) |
| 471 |
my $maxdays = ( |
481 |
my $maxdays = ( |
| 472 |
$overdue_rules->{ "delay" . ( $i + 1 ) } |
482 |
$overdue_rules->{ "delay" . ( $i + 1 ) } |
|
Lines 474-479
END_SQL
Link Here
|
| 474 |
: ($MAX) |
484 |
: ($MAX) |
| 475 |
); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended) |
485 |
); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended) |
| 476 |
|
486 |
|
|
|
487 |
next unless defined $mindays; |
| 488 |
|
| 477 |
if ( !$overdue_rules->{"letter$i"} ) { |
489 |
if ( !$overdue_rules->{"letter$i"} ) { |
| 478 |
$verbose and warn "No letter$i code for branch '$branchcode'"; |
490 |
$verbose and warn "No letter$i code for branch '$branchcode'"; |
| 479 |
next PERIOD; |
491 |
next PERIOD; |
|
Lines 571-577
END_SQL
Link Here
|
| 571 |
my $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"}, $branchcode ); |
583 |
my $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"}, $branchcode ); |
| 572 |
|
584 |
|
| 573 |
unless ($letter) { |
585 |
unless ($letter) { |
| 574 |
$verbose and warn "Message '$overdue_rules->{letter$i}' content not found"; |
586 |
$verbose and warn qq|Message '$overdue_rules->{"letter$i"}' content not found|; |
| 575 |
|
587 |
|
| 576 |
# might as well skip while PERIOD, no other borrowers are going to work. |
588 |
# might as well skip while PERIOD, no other borrowers are going to work. |
| 577 |
# FIXME : Does this mean a letter must be defined in order to trigger a debar ? |
589 |
# FIXME : Does this mean a letter must be defined in order to trigger a debar ? |
|
Lines 591-599
END_SQL
Link Here
|
| 591 |
); |
603 |
); |
| 592 |
$verbose and warn "debarring $borr\n"; |
604 |
$verbose and warn "debarring $borr\n"; |
| 593 |
} |
605 |
} |
| 594 |
# my @params = ($listall ? ( $borrowernumber , 1 , $MAX ) : ( $borrowernumber, $mindays, $maxdays )); |
|
|
| 595 |
my @params = ($borrowernumber); |
606 |
my @params = ($borrowernumber); |
| 596 |
$verbose and warn "STH2 PARAMS: borrowernumber = $borrowernumber"; |
607 |
$verbose and warn "STH2 PARAMS: borrowernumber = $borrowernumber"; |
|
|
608 |
|
| 597 |
$sth2->execute(@params); |
609 |
$sth2->execute(@params); |
| 598 |
my $itemcount = 0; |
610 |
my $itemcount = 0; |
| 599 |
my $titles = ""; |
611 |
my $titles = ""; |
|
Lines 671-677
END_SQL
Link Here
|
| 671 |
} |
683 |
} |
| 672 |
); |
684 |
); |
| 673 |
unless ($letter) { |
685 |
unless ($letter) { |
| 674 |
$verbose and warn "Message '$overdue_rules->{letter$i}' content not found"; |
686 |
$verbose and warn qq|Message '$overdue_rules->{"letter$i"}' content not found|; |
| 675 |
# this transport doesn't have a configured notice, so try another |
687 |
# this transport doesn't have a configured notice, so try another |
| 676 |
next; |
688 |
next; |
| 677 |
} |
689 |
} |
| 678 |
- |
|
|