Commit 2cae4efa authored by Andrew Moore's avatar Andrew Moore Committed by Joshua Ferraro

Bug 2176 (3/5): adding methods to manage message_queue, new advance_notices.pl, new C4::SMS module

I've added methods to to C4::Letters to manage the database table
message_queue. This will let us keep track of messages sent
via email, sms, and rss to patrons. That way, we can show the history,
deal with failures, and reconstruct an RSS feed when needed.

misc/cronjobs/overduenotics.pl has been added. It prepares advance notices
and item due notices and stages messages to be sent in the message_queue
table.

C4::Overdues::Getoverdues now takes two optional arguments to tell it how
old of overdues to fetch.

Also, a C4::Circualtion::getUpcomingDueIssues method was added that
advance_notices.pl uses.

misc/cronjobs/process_message_queue.pl has been added. It sends the email
or SMS messages out of the message queue.

The C4::SMS module didn't work at all, and it has been rebuilt to use
an external perl module from CPAN, SMS::Send.
Signed-off-by: default avatarJoshua Ferraro <jmf@liblime.com>
parent 401c84cc
......@@ -1782,6 +1782,40 @@ sub GetBiblioIssues {
return \@issues;
}
=head2 GetUpcomingDueIssues
=over 4
my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } );
=back
=cut
sub GetUpcomingDueIssues {
my $params = shift;
$params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'};
my $dbh = C4::Context->dbh;
my $statement = <<END_SQL;
SELECT issues.*, items.itype as itemtype, items.homebranch, TO_DAYS( date_due )-TO_DAYS( NOW() ) as days_until_due
FROM issues
LEFT JOIN items USING (itemnumber)
WhERE returndate is NULL
AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ?
END_SQL
my @bind_parameters = ( $params->{'days_in_advance'} );
my $sth = $dbh->prepare( $statement );
$sth->execute( @bind_parameters );
my $upcoming_dues = $sth->fetchall_arrayref({});
$sth->finish;
return $upcoming_dues;
}
=head2 CanBookBeRenewed
($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber);
......
......@@ -206,6 +206,7 @@ sub getalert {
In the table alert, a "id" is stored in the externalid field. This "id" is related to another table, depending on the type of the alert.
When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.
When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
=cut
sub findrelatedto {
......@@ -504,5 +505,156 @@ sub parseletter {
}
}
=head2 EnqueueLetter
=over 4
my $success = EnqueueLetter( { letter => $letter, borrowernumber => '12', message_transport_type => 'email' } )
places a letter in the message_queue database table, which will
eventually get processed (sent) by the process_message_queue.pl
cronjob when it calls SendQueuedMessages.
return true on success
=back
=cut
sub EnqueueLetter {
my $params = shift;
return unless exists $params->{'letter'};
return unless exists $params->{'borrowernumber'};
return unless exists $params->{'message_transport_type'};
my $dbh = C4::Context->dbh();
my $statement = << 'ENDSQL';
INSERT INTO message_queue
( borrowernumber, subject, content, message_transport_type, status, time_queued )
VALUES
( ?, ?, ?, ?, ?, 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
);
return $result;
}
=head2 SendQueuedMessages
=over 4
SendQueuedMessages()
sends all of the 'pending' items in the message queue.
my $sent = SendQueuedMessages( { verbose => 1 } )
returns number of messages sent.
=back
=cut
sub SendQueuedMessages {
my $params = shift;
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'};
# This is just begging for subclassing
next MESSAGE if ( lc( $message->{'message_transport_type'} eq 'rss' ) );
if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
_send_message_by_email( $message );
}
if ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
_send_message_by_sms( $message );
}
}
return scalar( @$unsent_messages );
}
sub _get_unsent_messages {
my $dbh = C4::Context->dbh();
my $statement = << 'ENDSQL';
SELECT message_id, borrowernumber, subject, content, type, status, time_queued
FROM message_queue
WHERE status = 'pending'
ENDSQL
my $sth = $dbh->prepare( $statement );
my $result = $sth->execute();
my $unsent_messages = $sth->fetchall_arrayref({});
return $unsent_messages;
}
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'},
);
if ( $success ) {
# warn "OK. Log says:\n", $Mail::Sendmail::log;
_set_message_status( { message_id => $message->{'message_id'},
status => 'sent' } );
return $success;
} else {
# warn $Mail::Sendmail::error;
_set_message_status( { message_id => $message->{'message_id'},
status => 'failed' } );
return;
}
}
sub _send_message_by_sms {
my $message = shift;
my $member = C4::Members::GetMember( $message->{'borrowernumber'} );
return unless $member->{'smsalertnumber'};
my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'},
message => $message->{'content'},
} );
if ( $success ) {
_set_message_status( { message_id => $message->{'message_id'},
status => 'sent' } );
return $success;
} else {
_set_message_status( { message_id => $message->{'message_id'},
status => 'failed' } );
return;
}
}
sub _set_message_status {
my $params = shift;
foreach my $required_parameter ( qw( message_id status ) ) {
return unless exists $params->{ $required_parameter };
}
my $dbh = C4::Context->dbh();
my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
my $sth = $dbh->prepare( $statement );
my $result = $sth->execute( $params->{'status'},
$params->{'message_id'} );
return $result;
}
1;
__END__
......@@ -105,7 +105,7 @@ overdue items. It is primarily used by the 'misc/fines2.pl' script.
=item Getoverdues
($overdues) = &Getoverdues();
$overdues = Getoverdues( { minimumdays => 1, maximumdays => 30 } );
Returns the list of all overdue books, with their itemtype.
......@@ -117,24 +117,43 @@ Koha database.
#'
sub Getoverdues {
my $params = shift;
my $dbh = C4::Context->dbh;
my $sth = (C4::Context->preference('item-level_itypes')) ?
$dbh->prepare(
"SELECT issues.*,items.itype as itemtype, items.homebranch FROM issues
LEFT JOIN items USING (itemnumber)
WHERE date_due < now()
ORDER BY borrowernumber " )
:
$dbh->prepare(
"SELECT issues.*,biblioitems.itemtype,items.itype, items.homebranch FROM issues
my $statement;
if ( C4::Context->preference('item-level_itypes') ) {
$statement = "
SELECT issues.*,items.itype as itemtype, items.homebranch FROM issues
LEFT JOIN items USING (itemnumber)
WHERE date_due < now()
";
} else {
$statement = "
SELECT issues.*,biblioitems.itemtype,items.itype, items.homebranch FROM issues
LEFT JOIN items USING (itemnumber)
LEFT JOIN biblioitems USING (biblioitemnumber)
WHERE date_due < now()
ORDER BY borrowernumber " );
$sth->execute;
";
}
my @bind_parameters;
if ( exists $params->{'minimumdays'} and exists $params->{'maximumdays'} ) {
$statement .= ' AND TO_DAYS( NOW() )-TO_DAYS( date_due ) BETWEEN ? and ? ';
push @bind_parameters, $params->{'minimumdays'}, $params->{'maximumdays'};
} elsif ( exists $params->{'minimumdays'} ) {
$statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) > ? ';
push @bind_parameters, $params->{'minimumdays'};
} elsif ( exists $params->{'maximumdays'} ) {
$statement .= ' AND ( TO_DAYS( NOW() )-TO_DAYS( date_due ) ) < ? ';
push @bind_parameters, $params->{'maximumdays'};
}
$statement .= 'ORDER BY borrowernumber';
my $sth = $dbh->prepare( $statement );
$sth->execute( @bind_parameters );
return $sth->fetchall_arrayref({});
}
=head2 checkoverdues
( $count, $overdueitems )=checkoverdues( $borrowernumber, $dbh );
......
package C4::SMS;
#Written by tgarip@neu.edu.tr for SMS message sending and other SMS related services
# 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
=head1 NAME
C4::SMS - send SMS messages
=head1 SYNOPSIS
my $success = C4::SMS->send_sms( message => 'This is my text message',
destination => '212-555-1212' );
=head1 DESCRIPTION
=cut
use strict;
use warnings;
use LWP::UserAgent;
use C4::Context;
use SMS::Send;
use vars qw($VERSION @ISA @EXPORT);
use vars qw( $VERSION );
BEGIN {
require Exporter;
@ISA = qw(Exporter);
$VERSION = 0.03;
@EXPORT = qw(
&get_sms_auth
&send_sms
&read_sms
&error_codes
&parse_phone
&parse_message
&write_sms
&mod_sms
&kill_sms
);
}
our $user = C4::Context->config('smsuser');
our $pwd = C4::Context->config('smspass');
our $uri = "https://spgw.kktcell.com/smshttpproxy/SmsHttpProxyServlet";
=head1 METHODS
=cut
sub get_sms_auth {
my $ua = LWP::UserAgent->new;
my $commands;
my $res=$ua->post($uri,[cmd=>'REGISTER',pUser=>$user,pPwd=>$pwd]);
if ($res->is_success){
$commands=parse_content($res->content);
}
return($commands,$ua);
}
# The previous implmentation used username and password.
# our $user = C4::Context->config('smsuser');
# our $pwd = C4::Context->config('smspass');
sub send_sms {
my $ua = shift or return undef;
my $phone=shift;
my $message=shift;
my $session=shift;
my $res=$ua->post($uri,[cmd=>'SENDSMS',pUser=>$user,pPwd=>$pwd,pSessionId=>$session,pService_Code=>4130,pMsisdn=>$phone,
pContent=>$message]);
return parse_content($res->content);
}
=head2 send_sms
sub read_sms {
my $ua = shift or return undef;
my $session=shift;
my $res=$ua->post($uri,[cmd=>'GETSMS',pUser=>$user,pPwd=>$pwd,pSessionId=>$session,pService_Code=>4130]);
return parse_content($res->content);
}
=over4
sub parse_content {
my $content = shift;
my %commands;
my @attributes = split /&/,$content;
foreach my $params(@attributes){
my (@param) = split /=/,$params;
$commands{$param[0]}=$param[1];
}
return(\%commands);
}
=back
sub error_codes {
my $error = shift;
($error== -1) and return "Closed session - Retry";
($error== -2) and return "Invalid session - Retry";
($error== -3) and return "Invalid password";
($error== -103) and return "Invalid user";
($error== -422) and return "Invalid Parameter";
($error== -426) and return "User does not have permission to send message";
($error== -700) and return "No permission";
($error== -801) and return "Msdisn count differs - warn administartor";
($error== -803) and return "Content count differs from XSER count";
($error== -1101) and return "Insufficient Credit - Do not retry";
($error== -1104) and return "Invalid Phone number";
($error==-10001) and return "Internal system error - Notify provider";
($error== -9005) and return "No messages to read";
if ($error){
warn "Unknown SMS error '$error' occured";
return "Unknown SMS error '$error' occured";
}
}
=cut
sub parse_phone {
## checks acceptable phone numbers
## FIXME: accept Telsim when available (542 numbers)
my $phone=shift;
$phone=~s/^0//g;
$phone=~s/ //g;
my $length=length($phone);
if ($length==10 || $length==12){
my $code=substr($phone,0,3) if $length==10;
$code=substr($phone,0,5) if $length==12;
if ($code=~/533/){
return $phone;
}
sub send_sms {
my $self = shift;
my $params= shift;
foreach my $required_parameter ( qw( message destination ) ) {
# Should I warn in some way?
return unless defined $params->{ $required_parameter };
}
return 0;
}
sub parse_message {
my $message = shift;
$message =~ s/ / /g;
my @parsed = split / /, $message;
return (@parsed);
}
# This allows the user to override the driver. See SMS::Send::Test
my $driver = exists $params->{'driver'} ? $params->{'driver'} : $self->driver();
return unless $driver;
sub write_sms {
my ($userid,$message,$phone)=@_;
my $dbh=C4::Context->dbh;
my $sth=$dbh->prepare("INSERT into sms_messages(userid,message,user_phone,date_received) values(?,?,?,now())");
$sth->execute($userid,$message,$phone);
$sth->finish;
return $dbh->{'mysql_insertid'}; # FIXME: mysql specific
}
# warn "using driver: $driver to send message to $params->{'destination'}";
# Create a sender
my $sender = SMS::Send->new( $driver,
_login => C4::Context->preference('SMSSendUsername'),
_password => C4::Context->preference('SMSSendPassword'),
);
sub mod_sms {
my ($smsid,$message)=@_;
my $dbh=C4::Context->dbh;
my $sth=$dbh->prepare("UPDATE sms_messages set reply=?, date_replied=now() where smsid=?");
$sth->execute($message,$smsid);
# Send a message
my $sent = $sender->send_sms( to => $params->{'destination'},
text => $params->{'message'},
);
# warn 'failure' unless $sent;
return $sent;
}
sub kill_sms {
#end a session
my $ua = shift or return undef;
my $session = shift;
my $res = $ua->post($uri,[cmd=>'KILLSESSION',pSessionId=>$session]);
=head2 driver
=over 4
=back
=cut
sub driver {
my $self = shift;
# return 'US::SprintPCS';
return C4::Context->preference('SMSSendDriver');
}
1;
__END__
#!/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
=head1 NAME
advance_notices.pl - cron script to put item due reminders into message queue
=head1 SYNOPSIS
./advance_notices.pl -c
or, in crontab:
0 1 * * * advance_notices.pl -c
=head1 DESCRIPTION
This script prepares pre-due and item due reminders to be sent to
patrons. It queues them in the message queue, which is processed by
the process_message_queue.pl cronjob. The type and timing of the
messages can be configured by the patrons in their "My Alerts" tab in
the OPAC.
=cut
use strict;
use warnings;
use Getopt::Long;
use Data::Dumper;
BEGIN {
# find Koha's Perl modules
# test carefully before changing this
use FindBin;
eval { require "$FindBin::Bin/../kohalib.pl" };
}
use C4::Biblio;
use C4::Context;
use C4::Letters;
use C4::Members;
use C4::Members::Messaging;
use C4::Overdues;
# These are defaults for command line options.
my $confirm; # -c: Confirm that the user has read and configured this script.
# my $confirm = 1; # -c: Confirm that the user has read and configured this script.
my $nomail; # -n: No mail. Will not send any emails.
my $mindays = 0; # -m: Maximum number of days in advance to send notices
my $maxdays = 30; # -e: the End of the time period
my $fromaddress = C4::Context->preference('KohaAdminEmailAddress'); # -f: From address for the emails
my $verbose = 0; # -v: verbose
GetOptions( 'c' => \$confirm,
'n' => \$nomail,
'm:i' => \$maxdays,
'f:s' => \$fromaddress,
'v' => \$verbose,
);
my $usage = << 'ENDUSAGE';
This script prepares pre-due and item due reminders to be sent to
patrons. It queues them in the message queue, which is processed by
the process_message_queue.pl cronjob.
See the comments in the script for directions on changing the script.
This script has the following parameters :
-c Confirm and remove this help & warning
-m maximum number of days in advance to send advance notices.
-f from address for the emails. Defaults to KohaAdminEmailAddress system preference
-n send No mail. Instead, all mail messages are printed on screen. Usefull for testing purposes.
-v verbose
ENDUSAGE
# Since advance notice options are not visible in the web-interface
# unless EnhancedMessagingPreferences is on, let the user know that
# this script probably isn't going to do much
if ( ! C4::Context->preference('EnhancedMessagingPreferences') ) {
warn <<'END_WARN';
The "EnhancedMessagingPreferences" syspref is off.
Therefore, it is unlikely that this script will actually produce any messages to be sent.
To change this, edit the "EnhancedMessagingPreferences" syspref.
END_WARN
}
unless ($confirm) {
print $usage;
print "Do you wish to continue? (y/n)";
chomp($_ = <STDIN>);
exit unless (/^y/i);
}
warn 'getting upcoming due issues' if $verbose;
my $upcoming_dues = C4::Circulation::GetUpcomingDueIssues( { days_in_advance => $maxdays } );
warn 'found ' . scalar( @$upcoming_dues ) . ' issues' if $verbose;
# hash of borrowernumber to number of items upcoming
# for patrons wishing digests only.
my $upcoming_digest;
my $due_digest;
UPCOMINGITEM: foreach my $upcoming ( @$upcoming_dues ) {
warn 'examining ' . $upcoming->{'itemnumber'} . ' upcoming due items' if $verbose;
# warn( Data::Dumper->Dump( [ $upcoming ], [ 'overdue' ] ) );
my $letter;
my $borrower_preferences;
if ( 0 == $upcoming->{'days_until_due'} ) {
# This item is due today. Send an 'item due' message.
$borrower_preferences = C4::Members::Messaging::GetMessagingPreferences( { borrowernumber => $upcoming->{'borrowernumber'},
message_name => 'item due' } );
# warn( Data::Dumper->Dump( [ $borrower_preferences ], [ 'borrower_preferences' ] ) );
next DUEITEM unless $borrower_preferences;
if ( $borrower_preferences->{'wants_digest'} ) {
# cache this one to process after we've run through all of the items.
$due_digest->{$upcoming->{'borrowernumber'}}++;
} else {
my $biblio = C4::Biblio::GetBiblioFromItemNumber( $upcoming->{'itemnumber'} );
my $letter_type = 'DUE';
$letter = C4::Letters::getletter( 'circulation', $letter_type );
die "no letter of type '$letter_type' found. Please see sample_notices.sql" unless $letter;
$letter = parse_letter( { letter => $letter,
borrowernumber => $upcoming->{'borrowernumber'},
branchchode => $upcoming->{'branchcode'},
biblionumber => $biblio->{'biblionumber'} } );
}
} else {
$borrower_preferences = C4::Members::Messaging::GetMessagingPreferences( { borrowernumber => $upcoming->{'borrowernumber'},
message_name => 'advance notice' } );
# warn( Data::Dumper->Dump( [ $borrower_preferences ], [ 'borrower_preferences' ] ) );
next UPCOMINGITEM unless $borrower_preferences && exists $borrower_preferences->{'days_in_advance'};
next UPCOMINGITEM unless $borrower_preferences->{'days_in_advance'} == $upcoming->{'days_until_due'};
if ( $borrower_preferences->{'wants_digest'} ) {
# cache this one to process after we've run through all of the items.
$upcoming_digest->{$upcoming->{'borrowernumber'}}++;
} else {
my $biblio = C4::Biblio::GetBiblioFromItemNumber( $upcoming->{'itemnumber'} );
my $letter_type = 'PREDUE';
$letter = C4::Letters::getletter( 'circulation', $letter_type );
die "no letter of type '$letter_type' found. Please see sample_notices.sql" unless $letter;
$letter = parse_letter( { letter => $letter,
borrowernumber => $upcoming->{'borrowernumber'},
branchchode => $upcoming->{'branchcode'},
biblionumber => $biblio->{'biblionumber'} } );
}
}
# If we have prepared a letter, send it.
if ( $letter ) {
foreach my $transport ( @{$borrower_preferences->{'transports'}} ) {
C4::Letters::EnqueueLetter( { letter => $letter,
borrowernumber => $upcoming->{'borrowernumber'},
message_transport_type => $transport } );
}
}
}
# warn( Data::Dumper->Dump( [ $upcoming_digest ], [ 'upcoming_digest' ] ) );
# Now, run through all the people that want digests and send them
PATRON: while ( my ( $borrowernumber, $count ) = each %$upcoming_digest ) {
my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences( { borrowernumber => $borrowernumber,
message_name => 'advance notice' } );
# warn( Data::Dumper->Dump( [ $borrower_preferences ], [ 'borrower_preferences' ] ) );
next PATRON unless $borrower_preferences; # how could this happen?
my $letter_type = 'PREDUEDGST';
my $letter = C4::Letters::getletter( 'circulation', $letter_type );
die "no letter of type '$letter_type' found. Please see sample_notices.sql" unless $letter;
$letter = parse_letter( { letter => $letter,
borrowernumber => $borrowernumber,
substitute => { count => $count }
} );
foreach my $transport ( @{$borrower_preferences->{'transports'}} ) {
C4::Letters::EnqueueLetter( { letter => $letter,
borrowernumber => $borrowernumber,
message_transport_type => $transport } );
}
}
# Now, run through all the people that want digests and send them
PATRON: while ( my ( $borrowernumber, $count ) = each %$due_digest ) {
my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences( { borrowernumber => $borrowernumber,
message_name => 'item due' } );
# warn( Data::Dumper->Dump( [ $borrower_preferences ], [ 'borrower_preferences' ] ) );
next PATRON unless $borrower_preferences; # how could this happen?
my $letter_type = 'DUEDGST';
my $letter = C4::Letters::getletter( 'circulation', $letter_type );
die "no letter of type '$letter_type' found. Please see sample_notices.sql" unless $letter;
$letter = parse_letter( { letter => $letter,
borrowernumber => $borrowernumber,
substitute => { count => $count }
} );
foreach my $transport ( @{$borrower_preferences->{'transports'}} ) {
C4::Letters::EnqueueLetter( { letter => $letter,
borrowernumber => $borrowernumber,
message_transport_type => $transport } );
}
}
=head1 METHODS
=head2 parse_letter
=cut
sub parse_letter {
my $params = shift;
foreach my $required ( qw( letter borrowernumber ) ) {
return unless exists $params->{$required};