From 8ae66932cd7108dd8d502edc45f92d26b5fb6c5f Mon Sep 17 00:00:00 2001 From: Andrew Moore Date: Wed, 9 Jul 2008 11:56:41 -0500 Subject: [PATCH] Bug 2274 [3/5]: 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 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. - now handles attachments with MIME::Lite C4::Overdues - added GetBranchcodesWithOverdueRules - added t/lib/KohaTest/Overdues/GerBranchcodesWithOverdueRules.pm to test that. circ/overdue.pl - replaced call to obsolete overduenotices-csv.pl with call to overdue_notices.pl KohaTest: - added three helper methods: random_phone, random_email, random_ip - these can be used to populate example records - you can now pass an optional lengh to random_string Signed-off-by: Joshua Ferraro --- C4/Letters.pm | 109 +++- C4/Members.pm | 41 +- C4/Overdues.pm | 21 + circ/overdue.pl | 2 +- misc/cronjobs/overdue_notices.pl | 573 ++++++++++++++++++ t/lib/KohaTest.pm | 69 ++- t/lib/KohaTest/Members/DebarMember.pm | 44 ++ .../GetBranchcodesWithOverdueRules.pm | 59 ++ 8 files changed, 892 insertions(+), 26 deletions(-) create mode 100755 misc/cronjobs/overdue_notices.pl create mode 100644 t/lib/KohaTest/Members/DebarMember.pm create mode 100644 t/lib/KohaTest/Overdues/GetBranchcodesWithOverdueRules.pm diff --git a/C4/Letters.pm b/C4/Letters.pm index d82e2b82ac..73608b0afe 100644 --- a/C4/Letters.pm +++ b/C4/Letters.pm @@ -18,10 +18,8 @@ package C4::Letters; # Suite 330, Boston, MA 02111-1307 USA use strict; +use MIME::Lite; use Mail::Sendmail; -# use C4::Date; -# use Date::Manip; -# use C4::Suggestions; use C4::Members; use C4::Log; use C4::SMS; @@ -528,22 +526,36 @@ sub EnqueueLetter { return unless exists $params->{'letter'}; return unless exists $params->{'borrowernumber'}; return unless exists $params->{'message_transport_type'}; - - my $dbh = C4::Context->dbh(); + + # If we have any attachments we should encode then into the body. + if ( $params->{'attachments'} ) { + $params->{'letter'} = _add_attachments( + { letter => $params->{'letter'}, + attachments => $params->{'attachments'}, + message => MIME::Lite->new( Type => 'multipart/mixed' ), + } + ); + } + + 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, content_type ) 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 $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 + $params->{'to_address'}, # to_address + $params->{'from_address'}, # from_address + $params->{'letter'}->{'content-type'}, # content_type + ); return $result; } @@ -569,7 +581,10 @@ sub SendQueuedMessages { my $unsent_messages = _get_unsent_messages(); MESSAGE: foreach my $message ( @$unsent_messages ) { # warn Data::Dumper->Dump( [ $message ], [ 'message' ] ); - warn "sending $message->{'message_transport_type'} message to patron $message->{'borrowernumber'}" if $params->{'verbose'}; + warn sprintf( 'sending %s message to patron: %s', + $message->{'message_transport_type'}, + $message->{'borrowernumber'} || 'Admin' ) + if $params->{'verbose'}; # This is just begging for subclassing next MESSAGE if ( lc( $message->{'message_transport_type'} eq 'rss' ) ); if ( lc( $message->{'message_transport_type'} ) eq 'email' ) { @@ -652,12 +667,57 @@ ENDSQL return $messages; } +=head2 _add_attachements + +named parameters: +letter - the standard letter hashref +attachments - listref of attachments. each attachment is a hashref of: + type - the mime type, like 'text/plain' + content - the actual attachment + filename - the name of the attachment. +message - a MIME::Lite object to attach these to. + +returns your letter object, with the content updated. + +=cut + +sub _add_attachments { + my $params = shift; + + return unless 'HASH' eq ref $params; + foreach my $required_parameter (qw( letter attachments message )) { + return unless exists $params->{$required_parameter}; + } + return $params->{'letter'} unless @{ $params->{'attachments'} }; + + # First, we have to put the body in as the first attachment + $params->{'message'}->attach( + Type => 'TEXT', + Data => $params->{'letter'}->{'content'}, + ); + + foreach my $attachment ( @{ $params->{'attachments'} } ) { + $params->{'message'}->attach( + Type => $attachment->{'type'}, + Data => $attachment->{'content'}, + Filename => $attachment->{'filename'}, + ); + } + # we're forcing list context here to get the header, not the count back from grep. + ( $params->{'letter'}->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) ); + $params->{'letter'}->{'content-type'} =~ s/^Content-Type:\s+//; + $params->{'letter'}->{'content'} = $params->{'message'}->body_as_string; + + return $params->{'letter'}; + +} + sub _get_unsent_messages { my $params = shift; my $dbh = C4::Context->dbh(); my $statement = << 'ENDSQL'; -SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued +SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, from_address, to_address, content_type FROM message_queue WHERE status = 'pending' ENDSQL @@ -688,13 +748,18 @@ sub _send_message_by_email { my $message = shift; 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 %sendmail_params = ( + To => $message->{'to_address'} || $member->{'email'}, + From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'), + Subject => $message->{'subject'}, + Message => $message->{'content'}, + ); + if ($message->{'content_type'}) { + $sendmail_params{'content-type'} = $message->{'content_type'}; + } + my $success = sendmail( %sendmail_params ); + 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 7c7c48c32c..8f27e8e87b 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 ); + +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/C4/Overdues.pm b/C4/Overdues.pm index 6f1cc848c9..35ae49d382 100644 --- a/C4/Overdues.pm +++ b/C4/Overdues.pm @@ -958,6 +958,27 @@ sub GetOverdueDelays { return(@delays); } +=head2 GetBranchcodesWithOverdueRules + +=over 4 + +my @branchcodes = C4::Overdues::GetBranchcodesWithOverdueRules() + +returns a list of branch codes for branches with overdue rules defined. + +=back + +=cut + +sub GetBranchcodesWithOverdueRules { + 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; +} + =item CheckAccountLineLevelInfo ($exist) = &CheckAccountLineLevelInfo($borrowernumber,$itemnumber,$accounttype,notify_level); diff --git a/circ/overdue.pl b/circ/overdue.pl index 86e9501d49..6ccfd3cd20 100755 --- a/circ/overdue.pl +++ b/circ/overdue.pl @@ -56,7 +56,7 @@ my $dbh = C4::Context->dbh; # download the complete CSV if ($op eq 'csv') { warn "BRANCH : $branchfilter"; - my $csv = `../misc/cronjobs/overduenotices-csv.pl -c -n -b $branchfilter`; + my $csv = `../misc/cronjobs/overdue_notices.pl -csv -n -b $branchfilter`; print $input->header(-type => 'application/vnd.sun.xml.calc', -encoding => 'utf-8', -attachment=>"overdues.csv", diff --git a/misc/cronjobs/overdue_notices.pl b/misc/cronjobs/overdue_notices.pl new file mode 100755 index 0000000000..1f870385aa --- /dev/null +++ b/misc/cronjobs/overdue_notices.pl @@ -0,0 +1,573 @@ +#!/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 [ -n ] [ -library ] [ -max ] [ -csv [ ] ] [ -itemscontent ] + + Options: + -help brief help message + -man full documentation + -n No email will be sent + -max maximum days overdue to deal with + -library only deal with overdues from this library + -csv populate CSV file + -itemscontent item information in templates + +=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. 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 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. + +=item B<-library> + +select overdues for one specific library. Use the value in the +branches.branchcode table. + +=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<-itemscontent> + +comma separated list of fields that get substituted into templates in +places of the EEitems.contentEE placeholder. This +defaults to issuedate,title,barcode,author + +Other possible values come from fields in the biblios, items, and +issues tables. + +=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 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 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 +EEthisEE. Those variables will be replaced with values +specific to the overdue items or relevant patron. Available variables +are: + +=over + +=item EEbibEE + +the name of the library + +=item EEitems.contentEE + +one line for each item, each line containing a tab separated list of +title, author, barcode, issuedate + +=item EEborrowers.*EE + +any field from the borrowers table + +=item EEbranches.*EE + +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 - In this most basic usage, with no command line +arguments, all libraries are procesed 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 - sends no email and +populates F with information about all overdue +items. + +C - prepare notices of +overdues in the last 2 weeks for the MAIN library. + +=head1 SEE ALSO + +The F program allows you to send +messages to patrons in advance of thier 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 $help = 0; +my $man = 0; +my $verbose = 0; +my $nomail = 0; +my $MAX = 90; +my $mybranch; +my $csvfilename; +my $itemscontent = join( ',', qw( issuedate title barcode author ) ); + +GetOptions( + 'help|?' => \$help, + 'man' => \$man, + 'v' => \$verbose, + 'n' => \$nomail, + 'max=s' => \$MAX, + 'library=s' => \$mybranch, + 'csv:s' => \$csvfilename, # this optional argument gets '' if not supplied. + 'itemscontent=s' => \$itemscontent, +) 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); +} + +my @branches = C4::Overdues::GetBranchcodesWithOverdueRules(); +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 = (''); + } +} + +# these are the fields that will be substituted into <> +my @item_content_fields = split( /,/, $itemscontent ); + +my $dbh = C4::Context->dbh(); + +our $csv; # the Text::CSV_XS object +our $csv_fh; # the filehandle to the CSV file. +if ( defined $csvfilename ) { + $csv = Text::CSV_XS->new( { binary => 1 } ); + 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 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'); + my @output_chunks; # may be sent to mail or stdout or csv file. + + $verbose and warn sprintf "branchcode : '%s' using %s\n", $branchcode, $admin_email_address; + + my $sth2 = $dbh->prepare( <<'END_SQL' ); +SELECT biblio.*, items.*, issues.* + 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) + + if ( !$overdue_rules->{"letter$i"} ) { + $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 : + # + + 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"; + + while ( my ( $itemcount, $borrowernumber, $firstname, $lastname, $address1, $address2, $city, $postcode, $email ) = $sth->fetchrow ) { + warn "borrower $firstname, $lastname ($borrowernumber) has $itemcount items overdue." if $verbose; + + my $letter = C4::Letters::getletter( 'circulation', $overdue_rules->{"letter$i"} ); + unless ($letter) { + $verbose and warn "Message '$overdue_rules->{letter$i}' content not found"; + + # might as well skip while PERIOD, no other borrowers are going to work. + next PERIOD; + } + + 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 $item_info = $sth2->fetchrow_hashref() ) { + my @item_info = map { $_ =~ /date$/ ? format_date( $item_info->{$_} ) : $item_info->{$_} || '' } @item_content_fields; + $titles .= join "\t", @item_info; + } + $sth2->finish; + + $letter = parse_letter( + { letter => $letter, + borrowernumber => $borrowernumber, + branchcode => $branchcode, + substitute => { + bib => $branch_details->{'branchname'}, + 'items.content' => $titles + } + } + ); + + my @misses = grep { /./ } map { /^([^>]*)[>]+/; ( $1 || '' ); } split /\{'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) { + + push @output_chunks, + prepare_letter_for_printing( + { letter => $letter, + borrowernumber => $borrowernumber, + firstname => $firstname, + lastname => $lastname, + address1 => $address1, + address2 => $address2, + city => $city, + postcode => $postcode, + email => $email, + itemcount => $itemcount, + titles => $titles, + outputformat => defined $csvfilename ? 'csv' : '', + } + ); + } else { + if ($email) { + C4::Letters::EnqueueLetter( + { letter => $letter, + borrowernumber => $borrowernumber, + message_transport_type => 'email', + from_address => $admin_email_address, + } + ); + } else { + + # If we don't have an email address for this patron, send it to the admin to deal with. + push @output_chunks, + prepare_letter_for_printing( + { letter => $letter, + borrowernumber => $borrowernumber, + firstname => $firstname, + lastname => $lastname, + address1 => $address1, + address2 => $address2, + city => $city, + postcode => $postcode, + email => $email, + itemcount => $itemcount, + titles => $titles, + outputformat => defined $csvfilename ? 'csv' : '', + } + ); + } + } + + } + $sth->finish; + } + } + + if (@output_chunks) { + if ($nomail) { + if ( defined $csvfilename ) { + print $csv_fh @output_chunks; + } else { + 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, + } + ); + } + } + +} +if ($csvfilename) { + + # note that we're not testing on $csv_fh to prevent closing + # STDOUT. + close $csv_fh; +} + +=head1 INTERNAL METHODS + +These methods are internal to the operation of overdue_notices.pl. + +=head2 parse_letter + +parses the letter template, replacing the placeholders with data +specific to this patron, biblio, or item + +named parameters: + letter - required hashref + borrowernumber - required integer + substitute - optional hashref of other key/value pairs that should + be substituted in the letter content + +returns the C hashref, with the content updated to reflect the +substituted keys and values. + + +=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 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; + 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->{'items.content'} + ) + ) { + return $csv->string, "\n"; + } else { + $verbose and warn 'combine failed on argument: ' . $csv->error_input; + } + } else { + $return .= "$params->{'letter'}->{'content'}\n"; + + # $return .= Data::Dumper->Dump( [ $params->{'borrowernumber'}, $params->{'letter'} ], [qw( borrowernumber letter )] ); + } + return $return; +} + diff --git a/t/lib/KohaTest.pm b/t/lib/KohaTest.pm index 31183eee44..69d4b6be84 100644 --- a/t/lib/KohaTest.pm +++ b/t/lib/KohaTest.pm @@ -285,6 +285,32 @@ sub startup_22_add_bookfund : Test(startup => 2) { return; } +=head2 startup_24_add_branch + +=cut + +sub startup_24_add_branch : Test(startup => 1) { + my $self = shift; + + my $branch_info = { + add => 1, + branchcode => $self->random_string(3), + branchname => $self->random_string(), + branchaddress1 => $self->random_string(), + branchaddress2 => $self->random_string(), + branchaddress3 => $self->random_string(), + branchphone => $self->random_phone(), + branchfax => $self->random_phone(), + brancemail => $self->random_email(), + branchip => $self->random_ip(), + branchprinter => $self->random_string(), + }; + C4::Branch::ModBranch($branch_info); + $self->{'branchcode'} = $branch_info->{'branchcode'}; + ok( $self->{'branchcode'}, "created branch: $self->{'branchcode'}" ); + +} + =head2 startup_24_add_member Add a patron/member for the tests to use @@ -377,7 +403,7 @@ like arbitrary. sub random_string { my $self = shift; - my $wordsize = 6; # how many letters in your string? + my $wordsize = shift || 6; # how many letters in your string? # leave out these characters: "oOlL10". They're too confusing. my @alphabet = ( 'a'..'k','m','n','p'..'z', 'A'..'K','M','N','P'..'Z', 2..9 ); @@ -390,6 +416,47 @@ sub random_string { } +=head3 random_phone + +generates a random phone number. Currently, it's not actually random. It's an unusable US phone number + +=cut + +sub random_phone { + my $self = shift; + + return '212-555-5555'; + +} + +=head3 random_email + +generates a random email address. They're all in the unusable +'example.com' domain that is designed for this purpose. + +=cut + +sub random_email { + my $self = shift; + + return $self->random_string() . '@example.com'; + +} + +=head3 random_ip + +returns an IP address suitable for testing purposes. + +=cut + +sub random_ip { + my $self = shift; + + return '127.0.0.2'; + +} + + =head3 add_biblios $self->add_biblios( count => 10, diff --git a/t/lib/KohaTest/Members/DebarMember.pm b/t/lib/KohaTest/Members/DebarMember.pm new file mode 100644 index 0000000000..9e27d6647a --- /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; diff --git a/t/lib/KohaTest/Overdues/GetBranchcodesWithOverdueRules.pm b/t/lib/KohaTest/Overdues/GetBranchcodesWithOverdueRules.pm new file mode 100644 index 0000000000..4ff8db4916 --- /dev/null +++ b/t/lib/KohaTest/Overdues/GetBranchcodesWithOverdueRules.pm @@ -0,0 +1,59 @@ +package KohaTest::Overdues::GetBranchcodesWithOverdueRules; +use base qw( KohaTest::Overdues ); + +use strict; +use warnings; + +use C4::Overdues; +use Test::More; + +sub my_branch_has_no_rules : Tests( 2 ) { + my $self = shift; + + ok( $self->{'branchcode'}, "we're looking for branch $self->{'branchcode'}" ); + + my @branches = C4::Overdues::GetBranchcodesWithOverdueRules; + my @found_branches = grep { $_ eq $self->{'branchcode'} } @branches; + is( scalar @found_branches, 0, '...and it is not in the list of branches') + +} + +sub my_branch_has_overdue_rules : Tests( 3 ) { + my $self = shift; + + ok( $self->{'branchcode'}, "we're looking for branch $self->{'branchcode'}" ); + + my $dbh = C4::Context->dbh(); + my $sql = <<'END_SQL'; +INSERT INTO overduerules +(branchcode, categorycode, +delay1, letter1, debarred1, +delay2, letter2, debarred2, +delay3, letter3, debarred3) +VALUES +( ?, ?, +?, ?, ?, +?, ?, ?, +?, ?, ?) +END_SQL + + my $sth = $dbh->prepare($sql); + my $success = $sth->execute( $self->{'branchcode'}, $self->random_string(2), + 1, $self->random_string(), 0, + 5, $self->random_string(), 0, + 9, $self->random_string(), 1, ); + ok( $success, '...and we have successfully given it an overdue rule' ); + + my @branches = C4::Overdues::GetBranchcodesWithOverdueRules; + my @found_branches = grep { $_ eq $self->{'branchcode'} } @branches; + is( scalar @found_branches, 1, '...and it IS in the list of branches.') + +} + +1; + + + + + + -- 2.39.5