From 5b362072db68d023d6c8649b81b9674981dbf9a3 Mon Sep 17 00:00:00 2001 From: Andrew Moore Date: Fri, 27 Jun 2008 11:40:59 -0500 Subject: [PATCH] Bug 2274 [2/2]: consolidating overdue notice cronjobs into one 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. --- C4/Letters.pm | 30 ++- C4/Members.pm | 44 ++++- misc/cronjobs/overdue_notices.pl | 414 +++++++++++++++++++++++++++++++++ t/lib/KohaTest/Members/DebarMember.pm | 44 ++++ 4 files changed, 517 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..474b2d7 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,37 @@ 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 $params = shift; + + return unless ref $params eq 'HASH'; + + foreach my $required_parameter ( qw( borrowernumber ) ) { + return unless defined $params->{ $required_parameter }; + } + + return ModMember( borrowernumber => $params->{'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..347d447 --- /dev/null +++ b/misc/cronjobs/overdue_notices.pl @@ -0,0 +1,414 @@ +#!/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 maximum days overdue to deal with + -branch only deal with overdues from this branch. + -csv 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<-c> + +Confirms that you have read the documentation and want the script to actually do something + +=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 $confirm = 0; # set to 1 to avoid the warning +my $nomail = 0; +my $MAX = 365; +my $mybranch; +my $csvfilename; + +GetOptions( + 'help|?' => \$help, + 'man' => \$man, + 'c' => \$confirm, + 'n' => \$nomail, + 'max=s' => \$MAX, + 'branch=s' => \$mybranch, + 'csv=s' => \$csvfilename, +) or pod2usage(2); +pod2usage(1) if $help; +pod2usage( -verbose => 2 ) if $man; + +unless ($confirm) { + print <<'END_WARNING'; +WARNING: You MUST edit this script for your library BEFORE you run it for the first time! +See the comments in the script for directions on changing the script. + +Do you wish to continue? (y/[n]) +END_WARNING + + chomp( $_ = ); + unless (/^\s*[yo]/i) { + print "Exiting.\n"; + exit; + } +} + +my @branches = get_branches_with_overdue_rules(); +my $branchcount = scalar(@branches); +if ($branchcount) { + my $branch_word = scalar @branches > 1 ? 'branches' : 'branch'; + print "Found $branchcount $branch_word with first message enabled: " . join( ', ', map { "'$_'" } @branches ), "\n"; +} else { + die 'No branches with active overduerules'; +} + +if ($mybranch) { + warn "Branch $mybranch selected\n"; + if ( scalar grep { $mybranch eq $_ } @branches ) { + @branches = ($mybranch); + } else { + warn "No active overduerules for branch '$mybranch'\n"; + ( scalar grep { '' eq $_ } @branches ) + or die "No active overduerules for DEFAULT either!"; + 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 { + 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'); + + 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 ) { + + $debug 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) { + warn "Message '$overdue_rules->{letter$i}' content not found"; + next PERIOD; + } + } else { + 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 : + # + + 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); + $debug 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 => $borrowernumber } ); + 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 /\{'content'}; + if (@misses) { + 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 { + 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..c36ca0d --- /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( { borrowernumber => $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( $self->{'memberid'} ); + ok( ! defined $result, 'DebarMember returns undef when not passed a hashref' ); + +} + +1; -- 1.5.5.GIT