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: Joshua Ferraro <jmf@liblime.com>
This commit is contained in:
Andrew Moore
Joshua Ferraro
parent
401c84cc09
commit
2cae4efa0a
|
|
@ -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);
|
||||
|
|
|
|||
152
C4/Letters.pm
152
C4/Letters.pm
|
|
@ -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
|
||||
LEFT JOIN items USING (itemnumber)
|
||||
LEFT JOIN biblioitems USING (biblioitemnumber)
|
||||
WHERE date_due < now()
|
||||
ORDER BY borrowernumber " );
|
||||
$sth->execute;
|
||||
return $sth->fetchall_arrayref({});
|
||||
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()
|
||||
";
|
||||
}
|
||||
|
||||
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 );
|
||||
|
|
|
|||
207
C4/SMS.pm
207
C4/SMS.pm
|
|
@ -1,140 +1,109 @@
|
|||
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
|
||||
);
|
||||
$VERSION = 0.03;
|
||||
}
|
||||
|
||||
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');
|
||||
|
||||
=head2 send_sms
|
||||
|
||||
=over4
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
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);
|
||||
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 };
|
||||
}
|
||||
|
||||
# This allows the user to override the driver. See SMS::Send::Test
|
||||
my $driver = exists $params->{'driver'} ? $params->{'driver'} : $self->driver();
|
||||
return unless $driver;
|
||||
|
||||
# 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'),
|
||||
);
|
||||
|
||||
# Send a message
|
||||
my $sent = $sender->send_sms( to => $params->{'destination'},
|
||||
text => $params->{'message'},
|
||||
);
|
||||
# warn 'failure' unless $sent;
|
||||
return $sent;
|
||||
}
|
||||
|
||||
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);
|
||||
=head2 driver
|
||||
|
||||
=over 4
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub driver {
|
||||
my $self = shift;
|
||||
|
||||
# return 'US::SprintPCS';
|
||||
return C4::Context->preference('SMSSendDriver');
|
||||
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
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";
|
||||
}
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub parse_message {
|
||||
my $message = shift;
|
||||
$message =~ s/ / /g;
|
||||
my @parsed = split / /, $message;
|
||||
return (@parsed);
|
||||
}
|
||||
|
||||
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
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
sub kill_sms {
|
||||
#end a session
|
||||
my $ua = shift or return undef;
|
||||
my $session = shift;
|
||||
my $res = $ua->post($uri,[cmd=>'KILLSESSION',pSessionId=>$session]);
|
||||
}
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,268 @@
|
|||
#!/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};
|
||||
}
|
||||
|
||||
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'};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
|
@ -0,0 +1,54 @@
|
|||
#!/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
|
||||
|
|
|
|||
|
|
@ -0,0 +1,26 @@
|
|||
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;
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
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;
|
||||
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
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;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
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;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,126 @@
|
|||
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 );
|
||||
}
|
||||
|
||||
sub basic_usage : Test( 2 ) {
|
||||
my $self = shift;
|
||||
|
||||
my $overdues = C4::Overdues::Getoverdues();
|
||||
isa_ok( $overdues, 'ARRAY' );
|
||||
is( scalar @$overdues, 1, 'found our one overdue book' );
|
||||
}
|
||||
|
||||
sub limit_minimum_and_maximum : Test( 2 ) {
|
||||
my $self = shift;
|
||||
|
||||
my $overdues = C4::Overdues::Getoverdues( { minimumdays => 1, maximumdays => 100 } );
|
||||
isa_ok( $overdues, 'ARRAY' );
|
||||
is( scalar @$overdues, 1, 'found our one overdue book' );
|
||||
}
|
||||
|
||||
sub limit_and_do_not_find_it : Test( 2 ) {
|
||||
my $self = shift;
|
||||
|
||||
my $overdues = C4::Overdues::Getoverdues( { minimumdays => 1, maximumdays => 2 } );
|
||||
isa_ok( $overdues, 'ARRAY' );
|
||||
is( scalar @$overdues, 0, 'there are no overdue books in that range.' );
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
sub run_overduenotices_script : Test( 1 ) {
|
||||
my $self = shift;
|
||||
|
||||
# make sure member wants alerts
|
||||
C4::Members::Attributes::UpdateBorrowerAttribute($self->{'memberid'},
|
||||
{ code => 'PREDEmail',
|
||||
value => '1' } );
|
||||
|
||||
# we're screwing with C4::Circulation::GetUpcomingIssues by passing in a negative number.
|
||||
C4::Members::Attributes::UpdateBorrowerAttribute($self->{'memberid'},
|
||||
{ code => 'PREDDAYS',
|
||||
value => '-6' } );
|
||||
|
||||
|
||||
my $before_count = $self->count_message_queue();
|
||||
|
||||
my $output = qx( ../misc/cronjobs/advance_notices.pl -c );
|
||||
|
||||
my $after_count = $self->count_message_queue();
|
||||
is( $after_count, $before_count + 1, 'there is one more message in the queue than there used to be.' )
|
||||
or diag $output;
|
||||
|
||||
}
|
||||
|
||||
|
||||
=cut
|
||||
|
||||
sub count_message_queue {
|
||||
my $self = shift;
|
||||
|
||||
my $dbh = C4::Context->dbh();
|
||||
my $statement = q( select count(0) from message_queue where status = 'pending' );
|
||||
my $countlist = $dbh->selectcol_arrayref( $statement );
|
||||
return $countlist->[0];
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
package KohaTest::SMS;
|
||||
use base qw( KohaTest );
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More;
|
||||
|
||||
use C4::SMS;
|
||||
sub testing_class { 'C4::SMS' };
|
||||
|
||||
|
||||
sub methods : Test( 1 ) {
|
||||
my $self = shift;
|
||||
my @methods = qw( send_sms
|
||||
driver
|
||||
);
|
||||
|
||||
can_ok( $self->testing_class, @methods );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
package KohaTest::SMS::send_sms;
|
||||
use base qw( KohaTest::SMS );
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More;
|
||||
|
||||
use C4::SMS;
|
||||
sub testing_class { 'C4::SMS' };
|
||||
|
||||
|
||||
sub send_a_message : Test( 2 ) {
|
||||
my $self = shift;
|
||||
|
||||
my $success = C4::SMS->send_sms( { destination => '+1 212-555-1111',
|
||||
message => 'This is the message',
|
||||
driver => 'Test' } );
|
||||
|
||||
ok( $success, "send_sms returned a true: $success" );
|
||||
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
Loading…
Reference in New Issue