#
# This file is part of Koha.
#
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
#
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
#
-# You should have received a copy of the GNU General Public License along
-# with Koha; if not, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
-use strict;
-use warnings;
+use Modern::Perl;
BEGIN {
use Getopt::Long;
use Pod::Usage;
use Text::CSV_XS;
-use Locale::Currency::Format 1.28;
-use Encode;
+use DateTime;
+use DateTime::Duration;
use C4::Context;
-use C4::Dates qw/format_date/;
-use C4::Debug;
use C4::Letters;
-use C4::Overdues qw(GetFine GetOverdueMessageTransportTypes);
-use C4::Budgets qw(GetCurrency);
-
-use Koha::Borrower::Debarments qw(AddUniqueDebarment);
+use C4::Overdues qw(GetFine GetOverdueMessageTransportTypes parse_overdues_letter);
+use C4::Log;
+use Koha::Patron::Debarments qw(AddUniqueDebarment);
use Koha::DateUtils;
+use Koha::Calendar;
+use Koha::Libraries;
+use Koha::Acquisition::Currencies;
=head1 NAME
Options:
-help brief help message
-man full documentation
+ -v verbose
-n No email will be sent
-max <days> maximum days overdue to deal with
-library <branchname> only deal with overdues from this library (repeatable : several libraries can be given)
-itemscontent <list of fields> item information in templates
-borcat <categorycode> category code that must be included
-borcatout <categorycode> category code that must be excluded
+ -t only include triggered overdues
+ --test Run in test mode. No changes will be made on the DB.
+ -list-all list all overdues
+ -date <yyyy-mm-dd> emulate overdues run for this date
-email <email_type> type of email that will be used. Can be 'email', 'emailpro' or 'B_email'. Repeatable.
=head1 OPTIONS
Produces html data. If patron does not have an email address or
-n (no mail) flag is set, an HTML file is generated in the specified
-directory. This can be downloaded or futher processed by library staff.
+directory. This can be downloaded or further processed by library staff.
The file will be called notices-YYYY-MM-DD.html and placed in the directory
specified.
Produces plain text data. If patron does not have an email address or
-n (no mail) flag is set, a text file is generated in the specified
-directory. This can be downloaded or futher processed by library staff.
+directory. This can be downloaded or further processed by library staff.
The file will be called notices-YYYY-MM-DD.txt and placed in the directory
specified.
=item B<-borcat>
-Repetable field, that permit to select only few of patrons categories.
+Repeatable field, that permits to select only some patron categories.
=item B<-borcatout>
-Repetable field, permis to exclude some patrons categories.
+Repeatable field, that permits to exclude some patron categories.
=item B<-t> | B<--triggered>
Add the --triggered option for daily cron, at the risk of no notice
being generated if the cron fails to run on time.
+=item B<-test>
+
+This option makes the script run in test mode.
+
+In test mode, the script won't make any changes on the DB. This is useful
+for debugging configuration.
+
=item B<-list-all>
Default items.content lists only those items that fall in the
=item B<-date>
-use it in order to send overdues on a specific date and not Now.
+use it in order to send overdues on a specific date and not Now. Format: YYYY-MM-DD.
=item B<-email>
=head1 USAGE EXAMPLES
C<overdue_notices.pl> - In this most basic usage, with no command line
-arguments, all libraries are procesed individually, and notices are
+arguments, all libraries are processed individually, and notices are
prepared for all patrons with overdue items for whom we have email
addresses. Messages for those patrons for whom we have no email
address are sent in a single attachment to the library administrator's
=head1 SEE ALSO
The F<misc/cronjobs/advance_notices.pl> program allows you to send
-messages to patrons in advance of thier items becoming due, or to
+messages to patrons in advance of their items becoming due, or to
alert them of items that have just become due.
=cut
my $verbose = 0;
my $nomail = 0;
my $MAX = 90;
+my $test_mode = 0;
my @branchcodes; # Branch(es) passed as parameter
my @emails_to_use; # Emails to use for messaging
my @emails; # Emails given in command-line parameters
my $itemscontent = join( ',', qw( date_due title barcode author itemnumber ) );
my @myborcat;
my @myborcatout;
-my $date;
+my ( $date_input, $today );
GetOptions(
'help|?' => \$help,
'itemscontent=s' => \$itemscontent,
'list-all' => \$listall,
't|triggered' => \$triggered,
- 'date' => \$date,
+ 'test' => \$test_mode,
+ 'date=s' => \$date_input,
'borcat=s' => \@myborcat,
'borcatout=s' => \@myborcatout,
'email=s' => \@emails,
pod2usage(1) if $help;
pod2usage( -verbose => 2 ) if $man;
+cronlogaction() unless $test_mode;
+
if ( defined $csvfilename && $csvfilename =~ /^-/ ) {
warn qq(using "$csvfilename" as filename, that seems odd);
}
@branches = ('');
}
}
-
-if ($date){
- $date=$dbh->quote($date);
+my $date_to_run;
+my $date;
+if ( $date_input ){
+ eval {
+ $date_to_run = dt_from_string( $date_input, 'iso' );
+ };
+ die "$date_input is not a valid date, aborting! Use a date in format YYYY-MM-DD."
+ if $@ or not $date_to_run;
+
+ # It's certainly useless to escape $date_input
+ # dt_from_string should not return something if $date_input is not correctly set.
+ $date = $dbh->quote( $date_input );
}
else {
$date="NOW()";
+ $date_to_run = dt_from_string();
}
# these are the fields that will be substituted into <<item.content>>
} else {
open $csv_fh, ">", $csvfilename or die "unable to open $csvfilename: $!";
}
- if ( $csv->combine(qw(name surname address1 address2 zipcode city country email itemcount itemsinfo)) ) {
+ if ( $csv->combine(qw(name surname address1 address2 zipcode city country email phone cardnumber itemcount itemsinfo branchname letternumber)) ) {
print $csv_fh $csv->string, "\n";
} else {
$verbose and warn 'combine failed on argument: ' . $csv->error_input;
$fh = *STDOUT;
} else {
my $today = DateTime->now(time_zone => C4::Context->tz );
- open $fh, ">",File::Spec->catdir ($htmlfilename,"notices-".$today->ymd().".html");
+ open $fh, ">:encoding(UTF-8)",File::Spec->catdir ($htmlfilename,"notices-".$today->ymd().".html");
}
print $fh "<html>\n";
print $fh "<head>\n";
+ print $fh "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />\n";
print $fh "<style type='text/css'>\n";
print $fh "pre {page-break-after: always;}\n";
print $fh "pre {white-space: pre-wrap;}\n";
}
foreach my $branchcode (@branches) {
+ my $calendar;
+ if ( C4::Context->preference('OverdueNoticeCalendar') ) {
+ $calendar = Koha::Calendar->new( branchcode => $branchcode );
+ if ( $calendar->is_holiday($date_to_run) ) {
+ next;
+ }
+ }
- my $branch_details = C4::Branch::GetBranchDetail($branchcode);
- my $admin_email_address = $branch_details->{'branchemail'} || C4::Context->preference('KohaAdminEmailAddress');
+ my $library = Koha::Libraries->find($branchcode);
+ my $admin_email_address = $library->branchemail
+ || C4::Context->preference('KohaAdminEmailAddress');
my @output_chunks; # may be sent to mail or stdout or csv file.
$verbose and warn sprintf "branchcode : '%s' using %s\n", $branchcode, $admin_email_address;
my $sth2 = $dbh->prepare( <<"END_SQL" );
-SELECT biblio.*, items.*, issues.*, biblioitems.itemtype, TO_DAYS($date)-TO_DAYS(date_due) AS days_overdue
- FROM issues,items,biblio, biblioitems
+SELECT biblio.*, items.*, issues.*, biblioitems.itemtype, branchname
+ FROM issues,items,biblio, biblioitems, branches b
WHERE items.itemnumber=issues.itemnumber
AND biblio.biblionumber = items.biblionumber
+ AND b.branchcode = items.homebranch
AND biblio.biblionumber = biblioitems.biblionumber
AND issues.borrowernumber = ?
- AND TO_DAYS($date)-TO_DAYS(date_due) BETWEEN ? and ?
+ AND issues.branchcode = ?
+ AND items.itemlost = 0
+ AND TO_DAYS($date)-TO_DAYS(issues.date_due) >= 0
END_SQL
my $query = "SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? ";
# my $outfile = 'overdues_' . ( $mybranch || $branchcode || 'default' );
while ( my $overdue_rules = $rqoverduerules->fetchrow_hashref ) {
PERIOD: foreach my $i ( 1 .. 3 ) {
- $verbose and warn "branch '$branchcode', pass $i\n";
+
+ $verbose and warn "branch '$branchcode', categorycode = $overdue_rules->{categorycode} pass $i\n";
+
my $mindays = $overdue_rules->{"delay$i"}; # the notice will be sent after mindays days (grace period)
my $maxdays = (
$overdue_rules->{ "delay" . ( $i + 1 ) }
: ($MAX)
); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended)
+ next unless defined $mindays;
+
if ( !$overdue_rules->{"letter$i"} ) {
$verbose and warn "No letter$i code for branch '$branchcode'";
next PERIOD;
# 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).
# <date> <itemcount> <firstname> <lastname> <address1> <address2> <address3> <city> <postcode> <country>
- my $borrower_sql = <<'END_SQL';
-SELECT distinct(issues.borrowernumber), firstname, surname, address, address2, city, zipcode, country, email, emailpro, B_email, smsalertnumber
-FROM issues,borrowers,categories
+ my $borrower_sql = <<"END_SQL";
+SELECT issues.borrowernumber, firstname, surname, address, address2, city, zipcode, country, email, emailpro, B_email, smsalertnumber, phone, cardnumber, date_due
+FROM issues,borrowers,categories,items
WHERE issues.borrowernumber=borrowers.borrowernumber
AND borrowers.categorycode=categories.categorycode
+AND issues.itemnumber = items.itemnumber
+AND items.itemlost = 0
+AND TO_DAYS($date)-TO_DAYS(issues.date_due) >= 0
END_SQL
my @borrower_parameters;
if ($branchcode) {
$borrower_sql .= ' AND borrowers.categorycode=? ';
push @borrower_parameters, $overdue_rules->{categorycode};
}
- $borrower_sql .= ' AND categories.overduenoticerequired=1 ';
- if($triggered) {
- $borrower_sql .= " AND TO_DAYS($date)-TO_DAYS(date_due) = ?";
- push @borrower_parameters, $mindays;
- } else {
- $borrower_sql .= " AND TO_DAYS($date)-TO_DAYS(date_due) BETWEEN ? and ? " ;
- push @borrower_parameters, $mindays, $maxdays;
- }
+ $borrower_sql .= ' AND categories.overduenoticerequired=1 ORDER BY issues.borrowernumber';
# $sth gets borrower info iff at least one overdue item has triggered the overdue action.
my $sth = $dbh->prepare($borrower_sql);
$sth->execute(@borrower_parameters);
- $verbose and warn $borrower_sql . "\n $branchcode | " . $overdue_rules->{'categorycode'} . "\n ($mindays, $maxdays)\nreturns " . $sth->rows . " rows";
+ $verbose and warn $borrower_sql . "\n $branchcode | " . $overdue_rules->{'categorycode'} . "\n ($mindays, $maxdays, ". $date_to_run->datetime() .")\nreturns " . $sth->rows . " rows";
+ my $borrowernumber;
while ( my $data = $sth->fetchrow_hashref ) {
- my $borrowernumber = $data->{'borrowernumber'};
+
+ # check the borrower has at least one item that matches
+ my $days_between;
+ if ( C4::Context->preference('OverdueNoticeCalendar') )
+ {
+ $days_between =
+ $calendar->days_between( dt_from_string($data->{date_due}),
+ $date_to_run );
+ }
+ else {
+ $days_between =
+ $date_to_run->delta_days( dt_from_string($data->{date_due}) );
+ }
+ $days_between = $days_between->in_units('days');
+ if ($triggered) {
+ if ( $mindays != $days_between ) {
+ next;
+ }
+ }
+ else {
+ unless ( $days_between >= $mindays
+ && $days_between <= $maxdays )
+ {
+ next;
+ }
+ }
+ if (defined $borrowernumber && $borrowernumber eq $data->{'borrowernumber'}){
+# we have already dealt with this borrower
+ $verbose and warn "already dealt with this borrower $borrowernumber";
+ next;
+ }
+ $borrowernumber = $data->{'borrowernumber'};
my $borr =
$data->{'firstname'} . ', '
. $data->{'surname'} . ' ('
my $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"}, $branchcode );
unless ($letter) {
- $verbose and warn "Message '$overdue_rules->{letter$i}' content not found";
+ $verbose and warn qq|Message '$overdue_rules->{"letter$i"}' content not found|;
# might as well skip while PERIOD, no other borrowers are going to work.
# FIXME : Does this mean a letter must be defined in order to trigger a debar ?
{
borrowernumber => $borrowernumber,
type => 'OVERDUES',
- comment => "Restriction added by overdues process "
- . output_pref( dt_from_string() ),
+ comment => "OVERDUES_PROCESS " . output_pref( dt_from_string() ),
}
- );
+ ) unless $test_mode;
$verbose and warn "debarring $borr\n";
}
- my @params = ($listall ? ( $borrowernumber , 1 , $MAX ) : ( $borrowernumber, $mindays, $maxdays ));
- $verbose and warn "STH2 PARAMS: borrowernumber = $borrowernumber, mindays = $mindays, maxdays = $maxdays";
+ my @params = ($borrowernumber,$branchcode);
+ $verbose and warn "STH2 PARAMS: borrowernumber = $borrowernumber";
+
$sth2->execute(@params);
my $itemcount = 0;
my $titles = "";
my $j = 0;
my $exceededPrintNoticesMaxLines = 0;
while ( my $item_info = $sth2->fetchrow_hashref() ) {
+ if ( C4::Context->preference('OverdueNoticeCalendar') ) {
+ $days_between =
+ $calendar->days_between(
+ dt_from_string( $item_info->{date_due} ), $date_to_run );
+ }
+ else {
+ $days_between =
+ $date_to_run->delta_days(
+ dt_from_string( $item_info->{date_due} ) );
+ }
+ $days_between = $days_between->in_units('days');
+ if ($listall){
+ unless ($days_between >= 1 and $days_between <= $MAX){
+ next;
+ }
+ }
+ else {
+ if ($triggered) {
+ if ( $mindays != $days_between ) {
+ next;
+ }
+ }
+ else {
+ unless ( $days_between >= $mindays
+ && $days_between <= $maxdays )
+ {
+ next;
+ }
+ }
+ }
+
if ( ( scalar(@emails_to_use) == 0 || $nomail ) && $PrintNoticesMaxLines && $j >= $PrintNoticesMaxLines ) {
$exceededPrintNoticesMaxLines = 1;
last;
}
$j++;
- my @item_info = map { $_ =~ /^date|date$/ ? format_date( $item_info->{$_} ) : $item_info->{$_} || '' } @item_content_fields;
- $titles .= join("\t", @item_info) . "\n";
+
+ $titles .= C4::Letters::get_item_content( { item => $item_info, item_content_fields => \@item_content_fields, dateonly => 1 } );
$itemcount++;
push @items, $item_info;
}
my $print_sent = 0; # A print notice is not yet sent for this patron
for my $mtt ( @message_transport_types ) {
+ my $effective_mtt = $mtt;
+ if ( ($mtt eq 'email' and not scalar @emails_to_use) or ($mtt eq 'sms' and not $data->{smsalertnumber}) ) {
+ # email or sms is requested but not exist, do a print.
+ $effective_mtt = 'print';
+ }
- my $letter = parse_letter(
+ my $letter_exists = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"}, $branchcode, $effective_mtt ) ? 1 : 0;
+ my $letter = parse_overdues_letter(
{ letter_code => $overdue_rules->{"letter$i"},
borrowernumber => $borrowernumber,
branchcode => $branchcode,
items => \@items,
substitute => { # this appears to be a hack to overcome incomplete features in this code.
- bib => $branch_details->{'branchname'}, # maybe 'bib' is a typo for 'lib<rary>'?
+ bib => $library->branchname, # maybe 'bib' is a typo for 'lib<rary>'?
'items.content' => $titles,
'count' => $itemcount,
},
- message_transport_type => $mtt,
+ # If there is no template defined for the requested letter
+ # Fallback on email
+ message_transport_type => $letter_exists ? $effective_mtt : 'email',
}
);
unless ($letter) {
- $verbose and warn "Message '$overdue_rules->{letter$i}' content not found";
+ $verbose and warn qq|Message '$overdue_rules->{"letter$i"}' content not found|;
# this transport doesn't have a configured notice, so try another
next;
}
address1 => $data->{'address'},
address2 => $data->{'address2'},
city => $data->{'city'},
+ phone => $data->{'phone'},
+ cardnumber => $data->{'cardnumber'},
+ branchname => $library->branchname,
+ letternumber => $i,
postcode => $data->{'zipcode'},
country => $data->{'country'},
email => $notice_email,
);
} else {
if ( ($mtt eq 'email' and not scalar @emails_to_use) or ($mtt eq 'sms' and not $data->{smsalertnumber}) ) {
- # email or sms is requested but not exist, do a print.
- $mtt = 'print';
+ push @output_chunks,
+ prepare_letter_for_printing(
+ { letter => $letter,
+ borrowernumber => $borrowernumber,
+ firstname => $data->{'firstname'},
+ lastname => $data->{'surname'},
+ address1 => $data->{'address'},
+ address2 => $data->{'address2'},
+ city => $data->{'city'},
+ postcode => $data->{'zipcode'},
+ country => $data->{'country'},
+ email => $notice_email,
+ itemcount => $itemcount,
+ titles => $titles,
+ outputformat => defined $csvfilename ? 'csv' : defined $htmlfilename ? 'html' : defined $text_filename ? 'text' : '',
+ }
+ );
}
- unless ( $mtt eq 'print' and $print_sent == 1 ) {
+ unless ( $effective_mtt eq 'print' and $print_sent == 1 ) {
# Just sent a print if not already done.
C4::Letters::EnqueueLetter(
{ letter => $letter,
borrowernumber => $borrowernumber,
- message_transport_type => $mtt,
+ message_transport_type => $effective_mtt,
from_address => $admin_email_address,
to_address => join(',', @emails_to_use),
}
- );
+ ) unless $test_mode;
# A print notice should be sent only once per overdue level.
# 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.
- $print_sent = 1 if $mtt eq 'print';
+ $print_sent = 1 if $effective_mtt eq 'print';
}
}
}
attachments => [$attachment],
to_address => $admin_email_address,
}
- );
+ ) unless $test_mode;
}
}
These methods are internal to the operation of overdue_notices.pl.
-=head2 parse_letter
-
-parses the letter template, replacing the placeholders with data
-specific to this patron, biblio, or item
-
-named parameters:
- letter - required hashref
- borrowernumber - required integer
- substitute - optional hashref of other key/value pairs that should
- be substituted in the letter content
-
-returns the C<letter> hashref, with the content updated to reflect the
-substituted keys and values.
-
-
-=cut
-
-sub parse_letter {
- my $params = shift;
- foreach my $required (qw( letter_code borrowernumber )) {
- return unless ( exists $params->{$required} && $params->{$required} );
- }
-
- my $substitute = $params->{'substitute'} || {};
- $substitute->{today} ||= C4::Dates->new()->output("syspref");
-
- my %tables = ( 'borrowers' => $params->{'borrowernumber'} );
- if ( my $p = $params->{'branchcode'} ) {
- $tables{'branches'} = $p;
- }
-
- my $currencies = GetCurrency();
- my $currency_format;
- $currency_format = $currencies->{currency} if defined($currencies);
-
- my @item_tables;
- if ( my $i = $params->{'items'} ) {
- my $item_format = '';
- foreach my $item (@$i) {
- my $fine = GetFine($item->{'itemnumber'}, $params->{'borrowernumber'});
- if ( !$item_format and defined $params->{'letter'}->{'content'} ) {
- $params->{'letter'}->{'content'} =~ m/(<item>.*<\/item>)/;
- $item_format = $1;
- }
-
- $item->{'fine'} = currency_format($currency_format, "$fine", FMT_SYMBOL);
- # if active currency isn't correct ISO code fallback to sprintf
- $item->{'fine'} = sprintf('%.2f', $fine) unless $item->{'fine'};
-
- push @item_tables, {
- 'biblio' => $item->{'biblionumber'},
- 'biblioitems' => $item->{'biblionumber'},
- 'items' => $item,
- 'issues' => $item->{'itemnumber'},
- };
- }
- }
-
- return C4::Letters::GetPreparedLetter (
- module => 'circulation',
- letter_code => $params->{'letter_code'},
- branchcode => $params->{'branchcode'},
- tables => \%tables,
- substitute => $substitute,
- repeat => { item => \@item_tables },
- message_transport_type => $params->{message_transport_type},
- );
-}
-
=head2 prepare_letter_for_printing
returns a string of text appropriate for printing in the event that an
if ( exists $params->{'outputformat'} && $params->{'outputformat'} eq 'csv' ) {
if ($csv->combine(
$params->{'firstname'}, $params->{'lastname'}, $params->{'address1'}, $params->{'address2'}, $params->{'postcode'},
- $params->{'city'}, $params->{'country'}, $params->{'email'}, $params->{'itemcount'}, $params->{'titles'}
+ $params->{'city'}, $params->{'country'}, $params->{'email'}, $params->{'phone'}, $params->{'cardnumber'},
+ $params->{'itemcount'}, $params->{'titles'}, $params->{'branchname'}, $params->{'letternumber'}
)
) {
return $csv->string, "\n";
}
} elsif ( exists $params->{'outputformat'} && $params->{'outputformat'} eq 'html' ) {
$return = "<pre>\n";
- my $content = $params->{'letter'}->{'content'};
- $content =~ s/\n/<br \/>/g;
- $content =~ s/\r//g;
- $return .= "$content\n";
+ $return .= "$params->{'letter'}->{'content'}\n";
$return .= "\n</pre>\n";
} else {
$return .= "$params->{'letter'}->{'content'}\n";