From: Andrew Moore <[EMAIL PROTECTED]>
This patch adds the misc/cronjobs/overdue_notices.pl script that is intended to
replace
overduenotices.pl, overduenotices-30.pl and overduenotices-csv.pl. It adds
messages to
the message_queue to be sent later (by process_message_queue.pl). It also marks
borrowers
as debarred if their issues become too overdue.
It is intended to be run from cron nightly with usage something like:
0 2 * * * misc/cronjobs/overdue_notices.pl -c
C4::Members:
- improved documentation on ModMember
- made ModMember return a useful value (the return value of the database call)
- added a DebarMember method
- adding t/lib/KohaTest/Members/DebarMember.pm to test ModMember
misc/cronjobs/overdue_notices.pl
- designed to replace overduenotices.pl, overduenotices-30.pl, and
overduenotice-csv
Changes to C4::Letters:
- EnqueueLetter now lets you pass in to_address and from_address which can
override defaults
- _send_message_by_email pays attention to these defaults.
Signed-off-by: Galen Charlton <[EMAIL PROTECTED]>
---
C4/Letters.pm | 30 ++-
C4/Members.pm | 41 ++++-
misc/cronjobs/overdue_notices.pl | 399 +++++++++++++++++++++++++++++++++
t/lib/KohaTest/Members/DebarMember.pm | 44 ++++
4 files changed, 499 insertions(+), 15 deletions(-)
create mode 100755 misc/cronjobs/overdue_notices.pl
create mode 100644 t/lib/KohaTest/Members/DebarMember.pm
diff --git a/C4/Letters.pm b/C4/Letters.pm
index d82e2b8..af69be5 100644
--- a/C4/Letters.pm
+++ b/C4/Letters.pm
@@ -532,18 +532,21 @@ sub EnqueueLetter {
my $dbh = C4::Context->dbh();
my $statement = << 'ENDSQL';
INSERT INTO message_queue
-( borrowernumber, subject, content, message_transport_type, status,
time_queued )
+( borrowernumber, subject, content, message_transport_type, status,
time_queued, to_address, from_address )
VALUES
-( ?, ?, ?, ?, ?, NOW() )
+( ?, ?, ?, ?, ?, NOW(),
?, ? )
ENDSQL
my $sth = $dbh->prepare( $statement );
- my $result = $sth->execute( $params->{'borrowernumber'}, #
borrowernumber
- $params->{'letter'}->{'title'}, # subject
- $params->{'letter'}->{'content'}, # content
- $params->{'message_transport_type'}, #
message_transport_type
- 'pending', # status
- );
+ my $result = $sth->execute(
+ $params->{'borrowernumber'}, # borrowernumber
+ $params->{'letter'}->{'title'}, # subject
+ $params->{'letter'}->{'content'}, # content
+ $params->{'message_transport_type'}, # message_transport_type
+ 'pending', # status
+ $params->{'to_address'}, # to_address
+ $params->{'from_address'}, # from_address
+ );
return $result;
}
@@ -690,11 +693,12 @@ sub _send_message_by_email {
my $member = C4::Members::GetMember( $message->{'borrowernumber'} );
return unless $member->{'email'};
- my $success = sendmail( To => $member->{'email'},
- From =>
C4::Context->preference('KohaAdminEmailAddress'),
- Subject => $message->{'subject'},
- Message => $message->{'content'},
- );
+ my $success = sendmail(
+ To => $message->{'to_address'} || $member->{'email'},
+ From => $message->{'from_address'} ||
C4::Context->preference('KohaAdminEmailAddress'),
+ Subject => $message->{'subject'},
+ Message => $message->{'content'},
+ );
if ( $success ) {
# warn "OK. Log says:\n", $Mail::Sendmail::log;
_set_message_status( { message_id => $message->{'message_id'},
diff --git a/C4/Members.pm b/C4/Members.pm
index 7c7c48c..999d8fb 100644
--- a/C4/Members.pm
+++ b/C4/Members.pm
@@ -594,10 +594,17 @@ sub GetMemberIssuesAndFines {
=head2 ModMember
- &ModMember($borrowernumber);
+=over 4
+
+my $success = ModMember(borrowernumber => $borrowernumber, [ field => value
]... );
Modify borrower's data. All date fields should ALREADY be in ISO format.
+return :
+true on success, or false on failure
+
+=back
+
=cut
#'
@@ -647,7 +654,7 @@ sub ModMember {
push @parameters, $data{'borrowernumber'};
$debug and print STDERR "$query (executed w/ arg:
$data{'borrowernumber'})";
$sth = $dbh->prepare($query);
- $sth->execute(@parameters);
+ my $execute_success = $sth->execute(@parameters);
$sth->finish;
# ok if its an adult (type) it may have borrowers that depend on it as a
guarantor
@@ -660,6 +667,8 @@ sub ModMember {
}
logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "$query (executed
w/ arg: $data{'borrowernumber'})")
if C4::Context->preference("BorrowersLog");
+
+ return $execute_success;
}
@@ -2018,6 +2027,34 @@ sub GetBorrowersNamesAndLatestIssue {
my $results = $sth->fetchall_arrayref({});
return $results;
}
+
+=head2 DebarMember
+
+=over 4
+
+my $success = DebarMember( { borrowernumber => $borrowernumber } );
+
+marks a Member as debarred, and therefore unable to checkout any more
+items.
+
+return :
+true on success, false on failure
+
+=back
+
+=cut
+
+sub DebarMember {
+ my $borrowernumber = shift;
+
+ return unless defined $borrowernumber;
+ return unless $borrowernumber =~ /^\d+$/;
+
+ return ModMember( borrowernumber => $borrowernumber,
+ debarred => 1 );
+
+}
+
END { } # module clean-up code here (global destructor)
1;
diff --git a/misc/cronjobs/overdue_notices.pl b/misc/cronjobs/overdue_notices.pl
new file mode 100755
index 0000000..637fc71
--- /dev/null
+++ b/misc/cronjobs/overdue_notices.pl
@@ -0,0 +1,399 @@
+#!/usr/bin/perl -w
+
+# Copyright 2008 Liblime
+#
+# 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 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., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use warnings;
+
+BEGIN {
+
+ # find Koha's Perl modules
+ # test carefully before changing this
+ use FindBin;
+ eval { require "$FindBin::Bin/../kohalib.pl" };
+}
+
+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;
+
+=head1 NAME
+
+overdue_notices.pl - prepare messages to be sent to patrons for overdue items
+
+=head1 SYNOPSIS
+
+overdue_notices.pl -c [ -n ] [ -branch MAIN ] [ -max 31 ]
+
+ Options:
+ -help brief help message
+ -man full documentation
+ -c Confirm that you have read the documentation
+ -n No email will be sent
+ -max <days> maximum days overdue to deal with
+ -branch <branchname> only deal with overdues from this branch.
+ -csv <filename> populate CSV file
+
+=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>
+
+Verbose. Without this flag set, only fatal errors are reported.
+
+=item B<-n>
+
+Do not send any email. The overdue notices are printed to standard out in this
case.
+
+=item B<-max>
+
+Items older than max days are handled somewhere else, probably borrower
suspended. Defaults to 365.
+
+=item B<-branch>
+
+select overdues for one specific branch
+
+=item B<-csv>
+
+populate CSV file with overdues information. If -n (no mail) is
+selected, all overdues are put in file, otherwise, only overdues that
+could not be emailed are sent.
+
+=back
+
+=head1 DESCRIPTION
+
+This script will send overdue notices by e-mail and prepare a file of
+notices for printing if the borrower does not have e-mail.
+
+=cut
+
+# These variables are set by command line options.
+# They are initially set to default values.
+my $help = 0;
+my $man = 0;
+my $verbose = 0;
+my $nomail = 0;
+my $MAX = 365;
+my $mybranch;
+my $csvfilename;
+
+GetOptions(
+ 'help|?' => \$help,
+ 'man' => \$man,
+ 'v' => \$verbose,
+ 'n' => \$nomail,
+ 'max=s' => \$MAX,
+ 'branch=s' => \$mybranch,
+ 'csv=s' => \$csvfilename,
+) or pod2usage(2);
+pod2usage(1) if $help;
+pod2usage( -verbose => 2 ) if $man;
+
+my @branches = get_branches_with_overdue_rules();
+my $branchcount = scalar(@branches);
+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";
+} else {
+ die 'No branches with active overduerules';
+}
+
+if ($mybranch) {
+ $verbose and warn "Branch $mybranch selected\n";
+ if ( scalar grep { $mybranch eq $_ } @branches ) {
+ @branches = ($mybranch);
+ } else {
+ $verbose and warn "No active overduerules for branch '$mybranch'\n";
+ ( scalar grep { '' eq $_ } @branches )
+ or die "No active overduerules for DEFAULT either!";
+ $verbose and warn "Falling back on default rules for $mybranch\n";
+ @branches = ('');
+ }
+}
+
+my $dbh = C4::Context->dbh();
+
+our $csv; # the Text::CSV_XS object
+our $csv_fh; # the filehandle to the CSV file.
+if ($csvfilename) {
+ $csv = Text::CSV_XS->new( { binary => 1 } );
+ open $csv_fh, ">", $csvfilename or die "unable to open $csvfilename: $!";
+ if ( $csv->combine(qw(name surname address1 address2 zipcode city email
itemcount itemsinfo)) ) {
+ print $csv_fh $csv->string, "\n";
+ } else {
+ $verbose and warn 'combine failed on argument: ' . $csv->error_input;
+ }
+
+}
+
+foreach my $branchcode (@branches) {
+
+ my $branch_details = C4::Branch::GetBranchDetail($branchcode);
+ my $admin_email_address = $branch_details->{'branchemail'} ||
C4::Context->preference('KohaAdminEmailAddress');
+
+ $verbose and warn sprintf "branchcode : '%s' using %s\n", $branchcode,
$admin_email_address;
+
+ my $sth2 = $dbh->prepare( <<'END_SQL' );
+SELECT biblio.title, biblio.author, items.barcode, issues.timestamp
+ FROM issues,items,biblio
+ WHERE items.itemnumber=issues.itemnumber
+ AND biblio.biblionumber = items.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 $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";
+ my $mindays = $overdue_rules->{"delay$i"}; # the notice will be
sent after mindays days (grace period)
+ my $maxdays = (
+ $overdue_rules->{ "delay" . ( $i + 1 ) }
+ ? $overdue_rules->{ "delay" . ( $i + 1 ) }
+ : ($MAX)
+ ); # issues being more
than maxdays late are managed somewhere else. (borrower probably suspended)
+
+ my $letter;
+ if ( $overdue_rules->{"letter$i"} ) {
+ $letter = C4::Letters::getletter( 'circulation',
$overdue_rules->{"letter$i"} );
+ unless ($letter) {
+ $verbose and warn "Message '$overdue_rules->{letter$i}'
content not found";
+ next PERIOD;
+ }
+ } else {
+ $verbose and warn "No letter$i code for branch '$branchcode'";
+ 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 :
+ # <date> <itemcount> <firstname> <lastname> <address1> <address2>
<address3> <city> <postcode>
+
+ my $borrower_sql = <<'END_SQL';
+SELECT COUNT(*), issues.borrowernumber, firstname, surname, address, address2,
city, zipcode, email, MIN(date_due) as longest_issue
+FROM issues,borrowers,categories
+WHERE issues.borrowernumber=borrowers.borrowernumber
+AND borrowers.categorycode=categories.categorycode
+END_SQL
+ my @borrower_parameters;
+ if ($branchcode) {
+ $borrower_sql .= ' AND issues.branchcode=? ';
+ push @borrower_parameters, $branchcode;
+ }
+ if ( $overdue_rules->{categorycode} ) {
+ $borrower_sql .= ' AND borrowers.categorycode=? ';
+ push @borrower_parameters, $overdue_rules->{categorycode};
+ }
+ $borrower_sql .= <<'END_SQL';
+AND categories.overduenoticerequired=1
+GROUP BY issues.borrowernumber
+HAVING TO_DAYS(NOW())-TO_DAYS(longest_issue) BETWEEN ? and ?
+END_SQL
+ push @borrower_parameters, $mindays, $maxdays;
+ my $sth = $dbh->prepare($borrower_sql);
+ $sth->execute(@borrower_parameters);
+ $verbose and warn $borrower_sql . "\n\n ($mindays,
$maxdays)\nreturns " . $sth->rows . " rows";
+ my $count = 0; # to keep track of how
many notices are printed
+ my $e_count = 0; # and e-mailed
+ my $date = C4::Dates->new()->output;
+
+ while ( my ( $itemcount, $borrowernumber, $firstname, $lastname,
$address1, $address2, $city, $postcode, $email ) = $sth->fetchrow ) {
+ if ( $overdue_rules->{"debarred$i"} ) {
+
+ #action taken is debarring
+ C4::Members::DebarMember( $borrowernumber );
+ $verbose and warn "debarring $borrowernumber $firstname
$lastname\n";
+ }
+
+ $sth2->execute( $borrowernumber, $mindays, $maxdays );
+ my $titles = "";
+ while ( my ( $title, $author, $barcode, $issuedate ) =
$sth2->fetchrow ) {
+ $titles .= join "\t", format_date($issuedate), ( $barcode
? $barcode : "" ), ( $title ? $title : "" ), ( $author ? $author : "" ) . "\n";
+ }
+ $sth2->finish;
+
+ $letter = parse_letter(
+ { letter => $letter,
+ borrowernumber => $borrowernumber,
+ branchcode => $branchcode,
+ substitute => {
+ date => $date,
+ bib => $branch_details->{'branchname'},
+ titles => $titles
+ }
+ }
+ );
+
+ 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;
+ }
+ $letter->{'content'} =~ s/\<[^<>]*?\>//g; # Now that we've
warned about them, remove them.
+ $letter->{'content'} =~ s/\<[^<>]*?\>//g; # 2nd pass for
the double nesting.
+
+ if ($nomail) {
+
+ # print the mail to stdout
+ print_letter(
+ { letter => $letter,
+ borrowernumber => $borrowernumber,
+ firstname => $firstname,
+ lastname => $lastname,
+ address1 => $address1,
+ address2 => $address2,
+ city => $city,
+ postcode => $postcode,
+ email => $email,
+ itemcount => $itemcount,
+ titles => $titles,
+ outputformat => $csvfilename ? 'csv' : '',
+ }
+ );
+ } else {
+ my $enqueue_parameters = {
+ letter => $letter,
+ borrowernumber => $borrowernumber,
+ message_transport_type => 'email',
+ from_address => $admin_email_address,
+ };
+
+ # If we don't have an email address for this patron, send
it to the admin to deal with.
+ if ( !$email ) {
+ $enqueue_parameters->{'to_address'} =
$admin_email_address;
+ }
+ C4::Letters::EnqueueLetter($enqueue_parameters);
+ }
+ }
+ $sth->finish;
+ }
+ }
+}
+
+if ($csvfilename) {
+ close $csv_fh;
+}
+
+=head1 INTERNAL METHODS
+
+=head2 get_branches_with_overdue_rules
+
+=cut
+
+sub get_branches_with_overdue_rules {
+ my $dbh = C4::Context->dbh;
+ my $rqoverduebranches = $dbh->prepare("SELECT DISTINCT branchcode FROM
overduerules WHERE delay1 IS NOT NULL");
+ $rqoverduebranches->execute;
+ my @branches = map { shift @$_ } @{ $rqoverduebranches->fetchall_arrayref
};
+ $rqoverduebranches->finish;
+ return @branches;
+}
+
+=head2 parse_letter
+
+
+
+=cut
+
+sub parse_letter {
+ my $params = shift;
+ foreach my $required (qw( letter borrowernumber )) {
+ return unless exists $params->{$required};
+ }
+
+ 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'} );
+
+ if ( $params->{'branchcode'} ) {
+ 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'} );
+ }
+
+ return $params->{'letter'};
+}
+
+=head2 print_letter
+
+required parameters:
+ letter
+ borrowernumber
+
+optional parameters:
+ outputformat
+
+=cut
+
+sub print_letter {
+ my $params = shift;
+
+ return unless ref $params eq 'HASH';
+
+ foreach my $required_parameter (qw( letter borrowernumber )) {
+ return unless defined $params->{$required_parameter};
+ }
+
+ if ( exists $params->{'outputformat'} && $params->{'outputformat'} eq
'csv' ) {
+ if ($csv->combine(
+ $params->{'firstname'}, $params->{'lastname'},
$params->{'address1'}, $params->{'address2'}, $params->{'postcode'},
+ $params->{'city'}, $params->{'email'},
$params->{'itemcount'}, $params->{'titles'}
+ )
+ ) {
+ print $csv_fh $csv->string, "\n";
+ } else {
+ $verbose and warn 'combine failed on argument: ' .
$csv->error_input;
+ }
+ } else {
+ print sprintf( 'To: "%s %s" <%s>', $params->{'firstname'},
$params->{'lastname'}, $params->{'email'} ), "\n";
+ print "Subject: $params->{'letter'}->{'title'}\n\n";
+ print "$params->{'letter'}->{'content'}\n";
+
+ # print Data::Dumper->Dump( [ $params->{'borrowernumber'},
$params->{'letter'} ], [qw( borrowernumber letter )] );
+ }
+
+}
+
diff --git a/t/lib/KohaTest/Members/DebarMember.pm
b/t/lib/KohaTest/Members/DebarMember.pm
new file mode 100644
index 0000000..9e27d66
--- /dev/null
+++ b/t/lib/KohaTest/Members/DebarMember.pm
@@ -0,0 +1,44 @@
+package KohaTest::Members::DebarMember;
+use base qw( KohaTest::Members );
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use C4::Members;
+sub testing_class { 'C4::Members' };
+
+
+sub simple_usage : Test( 6 ) {
+ my $self = shift;
+
+ ok( $self->{'memberid'}, 'we have a valid memberid to test with' );
+
+ my $details = C4::Members::GetMemberDetails( $self->{'memberid'} );
+ ok( exists $details->{'flags'}, 'member details has a
"flags" attribute');
+ isa_ok( $details->{'flags'}, 'HASH', 'the "flags"
attribute is a hashref');
+ ok( ! $details->{'flags'}->{'DBARRED'}, 'this member is NOT
debarred' );
+
+ # Now, let's debar this member and see what happens
+ my $success = C4::Members::DebarMember( $self->{'memberid'} );
+
+ ok( $success, 'we were able to debar the member' );
+
+ $details = C4::Members::GetMemberDetails( $self->{'memberid'} );
+ ok( $details->{'flags'}->{'DBARRED'}, 'this member is debarred
now' )
+ or diag( Data::Dumper->Dump( [ $details->{'flags'} ], [ 'flags' ] ) );
+}
+
+sub incorrect_usage : Test( 2 ) {
+ my $self = shift;
+
+ my $result = C4::Members::DebarMember();
+ ok( ! defined $result, 'DebarMember returns undef when passed no
parameters' );
+
+ $result = C4::Members::DebarMember( 'this is not a borrowernumber' );
+ ok( ! defined $result, 'DebarMember returns undef when not passed a
numeric argument' );
+
+}
+
+1;
--
1.5.5.GIT
_______________________________________________
Koha-patches mailing list
[email protected]
http://lists.koha.org/mailman/listinfo/koha-patches
