|
Lines 29-35
use DateTime::Duration;
Link Here
|
| 29 |
use Koha::Script -cron; |
29 |
use Koha::Script -cron; |
| 30 |
use C4::Context; |
30 |
use C4::Context; |
| 31 |
use C4::Letters; |
31 |
use C4::Letters; |
| 32 |
use C4::Overdues qw( GetOverdueMessageTransportTypes parse_overdues_letter ); |
32 |
use C4::Overdues qw( parse_overdues_letter ); |
| 33 |
use C4::Log qw( cronlogaction ); |
33 |
use C4::Log qw( cronlogaction ); |
| 34 |
use Koha::Patron::Debarments qw( AddUniqueDebarment ); |
34 |
use Koha::Patron::Debarments qw( AddUniqueDebarment ); |
| 35 |
use Koha::DateUtils qw( dt_from_string output_pref ); |
35 |
use Koha::DateUtils qw( dt_from_string output_pref ); |
|
Lines 488-530
END_SQL
Link Here
|
| 488 |
} |
488 |
} |
| 489 |
my $sth2 = $dbh->prepare($sql2); |
489 |
my $sth2 = $dbh->prepare($sql2); |
| 490 |
|
490 |
|
| 491 |
my $query = "SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? "; |
491 |
my @categories; |
| 492 |
$query .= " AND categorycode IN (".join( ',' , ('?') x @myborcat ).") " if (@myborcat); |
492 |
if (@myborcat) { |
| 493 |
$query .= " AND categorycode NOT IN (".join( ',' , ('?') x @myborcatout ).") " if (@myborcatout); |
493 |
@categories = @myborcat; |
| 494 |
|
494 |
} elsif (@myborcatout) { |
| 495 |
my $rqoverduerules = $dbh->prepare($query); |
495 |
@categories = Koha::Patron::Categories->search( { catagorycode => { 'not_in' => \@myborcatout } } ) |
| 496 |
$rqoverduerules->execute($branchcode, @myborcat, @myborcatout); |
496 |
->get_column('categorycode'); |
| 497 |
|
497 |
} else { |
| 498 |
# We get default rules if there is no rule for this branch |
498 |
@categories = Koha::Patron::Categories->search()->get_column('categorycode'); |
| 499 |
if($rqoverduerules->rows == 0){ |
|
|
| 500 |
$query = "SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = '' "; |
| 501 |
$query .= " AND categorycode IN (".join( ',' , ('?') x @myborcat ).") " if (@myborcat); |
| 502 |
$query .= " AND categorycode NOT IN (".join( ',' , ('?') x @myborcatout ).") " if (@myborcatout); |
| 503 |
|
| 504 |
$rqoverduerules = $dbh->prepare($query); |
| 505 |
$rqoverduerules->execute(@myborcat, @myborcatout); |
| 506 |
} |
499 |
} |
| 507 |
|
500 |
|
| 508 |
# my $outfile = 'overdues_' . ( $mybranch || $branchcode || 'default' ); |
501 |
for my $category (@categories) { |
| 509 |
while ( my $overdue_rules = $rqoverduerules->fetchrow_hashref ) { |
502 |
my $i = 0; |
| 510 |
PERIOD: foreach my $i ( 1 .. 3 ) { |
503 |
PERIOD: while (1) { |
|
|
504 |
$i++; |
| 505 |
my $j = $i + 1; |
| 506 |
my $overdue_rules = Koha::CirculationRules->get_effective_rules( |
| 507 |
{ |
| 508 |
rules => [ |
| 509 |
"overdue_$i" . '_delay', "overdue_$i" . '_notice', "overdue_$i" . '_mtt', |
| 510 |
"overdue_$i" . '_restrict', "overdue_$j" . '_delay' |
| 511 |
], |
| 512 |
categorycode => $category, |
| 513 |
branchcode => $branchcode |
| 514 |
} |
| 515 |
); |
| 516 |
$verbose and warn "branch '$branchcode', categorycode = $category pass $i\n"; |
| 511 |
|
517 |
|
| 512 |
$verbose and warn "branch '$branchcode', categorycode = $overdue_rules->{categorycode} pass $i\n"; |
518 |
if (!$overdue_rules->{"overdue_$i".'_delay'}) { |
|
|
519 |
last PERIOD; |
| 520 |
} |
| 513 |
|
521 |
|
| 514 |
my $mindays = $overdue_rules->{"delay$i"}; # the notice will be sent after mindays days (grace period) |
522 |
my $mindays = |
|
|
523 |
$overdue_rules->{ "overdue_$i" . '_delay' }; # the notice will be sent after mindays days (grace period) |
| 515 |
my $maxdays = ( |
524 |
my $maxdays = ( |
| 516 |
$overdue_rules->{ "delay" . ( $i + 1 ) } |
525 |
$overdue_rules->{ "overdue_$j" . '_delay' } |
| 517 |
? $overdue_rules->{ "delay" . ( $i + 1 ) } - 1 |
526 |
? $overdue_rules->{ "overdue_$j" . '_delay' } - 1 |
| 518 |
: ($MAX) |
527 |
: ($MAX) |
| 519 |
); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended) |
528 |
); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended) |
| 520 |
|
529 |
|
| 521 |
next unless defined $mindays; |
530 |
next unless defined $mindays; |
| 522 |
|
531 |
|
| 523 |
if ( !$overdue_rules->{"letter$i"} ) { |
532 |
if ( !$overdue_rules->{"overdue_$i".'_notice'} ) { |
| 524 |
$verbose and warn sprintf "No letter code found for pass %s\n", $i; |
533 |
$verbose and warn sprintf "No letter code found for pass %s\n", $i; |
| 525 |
next PERIOD; |
534 |
next PERIOD; |
| 526 |
} |
535 |
} |
| 527 |
$verbose and warn sprintf "Using letter code '%s' for pass %s\n", $overdue_rules->{"letter$i"}, $i; |
536 |
$verbose and warn sprintf "Using letter code '%s' for pass %s\n", $overdue_rules->{"overdue_$i".'_notice'}, $i; |
| 528 |
|
537 |
|
| 529 |
# $letter->{'content'} is the text of the mail that is sent. |
538 |
# $letter->{'content'} is the text of the mail that is sent. |
| 530 |
# this text contains fields that are replaced by their value. Those fields must be written between brackets |
539 |
# this text contains fields that are replaced by their value. Those fields must be written between brackets |
|
Lines 550-558
END_SQL
Link Here
|
| 550 |
} |
559 |
} |
| 551 |
push @borrower_parameters, $branchcode; |
560 |
push @borrower_parameters, $branchcode; |
| 552 |
} |
561 |
} |
| 553 |
if ( $overdue_rules->{categorycode} ) { |
562 |
if ( $category ) { |
| 554 |
$borrower_sql .= ' AND borrowers.categorycode=? '; |
563 |
$borrower_sql .= ' AND borrowers.categorycode=? '; |
| 555 |
push @borrower_parameters, $overdue_rules->{categorycode}; |
564 |
push @borrower_parameters, $category; |
| 556 |
} |
565 |
} |
| 557 |
$borrower_sql .= ' AND categories.overduenoticerequired=1 ORDER BY issues.borrowernumber'; |
566 |
$borrower_sql .= ' AND categories.overduenoticerequired=1 ORDER BY issues.borrowernumber'; |
| 558 |
|
567 |
|
|
Lines 562-568
END_SQL
Link Here
|
| 562 |
|
571 |
|
| 563 |
if ( $verbose > 1 ){ |
572 |
if ( $verbose > 1 ){ |
| 564 |
warn sprintf "--------Borrower SQL------\n"; |
573 |
warn sprintf "--------Borrower SQL------\n"; |
| 565 |
warn $borrower_sql . "\n $branchcode | " . $overdue_rules->{'categorycode'} . "\n ($mindays, $maxdays, ". $date_to_run->datetime() .")\n"; |
574 |
warn $borrower_sql . "\n $branchcode | " . $category . "\n ($mindays, $maxdays, ". $date_to_run->datetime() .")\n"; |
| 566 |
warn sprintf "--------------------------\n"; |
575 |
warn sprintf "--------------------------\n"; |
| 567 |
} |
576 |
} |
| 568 |
$verbose and warn sprintf "Found %s borrowers with overdues\n", $sth->rows; |
577 |
$verbose and warn sprintf "Found %s borrowers with overdues\n", $sth->rows; |
|
Lines 632-652
END_SQL
Link Here
|
| 632 |
my $letter = Koha::Notice::Templates->find_effective_template( |
641 |
my $letter = Koha::Notice::Templates->find_effective_template( |
| 633 |
{ |
642 |
{ |
| 634 |
module => 'circulation', |
643 |
module => 'circulation', |
| 635 |
code => $overdue_rules->{"letter$i"}, |
644 |
code => $overdue_rules->{"overdue_$i".'_notice'}, |
| 636 |
branchcode => $branchcode, |
645 |
branchcode => $branchcode, |
| 637 |
lang => $patron->lang |
646 |
lang => $patron->lang |
| 638 |
} |
647 |
} |
| 639 |
); |
648 |
); |
| 640 |
|
649 |
|
| 641 |
unless ($letter) { |
650 |
unless ($letter) { |
| 642 |
$verbose and warn qq|Message '$overdue_rules->{"letter$i"}' content not found|; |
651 |
$verbose and warn qq|Message '$overdue_rules->{"overdue_$i"."_notice"}' content not found|; |
| 643 |
|
652 |
|
| 644 |
# might as well skip while PERIOD, no other borrowers are going to work. |
653 |
# might as well skip while PERIOD, no other borrowers are going to work. |
| 645 |
# FIXME : Does this mean a letter must be defined in order to trigger a debar ? |
654 |
# FIXME : Does this mean a letter must be defined in order to trigger a debar ? |
| 646 |
next PERIOD; |
655 |
next PERIOD; |
| 647 |
} |
656 |
} |
| 648 |
|
657 |
|
| 649 |
if ( $overdue_rules->{"debarred$i"} ) { |
658 |
if ( $overdue_rules->{"overdue_$i".'_restrict'} ) { |
| 650 |
|
659 |
|
| 651 |
#action taken is debarring |
660 |
#action taken is debarring |
| 652 |
AddUniqueDebarment( |
661 |
AddUniqueDebarment( |
|
Lines 712-721
END_SQL
Link Here
|
| 712 |
} |
721 |
} |
| 713 |
$sth2->finish; |
722 |
$sth2->finish; |
| 714 |
|
723 |
|
| 715 |
my @message_transport_types = @{ GetOverdueMessageTransportTypes( $branchcode, $overdue_rules->{categorycode}, $i) }; |
724 |
my @message_transport_types = split( /,/, $overdue_rules->{ "overdue_$i" . '_mtt' } ); |
| 716 |
@message_transport_types = @{ GetOverdueMessageTransportTypes( q{}, $overdue_rules->{categorycode}, $i) } |
|
|
| 717 |
unless @message_transport_types; |
| 718 |
|
| 719 |
|
725 |
|
| 720 |
my $print_sent = 0; # A print notice is not yet sent for this patron |
726 |
my $print_sent = 0; # A print notice is not yet sent for this patron |
| 721 |
for my $mtt ( @message_transport_types ) { |
727 |
for my $mtt ( @message_transport_types ) { |
|
Lines 730-760
END_SQL
Link Here
|
| 730 |
|
736 |
|
| 731 |
my $letter_exists = Koha::Notice::Templates->find_effective_template( |
737 |
my $letter_exists = Koha::Notice::Templates->find_effective_template( |
| 732 |
{ |
738 |
{ |
| 733 |
module => 'circulation', |
739 |
module => 'circulation', |
| 734 |
code => $overdue_rules->{"letter$i"}, |
740 |
code => $overdue_rules->{ "overdue_$i" . '_notice' }, |
| 735 |
message_transport_type => $effective_mtt, |
741 |
message_transport_type => $effective_mtt, |
| 736 |
branchcode => $branchcode, |
742 |
branchcode => $branchcode, |
| 737 |
lang => $patron->lang |
743 |
lang => $patron->lang |
| 738 |
} |
744 |
} |
| 739 |
); |
745 |
); |
| 740 |
|
746 |
|
| 741 |
my $letter = parse_overdues_letter( |
747 |
my $letter = parse_overdues_letter( |
| 742 |
{ letter_code => $overdue_rules->{"letter$i"}, |
748 |
{ |
| 743 |
borrowernumber => $borrowernumber, |
749 |
letter_code => $overdue_rules->{ "overdue_$i" . '_notice' }, |
| 744 |
branchcode => $branchcode, |
750 |
borrowernumber => $borrowernumber, |
| 745 |
items => \@items, |
751 |
branchcode => $branchcode, |
| 746 |
substitute => { # this appears to be a hack to overcome incomplete features in this code. |
752 |
items => \@items, |
| 747 |
bib => $library->branchname, # maybe 'bib' is a typo for 'lib<rary>'? |
753 |
substitute => { # this appears to be a hack to overcome incomplete features in this code. |
| 748 |
'items.content' => $titles, |
754 |
bib => $library->branchname, # maybe 'bib' is a typo for 'lib<rary>'? |
| 749 |
'count' => $itemcount, |
755 |
'items.content' => $titles, |
| 750 |
}, |
756 |
'count' => $itemcount, |
|
|
757 |
}, |
| 758 |
|
| 751 |
# If there is no template defined for the requested letter |
759 |
# If there is no template defined for the requested letter |
| 752 |
# Fallback on the original type |
760 |
# Fallback on the original type |
| 753 |
message_transport_type => $letter_exists ? $effective_mtt : $mtt, |
761 |
message_transport_type => $letter_exists ? $effective_mtt : $mtt, |
| 754 |
} |
762 |
} |
| 755 |
); |
763 |
); |
| 756 |
unless ($letter && $letter->{content}) { |
764 |
unless ( $letter && $letter->{content} ) { |
| 757 |
$verbose and warn qq|Message '$overdue_rules->{"letter$i"}' content not found|; |
765 |
$verbose and warn qq|Message '$overdue_rules->{"overdue_$i"."_notice"}' content not found|; |
|
|
766 |
|
| 758 |
# this transport doesn't have a configured notice, so try another |
767 |
# this transport doesn't have a configured notice, so try another |
| 759 |
next; |
768 |
next; |
| 760 |
} |
769 |
} |
| 761 |
- |
|
|