1163 lines
45 KiB
Perl
Executable File
1163 lines
45 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
# Copyright 2008 Liblime
|
|
# Copyright 2010 BibLibre
|
|
#
|
|
# 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 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.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with Koha; if not, see <https://www.gnu.org/licenses>.
|
|
|
|
use Modern::Perl;
|
|
|
|
use Getopt::Long qw( GetOptions );
|
|
use Pod::Usage qw( pod2usage );
|
|
use Text::CSV_XS;
|
|
use DateTime;
|
|
use DateTime::Duration;
|
|
|
|
use Koha::Script -cron;
|
|
use C4::Context;
|
|
use C4::Letters;
|
|
use C4::Overdues qw( parse_overdues_letter );
|
|
use C4::Log qw( cronlogaction );
|
|
use Koha::Patron::Debarments qw( AddUniqueDebarment );
|
|
use Koha::DateUtils qw( dt_from_string output_pref );
|
|
use Koha::Library::Calendar;
|
|
use Koha::Libraries;
|
|
use Koha::Acquisition::Currencies;
|
|
use Koha::Patrons;
|
|
|
|
=head1 NAME
|
|
|
|
overdue_notices.pl - prepare messages to be sent to patrons for overdue items
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
overdue_notices.pl
|
|
[ -n ][ --library <branchcode> ][ --library <branchcode> ... ]
|
|
[ --max <number of days> ][ --csv [<filename>] ][ --itemscontent <field list> ]
|
|
[ --email <email_type> ... ]
|
|
|
|
Options:
|
|
--help Brief help message.
|
|
--man Full documentation.
|
|
--verbose | -v Verbose mode. Can be repeated for increased output.
|
|
--nomail | -n No email will be sent.
|
|
--max <days> Maximum days overdue to deal with.
|
|
--library <branchcode> Only deal with overdues from this library.
|
|
(repeatable : several libraries can be given)
|
|
--csv <filename> Populate CSV file.
|
|
--html <directory> Output html to a file in the given directory.
|
|
--text <directory> Output plain text to a file in the given directory.
|
|
--itemscontent <list of fields> Item information in templates.
|
|
--borcat <categorycode> Category code that must be included.
|
|
--borcatout <categorycode> Category code that must be excluded.
|
|
--triggered | -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.
|
|
--frombranch Organize and send overdue notices by home library (item-homebranch) or checkout library (item-issuebranch) or patron home library (patron-homebranch).
|
|
This option is only used, if the OverdueNoticeFrom system preference is set to 'command-line option'.
|
|
Defaults to item-issuebranch.
|
|
|
|
=head1 OPTIONS
|
|
|
|
=over 8
|
|
|
|
=item B<--help>
|
|
|
|
Print a brief help message and exits.
|
|
|
|
=item B<--man>
|
|
|
|
Prints the manual page and exits.
|
|
|
|
=item B<-v> | B<--verbose>
|
|
|
|
Verbose. Without this flag set, only fatal errors are reported.
|
|
A single 'v' will report info on branches, letter codes, and patrons.
|
|
A second 'v' will report the SQL code used to search for triggered patrons.
|
|
|
|
=item B<-n> | B<--nomail>
|
|
|
|
Do not send any email. Overdue notices that would have been sent to
|
|
the patrons or to the admin are printed to standard out. CSV data (if
|
|
the --csv flag is set) is written to standard out or to any csv
|
|
filename given.
|
|
|
|
=item B<--max>
|
|
|
|
Items older than max days are assumed to be handled somewhere else,
|
|
probably the F<longoverdues.pl> script. They are therefore ignored by
|
|
this program. No notices are sent for them, and they are not added to
|
|
any CSV files. Defaults to 90 to match F<longoverdues.pl>.
|
|
|
|
=item B<--library>
|
|
|
|
Select overdues for one specific library. Use the value in the
|
|
branches.branchcode table. This option can be repeated in order
|
|
to select overdues for a group of libraries.
|
|
|
|
=item B<--csv>
|
|
|
|
Produces CSV data. If -n (no mail) flag is set, then this CSV data is
|
|
sent to standard out or to a filename if provided. Otherwise, only
|
|
overdues that could not be emailed are sent in CSV format to the admin.
|
|
|
|
=item B<--html>
|
|
|
|
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 further processed by library staff.
|
|
The file will be called notices-YYYY-MM-DD.html and placed in the directory
|
|
specified.
|
|
|
|
=item B<--text>
|
|
|
|
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 further processed by library staff.
|
|
The file will be called notices-YYYY-MM-DD.txt and placed in the directory
|
|
specified.
|
|
|
|
=item B<--itemscontent>
|
|
|
|
Comma separated list of fields that get substituted into templates in
|
|
places of the E<lt>E<lt>items.contentE<gt>E<gt> placeholder. This
|
|
defaults to due date,title,barcode,author,itemnumber
|
|
|
|
Other possible values come from fields in the biblios, items and
|
|
issues tables.
|
|
|
|
=item B<--itemtypes>
|
|
|
|
Repeatable field, that permits to select only some item types.
|
|
|
|
=item B<--itemtypesout>
|
|
|
|
Repeatable field, that permits to exclude some item types.
|
|
|
|
=item B<--borcat>
|
|
|
|
Repeatable field that permits selecting only specific patron categories.
|
|
For example, --borcat STUDENT --borcat FACULTY would only process overdues
|
|
for patrons in the STUDENT and FACULTY categories.
|
|
|
|
=item B<--borcatout>
|
|
|
|
Repeatable field that permits excluding specific patron categories.
|
|
For example, --borcatout STAFF would skip processing overdues for
|
|
patrons in the STAFF category.
|
|
|
|
=item B<-t> | B<--triggered>
|
|
|
|
This option causes a notice to be generated if and only if
|
|
an item is overdue by the number of days defined in a notice trigger.
|
|
|
|
By default, a notice is sent each time the script runs, which is suitable for
|
|
less frequent run cron script, but requires syncing notice triggers with
|
|
the cron schedule to ensure proper behavior.
|
|
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 to the database. This is useful
|
|
for debugging configuration and testing notice generation without affecting
|
|
production data.
|
|
|
|
=item B<--list-all>
|
|
|
|
Default items.content lists only those items that fall in the
|
|
range of the currently processing notice.
|
|
Choose --list-all to include all overdue items in the list (limited by B<--max> setting).
|
|
|
|
=item B<--date>
|
|
|
|
Use it in order to send overdues on a specific date and not Now. Format: YYYY-MM-DD.
|
|
|
|
This allows running the script for a different date than the current one,
|
|
which can be helpful for testing, or for running overdues that should have
|
|
been sent earlier.
|
|
|
|
=item B<--email>
|
|
|
|
Allows to specify which type of email will be used. Can be email, emailpro or B_email. Repeatable.
|
|
|
|
This determines which email address field from the borrowers table will be used
|
|
for notification. If multiple types are specified, the script will try all of them
|
|
in the order provided until it finds a valid address.
|
|
|
|
If this parameter is not specified, the script will fall back to using Koha::Patron->notice_email_address,
|
|
which respects the patron's preferences and Koha system settings.
|
|
|
|
=item B<--frombranch>
|
|
|
|
Organize overdue notices either by checkout library (item-issuebranch) or item home library (item-homebranch) or patron home library (patron-homebranch).
|
|
This option is only used if the OverdueNoticeFrom system preference is set to use 'command-line option'.
|
|
Defaults to checkout library (item-issuebranch).
|
|
|
|
This setting affects which branch is considered the "source" of the notice, which
|
|
in turn affects various aspects of the notice, including the content, branding,
|
|
and from email address.
|
|
|
|
=back
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This script is designed to alert patrons and administrators of overdue
|
|
items.
|
|
|
|
=head2 Configuration
|
|
|
|
This script pays attention to the overdue notice configuration
|
|
performed in the "Overdue notice/status triggers" section of the
|
|
"Tools" area of the staff interface to Koha. There, you can choose
|
|
which letter templates are sent out after a configurable number of
|
|
days to patrons of each library. More information about the use of this
|
|
section of Koha is available in the Koha manual.
|
|
|
|
The templates used to craft the emails are defined in the "Tools:
|
|
Notices" section of the staff interface to Koha.
|
|
|
|
=head2 Outgoing emails
|
|
|
|
Typically, messages are prepared for each patron with overdue
|
|
items. Messages for whom there is no email address on file are
|
|
collected and sent as attachments in a single email to each library
|
|
administrator, or if that is not set, then to the email address in the
|
|
C<KohaAdminEmailAddress> system preference.
|
|
|
|
These emails are staged in the outgoing message queue, as are messages
|
|
produced by other features of Koha. This message queue must be
|
|
processed regularly by the
|
|
F<misc/cronjobs/process_message_queue.pl> program.
|
|
|
|
In the event that the C<-n> flag is passed to this program, no emails
|
|
are sent. Instead, messages are sent on standard output from this
|
|
program. They may be redirected to a file if desired.
|
|
|
|
=head2 Templates
|
|
|
|
Templates can contain variables enclosed in double angle brackets like
|
|
<<this>>. Those variables will be replaced with values
|
|
specific to the overdue items or relevant patron. Available variables
|
|
are:
|
|
|
|
=over
|
|
|
|
=item E<lt>E<lt>bibE<gt>E<gt>
|
|
|
|
the name of the library
|
|
|
|
=item E<lt>E<lt>items.contentE<gt>E<gt>
|
|
|
|
one line for each item, each line containing a tab separated list of
|
|
title, author, barcode, issuedate
|
|
|
|
=item E<lt>E<lt>borrowers.*E<gt>E<gt>
|
|
|
|
any field from the borrowers table
|
|
|
|
=item E<lt>E<lt>branches.*E<gt>E<gt>
|
|
|
|
any field from the branches table
|
|
|
|
=back
|
|
|
|
=head2 CSV output
|
|
|
|
The C<-csv> command line option lets you specify a file to which
|
|
overdues data should be output in CSV format.
|
|
|
|
With the C<-n> flag set, data about all overdues is written to the
|
|
file. Without that flag, only information about overdues that were
|
|
unable to be sent directly to the patrons will be written. In other
|
|
words, this CSV file replaces the data that is typically sent to the
|
|
administrator email address.
|
|
|
|
=head1 USAGE EXAMPLES
|
|
|
|
C<overdue_notices.pl> - In this most basic usage, with no command line
|
|
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
|
|
email address, or to the address in the KohaAdminEmailAddress system
|
|
preference.
|
|
|
|
C<overdue_notices.pl -n --csv /tmp/overdues.csv> - sends no email and
|
|
populates F</tmp/overdues.csv> with information about all overdue
|
|
items.
|
|
|
|
C<overdue_notices.pl --library MAIN max 14> - prepare notices of
|
|
overdues in the last 2 weeks for the MAIN library.
|
|
|
|
C<overdue_notices.pl --triggered --date 2023-05-01> - Run the script as if it
|
|
were May 1, 2023, and send only notices for items that are exactly at the trigger
|
|
point (rather than within the trigger range).
|
|
|
|
C<overdue_notices.pl --borcat STUDENT --email email --email B_email> - Only send
|
|
notices to patrons in the STUDENT category, trying both primary and alternate email
|
|
addresses.
|
|
|
|
C<overdue_notices.pl --html /tmp/notices> - Generate HTML files for patrons without
|
|
email addresses in the /tmp/notices directory.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
The F<misc/cronjobs/advance_notices.pl> program allows you to send
|
|
messages to patrons in advance of their items becoming due, or to
|
|
alert them of items that have just become due.
|
|
|
|
=cut
|
|
|
|
# These variables are set by command line options.
|
|
# They are initially set to default values.
|
|
my $dbh = C4::Context->dbh();
|
|
my $help = 0;
|
|
my $man = 0;
|
|
my $verbose = 0;
|
|
my $nomail = 0;
|
|
my $MAX = 90;
|
|
my $test_mode = 0;
|
|
my $frombranch = 'item-issuebranch';
|
|
my $itype_level = C4::Context->preference('item-level_itypes') ? 'item' : 'biblioitem';
|
|
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 $csvfilename;
|
|
my $htmlfilename;
|
|
my $text_filename;
|
|
my $triggered = 0;
|
|
my $listall = 0;
|
|
my $itemscontent = join( ',', qw( date_due title barcode author itemnumber ) );
|
|
my @myitemtypes;
|
|
my @myitemtypesout;
|
|
my @myborcat;
|
|
my @myborcatout;
|
|
my ( $date_input, $today );
|
|
GetOptions(
|
|
'help|?' => \$help,
|
|
'man' => \$man,
|
|
'v|verbose+' => \$verbose,
|
|
'n|nomail' => \$nomail,
|
|
'max=s' => \$MAX,
|
|
'library=s' => \@branchcodes,
|
|
'csv:s' => \$csvfilename, # this optional argument gets '' if not supplied.
|
|
'html:s' => \$htmlfilename, # this optional argument gets '' if not supplied.
|
|
'text:s' => \$text_filename, # this optional argument gets '' if not supplied.
|
|
'itemscontent=s' => \$itemscontent,
|
|
'itemtypes=s' => \@myitemtypes,
|
|
'itemtypesout=s' => \@myitemtypesout,
|
|
'list-all' => \$listall,
|
|
't|triggered' => \$triggered,
|
|
'test' => \$test_mode,
|
|
'date=s' => \$date_input,
|
|
'borcat=s' => \@myborcat,
|
|
'borcatout=s' => \@myborcatout,
|
|
'email=s' => \@emails,
|
|
'frombranch=s' => \$frombranch,
|
|
) or pod2usage(2);
|
|
pod2usage(1) if $help;
|
|
pod2usage( -verbose => 2 ) if $man;
|
|
|
|
if ( defined $csvfilename && $csvfilename =~ /^-/ ) {
|
|
warn qq(using "$csvfilename" as filename, that seems odd);
|
|
}
|
|
|
|
die "--frombranch takes item-homebranch or item-issuebranch or patron-homebranch only"
|
|
unless ( $frombranch eq 'item-issuebranch'
|
|
|| $frombranch eq 'item-homebranch'
|
|
|| $frombranch eq 'patron-homebranch' );
|
|
$frombranch =
|
|
C4::Context->preference('OverdueNoticeFrom') ne 'cron' ? C4::Context->preference('OverdueNoticeFrom') : $frombranch;
|
|
my $owning_library = ( $frombranch eq 'item-homebranch' ) ? 1 : 0;
|
|
my $patron_homelibrary = ( $frombranch eq 'patron-homebranch' ) ? 1 : 0;
|
|
|
|
my @overduebranches = C4::Overdues::GetBranchcodesWithOverdueRules(); # Branches with overdue rules
|
|
my @branches; # Branches passed as parameter with overdue rules
|
|
my $branchcount = scalar(@overduebranches);
|
|
|
|
my $overduebranch_word = scalar @overduebranches > 1 ? 'branches' : 'branch';
|
|
my $branchcodes_word = scalar @branchcodes > 1 ? 'branches' : 'branch';
|
|
|
|
my $PrintNoticesMaxLines = C4::Context->preference('PrintNoticesMaxLines');
|
|
|
|
if ($branchcount) {
|
|
$verbose
|
|
and warn "Found $branchcount $overduebranch_word with first message enabled: "
|
|
. join( ', ', map { "'$_'" } @overduebranches ), "\n";
|
|
} else {
|
|
$verbose and die 'No branches with active overduerules';
|
|
}
|
|
|
|
if (@branchcodes) {
|
|
$verbose and warn "$branchcodes_word @branchcodes passed on parameter\n";
|
|
|
|
# Getting libraries which have overdue rules
|
|
my %seen = map { $_ => 1 } @branchcodes;
|
|
@branches = grep { $seen{$_} } @overduebranches;
|
|
|
|
if (@branches) {
|
|
|
|
my $branch_word = scalar @branches > 1 ? 'branches' : 'branch';
|
|
$verbose and warn "$branch_word @branches have overdue rules\n";
|
|
|
|
} else {
|
|
|
|
$verbose and warn "No active overduerules for $branchcodes_word '@branchcodes'\n";
|
|
( scalar grep { '' eq $_ } @branches )
|
|
or die "No active overduerules for DEFAULT either!";
|
|
$verbose and warn "Falling back on default rules for @branchcodes\n";
|
|
@branches = ('');
|
|
}
|
|
}
|
|
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>>
|
|
my @item_content_fields = split( /,/, $itemscontent );
|
|
|
|
binmode( STDOUT, ':encoding(UTF-8)' );
|
|
|
|
our $csv; # the Text::CSV_XS object
|
|
our $csv_fh; # the filehandle to the CSV file.
|
|
if ( defined $csvfilename ) {
|
|
my $sep_char = C4::Context->csv_delimiter;
|
|
$csv = Text::CSV_XS->new( { binary => 1, sep_char => $sep_char, formula => "empty" } );
|
|
if ( $csvfilename eq '' ) {
|
|
$csv_fh = *STDOUT;
|
|
} else {
|
|
open $csv_fh, ">", $csvfilename or die "unable to open $csvfilename: $!";
|
|
}
|
|
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;
|
|
}
|
|
}
|
|
|
|
@branches = @overduebranches unless @branches;
|
|
|
|
# Setup output file if requested
|
|
our $fh;
|
|
if ( defined $htmlfilename ) {
|
|
if ( $htmlfilename eq '' ) {
|
|
$fh = *STDOUT;
|
|
} else {
|
|
my $today = dt_from_string();
|
|
open $fh, ">:encoding(UTF-8)", File::Spec->catdir( $htmlfilename, "notices-" . $today->ymd() . ".html" );
|
|
}
|
|
|
|
print $fh _get_html_start();
|
|
} elsif ( defined $text_filename ) {
|
|
if ( $text_filename eq '' ) {
|
|
$fh = *STDOUT;
|
|
} else {
|
|
my $today = dt_from_string();
|
|
open $fh, ">:encoding(UTF-8)", File::Spec->catdir( $text_filename, "notices-" . $today->ymd() . ".txt" );
|
|
}
|
|
}
|
|
|
|
# Setup category list
|
|
my @categories;
|
|
if (@myborcat) {
|
|
@categories = @myborcat;
|
|
} elsif (@myborcatout) {
|
|
@categories = Koha::Patron::Categories->search( { categorycode => { 'not_in' => \@myborcatout } } )
|
|
->get_column('categorycode');
|
|
} else {
|
|
@categories = Koha::Patron::Categories->search()->get_column('categorycode');
|
|
}
|
|
|
|
# Setup itemtype list
|
|
my @itemtypes;
|
|
if (@myitemtypes) {
|
|
@itemtypes = @myitemtypes;
|
|
} elsif (@myitemtypesout) {
|
|
@itemtypes =
|
|
Koha::ItemTypes->search( { itemtype => { 'not_in' => \@myitemtypesout } } )->get_column('itemtype');
|
|
} else {
|
|
@itemtypes = Koha::ItemTypes->search()->get_column('itemtype');
|
|
}
|
|
|
|
my %seen = map { $_ => 1 } @branches;
|
|
|
|
# Work through branches
|
|
my @output_chunks;
|
|
foreach my $branchcode (@branches) {
|
|
my $calendar;
|
|
if ( C4::Context->preference('OverdueNoticeCalendar') ) {
|
|
$calendar = Koha::Library::Calendar->new( branchcode => $branchcode );
|
|
if ( $calendar->is_holiday($date_to_run) ) {
|
|
next;
|
|
}
|
|
}
|
|
|
|
my $library = Koha::Libraries->find($branchcode);
|
|
my $admin_email_address = $library->from_email_address;
|
|
my $branch_email_address = C4::Context->preference('AddressForFailedOverdueNotices')
|
|
|| $library->inbound_email_address;
|
|
@output_chunks = (); # may be sent to mail or stdout or csv file.
|
|
|
|
$verbose and print "======================================\n";
|
|
$verbose and warn sprintf "branchcode : '%s' using %s\n", $branchcode, $branch_email_address;
|
|
|
|
# Work through patron categories
|
|
for my $category (@categories) {
|
|
|
|
# Fetch all overdues for patron categories that want overdues and where the item is not lost and group by borrower
|
|
my $borrower_sql = <<"END_SQL";
|
|
SELECT
|
|
issues.borrowernumber,
|
|
borrowers.firstname,
|
|
borrowers.surname,
|
|
borrowers.address,
|
|
borrowers.address2,
|
|
borrowers.city,
|
|
borrowers.zipcode,
|
|
borrowers.country,
|
|
borrowers.email,
|
|
borrowers.emailpro,
|
|
borrowers.B_email,
|
|
borrowers.smsalertnumber,
|
|
borrowers.phone,
|
|
borrowers.cardnumber,
|
|
biblio.*,
|
|
biblioitems.itemtype AS b_itemtype,
|
|
items.*,
|
|
issues.*,
|
|
branches.branchname
|
|
FROM
|
|
issues
|
|
JOIN
|
|
borrowers ON issues.borrowernumber = borrowers.borrowernumber
|
|
JOIN
|
|
categories ON borrowers.categorycode = categories.categorycode
|
|
JOIN
|
|
items ON issues.itemnumber = items.itemnumber
|
|
JOIN
|
|
biblio ON biblio.biblionumber = items.biblionumber
|
|
JOIN
|
|
biblioitems ON biblio.biblionumber = biblioitems.biblionumber
|
|
JOIN
|
|
branches ON branches.branchcode = items.homebranch
|
|
WHERE
|
|
items.itemlost = 0
|
|
AND TO_DAYS($date)-TO_DAYS(issues.date_due) >= 0
|
|
END_SQL
|
|
|
|
my @borrower_parameters;
|
|
if ($branchcode) {
|
|
if ($owning_library) {
|
|
$borrower_sql .= ' AND items.homebranch=? ';
|
|
} elsif ($patron_homelibrary) {
|
|
$borrower_sql .= ' AND borrowers.branchcode=? ';
|
|
} else {
|
|
$borrower_sql .= ' AND issues.branchcode=? ';
|
|
}
|
|
push @borrower_parameters, $branchcode;
|
|
}
|
|
if ($category) {
|
|
$borrower_sql .= ' AND borrowers.categorycode=? ';
|
|
push @borrower_parameters, $category;
|
|
}
|
|
if (@itemtypes) {
|
|
my $placeholders = join( ", ", ("?") x @itemtypes );
|
|
if ( $itype_level eq 'item' ) {
|
|
$borrower_sql .= " AND items.itype IN ($placeholders) ";
|
|
} else {
|
|
$borrower_sql .= " AND biblioitems.itemtype IN ($placeholders) ";
|
|
}
|
|
push @borrower_parameters, @itemtypes;
|
|
}
|
|
$borrower_sql .= ' AND categories.overduenoticerequired=1 ORDER BY issues.borrowernumber';
|
|
|
|
# $sth gets borrower info if at least one overdue item has triggered the overdue action.
|
|
my $sth = $dbh->prepare($borrower_sql);
|
|
$sth->execute(@borrower_parameters);
|
|
|
|
if ( $verbose > 1 ) {
|
|
warn sprintf "--------Borrower SQL------\n";
|
|
warn $borrower_sql
|
|
. "\n $branchcode | "
|
|
. "'$category' | "
|
|
. join( "','", @itemtypes ) . " | "
|
|
. $date_to_run->datetime() . ")\n";
|
|
warn sprintf "--------------------------\n";
|
|
}
|
|
$verbose and warn sprintf "Found %s overdues for $category on $date_to_run\n", $sth->rows;
|
|
|
|
my $borrowernumber;
|
|
my $borrower_overdues = {};
|
|
|
|
# Iterate over all overdues
|
|
OVERDUE: while ( my $data = $sth->fetchrow_hashref ) {
|
|
my $itemtype = $data->{itype} // $data->{b_itemtype};
|
|
|
|
# Collect triggers or act on them if we're switching borrower
|
|
if ( !defined $borrower_overdues->{borrowernumber} ) {
|
|
if ($verbose) {
|
|
warn "\n-----------------------------------------\n";
|
|
warn "Collecting overdue triggers for borrower " . $data->{borrowernumber} . "\n";
|
|
}
|
|
$borrower_overdues = { borrowernumber => $data->{borrowernumber}, branchcode => $branchcode };
|
|
} elsif ( $borrower_overdues->{borrowernumber} ne $data->{borrowernumber} ) {
|
|
$verbose and warn "Collected overdue triggers for " . $borrower_overdues->{borrowernumber} . "\n";
|
|
_enact_trigger($borrower_overdues);
|
|
if ($verbose) {
|
|
warn "\n-----------------------------------------\n";
|
|
warn "Collecting overdue triggers for borrower " . $data->{borrowernumber} . "\n";
|
|
}
|
|
$borrower_overdues = { borrowernumber => $data->{borrowernumber}, branchcode => $branchcode };
|
|
}
|
|
|
|
$verbose
|
|
and warn "\nProcessing overdue "
|
|
. $data->{issue_id}
|
|
. " with branch = '$branchcode', categorycode = '$category' and itemtype = '$itemtype'\n";
|
|
|
|
# Work through triggers until we run out of rules or find a match
|
|
my $i = 0;
|
|
PERIOD: while (1) {
|
|
$i++;
|
|
my $ii = $i + 1;
|
|
my $overdue_rules = Koha::CirculationRules->get_effective_rules(
|
|
{
|
|
rules => [
|
|
"overdue_$i" . '_delay', "overdue_$i" . '_notice', "overdue_$i" . '_mtt',
|
|
"overdue_$i" . '_restrict', "overdue_$ii" . '_delay'
|
|
],
|
|
categorycode => $category,
|
|
branchcode => $branchcode,
|
|
itemtype => $itemtype,
|
|
}
|
|
);
|
|
|
|
if ( !defined( $overdue_rules->{ "overdue_$i" . '_delay' } ) ) {
|
|
last PERIOD;
|
|
}
|
|
|
|
my $mindays =
|
|
$overdue_rules->{ "overdue_$i" . '_delay' }
|
|
; # the notice will be sent after mindays days (grace period)
|
|
my $maxdays = (
|
|
$overdue_rules->{ "overdue_$ii" . '_delay' }
|
|
? $overdue_rules->{ "overdue_$ii" . '_delay' } - 1
|
|
: ($MAX)
|
|
); # issues being more than maxdays late are managed somewhere else. (borrower probably suspended)
|
|
|
|
if ( !$overdue_rules->{ "overdue_$i" . '_notice' } ) {
|
|
$verbose and warn sprintf "Trigger %s skipped, No letter code found\n", $i;
|
|
next PERIOD;
|
|
}
|
|
|
|
# $letter->{'content'} is the text of the mail that is sent.
|
|
# this text contains fields that are replaced by their value. Those fields must be written between brackets
|
|
# The following fields are available :
|
|
# 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>
|
|
|
|
# Check the overdue period 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 ($listall) {
|
|
unless ( $days_between >= 1 and $days_between <= $MAX ) {
|
|
next;
|
|
}
|
|
} else {
|
|
if ($triggered) {
|
|
if ( $mindays != $days_between ) {
|
|
$verbose and warn "Overdue skipped for trigger $i\n";
|
|
next;
|
|
}
|
|
} else {
|
|
unless ( $days_between >= $mindays
|
|
&& $days_between <= $maxdays )
|
|
{
|
|
$verbose and warn "Overdue skipped for trigger $i\n";
|
|
next;
|
|
}
|
|
}
|
|
}
|
|
|
|
if ($verbose) {
|
|
my $borr = sprintf(
|
|
"%s%s%s (%s)",
|
|
$data->{'surname'} || '',
|
|
$data->{'firstname'} && $data->{'surname'} ? ', ' : '',
|
|
$data->{'firstname'} || '',
|
|
$data->{borrowernumber}
|
|
);
|
|
warn sprintf "Overdue matched trigger %s for %s with delay of %s days and overdue due date of %s\n",
|
|
$i, $borr,
|
|
$overdue_rules->{ "overdue_$i" . '_delay' }, $data->{date_due};
|
|
warn sprintf "Using letter code '%s'\n",
|
|
$overdue_rules->{ "overdue_$i" . '_notice' };
|
|
}
|
|
|
|
my @message_transport_types = split( /,/, $overdue_rules->{ "overdue_$i" . '_mtt' } );
|
|
for my $mtt (@message_transport_types) {
|
|
push @{ $borrower_overdues->{triggers}->{$i}->{ $overdue_rules->{ "overdue_$i" . '_notice' } }
|
|
->{$mtt} }, $data;
|
|
}
|
|
if ( $overdue_rules->{ "overdue_$i" . '_restrict' } ) {
|
|
$borrower_overdues->{restrict} = 1;
|
|
}
|
|
$borrower_overdues->{'email'} = $data->{'email'};
|
|
$borrower_overdues->{'emailpro'} = $data->{'emailpro'};
|
|
$borrower_overdues->{'B_email'} = $data->{'B_email'};
|
|
$borrower_overdues->{'smsalertnumber'} = $data->{'smsalertnumber'};
|
|
$borrower_overdues->{'phone'} = $data->{'phone'};
|
|
$borrower_overdues->{'firstname'} = $data->{'firstname'};
|
|
$borrower_overdues->{'surname'} = $data->{'surname'};
|
|
$borrower_overdues->{'address'} = $data->{'address'};
|
|
$borrower_overdues->{'address2'} = $data->{'address2'};
|
|
$borrower_overdues->{'city'} = $data->{'city'};
|
|
$borrower_overdues->{'zipcode'} = $data->{'zipcode'};
|
|
$borrower_overdues->{'country'} = $data->{'country'};
|
|
$borrower_overdues->{'cardnumber'} = $data->{'cardnumber'};
|
|
}
|
|
}
|
|
$sth->finish;
|
|
|
|
# Catch final trigger
|
|
if ( $borrower_overdues->{borrowernumber} ) {
|
|
$verbose and warn "Collected overdue triggers for " . $borrower_overdues->{borrowernumber} . "\n";
|
|
_enact_trigger($borrower_overdues);
|
|
$borrower_overdues = {};
|
|
}
|
|
}
|
|
|
|
if (@output_chunks) {
|
|
if ( defined $csvfilename ) {
|
|
print $csv_fh @output_chunks;
|
|
} elsif ( defined $htmlfilename ) {
|
|
print $fh @output_chunks;
|
|
} elsif ( defined $text_filename ) {
|
|
print $fh @output_chunks;
|
|
} elsif ($nomail) {
|
|
local $, = "\f"; # pagebreak
|
|
print @output_chunks;
|
|
}
|
|
|
|
# Generate the content of the csv with headers
|
|
my $content;
|
|
if ( defined $csvfilename ) {
|
|
my $delimiter = C4::Context->csv_delimiter;
|
|
$content = join(
|
|
$delimiter,
|
|
qw(title name surname address1 address2 zipcode city country email itemcount itemsinfo due_date issue_date)
|
|
) . "\n";
|
|
$content .= join( "\n", @output_chunks );
|
|
} elsif ( defined $htmlfilename ) {
|
|
$content = _get_html_start();
|
|
$content .= join( "\n", @output_chunks );
|
|
$content .= _get_html_end();
|
|
} else {
|
|
$content = join( "\n", @output_chunks );
|
|
}
|
|
|
|
if ( C4::Context->preference('EmailOverduesNoEmail') ) {
|
|
my $attachment = {
|
|
filename => defined $csvfilename ? 'attachment.csv'
|
|
: defined $htmlfilename ? 'attachment.html'
|
|
: 'attachment.txt',
|
|
type => defined $htmlfilename ? 'text/html' : 'text/plain',
|
|
content => $content,
|
|
};
|
|
|
|
my $letter = {
|
|
title => 'Overdue Notices',
|
|
content => 'These messages were not sent directly to the patrons.',
|
|
};
|
|
|
|
C4::Letters::EnqueueLetter(
|
|
{
|
|
letter => $letter,
|
|
borrowernumber => undef,
|
|
message_transport_type => 'email',
|
|
attachments => [$attachment],
|
|
to_address => $branch_email_address,
|
|
}
|
|
) unless $test_mode;
|
|
}
|
|
}
|
|
}
|
|
|
|
if ($csvfilename) {
|
|
|
|
# note that we're not testing on $csv_fh to prevent closing
|
|
# STDOUT.
|
|
close $csv_fh;
|
|
}
|
|
|
|
if ( defined $htmlfilename ) {
|
|
print $fh _get_html_end();
|
|
close $fh;
|
|
} elsif ( defined $text_filename ) {
|
|
close $fh;
|
|
}
|
|
|
|
=head1 INTERNAL METHODS
|
|
|
|
These methods are internal to the operation of overdue_notices.pl.
|
|
|
|
=cut
|
|
|
|
sub _enact_trigger {
|
|
my ($borrower_overdues) = @_;
|
|
|
|
my $borrowernumber = $borrower_overdues->{borrowernumber};
|
|
my $branchcode = $borrower_overdues->{branchcode};
|
|
my $patron = Koha::Patrons->find($borrowernumber);
|
|
my ( $library, $admin_email_address, $branch_email_address );
|
|
$library = Koha::Libraries->find($branchcode);
|
|
$admin_email_address = $library->from_email_address;
|
|
|
|
if ($patron_homelibrary) {
|
|
$branchcode = $patron->branchcode;
|
|
$library = Koha::Libraries->find($branchcode);
|
|
$admin_email_address = $library->from_email_address;
|
|
$branch_email_address = C4::Context->preference('AddressForFailedOverdueNotices')
|
|
|| $library->inbound_email_address;
|
|
}
|
|
@emails_to_use = ();
|
|
my $notice_email = $patron->notice_email_address;
|
|
unless ($nomail) {
|
|
if (@emails) {
|
|
foreach (@emails) {
|
|
push @emails_to_use, $borrower_overdues->{$_} if ( $borrower_overdues->{$_} );
|
|
}
|
|
} else {
|
|
push @emails_to_use, $notice_email if ($notice_email);
|
|
}
|
|
}
|
|
|
|
for my $trigger ( sort keys %{ $borrower_overdues->{triggers} } ) {
|
|
for my $notice ( keys %{ $borrower_overdues->{triggers}->{$trigger} } ) {
|
|
my $print_sent = 0; # A print notice is not yet sent for this patron
|
|
for my $mtt ( keys %{ $borrower_overdues->{triggers}->{$trigger}->{$notice} } ) {
|
|
|
|
next if $mtt eq 'itiva';
|
|
my $effective_mtt = $mtt;
|
|
if ( ( $mtt eq 'email' and not scalar @emails_to_use )
|
|
or ( $mtt eq 'sms' and not $borrower_overdues->{smsalertnumber} ) )
|
|
{
|
|
# email or sms is requested but not exist, do a print.
|
|
$effective_mtt = 'print';
|
|
}
|
|
|
|
my $j = 0;
|
|
my $exceededPrintNoticesMaxLines = 0;
|
|
|
|
# Get each overdue item for this trigger
|
|
my $itemcount = 0;
|
|
my $titles = "";
|
|
my @items = ();
|
|
for my $item_info ( @{ $borrower_overdues->{triggers}->{$trigger}->{$notice}->{$mtt} } ) {
|
|
if ( ( scalar(@emails_to_use) == 0 || $nomail )
|
|
&& $PrintNoticesMaxLines
|
|
&& $j >= $PrintNoticesMaxLines )
|
|
{
|
|
$exceededPrintNoticesMaxLines = 1;
|
|
last;
|
|
}
|
|
next if $patron_homelibrary and !grep { $seen{ $item_info->{branchcode} } } @branches;
|
|
$j++;
|
|
|
|
$titles .= C4::Letters::get_item_content(
|
|
{ item => $item_info, item_content_fields => \@item_content_fields, dateonly => 1 } );
|
|
$itemcount++;
|
|
push @items, $item_info;
|
|
}
|
|
|
|
splice @items, $PrintNoticesMaxLines
|
|
if $effective_mtt eq 'print'
|
|
&& $PrintNoticesMaxLines
|
|
&& scalar @items > $PrintNoticesMaxLines;
|
|
|
|
#catch the case where we are sending a print to someone with an email
|
|
|
|
my $letter_exists = Koha::Notice::Templates->find_effective_template(
|
|
{
|
|
module => 'circulation',
|
|
code => $notice,
|
|
message_transport_type => $effective_mtt,
|
|
branchcode => $branchcode,
|
|
lang => $patron->lang
|
|
}
|
|
);
|
|
|
|
unless ($letter_exists) {
|
|
$verbose and warn qq|Message '$notice' for '$effective_mtt' content not found|;
|
|
next;
|
|
}
|
|
|
|
my $letter = parse_overdues_letter(
|
|
{
|
|
letter_code => $notice,
|
|
borrowernumber => $borrowernumber,
|
|
branchcode => $branchcode,
|
|
items => \@items,
|
|
substitute => { # this appears to be a hack to overcome incomplete features in this code.
|
|
bib => $library->branchname, # maybe 'bib' is a typo for 'lib<rary>'?
|
|
'items.content' => $titles,
|
|
'count' => $itemcount,
|
|
},
|
|
|
|
# If there is no template defined for the requested letter
|
|
# Fallback on the original type
|
|
message_transport_type => $letter_exists ? $effective_mtt : $mtt,
|
|
}
|
|
);
|
|
unless ( $letter && $letter->{content} ) {
|
|
$verbose and warn qq|Message '$notice' content not found|;
|
|
|
|
# this transport doesn't have a configured notice, so try another
|
|
next;
|
|
}
|
|
|
|
if ($exceededPrintNoticesMaxLines) {
|
|
$letter->{'content'} .=
|
|
"List too long for form; please check your account online for a complete list of your overdue items.";
|
|
}
|
|
|
|
my @misses = grep { /./ } map { /^([^>]*)[>]+/; ( $1 || '' ); } split /\</,
|
|
$letter->{'content'};
|
|
if (@misses) {
|
|
$verbose
|
|
and warn "The following terms were not matched and replaced: \n\t" . join "\n\t",
|
|
@misses;
|
|
}
|
|
|
|
if ($nomail) {
|
|
push @output_chunks,
|
|
prepare_letter_for_printing(
|
|
{
|
|
letter => $letter,
|
|
borrowernumber => $borrowernumber,
|
|
firstname => $borrower_overdues->{'firstname'},
|
|
lastname => $borrower_overdues->{'surname'},
|
|
address1 => $borrower_overdues->{'address'},
|
|
address2 => $borrower_overdues->{'address2'},
|
|
city => $borrower_overdues->{'city'},
|
|
phone => $borrower_overdues->{'phone'},
|
|
cardnumber => $borrower_overdues->{'cardnumber'},
|
|
branchname => $library->branchname,
|
|
letternumber => $trigger,
|
|
postcode => $borrower_overdues->{'zipcode'},
|
|
country => $borrower_overdues->{'country'},
|
|
email => $notice_email,
|
|
itemcount => $itemcount,
|
|
titles => $titles,
|
|
outputformat => defined $csvfilename ? 'csv'
|
|
: defined $htmlfilename ? 'html'
|
|
: defined $text_filename ? 'text'
|
|
: '',
|
|
}
|
|
);
|
|
} else {
|
|
if ( ( $mtt eq 'email' and not scalar @emails_to_use )
|
|
or ( $mtt eq 'sms' and not $borrower_overdues->{smsalertnumber} ) )
|
|
{
|
|
push @output_chunks,
|
|
prepare_letter_for_printing(
|
|
{
|
|
letter => $letter,
|
|
borrowernumber => $borrowernumber,
|
|
firstname => $borrower_overdues->{'firstname'},
|
|
lastname => $borrower_overdues->{'surname'},
|
|
address1 => $borrower_overdues->{'address'},
|
|
address2 => $borrower_overdues->{'address2'},
|
|
city => $borrower_overdues->{'city'},
|
|
postcode => $borrower_overdues->{'zipcode'},
|
|
country => $borrower_overdues->{'country'},
|
|
email => $notice_email,
|
|
itemcount => $itemcount,
|
|
titles => $titles,
|
|
outputformat => defined $csvfilename ? 'csv'
|
|
: defined $htmlfilename ? 'html'
|
|
: defined $text_filename ? 'text'
|
|
: '',
|
|
}
|
|
);
|
|
}
|
|
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 => $effective_mtt,
|
|
from_address => $admin_email_address,
|
|
to_address => join( ',', @emails_to_use ),
|
|
reply_address => $library->inbound_email_address,
|
|
}
|
|
) 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 $effective_mtt eq 'print';
|
|
}
|
|
}
|
|
}
|
|
|
|
}
|
|
}
|
|
|
|
if ( $borrower_overdues->{restrict} ) {
|
|
|
|
#action taken is debarring
|
|
AddUniqueDebarment(
|
|
{
|
|
borrowernumber => $borrowernumber,
|
|
type => 'OVERDUES',
|
|
comment => "OVERDUES_PROCESS " . output_pref( dt_from_string() ),
|
|
}
|
|
) unless $test_mode;
|
|
|
|
my $borr = sprintf(
|
|
"%s%s%s (%s)",
|
|
$borrower_overdues->{'surname'} || '',
|
|
$borrower_overdues->{'firstname'} && $borrower_overdues->{'surname'} ? ', ' : '',
|
|
$borrower_overdues->{'firstname'} || '',
|
|
$borrower_overdues->{borrowernumber}
|
|
);
|
|
$verbose and warn "debarring $borr\n";
|
|
}
|
|
}
|
|
|
|
=head2 prepare_letter_for_printing
|
|
|
|
returns a string of text appropriate for printing in the event that an
|
|
overdue notice will not be sent to the patron's email
|
|
address. Depending on the desired output format, this may be a CSV
|
|
string, or a human-readable representation of the notice.
|
|
|
|
required parameters:
|
|
letter
|
|
borrowernumber
|
|
|
|
optional parameters:
|
|
outputformat
|
|
|
|
=cut
|
|
|
|
sub prepare_letter_for_printing {
|
|
my $params = shift;
|
|
|
|
return unless ref $params eq 'HASH';
|
|
|
|
foreach my $required_parameter (qw( letter borrowernumber )) {
|
|
return unless defined $params->{$required_parameter};
|
|
}
|
|
|
|
my $return;
|
|
chomp $params->{titles};
|
|
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->{'phone'},
|
|
$params->{'cardnumber'},
|
|
$params->{'itemcount'}, $params->{'titles'}, $params->{'branchname'}, $params->{'letternumber'}
|
|
)
|
|
)
|
|
{
|
|
return $csv->string, "\n";
|
|
} else {
|
|
$verbose and warn 'combine failed on argument: ' . $csv->error_input;
|
|
}
|
|
} elsif ( exists $params->{'outputformat'} && $params->{'outputformat'} eq 'html' ) {
|
|
$return = "<pre>\n";
|
|
$return .= "$params->{'letter'}->{'content'}\n";
|
|
$return .= "\n</pre>\n";
|
|
} else {
|
|
$return .= "$params->{'letter'}->{'content'}\n";
|
|
|
|
# $return .= Data::Dumper->Dump( [ $params->{'borrowernumber'}, $params->{'letter'} ], [qw( borrowernumber letter )] );
|
|
}
|
|
return $return;
|
|
}
|
|
|
|
=head2 _get_html_start
|
|
|
|
Return the start of a HTML document, including html, head and the start body
|
|
tags. This should be usable both in the HTML file written to disc, and in the
|
|
attachment.html sent as email.
|
|
|
|
=cut
|
|
|
|
sub _get_html_start {
|
|
|
|
return "<html>
|
|
<head>
|
|
<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />
|
|
<style type='text/css'>
|
|
pre {page-break-after: always;}
|
|
pre {white-space: pre-wrap;}
|
|
</style>
|
|
</head>
|
|
<body>";
|
|
|
|
}
|
|
|
|
=head2 _get_html_end
|
|
|
|
Return the end of an HTML document, namely the closing body and html tags.
|
|
|
|
=cut
|
|
|
|
sub _get_html_end {
|
|
|
|
return "</body>
|
|
</html>";
|
|
|
|
}
|
|
|