|
Lines 316-386
pod2usage( -verbose => 2 ) if $man;
Link Here
|
| 316 |
|
316 |
|
| 317 |
cronlogaction(); |
317 |
cronlogaction(); |
| 318 |
|
318 |
|
| 319 |
if ( defined $csvfilename && $csvfilename =~ /^-/ ) { |
319 |
sub VERBOSE{ |
| 320 |
warn qq(using "$csvfilename" as filename, that seems odd); |
320 |
if ($verbose){ |
|
|
321 |
printf STDERR "%s\n", shift; |
| 322 |
} |
| 321 |
} |
323 |
} |
| 322 |
|
324 |
|
| 323 |
my @overduebranches = C4::Overdues::GetBranchcodesWithOverdueRules(); # Branches with overdue rules |
325 |
if ( defined $csvfilename && $csvfilename =~ /^-/ ) { |
| 324 |
my @branches; # Branches passed as parameter with overdue rules |
326 |
warn qq(using "$csvfilename" as filename, that seems odd); |
| 325 |
my $branchcount = scalar(@overduebranches); |
|
|
| 326 |
|
| 327 |
my $overduebranch_word = scalar @overduebranches > 1 ? 'branches' : 'branch'; |
| 328 |
my $branchcodes_word = scalar @branchcodes > 1 ? 'branches' : 'branch'; |
| 329 |
|
| 330 |
my $PrintNoticesMaxLines = C4::Context->preference('PrintNoticesMaxLines'); |
| 331 |
|
| 332 |
if ($branchcount) { |
| 333 |
$verbose and warn "Found $branchcount $overduebranch_word with first message enabled: " . join( ', ', map { "'$_'" } @overduebranches ), "\n"; |
| 334 |
} else { |
| 335 |
die 'No branches with active overduerules'; |
| 336 |
} |
327 |
} |
| 337 |
|
328 |
|
| 338 |
if (@branchcodes) { |
|
|
| 339 |
$verbose and warn "$branchcodes_word @branchcodes passed on parameter\n"; |
| 340 |
|
| 341 |
# Getting libraries which have overdue rules |
| 342 |
my %seen = map { $_ => 1 } @branchcodes; |
| 343 |
@branches = grep { $seen{$_} } @overduebranches; |
| 344 |
|
| 345 |
|
| 346 |
if (@branches) { |
| 347 |
|
| 348 |
my $branch_word = scalar @branches > 1 ? 'branches' : 'branch'; |
| 349 |
$verbose and warn "$branch_word @branches have overdue rules\n"; |
| 350 |
|
| 351 |
} else { |
| 352 |
|
| 353 |
$verbose and warn "No active overduerules for $branchcodes_word '@branchcodes'\n"; |
| 354 |
( scalar grep { '' eq $_ } @branches ) |
| 355 |
or die "No active overduerules for DEFAULT either!"; |
| 356 |
$verbose and warn "Falling back on default rules for @branchcodes\n"; |
| 357 |
@branches = (''); |
| 358 |
} |
| 359 |
} |
| 360 |
my $date_to_run; |
329 |
my $date_to_run; |
| 361 |
my $date; |
330 |
my $date; |
| 362 |
if ( $date_input ){ |
331 |
if ( $date_input ){ |
|
|
332 |
$date = $dbh->quote($date); |
| 363 |
eval { |
333 |
eval { |
| 364 |
$date_to_run = dt_from_string( $date_input, 'iso' ); |
334 |
$date_to_run = dt_from_string( $date_input ); |
| 365 |
}; |
335 |
}; |
| 366 |
die "$date_input is not a valid date, aborting! Use a date in format YYYY-MM-DD." |
336 |
die "$date_input is not a valid date, aborting!" |
| 367 |
if $@ or not $date_to_run; |
337 |
if $@ or not $date_to_run; |
| 368 |
|
338 |
|
| 369 |
# It's certainly useless to escape $date_input |
|
|
| 370 |
# dt_from_string should not return something if $date_input is not correctly set. |
| 371 |
$date = $dbh->quote( $date_input ); |
| 372 |
} |
339 |
} |
| 373 |
else { |
340 |
else { |
| 374 |
$date="NOW()"; |
341 |
$date="NOW()"; |
| 375 |
$date_to_run = dt_from_string(); |
342 |
$date_to_run = dt_from_string(); |
| 376 |
} |
343 |
} |
| 377 |
|
344 |
|
|
|
345 |
## |
| 346 |
## Some file/html preparation ? |
| 347 |
## |
| 348 |
|
| 349 |
my $printNoticesMaxLines = C4::Context->preference('PrintNoticesMaxLines'); |
| 350 |
|
| 378 |
# these are the fields that will be substituted into <<item.content>> |
351 |
# these are the fields that will be substituted into <<item.content>> |
| 379 |
my @item_content_fields = split( /,/, $itemscontent ); |
352 |
my @item_content_fields = split( /,/, $itemscontent ); |
| 380 |
|
353 |
|
| 381 |
binmode( STDOUT, ':encoding(UTF-8)' ); |
354 |
binmode( STDOUT, ':encoding(UTF-8)' ); |
| 382 |
|
355 |
|
| 383 |
|
|
|
| 384 |
our $csv; # the Text::CSV_XS object |
356 |
our $csv; # the Text::CSV_XS object |
| 385 |
our $csv_fh; # the filehandle to the CSV file. |
357 |
our $csv_fh; # the filehandle to the CSV file. |
| 386 |
if ( defined $csvfilename ) { |
358 |
if ( defined $csvfilename ) { |
|
Lines 392-417
if ( defined $csvfilename ) {
Link Here
|
| 392 |
} else { |
364 |
} else { |
| 393 |
open $csv_fh, ">", $csvfilename or die "unable to open $csvfilename: $!"; |
365 |
open $csv_fh, ">", $csvfilename or die "unable to open $csvfilename: $!"; |
| 394 |
} |
366 |
} |
| 395 |
if ( $csv->combine(qw(name surname address1 address2 zipcode city country email phone cardnumber itemcount itemsinfo branchname letternumber)) ) { |
367 |
if ( $csv->combine(qw(name surname address1 address2 zipcode city country email itemcount itemsinfo)) ) { |
| 396 |
print $csv_fh $csv->string, "\n"; |
368 |
print $csv_fh $csv->string, "\n"; |
| 397 |
} else { |
369 |
} else { |
| 398 |
$verbose and warn 'combine failed on argument: ' . $csv->error_input; |
370 |
VERBOSE( 'combine failed on argument: ' . $csv->error_input); |
| 399 |
} |
371 |
} |
| 400 |
} |
372 |
} |
| 401 |
|
373 |
|
| 402 |
@branches = @overduebranches unless @branches; |
|
|
| 403 |
our $fh; |
374 |
our $fh; |
| 404 |
if ( defined $htmlfilename ) { |
375 |
if ( defined $htmlfilename ) { |
| 405 |
if ( $htmlfilename eq '' ) { |
376 |
if ( $htmlfilename eq '' ) { |
| 406 |
$fh = *STDOUT; |
377 |
$fh = *STDOUT; |
| 407 |
} else { |
378 |
} else { |
| 408 |
my $today = DateTime->now(time_zone => C4::Context->tz ); |
379 |
my $today = DateTime->now(time_zone => C4::Context->tz ); |
| 409 |
open $fh, ">:encoding(UTF-8)",File::Spec->catdir ($htmlfilename,"notices-".$today->ymd().".html"); |
380 |
open $fh, ">",File::Spec->catdir ($htmlfilename,"notices-".$today->ymd().".html"); |
| 410 |
} |
381 |
} |
| 411 |
|
382 |
|
| 412 |
print $fh "<html>\n"; |
383 |
print $fh "<html>\n"; |
| 413 |
print $fh "<head>\n"; |
384 |
print $fh "<head>\n"; |
| 414 |
print $fh "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />\n"; |
|
|
| 415 |
print $fh "<style type='text/css'>\n"; |
385 |
print $fh "<style type='text/css'>\n"; |
| 416 |
print $fh "pre {page-break-after: always;}\n"; |
386 |
print $fh "pre {page-break-after: always;}\n"; |
| 417 |
print $fh "pre {white-space: pre-wrap;}\n"; |
387 |
print $fh "pre {white-space: pre-wrap;}\n"; |
|
Lines 431-818
elsif ( defined $text_filename ) {
Link Here
|
| 431 |
} |
401 |
} |
| 432 |
} |
402 |
} |
| 433 |
|
403 |
|
| 434 |
foreach my $branchcode (@branches) { |
404 |
## |
| 435 |
if ( C4::Context->preference('OverdueNoticeCalendar') ) { |
405 |
## sql queries |
| 436 |
my $calendar = Koha::Calendar->new( branchcode => $branchcode ); |
406 |
## |
| 437 |
if ( $calendar->is_holiday($date_to_run) ) { |
407 |
my $sqlIssues = "SELECT biblio.*, items.*, issues.*, biblioitems.itemtype, TO_DAYS($date)-TO_DAYS(date_due) AS days_overdue |
| 438 |
next; |
408 |
FROM issues,items,biblio, biblioitems |
| 439 |
} |
409 |
WHERE items.itemnumber=issues.itemnumber |
| 440 |
} |
|
|
| 441 |
|
| 442 |
my $branch_details = C4::Branch::GetBranchDetail($branchcode); |
| 443 |
my $admin_email_address = $branch_details->{'branchemail'} |
| 444 |
|| C4::Context->preference('KohaAdminEmailAddress'); |
| 445 |
my @output_chunks; # may be sent to mail or stdout or csv file. |
| 446 |
|
| 447 |
$verbose and warn sprintf "branchcode : '%s' using %s\n", $branchcode, $admin_email_address; |
| 448 |
|
| 449 |
my $sth2 = $dbh->prepare( <<"END_SQL" ); |
| 450 |
SELECT biblio.*, items.*, issues.*, biblioitems.itemtype, TO_DAYS($date)-TO_DAYS(date_due) AS days_overdue, branchname |
| 451 |
FROM issues,items,biblio, biblioitems, branches b |
| 452 |
WHERE items.itemnumber=issues.itemnumber |
| 453 |
AND biblio.biblionumber = items.biblionumber |
410 |
AND biblio.biblionumber = items.biblionumber |
| 454 |
AND b.branchcode = items.homebranch |
|
|
| 455 |
AND biblio.biblionumber = biblioitems.biblionumber |
411 |
AND biblio.biblionumber = biblioitems.biblionumber |
| 456 |
AND issues.borrowernumber = ? |
412 |
AND TO_DAYS($date)-TO_DAYS(date_due) BETWEEN 1 AND $MAX "; |
| 457 |
END_SQL |
413 |
|
| 458 |
|
414 |
my $sqlBorrowers = "SELECT issues.borrowernumber, firstname, surname, address, address2, city, zipcode, |
| 459 |
my $query = "SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? "; |
415 |
country, email, emailpro, B_email, smsalertnumber, borrowers.categorycode |
| 460 |
$query .= " AND categorycode IN (".join( ',' , ('?') x @myborcat ).") " if (@myborcat); |
416 |
FROM issues,borrowers,categories |
| 461 |
$query .= " AND categorycode NOT IN (".join( ',' , ('?') x @myborcatout ).") " if (@myborcatout); |
417 |
WHERE issues.borrowernumber=borrowers.borrowernumber |
| 462 |
|
418 |
AND borrowers.categorycode=categories.categorycode |
| 463 |
my $rqoverduerules = $dbh->prepare($query); |
419 |
AND TO_DAYS($date)-TO_DAYS(date_due) BETWEEN 1 AND $MAX |
| 464 |
$rqoverduerules->execute($branchcode, @myborcat, @myborcatout); |
420 |
AND categories.overduenoticerequired=1 "; |
| 465 |
|
421 |
|
| 466 |
# We get default rules is there is no rule for this branch |
422 |
my $sqlRules = "SELECT * |
| 467 |
if($rqoverduerules->rows == 0){ |
423 |
FROM overduerules |
| 468 |
$query = "SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = '' "; |
424 |
WHERE delay != 0 |
| 469 |
$query .= " AND categorycode IN (".join( ',' , ('?') x @myborcat ).") " if (@myborcat); |
425 |
AND letter <> '' |
| 470 |
$query .= " AND categorycode NOT IN (".join( ',' , ('?') x @myborcatout ).") " if (@myborcatout); |
426 |
ORDER BY branchcode desc, categorycode desc, itemtype desc, onhold desc, delay desc"; |
| 471 |
|
427 |
|
| 472 |
$rqoverduerules = $dbh->prepare($query); |
428 |
my $sqlMTT = "SELECT message_transport_type from overduerules_transport_types where overduerules_id = ?"; |
| 473 |
$rqoverduerules->execute(@myborcat, @myborcatout); |
429 |
|
| 474 |
} |
430 |
my $sqlReserves = "SELECT distinct(biblionumber) FROM reserves"; |
| 475 |
|
431 |
|
| 476 |
# my $outfile = 'overdues_' . ( $mybranch || $branchcode || 'default' ); |
432 |
## |
| 477 |
while ( my $overdue_rules = $rqoverduerules->fetchrow_hashref ) { |
433 |
## customized depending on parameters |
| 478 |
PERIOD: foreach my $i ( 1 .. 3 ) { |
434 |
## |
| 479 |
|
435 |
if(@branchcodes){ |
| 480 |
$verbose and warn "branch '$branchcode', categorycode = $overdue_rules->{categorycode} pass $i\n"; |
436 |
$sqlIssues .= " AND issues.branchcode IN ('" . join ("','", @branchcodes) . "')"; |
|
|
437 |
} |
| 438 |
if(@myborcat){ |
| 439 |
$sqlBorrowers .= " AND borrower.categorycode IN ('" . join ("','", @myborcat) . "')"; |
| 440 |
} |
| 441 |
if(@myborcatout){ |
| 442 |
$sqlBorrowers .= " AND borrower.categorycode NOT IN ('" . join ("','", @myborcatout) . "')"; |
| 443 |
} |
| 481 |
|
444 |
|
| 482 |
my $mindays = $overdue_rules->{"delay$i"}; # the notice will be sent after mindays days (grace period) |
445 |
## |
| 483 |
my $maxdays = ( |
446 |
## collect everything in meaningful hashes |
| 484 |
$overdue_rules->{ "delay" . ( $i + 1 ) } |
447 |
## |
| 485 |
? $overdue_rules->{ "delay" . ( $i + 1 ) } - 1 |
448 |
my $hrBorrowers = $dbh->selectall_hashref($sqlBorrowers, 'borrowernumber'); |
| 486 |
: ($MAX) |
449 |
VERBOSE("$sqlBorrowers\nReturned " . (scalar keys $hrBorrowers) . " borrowers with issues."); |
| 487 |
); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended) |
450 |
my $hrOverdueIssues = $dbh->selectall_hashref($sqlIssues, 'itemnumber' ); |
|
|
451 |
VERBOSE("$sqlIssues\nReturned " . (scalar keys $hrOverdueIssues) . " overdue issues."); |
| 452 |
my $arRules = $dbh->selectall_arrayref($sqlRules, { Slice => {} } ); |
| 453 |
VERBOSE("\nRule order:\nId\tBranch\tCat\tItem\tHold\tDelay\tDebarred\tLetter"); |
| 454 |
foreach my $rule (@$arRules){ |
| 455 |
$rule->{mtt} = $dbh->selectcol_arrayref($sqlMTT, undef, $rule->{overduerules_id}); |
| 456 |
VERBOSE("$rule->{id}\t$rule->{branchcode}\t$rule->{categorycode}\t$rule->{itemtype}\t$rule->{onhold}\t$rule->{delay}\t$rule->{debarred}\t$rule->{letter}"); |
| 457 |
} |
| 458 |
my $hrReserves = $dbh->selectall_hashref($sqlReserves, 'biblionumber'); |
| 459 |
VERBOSE("$sqlReserves\nReturned " . (scalar keys $hrReserves) . " unique reserves."); |
| 460 |
my %hBranches; |
| 461 |
my %hChunks; # messages to send once per branch to the administrator |
| 462 |
|
| 463 |
## |
| 464 |
## For each issue, determine the most meaningful rule that applies |
| 465 |
## and associate it to the borrower |
| 466 |
## |
| 467 |
|
| 468 |
my $whichItemType = C4::Context->preference('item-level_itypes') ? 'itype' : 'itemtype'; |
| 469 |
foreach my $in (keys $hrOverdueIssues){ |
| 470 |
my $issue = $hrOverdueIssues->{$in}; |
| 471 |
VERBOSE("Processing issue $in. branchcode: $issue->{branchcode}, borrower: $issue->{borrowernumber}."); |
| 472 |
foreach my $rule(@$arRules){ |
| 473 |
if( ($rule->{branchcode} eq '' || $rule->{branchcode} eq $issue->{branchcode}) && |
| 474 |
($rule->{categorycode} eq '' || $rule->{categorycode} eq $hrBorrowers->{$issue->{borrowernumber}}->{categorycode}) && |
| 475 |
($rule->{itemtype} eq '' || $rule->{itemtype} eq $issue->{$whichItemType}) && |
| 476 |
(!$rule->{onhold} || defined $hrReserves->{$issue->{biblionumber}}) |
| 477 |
) |
| 478 |
{ |
| 479 |
# limit the creation of calendar objects |
| 480 |
if(!defined $hBranches{$issue->{branchcode}}){ |
| 481 |
$hBranches{$issue->{branchcode}} = C4::Branch::GetBranchDetail($issue->{branchcode}); |
| 482 |
$hBranches{$issue->{branchcode}}{CALENDAR} = Koha::Calendar->new( branchcode => $issue->{branchcode} ); |
| 483 |
} |
| 488 |
|
484 |
|
| 489 |
next unless defined $mindays; |
485 |
# validate number of days overdue vs delay |
|
|
486 |
if ( C4::Context->preference('OverdueNoticeCalendar') ){ |
| 487 |
my $days_between = $hBranches{$issue->{branchcode}}{CALENDAR}->days_between( dt_from_string($issue->{date_due}), $date_to_run ); |
| 488 |
$issue->{days_overdue} = $days_between->in_units('days'); |
| 489 |
} |
| 490 |
next if ( $triggered && $rule->{delay} != $issue->{days_overdue}); # on "triggered". we only look for exact matches |
| 491 |
next if (!$triggered && $rule->{delay} > $issue->{days_overdue}); |
| 490 |
|
492 |
|
| 491 |
if ( !$overdue_rules->{"letter$i"} ) { |
493 |
# validate the letter |
| 492 |
$verbose and warn "No letter$i code for branch '$branchcode'"; |
494 |
unless(C4::Letters::getletter( 'circulation', $rule->{letter}, $issue->{branchcode} )){ |
| 493 |
next PERIOD; |
495 |
VERBOSE("Message '$rule->{letter}' content not found"); |
|
|
496 |
last; # if no letter |
| 494 |
} |
497 |
} |
| 495 |
|
498 |
|
| 496 |
# $letter->{'content'} is the text of the mail that is sent. |
499 |
# we found the best rule to apply, let's store the branchcode/lettter combo into the borrower |
| 497 |
# this text contains fields that are replaced by their value. Those fields must be written between brackets |
500 |
my $arItems = $hrBorrowers->{$issue->{borrowernumber}}{NOTICES}{$issue->{branchcode}}{$rule->{letter}}{ITEMS} ||= []; |
| 498 |
# The following fields are available : |
501 |
push $arItems, $issue->{itemnumber}; |
| 499 |
# itemcount is interpreted here as the number of items in the overdue range defined by the current notice or all overdues < max if(-list-all). |
502 |
# And note that we union the transport types, so IF the user set two similar alerts (except for delay and mtt), then |
| 500 |
# <date> <itemcount> <firstname> <lastname> <address1> <address2> <address3> <city> <postcode> <country> |
503 |
# only one message will be sent to each of the transport specified by both rules together |
| 501 |
|
504 |
my $hrMtts = $hrBorrowers->{$issue->{borrowernumber}}{NOTICES}{$issue->{branchcode}}{$rule->{letter}}{MTTS} ||= {}; |
| 502 |
my $borrower_sql = <<'END_SQL'; |
505 |
foreach my $mtt(@{$rule->{mtt}}){ |
| 503 |
SELECT issues.borrowernumber, firstname, surname, address, address2, city, zipcode, country, email, emailpro, B_email, smsalertnumber, phone, cardnumber, |
506 |
$hrMtts->{$mtt} = 1; |
| 504 |
TO_DAYS(?)-TO_DAYS(date_due) as difference, date_due |
|
|
| 505 |
FROM issues,borrowers,categories |
| 506 |
WHERE issues.borrowernumber=borrowers.borrowernumber |
| 507 |
AND borrowers.categorycode=categories.categorycode |
| 508 |
END_SQL |
| 509 |
my @borrower_parameters; |
| 510 |
push @borrower_parameters, $date_to_run->datetime(); |
| 511 |
if ($branchcode) { |
| 512 |
$borrower_sql .= ' AND issues.branchcode=? '; |
| 513 |
push @borrower_parameters, $branchcode; |
| 514 |
} |
507 |
} |
| 515 |
if ( $overdue_rules->{categorycode} ) { |
508 |
VERBOSE("User $hrBorrowers->{$issue->{borrowernumber}}{surname}, Branch $issue->{branchcode}, Letter $rule->{letter} : Item $issue->{itemnumber}"); |
| 516 |
$borrower_sql .= ' AND borrowers.categorycode=? '; |
509 |
|
| 517 |
push @borrower_parameters, $overdue_rules->{categorycode}; |
510 |
# block the user if needed |
|
|
511 |
if ( $rule->{"debarred"} ) { |
| 512 |
AddUniqueDebarment({ |
| 513 |
borrowernumber => $issue->{borrowernumber}, |
| 514 |
type => 'OVERDUES', |
| 515 |
comment => "Restriction added by overdues process " . output_pref( dt_from_string() ), |
| 516 |
}); |
| 517 |
VERBOSE("debarring user $issue->{borrowernumber} (" . $hrBorrowers->{$issue->{borrowernumber}}{surname} . ")"); |
| 518 |
} |
518 |
} |
| 519 |
$borrower_sql .= ' AND categories.overduenoticerequired=1 ORDER BY issues.borrowernumber'; |
519 |
last; # we found a rule, let's move to the next issue |
| 520 |
|
520 |
} |
| 521 |
# $sth gets borrower info iff at least one overdue item has triggered the overdue action. |
521 |
} |
| 522 |
my $sth = $dbh->prepare($borrower_sql); |
522 |
} |
| 523 |
$sth->execute(@borrower_parameters); |
|
|
| 524 |
|
| 525 |
$verbose and warn $borrower_sql . "\n $branchcode | " . $overdue_rules->{'categorycode'} . "\n ($mindays, $maxdays, ". $date_to_run->datetime() .")\nreturns " . $sth->rows . " rows"; |
| 526 |
my $borrowernumber; |
| 527 |
while ( my $data = $sth->fetchrow_hashref ) { |
| 528 |
|
| 529 |
next unless ( DateTime->compare( $date_to_run, dt_from_string($data->{date_due})) ) == 1; |
| 530 |
|
| 531 |
# check the borrower has at least one item that matches |
| 532 |
my $days_between; |
| 533 |
if ( C4::Context->preference('OverdueNoticeCalendar') ) |
| 534 |
{ |
| 535 |
my $calendar = |
| 536 |
Koha::Calendar->new( branchcode => $branchcode ); |
| 537 |
$days_between = |
| 538 |
$calendar->days_between( dt_from_string($data->{date_due}), |
| 539 |
$date_to_run ); |
| 540 |
} |
| 541 |
else { |
| 542 |
$days_between = |
| 543 |
$date_to_run->delta_days( dt_from_string($data->{date_due}) ); |
| 544 |
} |
| 545 |
$days_between = $days_between->in_units('days'); |
| 546 |
if ($triggered) { |
| 547 |
if ( $mindays != $days_between ) { |
| 548 |
next; |
| 549 |
} |
| 550 |
} |
| 551 |
else { |
| 552 |
unless ( $days_between >= $mindays |
| 553 |
&& $days_between <= $maxdays ) |
| 554 |
{ |
| 555 |
next; |
| 556 |
} |
| 557 |
} |
| 558 |
if (defined $borrowernumber && $borrowernumber eq $data->{'borrowernumber'}){ |
| 559 |
# we have already dealt with this borrower |
| 560 |
$verbose and warn "already dealt with this borrower $borrowernumber"; |
| 561 |
next; |
| 562 |
} |
| 563 |
$borrowernumber = $data->{'borrowernumber'}; |
| 564 |
my $borr = |
| 565 |
$data->{'firstname'} . ', ' |
| 566 |
. $data->{'surname'} . ' (' |
| 567 |
. $borrowernumber . ')'; |
| 568 |
$verbose |
| 569 |
and warn "borrower $borr has items triggering level $i."; |
| 570 |
|
| 571 |
@emails_to_use = (); |
| 572 |
my $notice_email = |
| 573 |
C4::Members::GetNoticeEmailAddress($borrowernumber); |
| 574 |
unless ($nomail) { |
| 575 |
if (@emails) { |
| 576 |
foreach (@emails) { |
| 577 |
push @emails_to_use, $data->{$_} if ( $data->{$_} ); |
| 578 |
} |
| 579 |
} |
| 580 |
else { |
| 581 |
push @emails_to_use, $notice_email if ($notice_email); |
| 582 |
} |
| 583 |
} |
| 584 |
|
523 |
|
| 585 |
my $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"}, $branchcode ); |
524 |
## |
|
|
525 |
## Main loop |
| 526 |
## |
| 527 |
VERBOSE("Main loop."); |
| 528 |
foreach my $borrowernumber(keys $hrBorrowers){ |
| 529 |
if(!defined $hrBorrowers->{$borrowernumber}{NOTICES}){ |
| 530 |
VERBOSE("User $hrBorrowers->{$borrowernumber}{surname} has no notice."); |
| 531 |
next; |
| 532 |
} |
| 533 |
# for each branch |
| 534 |
foreach my $branchcode (keys $hrBorrowers->{$borrowernumber}{NOTICES}){ |
| 535 |
my $admin_email_address = $hBranches{$branchcode}{'branchemail'} || C4::Context->preference('KohaAdminEmailAddress'); |
| 536 |
if($hBranches{$branchcode}{CALENDAR}->is_holiday($date_to_run)){ |
| 537 |
VERBOSE("$date_to_run is a holiday at branch $branchcode"); |
| 538 |
next; |
| 539 |
} |
| 586 |
|
540 |
|
| 587 |
unless ($letter) { |
541 |
# for each letter |
| 588 |
$verbose and warn qq|Message '$overdue_rules->{"letter$i"}' content not found|; |
542 |
foreach my $lettercode (keys $hrBorrowers->{$borrowernumber}{NOTICES}{$branchcode}){ |
|
|
543 |
@emails_to_use = (); |
| 544 |
my $notice_email = C4::Members::GetNoticeEmailAddress($borrowernumber); |
| 545 |
unless ($nomail) { |
| 546 |
if (@emails) { |
| 547 |
@emails_to_use = @emails; |
| 548 |
# foreach (@emails) { |
| 549 |
# push @emails_to_use, $data->{$_} if ( $data->{$_} ); |
| 550 |
# } |
| 551 |
}else{ |
| 552 |
push @emails_to_use, $notice_email if ($notice_email); |
| 553 |
} |
| 554 |
} |
| 589 |
|
555 |
|
| 590 |
# might as well skip while PERIOD, no other borrowers are going to work. |
556 |
# finally, the items |
| 591 |
# FIXME : Does this mean a letter must be defined in order to trigger a debar ? |
557 |
my $arItems = $hrBorrowers->{$borrowernumber}{NOTICES}{$branchcode}{$lettercode}{ITEMS}; |
| 592 |
next PERIOD; |
558 |
if(!defined $arItems){ |
|
|
559 |
VERBOSE("No item for borrower $borrowernumber"); |
| 560 |
next; |
| 561 |
} |
| 562 |
my $itemcount = 0; |
| 563 |
my $titles = ""; |
| 564 |
my @items = (); |
| 565 |
|
| 566 |
my $j = 0; |
| 567 |
my $exceededPrintNoticesMaxLines = 0; |
| 568 |
foreach my $itemnumber(@{$arItems}){ |
| 569 |
if ( ( scalar(@emails_to_use) == 0 || $nomail ) && $printNoticesMaxLines && $j >= $printNoticesMaxLines ) { |
| 570 |
$exceededPrintNoticesMaxLines = 1; |
| 571 |
last; |
| 593 |
} |
572 |
} |
| 594 |
|
573 |
$j++; |
| 595 |
if ( $overdue_rules->{"debarred$i"} ) { |
574 |
my $item = $hrOverdueIssues->{$itemnumber}; |
| 596 |
|
575 |
my @item_info = map { $_ =~ /^date|date$/ ? format_date( $item->{$_} ) : $item->{$_} || '' } @item_content_fields; |
| 597 |
#action taken is debarring |
576 |
$titles .= join("\t", @item_info) . "\n"; |
| 598 |
AddUniqueDebarment( |
577 |
$itemcount++; |
| 599 |
{ |
578 |
push @items, $item; |
| 600 |
borrowernumber => $borrowernumber, |
579 |
} |
| 601 |
type => 'OVERDUES', |
580 |
|
| 602 |
comment => "Restriction added by overdues process " |
581 |
# the transport types (email, sms...) |
| 603 |
. output_pref( dt_from_string() ), |
582 |
my @message_transport_types = keys $hrBorrowers->{$borrowernumber}{NOTICES}{$branchcode}{$lettercode}{MTTS}; |
| 604 |
} |
583 |
my $print_sent = 0; # A print notice is not yet sent for this patron |
| 605 |
); |
584 |
for my $mtt ( @message_transport_types ) { |
| 606 |
$verbose and warn "debarring $borr\n"; |
585 |
my $letter = parse_letter( { |
|
|
586 |
letter_code => $lettercode, |
| 587 |
borrowernumber => $borrowernumber, |
| 588 |
branchcode => $branchcode, |
| 589 |
items => \@items, |
| 590 |
substitute => { # this appears to be a hack to overcome incomplete features in this code. |
| 591 |
bib => $hBranches{$branchcode}{'branchname'}, # maybe 'bib' is a typo for 'lib<rary>'? |
| 592 |
'items.content' => $titles, |
| 593 |
'count' => $itemcount, |
| 594 |
}, |
| 595 |
message_transport_type => $mtt, |
| 596 |
} ); |
| 597 |
unless ($letter) { |
| 598 |
VERBOSE("Message '$lettercode' content not found (transport $mtt, branch $branchcode)"); |
| 599 |
next; |
| 607 |
} |
600 |
} |
| 608 |
my @params = ($borrowernumber); |
|
|
| 609 |
$verbose and warn "STH2 PARAMS: borrowernumber = $borrowernumber"; |
| 610 |
|
| 611 |
$sth2->execute(@params); |
| 612 |
my $itemcount = 0; |
| 613 |
my $titles = ""; |
| 614 |
my @items = (); |
| 615 |
|
| 616 |
my $j = 0; |
| 617 |
my $exceededPrintNoticesMaxLines = 0; |
| 618 |
while ( my $item_info = $sth2->fetchrow_hashref() ) { |
| 619 |
next unless ( DateTime->compare( $date_to_run, dt_from_string($item_info->{date_due})) ) == 1; |
| 620 |
|
| 621 |
if ( C4::Context->preference('OverdueNoticeCalendar') ) { |
| 622 |
my $calendar = |
| 623 |
Koha::Calendar->new( branchcode => $branchcode ); |
| 624 |
$days_between = |
| 625 |
$calendar->days_between( |
| 626 |
dt_from_string( $item_info->{date_due} ), $date_to_run ); |
| 627 |
} |
| 628 |
else { |
| 629 |
$days_between = |
| 630 |
$date_to_run->delta_days( |
| 631 |
dt_from_string( $item_info->{date_due} ) ); |
| 632 |
} |
| 633 |
$days_between = $days_between->in_units('days'); |
| 634 |
if ($listall){ |
| 635 |
unless ($days_between >= 1 and $days_between <= $MAX){ |
| 636 |
next; |
| 637 |
} |
| 638 |
} |
| 639 |
else { |
| 640 |
if ($triggered) { |
| 641 |
if ( $mindays != $days_between ) { |
| 642 |
next; |
| 643 |
} |
| 644 |
} |
| 645 |
else { |
| 646 |
unless ( $days_between >= $mindays |
| 647 |
&& $days_between <= $maxdays ) |
| 648 |
{ |
| 649 |
next; |
| 650 |
} |
| 651 |
} |
| 652 |
} |
| 653 |
|
601 |
|
| 654 |
if ( ( scalar(@emails_to_use) == 0 || $nomail ) && $PrintNoticesMaxLines && $j >= $PrintNoticesMaxLines ) { |
602 |
if ( $exceededPrintNoticesMaxLines ) { |
| 655 |
$exceededPrintNoticesMaxLines = 1; |
603 |
$letter->{'content'} .= "List too long for form; please check your account online for a complete list of your overdue items."; |
| 656 |
last; |
|
|
| 657 |
} |
| 658 |
$j++; |
| 659 |
my @item_info = map { $_ =~ /^date|date$/ ? |
| 660 |
eval { output_pref( { dt => dt_from_string( $item_info->{$_} ), dateonly => 1 } ); } |
| 661 |
: |
| 662 |
$item_info->{$_} || '' } @item_content_fields; |
| 663 |
$titles .= join("\t", @item_info) . "\n"; |
| 664 |
$itemcount++; |
| 665 |
push @items, $item_info; |
| 666 |
} |
604 |
} |
| 667 |
$sth2->finish; |
|
|
| 668 |
|
| 669 |
my @message_transport_types = @{ GetOverdueMessageTransportTypes( $branchcode, $overdue_rules->{categorycode}, $i) }; |
| 670 |
@message_transport_types = @{ GetOverdueMessageTransportTypes( q{}, $overdue_rules->{categorycode}, $i) } |
| 671 |
unless @message_transport_types; |
| 672 |
|
| 673 |
|
| 674 |
my $print_sent = 0; # A print notice is not yet sent for this patron |
| 675 |
for my $mtt ( @message_transport_types ) { |
| 676 |
|
| 677 |
my $letter = parse_overdues_letter( |
| 678 |
{ letter_code => $overdue_rules->{"letter$i"}, |
| 679 |
borrowernumber => $borrowernumber, |
| 680 |
branchcode => $branchcode, |
| 681 |
items => \@items, |
| 682 |
substitute => { # this appears to be a hack to overcome incomplete features in this code. |
| 683 |
bib => $branch_details->{'branchname'}, # maybe 'bib' is a typo for 'lib<rary>'? |
| 684 |
'items.content' => $titles, |
| 685 |
'count' => $itemcount, |
| 686 |
}, |
| 687 |
message_transport_type => $mtt, |
| 688 |
} |
| 689 |
); |
| 690 |
unless ($letter) { |
| 691 |
$verbose and warn qq|Message '$overdue_rules->{"letter$i"}' content not found|; |
| 692 |
# this transport doesn't have a configured notice, so try another |
| 693 |
next; |
| 694 |
} |
| 695 |
|
605 |
|
| 696 |
if ( $exceededPrintNoticesMaxLines ) { |
606 |
my @misses = grep { /./ } map { /^([^>]*)[>]+/; ( $1 || '' ); } split /\</, $letter->{'content'}; |
| 697 |
$letter->{'content'} .= "List too long for form; please check your account online for a complete list of your overdue items."; |
607 |
if (@misses) { |
| 698 |
} |
608 |
VERBOSE( "The following terms were not matched and replaced: \n\t" . join "\n\t", @misses ); |
|
|
609 |
} |
| 699 |
|
610 |
|
| 700 |
my @misses = grep { /./ } map { /^([^>]*)[>]+/; ( $1 || '' ); } split /\</, $letter->{'content'}; |
611 |
if ($nomail) { |
| 701 |
if (@misses) { |
612 |
$hChunks{$admin_email_address} ||= []; |
| 702 |
$verbose and warn "The following terms were not matched and replaced: \n\t" . join "\n\t", @misses; |
613 |
push $hChunks{$admin_email_address}, prepare_letter_for_printing( { |
|
|
614 |
letter => $letter, |
| 615 |
borrowernumber => $borrowernumber, |
| 616 |
firstname => $hrBorrowers->{$borrowernumber}->{'firstname'}, |
| 617 |
lastname => $hrBorrowers->{$borrowernumber}->{'surname'}, |
| 618 |
address1 => $hrBorrowers->{$borrowernumber}->{'address'}, |
| 619 |
address2 => $hrBorrowers->{$borrowernumber}->{'address2'}, |
| 620 |
city => $hrBorrowers->{$borrowernumber}->{'city'}, |
| 621 |
postcode => $hrBorrowers->{$borrowernumber}->{'zipcode'}, |
| 622 |
country => $hrBorrowers->{$borrowernumber}->{'country'}, |
| 623 |
email => $notice_email, |
| 624 |
itemcount => $itemcount, |
| 625 |
titles => $titles, |
| 626 |
outputformat => defined $csvfilename ? 'csv' : defined $htmlfilename ? 'html' : defined $text_filename ? 'text' : '', |
| 627 |
} ); |
| 628 |
} else { |
| 629 |
if ( ($mtt eq 'email' and not scalar @emails_to_use) or ($mtt eq 'sms' and not $hrBorrowers->{$borrowernumber}->{smsalertnumber}) ) { |
| 630 |
# email or sms is requested but not exist, do a print. |
| 631 |
$mtt = 'print'; |
| 703 |
} |
632 |
} |
| 704 |
|
633 |
unless ( $mtt eq 'print' and $print_sent == 1 ) { |
| 705 |
if ($nomail) { |
634 |
# Just sent a print if not already done. |
| 706 |
push @output_chunks, |
635 |
C4::Letters::EnqueueLetter( |
| 707 |
prepare_letter_for_printing( |
636 |
{ letter => $letter, |
| 708 |
{ letter => $letter, |
637 |
borrowernumber => $borrowernumber, |
| 709 |
borrowernumber => $borrowernumber, |
638 |
message_transport_type => $mtt, |
| 710 |
firstname => $data->{'firstname'}, |
639 |
from_address => $admin_email_address, |
| 711 |
lastname => $data->{'surname'}, |
640 |
to_address => join(',', @emails_to_use), |
| 712 |
address1 => $data->{'address'}, |
|
|
| 713 |
address2 => $data->{'address2'}, |
| 714 |
city => $data->{'city'}, |
| 715 |
phone => $data->{'phone'}, |
| 716 |
cardnumber => $data->{'cardnumber'}, |
| 717 |
branchname => $branch_details->{'branchname'}, |
| 718 |
letternumber => $i, |
| 719 |
postcode => $data->{'zipcode'}, |
| 720 |
country => $data->{'country'}, |
| 721 |
email => $notice_email, |
| 722 |
itemcount => $itemcount, |
| 723 |
titles => $titles, |
| 724 |
outputformat => defined $csvfilename ? 'csv' : defined $htmlfilename ? 'html' : defined $text_filename ? 'text' : '', |
| 725 |
} |
641 |
} |
| 726 |
); |
642 |
); |
| 727 |
} else { |
643 |
# A print notice should be sent only once per overdue level. |
| 728 |
if ( ($mtt eq 'email' and not scalar @emails_to_use) or ($mtt eq 'sms' and not $data->{smsalertnumber}) ) { |
644 |
# Without this check, a print could be sent twice or more if the library checks sms and email and print and the patron has no email or sms number. |
| 729 |
# email or sms is requested but not exist, do a print. |
645 |
$print_sent = 1 if $mtt eq 'print'; |
| 730 |
$mtt = 'print'; |
|
|
| 731 |
push @output_chunks, |
| 732 |
prepare_letter_for_printing( |
| 733 |
{ letter => $letter, |
| 734 |
borrowernumber => $borrowernumber, |
| 735 |
firstname => $data->{'firstname'}, |
| 736 |
lastname => $data->{'surname'}, |
| 737 |
address1 => $data->{'address'}, |
| 738 |
address2 => $data->{'address2'}, |
| 739 |
city => $data->{'city'}, |
| 740 |
postcode => $data->{'zipcode'}, |
| 741 |
country => $data->{'country'}, |
| 742 |
email => $notice_email, |
| 743 |
itemcount => $itemcount, |
| 744 |
titles => $titles, |
| 745 |
outputformat => defined $csvfilename ? 'csv' : defined $htmlfilename ? 'html' : defined $text_filename ? 'text' : '', |
| 746 |
} |
| 747 |
); |
| 748 |
} |
| 749 |
unless ( $mtt eq 'print' and $print_sent == 1 ) { |
| 750 |
# Just sent a print if not already done. |
| 751 |
C4::Letters::EnqueueLetter( |
| 752 |
{ letter => $letter, |
| 753 |
borrowernumber => $borrowernumber, |
| 754 |
message_transport_type => $mtt, |
| 755 |
from_address => $admin_email_address, |
| 756 |
to_address => join(',', @emails_to_use), |
| 757 |
} |
| 758 |
); |
| 759 |
# A print notice should be sent only once per overdue level. |
| 760 |
# Without this check, a print could be sent twice or more if the library checks sms and email and print and the patron has no email or sms number. |
| 761 |
$print_sent = 1 if $mtt eq 'print'; |
| 762 |
} |
| 763 |
} |
646 |
} |
| 764 |
} |
647 |
} |
| 765 |
} |
648 |
} |
| 766 |
$sth->finish; |
|
|
| 767 |
} |
649 |
} |
| 768 |
} |
650 |
} |
|
|
651 |
} |
| 769 |
|
652 |
|
| 770 |
if (@output_chunks) { |
653 |
foreach my $admin_email_address (keys %hChunks) { |
| 771 |
if ( defined $csvfilename ) { |
654 |
my @output_chunks = @{$hChunks{$admin_email_address}}; |
| 772 |
print $csv_fh @output_chunks; |
655 |
if ( defined $csvfilename ) { |
| 773 |
} |
656 |
print $csv_fh @output_chunks; |
| 774 |
elsif ( defined $htmlfilename ) { |
657 |
} |
| 775 |
print $fh @output_chunks; |
658 |
elsif ( defined $htmlfilename ) { |
| 776 |
} |
659 |
print $fh @output_chunks; |
| 777 |
elsif ( defined $text_filename ) { |
660 |
} |
| 778 |
print $fh @output_chunks; |
661 |
elsif ( defined $text_filename ) { |
| 779 |
} |
662 |
print $fh @output_chunks; |
| 780 |
elsif ($nomail){ |
663 |
} |
| 781 |
local $, = "\f"; # pagebreak |
664 |
elsif ($nomail){ |
| 782 |
print @output_chunks; |
665 |
local $, = "\f"; # pagebreak |
| 783 |
} |
666 |
print @output_chunks; |
| 784 |
# Generate the content of the csv with headers |
667 |
} |
| 785 |
my $content; |
668 |
# Generate the content of the csv with headers |
| 786 |
if ( defined $csvfilename ) { |
669 |
my $content; |
| 787 |
my $delimiter = C4::Context->preference('delimiter') || ';'; |
670 |
if ( defined $csvfilename ) { |
| 788 |
$content = join($delimiter, qw(title name surname address1 address2 zipcode city country email itemcount itemsinfo due_date issue_date)) . "\n"; |
671 |
my $delimiter = C4::Context->preference('delimiter') || ';'; |
| 789 |
} |
672 |
$content = join($delimiter, qw(title name surname address1 address2 zipcode city country email itemcount itemsinfo due_date issue_date)) . "\n"; |
| 790 |
else { |
|
|
| 791 |
$content = ""; |
| 792 |
} |
| 793 |
$content .= join( "\n", @output_chunks ); |
| 794 |
|
| 795 |
my $attachment = { |
| 796 |
filename => defined $csvfilename ? 'attachment.csv' : 'attachment.txt', |
| 797 |
type => 'text/plain', |
| 798 |
content => $content, |
| 799 |
}; |
| 800 |
|
| 801 |
my $letter = { |
| 802 |
title => 'Overdue Notices', |
| 803 |
content => 'These messages were not sent directly to the patrons.', |
| 804 |
}; |
| 805 |
C4::Letters::EnqueueLetter( |
| 806 |
{ letter => $letter, |
| 807 |
borrowernumber => undef, |
| 808 |
message_transport_type => 'email', |
| 809 |
attachments => [$attachment], |
| 810 |
to_address => $admin_email_address, |
| 811 |
} |
| 812 |
); |
| 813 |
} |
673 |
} |
|
|
674 |
else { |
| 675 |
$content = ""; |
| 676 |
} |
| 677 |
$content .= join( "\n", @output_chunks ); |
| 678 |
|
| 679 |
my $attachment = { |
| 680 |
filename => defined $csvfilename ? 'attachment.csv' : 'attachment.txt', |
| 681 |
type => 'text/plain', |
| 682 |
content => $content, |
| 683 |
}; |
| 814 |
|
684 |
|
|
|
685 |
my $letter = { |
| 686 |
title => 'Overdue Notices', |
| 687 |
content => 'These messages were not sent directly to the patrons.', |
| 688 |
}; |
| 689 |
C4::Letters::EnqueueLetter( { |
| 690 |
letter => $letter, |
| 691 |
borrowernumber => undef, |
| 692 |
message_transport_type => 'email', |
| 693 |
attachments => [$attachment], |
| 694 |
to_address => $admin_email_address, |
| 695 |
} ); |
| 815 |
} |
696 |
} |
|
|
697 |
|
| 816 |
if ($csvfilename) { |
698 |
if ($csvfilename) { |
| 817 |
# note that we're not testing on $csv_fh to prevent closing |
699 |
# note that we're not testing on $csv_fh to prevent closing |
| 818 |
# STDOUT. |
700 |
# STDOUT. |
|
Lines 820-830
if ($csvfilename) {
Link Here
|
| 820 |
} |
702 |
} |
| 821 |
|
703 |
|
| 822 |
if ( defined $htmlfilename ) { |
704 |
if ( defined $htmlfilename ) { |
| 823 |
print $fh "</body>\n"; |
705 |
print $fh "</body>\n"; |
| 824 |
print $fh "</html>\n"; |
706 |
print $fh "</html>\n"; |
| 825 |
close $fh; |
707 |
close $fh; |
| 826 |
} elsif ( defined $text_filename ) { |
708 |
} elsif ( defined $text_filename ) { |
| 827 |
close $fh; |
709 |
close $fh; |
| 828 |
} |
710 |
} |
| 829 |
|
711 |
|
| 830 |
=head1 INTERNAL METHODS |
712 |
=head1 INTERNAL METHODS |
|
Lines 861-868
sub prepare_letter_for_printing {
Link Here
|
| 861 |
if ( exists $params->{'outputformat'} && $params->{'outputformat'} eq 'csv' ) { |
743 |
if ( exists $params->{'outputformat'} && $params->{'outputformat'} eq 'csv' ) { |
| 862 |
if ($csv->combine( |
744 |
if ($csv->combine( |
| 863 |
$params->{'firstname'}, $params->{'lastname'}, $params->{'address1'}, $params->{'address2'}, $params->{'postcode'}, |
745 |
$params->{'firstname'}, $params->{'lastname'}, $params->{'address1'}, $params->{'address2'}, $params->{'postcode'}, |
| 864 |
$params->{'city'}, $params->{'country'}, $params->{'email'}, $params->{'phone'}, $params->{'cardnumber'}, |
746 |
$params->{'city'}, $params->{'country'}, $params->{'email'}, $params->{'itemcount'}, $params->{'titles'} |
| 865 |
$params->{'itemcount'}, $params->{'titles'}, $params->{'branchname'}, $params->{'letternumber'} |
|
|
| 866 |
) |
747 |
) |
| 867 |
) { |
748 |
) { |
| 868 |
return $csv->string, "\n"; |
749 |
return $csv->string, "\n"; |
| 869 |
- |
|
|