Commit 8ae66932 authored by Andrew Moore's avatar Andrew Moore Committed by Joshua Ferraro

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: default avatarJoshua Ferraro <jmf@liblime.com>
parent 6fce5692
......@@ -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'},
......
......@@ -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;
......
......@@ -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);
......
......@@ -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",
......
This diff is collapsed.
......@@ -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,
......
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;
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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment