-#!/usr/bin/perl -w
+#!/usr/bin/perl
# Copyright 2008 Liblime
+# Copyright 2010 BibLibre
#
# This file is part of Koha.
#
# 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., 59 Temple Place,
-# Suite 330, Boston, MA 02111-1307 USA
+# 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.
use strict;
use warnings;
eval { require "$FindBin::Bin/../kohalib.pl" };
}
+use Getopt::Long;
+use Pod::Usage;
+use Text::CSV_XS;
+use Locale::Currency::Format 1.28;
+use Encode;
+
use C4::Context;
use C4::Dates qw/format_date/;
use C4::Debug;
use C4::Letters;
-
-use Getopt::Long;
-use Pod::Usage;
-use Text::CSV_XS;
+use C4::Overdues qw(GetFine);
=head1 NAME
=head1 SYNOPSIS
-overdue_notices.pl [ -n ] [ -library <branchcode> ] [ -max <number of days> ] [ -csv [ <filename> ] ] [ -itemscontent <field list> ]
+overdue_notices.pl [ -n ] [ -library <branchcode> ] [ -library <branchcode>...] [ -max <number of days> ] [ -csv [ <filename> ] ] [ -itemscontent <field list> ]
Options:
-help brief help message
-man full documentation
-n No email will be sent
-max <days> maximum days overdue to deal with
- -library <branchname> only deal with overdues from this library
+ -library <branchname> only deal with overdues from this library (repeatable : several libraries can be given)
-csv <filename> populate CSV file
+ -html <filename> Output html to file
-itemscontent <list of fields> item information in templates
+ -borcat <categorycode> category code that must be included
+ -borcatout <categorycode> category code that must be excluded
=head1 OPTIONS
=item B<-library>
select overdues for one specific library. Use the value in the
-branches.branchcode table.
+branches.branchcode table. This option can be repeated in order
+to select overdues for a group of libraries.
=item B<-csv>
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 a mail 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.
+
=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 issuedate,title,barcode,author
+defaults to due date,title,barcode,author
-Other possible values come from fields in the biblios, items, and
+Other possible values come from fields in the biblios, items and
issues tables.
+=item B<-borcat>
+
+Repetable field, that permit to select only few of patrons categories.
+
+=item B<-borcatout>
+
+Repetable field, permis to exclude some patrons categories.
+
=item B<-t> | B<--triggered>
This option causes a notice to be generated if and only if
# 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 $mybranch;
+my @branchcodes; # Branch(es) passed as parameter
my $csvfilename;
+my $htmlfilename;
my $triggered = 0;
my $listall = 0;
-my $itemscontent = join( ',', qw( issuedate title barcode author ) );
+my $itemscontent = join( ',', qw( date_due title barcode author itemnumber ) );
+my @myborcat;
+my @myborcatout;
GetOptions(
'help|?' => \$help,
'v' => \$verbose,
'n' => \$nomail,
'max=s' => \$MAX,
- 'library=s' => \$mybranch,
+ 'library=s' => \@branchcodes,
'csv:s' => \$csvfilename, # this optional argument gets '' if not supplied.
+ 'html:s' => \$htmlfilename, # this optional argument gets '' if not supplied.
'itemscontent=s' => \$itemscontent,
'list-all' => \$listall,
't|triggered' => \$triggered,
+ 'borcat=s' => \@myborcat,
+ 'borcatout=s' => \@myborcatout,
) or pod2usage(2);
pod2usage(1) if $help;
pod2usage( -verbose => 2 ) if $man;
warn qq(using "$csvfilename" as filename, that seems odd);
}
-my @branches = C4::Overdues::GetBranchcodesWithOverdueRules();
-my $branchcount = scalar(@branches);
+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) {
- my $branch_word = scalar @branches > 1 ? 'branches' : 'branch';
- $verbose and warn "Found $branchcount $branch_word with first message enabled: " . join( ', ', map { "'$_'" } @branches ), "\n";
+ $verbose and warn "Found $branchcount $overduebranch_word with first message enabled: " . join( ', ', map { "'$_'" } @overduebranches ), "\n";
} else {
die 'No branches with active overduerules';
}
-if ($mybranch) {
- $verbose and warn "Branch $mybranch selected\n";
- if ( scalar grep { $mybranch eq $_ } @branches ) {
- @branches = ($mybranch);
+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 (@overduebranches) {
+
+ 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 branch '$mybranch'\n";
+
+ $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 $mybranch\n";
+ $verbose and warn "Falling back on default rules for @branchcodes\n";
@branches = ('');
}
}
# these are the fields that will be substituted into <<item.content>>
my @item_content_fields = split( /,/, $itemscontent );
-my $dbh = C4::Context->dbh();
binmode( STDOUT, ":utf8" );
+
our $csv; # the Text::CSV_XS object
our $csv_fh; # the filehandle to the CSV file.
if ( defined $csvfilename ) {
}
}
+@branches = @overduebranches unless @branches;
+our $html_fh;
+if ( defined $htmlfilename ) {
+ if ( $htmlfilename eq '' ) {
+ $html_fh = *STDOUT;
+ } else {
+ my $today = C4::Dates->new();
+ open $html_fh, ">",File::Spec->catdir ($htmlfilename,"notices-".$today->output('iso').".html");
+ }
+
+ print $html_fh "<html>\n";
+ print $html_fh "<head>\n";
+ print $html_fh "<style type='text/css'>\n";
+ print $html_fh "pre {page-break-after: always;}\n";
+ print $html_fh "pre {white-space: pre-wrap;}\n";
+ print $html_fh "pre {white-space: -moz-pre-wrap;}\n";
+ print $html_fh "pre {white-space: -o-pre-wrap;}\n";
+ print $html_fh "pre {word-wrap: break-work;}\n";
+ print $html_fh "</style>\n";
+ print $html_fh "</head>\n";
+ print $html_fh "<body>\n";
+}
+
foreach my $branchcode (@branches) {
my $branch_details = C4::Branch::GetBranchDetail($branchcode);
$verbose and warn sprintf "branchcode : '%s' using %s\n", $branchcode, $admin_email_address;
my $sth2 = $dbh->prepare( <<'END_SQL' );
-SELECT biblio.*, items.*, issues.*, TO_DAYS(NOW())-TO_DAYS(date_due) AS days_overdue
- FROM issues,items,biblio
+SELECT biblio.*, items.*, issues.*, biblioitems.itemtype, TO_DAYS(NOW())-TO_DAYS(date_due) AS days_overdue
+ FROM issues,items,biblio, biblioitems
WHERE items.itemnumber=issues.itemnumber
AND biblio.biblionumber = items.biblionumber
+ AND biblio.biblionumber = biblioitems.biblionumber
AND issues.borrowernumber = ?
AND TO_DAYS(NOW())-TO_DAYS(date_due) BETWEEN ? and ?
END_SQL
- my $rqoverduerules = $dbh->prepare("SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? ");
- $rqoverduerules->execute($branchcode);
+ my $query = "SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = ? ";
+ $query .= " AND categorycode IN (".join( ',' , ('?') x @myborcat ).") " if (@myborcat);
+ $query .= " AND categorycode NOT IN (".join( ',' , ('?') x @myborcatout ).") " if (@myborcatout);
+
+ my $rqoverduerules = $dbh->prepare($query);
+ $rqoverduerules->execute($branchcode, @myborcat, @myborcatout);
+
+ # We get default rules is there is no rule for this branch
+ if($rqoverduerules->rows == 0){
+ $query = "SELECT * FROM overduerules WHERE delay1 IS NOT NULL AND branchcode = '' ";
+ $query .= " AND categorycode IN (".join( ',' , ('?') x @myborcat ).") " if (@myborcat);
+ $query .= " AND categorycode NOT IN (".join( ',' , ('?') x @myborcatout ).") " if (@myborcatout);
+
+ $rqoverduerules = $dbh->prepare($query);
+ $rqoverduerules->execute(@myborcat, @myborcatout);
+ }
+
# my $outfile = 'overdues_' . ( $mybranch || $branchcode || 'default' );
while ( my $overdue_rules = $rqoverduerules->fetchrow_hashref ) {
PERIOD: foreach my $i ( 1 .. 3 ) {
$sth->execute(@borrower_parameters);
$verbose and warn $borrower_sql . "\n $branchcode | " . $overdue_rules->{'categorycode'} . "\n ($mindays, $maxdays)\nreturns " . $sth->rows . " rows";
- while( my ( $itemcount, $borrowernumber, $firstname, $lastname, $address1, $address2, $city, $postcode, $email ) = $sth->fetchrow ) {
+ while ( my ($itemcount, $borrowernumber, $firstname, $lastname,
+ $address1, $address2, $city, $postcode, $country, $email,
+ $longest_issue ) = $sth->fetchrow )
+ {
$verbose and warn "borrower $firstname, $lastname ($borrowernumber) has $itemcount items triggering level $i.";
my $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"} );
+
unless ($letter) {
$verbose and warn "Message '$overdue_rules->{letter$i}' content not found";
C4::Members::DebarMember($borrowernumber);
$verbose and warn "debarring $borrowernumber $firstname $lastname\n";
}
- $sth2->execute( ($listall) ? ( $borrowernumber , 1 , $MAX ) : ( $borrowernumber, $mindays, $maxdays ) );
+ my @params = ($listall ? ( $borrowernumber , 1 , $MAX ) : ( $borrowernumber, $mindays, $maxdays ));
+ $verbose and warn "STH2 PARAMS: borrowernumber = $borrowernumber, mindays = $mindays, maxdays = $maxdays";
+ $sth2->execute(@params);
my $itemcount = 0;
my $titles = "";
+ my @items = ();
+
+ my $i = 0;
+ my $exceededPrintNoticesMaxLines = 0;
while ( my $item_info = $sth2->fetchrow_hashref() ) {
+ if ( ( !$email || $nomail ) && $PrintNoticesMaxLines && $i >= $PrintNoticesMaxLines ) {
+ $exceededPrintNoticesMaxLines = 1;
+ last;
+ }
+ $i++;
my @item_info = map { $_ =~ /^date|date$/ ? format_date( $item_info->{$_} ) : $item_info->{$_} || '' } @item_content_fields;
$titles .= join("\t", @item_info) . "\n";
$itemcount++;
+ push @items, { itemnumber => $item_info->{'itemnumber'}, biblionumber => $item_info->{'biblionumber'} };
}
$sth2->finish;
-
$letter = parse_letter(
- { letter => $letter,
- borrowernumber => $borrowernumber,
- branchcode => $branchcode,
- substitute => {
- bib => $branch_details->{'branchname'},
- 'items.content' => $titles
- }
+ { letter => $letter,
+ 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>'?
+ 'items.content' => $titles
+ }
}
);
-
+
+ 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;
email => $email,
itemcount => $itemcount,
titles => $titles,
- outputformat => defined $csvfilename ? 'csv' : '',
+ outputformat => defined $csvfilename ? 'csv' : defined $htmlfilename ? 'html' : '',
}
);
} else {
email => $email,
itemcount => $itemcount,
titles => $titles,
- outputformat => defined $csvfilename ? 'csv' : '',
+ outputformat => defined $csvfilename ? 'csv' : defined $htmlfilename ? 'html' : '',
}
);
}
}
if (@output_chunks) {
- if ($nomail) {
- if ( defined $csvfilename ) {
- print $csv_fh @output_chunks;
- } else {
+ if ( defined $csvfilename ) {
+ print $csv_fh @output_chunks;
+ }
+ elsif ( defined $htmlfilename ) {
+ print $html_fh @output_chunks;
+ }
+ elsif ($nomail){
local $, = "\f"; # pagebreak
print @output_chunks;
- }
- } else {
- my $attachment = {
- filename => defined $csvfilename ? 'attachment.csv' : 'attachment.txt',
- type => 'text/plain',
- content => join( "\n", @output_chunks )
- };
-
- 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 => $admin_email_address,
- }
- );
}
+ # Generate the content of the csv with headers
+ my $content = join(";", qw(title name surname address1 address2 zipcode city email itemcount itemsinfo due_date issue_date)) . "\n";
+ $content .= join( "\n", @output_chunks );
+
+ my $attachment = {
+ filename => defined $csvfilename ? 'attachment.csv' : 'attachment.txt',
+ type => '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 => $admin_email_address,
+ }
+ );
}
}
if ($csvfilename) {
-
# note that we're not testing on $csv_fh to prevent closing
# STDOUT.
close $csv_fh;
}
+if ( defined $htmlfilename ) {
+ print $html_fh "</body>\n";
+ print $html_fh "</html>\n";
+ close $html_fh;
+}
+
=head1 INTERNAL METHODS
These methods are internal to the operation of overdue_notices.pl.
=cut
-sub parse_letter {
+sub parse_letter { # FIXME: this code should probably be moved to C4::Letters:parseletter
my $params = shift;
foreach my $required (qw( letter borrowernumber )) {
return unless exists $params->{$required};
}
+ my $todaysdate = C4::Dates->new()->output("syspref");
+ $params->{'letter'}->{title} =~ s/<<today>>/$todaysdate/g;
+ $params->{'letter'}->{content} =~ s/<<today>>/$todaysdate/g;
+
if ( $params->{'substitute'} ) {
while ( my ( $key, $replacedby ) = each %{ $params->{'substitute'} } ) {
my $replacefield = "<<$key>>";
-
$params->{'letter'}->{title} =~ s/$replacefield/$replacedby/g;
$params->{'letter'}->{content} =~ s/$replacefield/$replacedby/g;
}
}
- C4::Letters::parseletter( $params->{'letter'}, 'borrowers', $params->{'borrowernumber'} );
+ $params->{'letter'} = C4::Letters::parseletter( $params->{'letter'}, 'borrowers', $params->{'borrowernumber'} );
if ( $params->{'branchcode'} ) {
- C4::Letters::parseletter( $params->{'letter'}, 'branches', $params->{'branchcode'} );
+ $params->{'letter'} = C4::Letters::parseletter( $params->{'letter'}, 'branches', $params->{'branchcode'} );
}
- if ( $params->{'biblionumber'} ) {
- C4::Letters::parseletter( $params->{'letter'}, 'biblio', $params->{'biblionumber'} );
- C4::Letters::parseletter( $params->{'letter'}, 'biblioitems', $params->{'biblionumber'} );
- }
+ if ( $params->{'items'} ) {
+ my $item_format = '';
+ PROCESS_ITEMS:
+ while (scalar(@{$params->{'items'}}) > 0) {
+ my $item = shift @{$params->{'items'}};
+ my $fine = GetFine($item->{'itemnumber'}, $params->{'borrowernumber'});
+ if (!$item_format) {
+ $params->{'letter'}->{'content'} =~ m/(<item>.*<\/item>)/;
+ $item_format = $1;
+ }
+ if ($params->{'letter'}->{'content'} =~ m/<fine>(.*)<\/fine>/) { # process any fine tags...
+ my $formatted_fine = currency_format("$1", "$fine", FMT_SYMBOL);
+ $params->{'letter'}->{'content'} =~ s/<fine>.*<\/fine>/$formatted_fine/;
+ }
+ $params->{'letter'} = C4::Letters::parseletter( $params->{'letter'}, 'biblio', $item->{'biblionumber'} );
+ $params->{'letter'} = C4::Letters::parseletter( $params->{'letter'}, 'biblioitems', $item->{'biblionumber'} );
+ $params->{'letter'} = C4::Letters::parseletter( $params->{'letter'}, 'items', $item->{'itemnumber'} );
+ $params->{'letter'}->{'content'} =~ s/(<item>.*<\/item>)/$1\n$item_format/ if scalar(@{$params->{'items'}} > 0);
+ }
+ }
+ $params->{'letter'}->{'content'} =~ s/<\/{0,1}?item>//g; # strip all remaining item tags...
return $params->{'letter'};
}
} 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";