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__
This diff is collapsed.
#!/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::Letters;
use Getopt::Long;
my $help = 0;
my $verbose = 0;
GetOptions( 'h' => \$help,
'v' => \$verbose,
);
my $usage = << 'ENDUSAGE';
This script processes the message queue in the message_queue database
table. It sends out the messages in that queue and marks them
appropriately to indicate success or failure. It is recommended that
you run this regularly from cron, especially if you are using the
advance_notices.pl script.
This script has the following parameters :
-n help: this message
-v verbose
ENDUSAGE
die $usage if $help;
C4::Letters::SendQueuedMessages( { verbose => $verbose } );
......@@ -29,6 +29,7 @@ sub methods : Test( 1 ) {
GetItemIssue
GetItemIssues
GetBiblioIssues
GetUpcomingDueIssues
CanBookBeRenewed
AddRenewal
GetRenewCount
......
package KohaTest::Circulation::GetUpcomingDueIssues;
use base qw(KohaTest::Circulation);
use strict;
use warnings;
use Test::More;
=head2 basic_usage
basic usage of C4::Circulation::GetUpcomingDueIssues()
=cut
sub basic_usage : Test(2) {
my $self = shift;
my $upcoming = C4::Circulation::GetUpcomingDueIssues();
isa_ok( $upcoming, 'ARRAY' );
is( scalar @$upcoming, 0, 'no issues yet' )
or diag( Data::Dumper->Dump( [$upcoming], ['upcoming'] ) );
}
1;
package KohaTest::Letters;
use base qw( KohaTest );
use strict;
use warnings;
use Test::More;
use C4::Members;
sub testing_class { 'C4::Letters' };
sub methods : Test( 1 ) {
my $self = shift;
my @methods = qw( getletter
addalert
delalert
getalert
findrelatedto
SendAlerts
parseletter
);
can_ok( $self->testing_class, @methods );
}
1;
package KohaTest::Letters::GetLetter;
use base qw( KohaTest::Letters );
use strict;
use warnings;
use C4::Letters;
use Test::More;
sub GetLetter : Test( 6 ) {
my $self = shift;
my $letter = getletter( 'circulation', 'ODUE' );
isa_ok( $letter, 'HASH' )
or diag( Data::Dumper->Dump( [ $letter ], [ 'letter' ] ) );
is( $letter->{'code'}, 'ODUE', 'code' );
is( $letter->{'module'}, 'circulation', 'module' );
ok( exists $letter->{'content'}, 'content' );
ok( exists $letter->{'name'}, 'name' );
ok( exists $letter->{'title'}, 'title' );
}
1;
package KohaTest::Letters::GetLetters;
use base qw( KohaTest::Letters );
use strict;
use warnings;
use C4::Letters;
use Test::More;
sub GetDefaultLetters : Test( 2 ) {
my $self = shift;
my $letters = GetLetters();
# the default install includes several entries in the letter table.
isa_ok( $letters, 'HASH' )
or diag( Data::Dumper->Dump( [ $letters ], [ 'letters' ] ) );
ok( scalar keys( %$letters ) > 0, 'we got some letters' );
}
1;
package KohaTest::Overdues::GetOverdues;
use base qw( KohaTest::Overdues );
use strict;
use warnings;
use C4::Overdues;
use Test::More;
=head3 create_overdue_item
=cut
sub startup_60_create_overdue_item : Test( startup => 17 ) {
my $self = shift;
$self->add_biblios( add_items => 1 );
my $biblionumber = $self->{'biblios'}[0];
ok( $biblionumber, 'biblionumber' );
my @biblioitems = C4::Biblio::GetBiblioItemByBiblioNumber( $biblionumber );
ok( scalar @biblioitems > 0, 'there is at least one biblioitem' );
my $biblioitemnumber = $biblioitems[0]->{'biblioitemnumber'};
ok( $biblioitemnumber, 'got a biblioitemnumber' );
my $items = C4::Items::GetItemsByBiblioitemnumber( $biblioitemnumber);
my $item = $items->[0];
ok( $item->{'itemnumber'}, 'item number' );
$self->{'overdueitemnumber'} = $item->{'itemnumber'};
# let's use the database to do date math for us.
# This is a US date, but that's how C4::Dates likes it, apparently.
my $dbh = C4::Context->dbh();
my $date_list = $dbh->selectcol_arrayref( q( select DATE_FORMAT( FROM_DAYS( TO_DAYS( NOW() ) - 6 ), '%m/%d/%Y' ) ) );
my $six_days_ago = shift( @$date_list );
my $duedate = C4::Dates->new( $six_days_ago );
# diag( Data::Dumper->Dump( [ $duedate ], [ 'duedate' ] ) );
ok( $item->{'barcode'}, 'barcode' )
or diag( Data::Dumper->Dump( [ $item ], [ 'item' ] ) );
# my $item_from_barcode = C4::Items::GetItem( undef, $item->{'barcode'} );
# diag( Data::Dumper->Dump( [ $item_from_barcode ], [ 'item_from_barcode' ] ) );
ok( $self->{'memberid'}, 'memberid' );
my $borrower = C4::Members::GetMember( $self->{'memberid'} );
ok( $borrower->{'borrowernumber'}, 'borrowernumber' );
my ( $issuingimpossible, $needsconfirmation ) = C4::Circulation::CanBookBeIssued( $borrower, $item->{'barcode'}, $duedate, 0 );
# diag( Data::Dumper->Dump( [ $issuingimpossible, $needsconfirmation ], [ qw( issuingimpossible needsconfirmation ) ] ) );
is( keys %$issuingimpossible, 0, 'issuing is not impossible' );
is( keys %$needsconfirmation, 0, 'issuing needs no confirmation' );
C4::Circulation::AddIssue( $borrower, $item->{'barcode'}, $duedate );
}