[libsms-aql-perl] 01/06: Import original source of SMS-AQL 1.02
dom at earth.li
dom at earth.li
Tue Jun 16 23:21:33 UTC 2015
This is an automated email from the git hooks/post-receive script.
dom pushed a commit to branch master
in repository libsms-aql-perl.
commit 47802dcaf9116c3e511506de75a1a4dd1e4aaf62
Author: Dominic Hargreaves <dom at earth.li>
Date: Tue Jun 16 18:41:21 2015 +0100
Import original source of SMS-AQL 1.02
---
Changes | 75 +++++++
MANIFEST | 14 ++
META.json | 52 +++++
META.yml | 28 +++
Makefile.PL | 24 +++
README | 74 +++++++
TODO | 18 ++
eg/example.pl | 45 ++++
eg/send-sms | 79 +++++++
lib/SMS/AQL.pm | 593 +++++++++++++++++++++++++++++++++++++++++++++++++++++
t/1-basic.t | 78 +++++++
t/2-pod.t | 13 ++
t/3-pod-coverage.t | 13 ++
t/4-mock.t | 351 +++++++++++++++++++++++++++++++
14 files changed, 1457 insertions(+)
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..4a6980f
--- /dev/null
+++ b/Changes
@@ -0,0 +1,75 @@
+Revision history for Perl extension SMS::AQL.
+
+
+1.02 2015-03-20
+- Declare HTTP::Message as a pre-req (thanks to pink-mist, GH-2)
+
+1.00 2012-12-15
+- Example script eg/send-sms added (useful for other programs to call, I use
+ this from procmail to alert me when specific emails come in).
+
+0.08 2008-03-18
+Support for voice push messages (strictly speaking this ought to be in
+a seperate module as it's not an SMS-related feature, but it makes sense
+to group with here I think. If I ever do seperate it, I'll probably go
+for Net::AQL::SMS and Net::AQL::Voice, and have them use Net::AQL::Common
+for shared implementation.)
+
+0.07 2008-01-14
+Minor changes to boost Kwalitee score on cpants.perl.org - mostly updated
+META.yml (and also adding LWP::UserAgent as a pre-req in Makefile.PL)
+
+0.06 2007-08-22
+Changes to make SMS::AQL work under prehistoric perl 5.005
+
+0.05 2007-08-14
+Added support for connecting via a proxy - simply supply the proxy URL in
+the options hashref when instantiating the object:
+my $sms = new SMS::AQL({
+ username => 'user',
+ password => 'pass',
+ options => {
+ proxy => 'http://user:pass@host:port/',
+ }
+});
+
+0.04 2007-07-16
+New release incorporating several improvements kindly submitted by
+Ton Voon at Altinity (http://www.altinity.com/) - thanks Ton! There's
+numerous documentation improvements, better parsing of server responses,
+and a new test script using Test::MockObject to exercise the module
+code without actually interacting with the AQL servers or sending
+messages. Nice work Ton, thanks for your contribution!
+
+
+0.03 2007-06-26
+Previous versions had use 5.008007 in the Makefile, where I forgot to
+change it. There's nothing funky in this module that should require
+5.8.7, 5.8.0 should be good enough. Thanks to Nicola W for pointing
+this out.
+
+Also added new credit() method to return the number of message credits
+available on the account.
+
+
+0.02 2007-01-04
+Fix stupid, stupid bug #24201 - don't remove servers from the list of
+servers, unless we fail to send a message. Previously, each instance
+of SMS::AQL could only send 4 messages in a row before starting to fail.
+Obviously, passed all tests, only showed up in real usage. Wibble.
+Also some minor style problems cleared up.
+
+Important: constructor now takes a hashref of params to provide for
+future expansion needs.
+
+0.01 2006-08-10
+development starts... pre-alpha version started life as Net::AQSMS::Send,
+name SMS::AQL was then agreed after brief discussion with modules at perl.org
+guys, Brian in particular - thanks for your input Brian.
+
+Initial version is quite limited, but tested and works well for me.
+Not tested with non-UK destination numbers.
+
+
+
+$Id$
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..1549801
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,14 @@
+Changes
+Makefile.PL
+MANIFEST
+README
+TODO
+eg/example.pl
+eg/send-sms
+t/1-basic.t
+t/2-pod.t
+t/3-pod-coverage.t
+t/4-mock.t
+lib/SMS/AQL.pm
+META.yml Module meta-data (added by MakeMaker)
+META.json Module JSON meta-data (added by MakeMaker)
diff --git a/META.json b/META.json
new file mode 100644
index 0000000..3974397
--- /dev/null
+++ b/META.json
@@ -0,0 +1,52 @@
+{
+ "abstract" : "Perl extension to send SMS text messages via AQL's SMS service",
+ "author" : [
+ "David Precious <davidp at preshweb.co.uk>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 6.82, CPAN::Meta::Converter version 2.120351",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "SMS-AQL",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "HTTP::Request" : "0",
+ "LWP::UserAgent" : "0",
+ "perl" : "5.005"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "bugtracker" : {
+ "web" : "https://github.com/bigpresh/SMS-AQL/issues"
+ },
+ "homepage" : "https://github.com/bigpresh/SMS-AQL/",
+ "repository" : {
+ "url" : "https://github.com/bigpresh/SMS-AQL"
+ }
+ },
+ "version" : "1.02"
+}
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..b8e2f60
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,28 @@
+---
+abstract: "Perl extension to send SMS text messages via AQL's SMS service"
+author:
+ - 'David Precious <davidp at preshweb.co.uk>'
+build_requires:
+ ExtUtils::MakeMaker: 0
+configure_requires:
+ ExtUtils::MakeMaker: 0
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 6.82, CPAN::Meta::Converter version 2.120351'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: SMS-AQL
+no_index:
+ directory:
+ - t
+ - inc
+requires:
+ HTTP::Request: 0
+ LWP::UserAgent: 0
+ perl: 5.005
+resources:
+ bugtracker: https://github.com/bigpresh/SMS-AQL/issues
+ homepage: https://github.com/bigpresh/SMS-AQL/
+ repository: https://github.com/bigpresh/SMS-AQL
+version: 1.02
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..6688e12
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,24 @@
+use 5.005000;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ NAME => 'SMS::AQL',
+ VERSION_FROM => 'lib/SMS/AQL.pm', # finds $VERSION
+ PREREQ_PM => { LWP::UserAgent => 0, HTTP::Request => 0 },
+ MIN_PERL_VERSION => 5.005,
+ ($] > 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'lib/SMS/AQL.pm',
+ AUTHOR => 'David Precious <davidp at preshweb.co.uk>') : ()),
+ ($ExtUtils::MakeMaker::VERSION >= 6.3002
+ ? ('LICENSE'=> 'perl')
+ : ()),
+
+ META_MERGE => {
+ resources => {
+ repository => 'https://github.com/bigpresh/SMS-AQL',
+ bugtracker => 'https://github.com/bigpresh/SMS-AQL/issues',
+ homepage => 'https://github.com/bigpresh/SMS-AQL/',
+ },
+ },
+);
diff --git a/README b/README
new file mode 100644
index 0000000..54ca698
--- /dev/null
+++ b/README
@@ -0,0 +1,74 @@
+SMS::AQL README
+===========================
+
+SMS::AQL is a simple module which provides a clean
+object-oriented interface to allow sending of SMS text messages
+to mobile phones using the HTTP gateway from AQL (www.aql.com).
+
+In order to use AQL's gateway, you will need to get an account
+with them (free), and purchase some credits (not free obviously).
+
+Note, I have no connection to AQL other than being a user of their
+services. I started writing this module for myself, then thought
+I should do the Right Thing and release it to CPAN.
+
+I contacted AQL to discuss doing this and ask for some test SMS
+credits to assist with testing the module, and they were most
+helpful - thanks guys, you're a top company :)
+
+
+INSTALLATION
+
+To install this module use the standard routine:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ LWP
+
+
+PROXY SUPPORT
+
+If you provide a proxy setting in the options when instantiating the object,
+it will be passed through to LWP. If the proxy requires authentication, then
+supply the username and password in the proxy URL, like so:
+
+ http://user:pass@host:port/
+
+If you don't need a username and password, leave them out.
+
+An example:
+
+my $sms = new SMS::AQL({
+ username => 'user',
+ password => 'pass',
+ options => {
+ proxy => 'http://user:pass@host:port/',
+ }
+});
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2006-2007 by David Precious
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.7 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+THANKS
+
+ - to Adam Beaumount and the AQL team for their assistance
+ - to Ton Voon at Altinity (http://www.altinity.com/) for contributing
+ several improvements
+
+
+$Id$
diff --git a/TODO b/TODO
new file mode 100644
index 0000000..3a5b1f5
--- /dev/null
+++ b/TODO
@@ -0,0 +1,18 @@
+
+TODO for SMS::AQL
+
+ - new method to send message to multiple recipients at once
+
+ - option to enable/disable concatenation (messages > 160 chars) and set
+ maximum length (would be useful just in case some script error in the
+ calling script made it try to send an excessively long message
+
+ - improve documentation
+
+ - testing with non-UK destination numbers... obviously I don't have a
+ non-UK phone to test with, does anybody outside of the UK want to
+ help out by performing tests? Free credits will be allocated for
+ testing.
+
+
+$Id$
diff --git a/eg/example.pl b/eg/example.pl
new file mode 100644
index 0000000..44bc77a
--- /dev/null
+++ b/eg/example.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+# $Id$
+
+# Simple usage example for SMS::AQL
+
+# NOTE - the test username and password is for testing SMS::AQL *only*,
+# not to be used for any other purpose. It is given a small amount of
+# credit now and then, if you try to abuse it, it just won't get given
+# any more credit. So don't.
+my $test_user = 'sms-aql-test';
+my $test_pass = 'sms-aql-test';
+
+use warnings;
+use lib '../lib/';
+use SMS::AQL;
+
+my $sender = new SMS::AQL({username => $test_user, password => $test_pass});
+
+if (!$sender || ! ref $sender) { die('Failed to instantiate SMS::AQL'); }
+
+
+print "SMS::AQL $SMS::AQL::VERSION loaded OK\n";
+
+my $credits = $sender->credit();
+
+print "Account $test_user has $credits credits.\n";
+
+print "Destination: ?> ";
+my $test_to = <>;
+
+print "Message: ?> ";
+my $message = <>;
+
+my ($ok, $why) = $sender->send_sms($test_to, $message,
+ { sender => 'SMS-AQL' });
+
+printf "Status: %s, Reason: %s, Server response: %s\n",
+ ($ok? 'Successful' : 'Failed'),
+ $why,
+ $sender->{last_response};
+
+
+# note: we could also have specified the sender when we created an instance of
+# SMS::AQL, to save passing it to the send_sms() call - see the POD docs.
diff --git a/eg/send-sms b/eg/send-sms
new file mode 100755
index 0000000..08b931e
--- /dev/null
+++ b/eg/send-sms
@@ -0,0 +1,79 @@
+#!/usr/bin/perl
+
+# $Id$
+# A simple script to be called by other scripts, taking either two parameters - a
+# mobile number (or comma-separated list of numbers) and a message, or just a
+# message, in which case the default_destination in the config file is used.
+#
+# Reads www.aql.com account details from a YANL
+# file ~/.aql_login, which should contain username, password and sender number
+# (if a sender number is not included, the machine's hostname will be used).
+# (Yes, a sender can be a mobile number, or any text).
+
+use strict;
+use SMS::AQL;
+use Sys::Hostname;
+use YAML;
+
+my $conf_file = $ENV{HOME} . '/.aql_login';
+my $conf = YAML::LoadFile($conf_file)
+ or die "Failed to read $conf_file";
+
+
+my ($destinations, $message);
+
+if (@ARGV == 2) {
+ $destinations = shift @ARGV;
+ $message = join ' ', @ARGV;
+} elsif (@ARGV == 1) {
+ $destinations = $conf->{default_destination};
+ if (!$destinations) {
+ die "Called with only one parameter, and no default_destination "
+ ."specified in $conf_file";
+ }
+ $message = shift @ARGV;
+} else {
+ show_usage();
+}
+
+
+my $sms = SMS::AQL->new({
+ username => $conf->{username},
+ password => $conf->{password},
+ options => {
+ sender => $conf->{sender} || Sys::Hostname::hostname(),
+ },
+});
+
+if (!$sms) {
+ die "Failed to get SMS::AQL object";
+}
+
+my $failures;
+
+for my $destination (split /,/, $destinations) {
+ my ($ok, $why) = $sms->send_sms($destination, $message);
+ if (!$ok) {
+ warn "Failed to send to $destination - $why";
+ $failures++;
+ }
+}
+
+if ($failures) {
+ exit -1;
+} else {
+ exit 0;
+}
+
+
+
+sub show_usage {
+print <<USAGE;
+
+Usage: $0 destination message
+
+E.g. $0 +44788123456 "Here is a nice message"
+USAGE
+exit;
+}
+
diff --git a/lib/SMS/AQL.pm b/lib/SMS/AQL.pm
new file mode 100644
index 0000000..3d948d4
--- /dev/null
+++ b/lib/SMS/AQL.pm
@@ -0,0 +1,593 @@
+package SMS::AQL;
+
+# SMS::AQL - Sends text messages via AQL's gateway
+#
+# David Precious, davidp at preshweb.co.uk
+#
+# $Id$
+
+
+use 5.005000;
+
+use strict;
+use warnings;
+use Carp;
+use LWP::UserAgent;
+use HTTP::Request;
+use vars qw($VERSION);
+
+$VERSION = '1.02';
+
+my $UNRECOGNISED_RESPONSE = "Unrecognised response from server";
+my $NO_RESPONSES = "Could not get valid response from any server";
+
+=head1 NAME
+
+SMS::AQL - Perl extension to send SMS text messages via AQL's SMS service
+
+=head1 SYNOPSIS
+
+ # create an instance of SMS::AQL, passing it your AQL username
+ # and password (if you do not have a username and password,
+ # register at www.aql.com first).
+
+ $sms = new SMS::AQL({
+ username => 'username',
+ password => 'password'
+ });
+
+ # other parameters can be passed like so:
+ $sms = new SMS::AQL({
+ username => 'username',
+ password => 'password',
+ options => { sender => '+4471234567' }
+ });
+
+ # send an SMS:
+
+ $sms->send_sms($to, $msg) || die;
+
+ # called in list context, we can see what went wrong:
+ my ($ok, $why) = $sms->send_sms($to, $msg);
+ if (!$ok) {
+ print "Failed, error was: $why\n";
+ }
+
+ # params for this send operation only can be supplied:
+ $sms->send_sms($to, $msg, { sender => 'bob the builder' });
+
+ # make a phone call and read out a message:
+ my ($ok, $why) = $sms->voice_push($to, $msg);
+
+
+
+=head1 DESCRIPTION
+
+SMS::AQL provides a nice object-oriented interface to send SMS text
+messages using the HTTP gateway provided by AQ Ltd (www.aql.com) in
+the UK.
+
+It supports concatenated text messages (over the 160-character limit
+of normal text messages, achieved by sending multiple messages with
+a header to indicate that they are part of one message (this is
+handset-dependent, but supported by all reasonably new mobiles).
+
+
+
+=head1 METHODS
+
+=over
+
+=item new (constructor)
+
+You must create an instance of SMS::AQL, passing it the username and
+password of your AQL account:
+
+ $sms = new SMS::AQL({ username => 'fred', password => 'bloggs' });
+
+You can pass extra parameters (such as the default sender number to use,
+or a proxy server) like so:
+
+ $sms = new SMS::AQL({
+ username => 'fred',
+ password => 'bloggs',
+ options => {
+ sender => '+44123456789012',
+ proxy => 'http://user:pass@host:port/',
+ },
+ });
+
+=cut
+
+sub new {
+
+ my ($package, $params) = @_;
+
+ if (!$params->{username} || !$params->{password}) {
+ warn 'Must supply username and password';
+ return undef;
+ }
+
+ my $self = bless { contents => {} } =>
+ ($package || 'SMS::AQL');
+
+ # get an LWP user agent ready
+ $self->{ua} = new LWP::UserAgent;
+ $self->{ua}->agent("SMS::AQL/$VERSION");
+
+ # configure user agent to use a proxy, if requested:
+ # TODO: validate supplied proxy details
+ if ($params->{options}->{proxy}) {
+ $self->{ua}->proxy(['http','https'] => $params->{options}->{proxy});
+ }
+
+ # remember the username and password
+ ($self->{user}, $self->{pass}) =
+ ($params->{username}, $params->{password});
+
+
+ # remember extra params:
+ $self->{options} = $params->{options};
+
+ # the list of servers we can try:
+ $self->{sms_servers} = [qw(
+ gw.aql.com
+ )];
+
+ $self->{voice_servers} = ['vp1.aql.com'];
+
+ # remember the last server response we saw:
+ $self->{last_response} = '';
+ $self->{last_response_text} = '';
+ $self->{last_error} = '';
+ $self->{last_status} = 0;
+
+ return $self;
+}
+
+
+
+=item send_sms($to, $message [, \%params])
+
+Sends the message $message to the number $to, optionally
+using the parameters supplied as a hashref.
+
+If called in scalar context, returns 1 if the message was
+sent, 0 if it wasn't.
+
+If called in list context, returns a two-element list, the
+first element being 1 for success or 0 for fail, and the second
+being a message indicating why the message send operation
+failed.
+
+You must set a sender, either at new or for each send_sms call.
+
+Examples:
+
+ if ($sms->send_sms('+44123456789012', $message)) {
+ print "Sent message successfully";
+ }
+
+ my ($ok, $msg) = $sms->send_sms($to, $msg);
+ if (!$ok) {
+ print "Failed to send the message, error: $msg\n";
+ }
+
+=cut
+
+sub send_sms {
+
+ my ($self, $to, $text, $opts) = @_;
+
+ $to =~ s/[^0-9+]//xms;
+
+ # assemble the data we need to POST to the server:
+ my %postdata = (
+ username => $self->{user},
+ password => $self->{pass},
+ orig => $opts->{sender} || $self->{options}->{sender},
+ to_num => $to,
+ message => $text,
+ );
+
+ if (!$postdata{orig}) {
+ $self->{last_error} = "Cannot send message without sender specified";
+ warn($self->{last_error});
+ return 0;
+ }
+
+ my $response =
+ $self->_do_post($self->{sms_servers},
+ '/sms/postmsg-concat.php', \%postdata);
+
+ if ($response && $response->is_success) {
+ $self->_check_aql_response_code($response);
+ return wantarray ?
+ ($self->last_status, $self->last_response_text) : $self->last_status;
+ }
+
+ # OK, we got no response from any of the servers we tried:
+ $self->_set_no_valid_response;
+ return wantarray ? (0, $self->last_error) : 0;
+
+} # end of sub send_sms
+
+
+
+=item voice_push($to, $message [, \%params])
+
+Make a telephone call to the given phone number, using speech synthesis to
+read out the message supplied.
+
+$to and $message are the destination telephone number and the message to read
+out. The third optional parameter is a hashref of options to modify the
+behaviour of this method - currently, the only option is:
+
+=over 4
+
+=item skipintro
+
+Skips the introductory message that AQL's system normally reads out. (If you
+use this, it's recommended to add your own introduction to your message, for
+example "This is an automated call from ACME Inc...")
+
+=back
+
+If called in scalar context, returns 1 if the message was sent, 0 if it wasn't.
+
+If called in list context, returns a two-element list, the first element being
+1 for success or 0 for fail, and the second being a message indicating why the
+operation failed.
+
+Note that, at the current time, this feature supports only UK telephone numbers.
+
+=cut
+
+sub voice_push {
+
+ my ($self, $to, $text, $opts) = @_;
+
+ if (!$to) {
+ carp "SMS::AQL->voice_push() called without destination number";
+ return;
+ }
+
+ if (!$text) {
+ carp "SMS::AQL->voice_push() called without message";
+ return;
+ }
+
+ # voice push only works for UK numbers, and does not accept international
+ # format. If the number was given in +44 format, turn it into standard
+ # UK format; if it's an non-UK number, don't even try to send.
+ $to =~ s{^\+440?}{0};
+
+ if ($to !~ m{^0}) {
+ carp "SMS::AQL->voice_push() called with a non-UK telephone number";
+ return;
+ }
+
+ my %postdata = (
+ username => $self->{user},
+ password => $self->{pass},
+ msisdn => $to,
+ message => $text,
+ );
+
+ if ($opts->{skipintro}) {
+ $postdata{skipintro} = 1;
+ }
+
+
+ my $response = $self->_do_post(
+ $self->{voice_servers}, '/voice_push.php', \%postdata
+ );
+
+ if ($response && $response->is_success) {
+ my $status = (split /\n/, $response->content)[0];
+
+ my %response_lookup = (
+ VP_OK => {
+ status => 1,
+ message => 'OK',
+ },
+ VP_ERR_NOTOMOBNUM => {
+ status => 0,
+ message => 'Telephone number not provided',
+ },
+ VP_ERR_INVALID_MOBNUM => {
+ status => 0,
+ message => 'Invalid telephone number',
+ },
+ VP_ERR_NOTGLOBAL => {
+ status => 0,
+ message => 'Voice push is currently only available for'
+ . ' UK telephone numbers',
+ },
+ VP_ERR_NOCREDIT => {
+ status => 0,
+ message => 'Insufficient credit',
+ },
+ VP_ERR_INVALIDAUTH => {
+ status => 0,
+ message => 'Username/password rejected',
+ },
+ VP_ERR_NOAUTH => {
+ # we should never see this, as we fail to create SMS::AQL
+ # instance without a username and password
+ status => 0,
+ message => 'Username/password not supplied',
+ },
+ VP_ERR_NOMSG => {
+ status => 0,
+ message => 'Message not provided',
+ },
+ );
+
+ my $response_details = $response_lookup{$status};
+
+ if (!$response_details) {
+ warn "Unrecognised status '$status' from AQL";
+ $response_details = {
+ status => 0,
+ message => 'Unrecognised response',
+ };
+ }
+
+ $self->{last_response} = $status;
+ $self->{last_response_text} = $response_details->{message};
+ $self->{last_status} = $response_details->{status};
+
+ return wantarray ?
+ @$response_details{qw(status message)} : $response_details->{status};
+
+ } else {
+ # no response received:
+ $self->{last_response} = '';
+ $self->{last_response_text} = 'No response from AQL servers';
+ $self->{last_status} = 0;
+ return wantarray ?
+ (0, 'No response from AQL servers') : 0;
+ }
+
+}
+
+
+
+=item credit()
+
+Returns the current account credit. Returns undef if any errors occurred
+
+=cut
+
+sub credit {
+
+ my $self = shift;
+
+ # assemble the data we need to POST to the server:
+ my %postdata = (
+ 'username' => $self->{user},
+ 'password' => $self->{pass},
+ 'cmd' => 'credit',
+ );
+
+ # try the request to each sever in turn, stop as soon as one succeeds.
+ for my $server (sort { (-1,1)[rand 2] } @{$self->{sms_servers}} ) {
+
+ my $response = $self->{ua}->post(
+ "http://$server/sms/postmsg.php", \%postdata);
+
+ next unless ($response->is_success); # try next server if we failed.
+
+ $self->_check_aql_response_code($response);
+
+ my ($credit) = $response->content =~ /AQSMS-CREDIT=(\d+)/;
+
+ return $credit;
+
+ }
+
+ $self->_set_no_valid_response;
+ return undef;
+} # end of sub credit
+
+
+
+=item last_status()
+
+Returns the status of the last command: 1 = OK, 0 = ERROR.
+
+=cut
+
+sub last_status { shift->{last_status} }
+
+=item last_error()
+
+Returns the error message of the last failed command.
+
+=cut
+
+sub last_error { shift->{last_error} }
+
+=item last_response()
+
+Returns the raw response from the AQL gateway.
+
+=cut
+
+sub last_response { shift->{last_response} }
+
+=item last_response_text()
+
+Returns the last result code received from the AQL
+gateway in a readable format.
+
+Possible codes are:
+
+=over
+
+=item AQSMS-AUTHERROR
+
+The username and password supplied were incorrect
+
+=item AQSMS-NOCREDIT
+
+Out of credits (The account specified did not have sufficient credit)
+
+=item AQSMS-OK
+
+OK (The message was queued on our system successfully)
+
+=item AQSMS-NOMSG
+
+No message or no destination number were supplied
+
+=back
+
+=cut
+
+my %lookup = (
+ "AQSMS-AUTHERROR" => {
+ text => "The username and password supplied were incorrect",
+ status => 0,
+ },
+ "AQSMS-NOCREDIT" => {
+ #text => "The account specified did not have sufficient credit",
+ text => "Out of credits",
+ status => 0,
+ },
+ "AQSMS-OK" => {
+ #text => "The message was queued on our system successfully",
+ text => "OK",
+ status => 1,
+ },
+ "AQSMS-CREDIT" => {
+ #text is filled out in credit sub
+ status => 1,
+ },
+ "AQSMS-NOMSG" => {
+ text => "No message or no destination number were supplied",
+ status => 0,
+ },
+ "AQSMS-INVALID_DESTINATION" => {
+ text => "Invalid destination",
+ status => 0,
+ },
+);
+
+sub last_response_text { shift->{last_response_text} }
+
+
+# private implementation methods follow - you are advised not to call these
+# directly, as their behaviour or even very existence could change in future
+# versions.
+
+sub _check_aql_response_code {
+ my ($self, $res) = @_;
+ my $r = $self->{last_response} = $res->content;
+ # Strip everything after initial alphanumerics and hyphen:
+ $r =~ s/^([\w\-]+).*/$1/;
+ if (exists $lookup{$r}) {
+ $self->{last_response_text} = $lookup{$r}->{text};
+ $self->{last_status} = $lookup{$r}->{status};
+ } else {
+ $self->{last_response_text} = "$UNRECOGNISED_RESPONSE: $r";
+ $self->{last_status} = 0;
+ }
+ unless ($self->last_status) {
+ $self->{last_error} = $self->{last_response_text};
+ }
+}
+
+
+
+# given an arrayref of possible servers, an URL and a hashref of POST data,
+# makes a POST request to each server in turn, stopping as soon as a successful
+# response is received and returning the LWP response object.
+sub _do_post {
+
+ my ($self, $servers, $url, $postdata) = @_;
+
+ if (ref $servers ne 'ARRAY') {
+ die "_do_post expects an arrayref of servers to try";
+ }
+
+ if (ref $postdata ne 'HASH') {
+ die "_do_post expects a hashref of post data";
+ }
+
+ if (!$url || ref $url) {
+ die "_do_post expects an URL";
+ }
+
+ $url =~ s{^/}{};
+
+ for my $server (sort { (-1,1)[rand 2] } @{$servers} ) {
+ my $response = $self->{ua}->post(
+ "http://$server/$url", $postdata);
+
+ if ($response->is_success) {
+ return $response;
+ }
+ }
+
+ # if we get here, none of the servers we asked responded:
+ return;
+}
+
+
+# fix up the number
+sub _canonical_number {
+
+ my ($self, $num) = @_;
+
+ $num =~ s/[^0-9+]//;
+ if (!$num) { return undef; }
+ $num =~ s/^0/+44/;
+
+ return $num;
+}
+
+
+sub _set_no_valid_response {
+ my $self = shift;
+ $self->{last_error} = $NO_RESPONSES;
+ $self->{last_status} = 0;
+}
+
+
+1;
+__END__
+
+
+=back
+
+
+=head1 SEE ALSO
+
+http://www.aql.com/
+
+
+=head1 AUTHOR
+
+David Precious, E<lt>davidp at preshweb.co.ukE<gt>
+
+All bug reports, feature requests, patches etc welcome.
+
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2006-2008 by David Precious
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.7 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=head1 THANKS
+
+ - to Adam Beaumount and the AQL team for their assistance
+ - to Ton Voon at Altinity (http://www.altinity.com/) for contributing
+ several improvements
+
+=cut
diff --git a/t/1-basic.t b/t/1-basic.t
new file mode 100644
index 0000000..10f42a4
--- /dev/null
+++ b/t/1-basic.t
@@ -0,0 +1,78 @@
+#!/usr/bin/perl
+
+# Basic operational tests for SMS::AQL
+# $Id$
+
+use strict;
+use Test::More tests => 4;
+
+# NOTE - the test username and password is for testing SMS::AQL *only*,
+# not to be used for any other purpose. It is given a small amount of
+# credit now and then, if you try to abuse it, it just won't get given
+# any more credit. So don't.
+my $test_user = 'sms-aql-test';
+my $test_pass = 'sms-aql-test';
+
+
+use lib '../lib/';
+use_ok('SMS::AQL');
+
+
+
+ok(my $sender = new SMS::AQL({username => $test_user, password => $test_pass}),
+ 'Create instance of SMS::AQL');
+
+ok(ref $sender eq 'SMS::AQL',
+ '$sender is an instance of SMS::AQL');
+
+my $balance = $sender->credit();
+
+ok($balance =~ /^[0-9]+$/, 'got account balance');
+
+
+=begin
+
+TODO: refactor this bigtime! I've disabled the sending test because I don't
+want to demand the destination number here if it's an automated install
+
+
+my $test_to;
+if ($balance) {
+ # have to send it to STDERR, as Test::Harness swallows our STDOUT...
+ print STDERR qq[
+To properly test SMS::AQL, I need a test number to send a text message to.
+Please supply a mobile number, and I will try to send a text message to it.
+If you'd rather not and wish to skip the tests, just leave it blank (or
+enter any "non-true" value).
+
+Mobile number: ?> ];
+
+ $test_to = <>;
+} else {
+ print STDERR "Skipping sending test - test account has no credit left\n";
+ $test_to = '';
+}
+
+# OK, a little crufty here with the double skip blocks, but we want
+# to skip the sending test if the destination number isn't given, and
+# also if the result of the send attempt is out of credit, we want to
+# skip rather than fail.
+my ($ok, $why);
+SKIP: {
+ skip "No destination number given" unless $test_to;
+
+ # now call in list context to check it definately worked:
+ ($ok, $why) = $sender->send_sms($test_to, 'Test message from SMS::AQL ' .
+ 'test suite',
+ { sender => 'SMS::AQL' });
+
+ SKIP: {
+ skip "No credit in testing account" if $why eq 'Out of credits';
+ skip "Invalid destination entered" if $why eq 'Invalid destination';
+ is($why, 'OK', 'Test message sent OK');
+ }
+
+}
+
+=cut
+
diff --git a/t/2-pod.t b/t/2-pod.t
new file mode 100644
index 0000000..1a82958
--- /dev/null
+++ b/t/2-pod.t
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+# Test POD correctness for SMS::AQL
+#
+# $Id$
+
+use strict;
+use Test::More;
+
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+
diff --git a/t/3-pod-coverage.t b/t/3-pod-coverage.t
new file mode 100644
index 0000000..ad33480
--- /dev/null
+++ b/t/3-pod-coverage.t
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+# Test POD coverage for SMS::AQL
+#
+# $Id$
+
+
+use strict;
+use Test::More;
+eval "use Test::Pod::Coverage 1.00";
+plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage"
+ if $@;
+all_pod_coverage_ok();
\ No newline at end of file
diff --git a/t/4-mock.t b/t/4-mock.t
new file mode 100644
index 0000000..77819e7
--- /dev/null
+++ b/t/4-mock.t
@@ -0,0 +1,351 @@
+#!/usr/bin/perl
+
+# Tests for SMS::AQL using a mocked interface
+#
+# Thanks to Ton Voon @ Altinity (www.altinity.com) for providing this
+# set of tests!
+#
+# $Id$
+
+use strict;
+
+use Test::More;
+use LWP::UserAgent;
+
+
+eval "use Test::MockObject::Extends";
+plan skip_all => "Test::MockObject::Extends required for mock testing"
+ if $@;
+
+# OK, we've got Test::MockObject::Extends, so we can go ahead:
+plan tests => 92;
+
+
+# NOTE - the test username and password is for testing SMS::AQL *only*,
+# not to be used for any other purpose. It is given a small amount of
+# credit now and then, if you try to abuse it, it just won't get given
+# any more credit. So don't.
+my $test_user = 'test_user';
+my $test_pass = 'test_password';
+
+
+use lib '../lib/';
+use_ok('SMS::AQL');
+
+my $warning;
+my $sender;
+
+# Catch warnings to test
+local $SIG{__WARN__} = sub { $warning=shift };
+
+$_ = SMS::AQL->new( { username => "this" } );
+is($_, undef, "Fails to create new instance with only username");
+like($warning, '/^Must supply username and password/', "Correct error message");
+
+$_ = SMS::AQL->new( { password => "that" } );
+is($_, undef, "Fails to create new instance with only password");
+like($warning, '/^Must supply username and password/', "Correct error message");
+
+$_ = SMS::AQL->new();
+is($_, undef, "Fails to create new instance");
+like($warning, '/^Must supply username and password/', "Correct error message");
+
+
+ok($sender = new SMS::AQL({username => $test_user, password => $test_pass}),
+ 'Create instance of SMS::AQL');
+
+ok(ref $sender eq 'SMS::AQL',
+ '$sender is an instance of SMS::AQL');
+
+# This wraps the ua so that methods can be overridden for testing purposes
+my $mocked_ua = $sender->{ua} = Test::MockObject::Extends->new( $sender->{ua} );
+
+
+$mocked_ua->mock("post", \&check_credit);
+my $balance = $sender->credit();
+is($balance, 501, "got account balance $balance");
+is($sender->last_response, "AQSMS-CREDIT=501", "Got reply correctly");
+is($sender->last_status, 1, "OK state");
+
+sub check_credit {
+ my ($self, $server, $postdata) = @_;
+ my $expected = { username => "test_user", password => "test_password", cmd => "credit" };
+
+ like( $server, '/^http:\/\/.*\/sms\/postmsg.php$/', "Server correct format: $server");
+ is_deeply( $postdata, $expected, "Post data correct" );
+
+ my $res = Test::MockObject->new();
+ $res->set_true( "is_success" );
+ $res->mock( "content", sub { "AQSMS-CREDIT=501" } );
+ return $res;
+}
+
+$sender->{user} = "wrong_user";
+$mocked_ua->mock( "post", \&check_credit_wrong_credentials );
+$balance = $sender->credit;
+is($balance, undef, "No balance received");
+is($sender->last_response, "AQSMS-AUTHERROR", "Response gives AUTHERROR message");
+is($sender->last_response_text, "The username and password supplied were incorrect", "Got nice text too");
+is($sender->last_error, $sender->last_response_text, "And saved to last_error too");
+is($sender->last_status, 0, "Error state");
+
+sub check_credit_wrong_credentials {
+ my ($self, $server, $postdata) = @_;
+ my $expected = { username => "wrong_user", password => "test_password", cmd => "credit" };
+
+ like( $server, '/^http:\/\/.*\/sms\/postmsg.php$/', "Server correct format: $server");
+ is_deeply( $postdata, $expected, "Post data correct" );
+
+ my $res = Test::MockObject->new();
+ $res->set_true( "is_success" );
+ $res->mock( "content", sub { "AQSMS-AUTHERROR" } );
+ return $res;
+}
+
+$mocked_ua->mock( "post", sub { my $r = Test::MockObject->new(); $r->set_false( "is_success" ); return $r; } );
+$balance = $sender->credit;
+is($balance, undef, "No server available");
+is($sender->last_error, "Could not get valid response from any server", "Correct error message");
+is($sender->last_status, 0, "Error state");
+
+
+my $rc = $sender->send_sms( "000", "Test text" );
+is($rc, 0, "Sending failure due to no originator");
+is($sender->last_error, "Cannot send message without sender specified", "And last_error set correctly");
+is($sender->last_status, 0, "Error state");
+like( $warning, '/^Cannot send message without sender specified/', "And right warning" );
+
+
+
+
+
+
+#
+# Sending tests
+#
+diag("Testing sending text, simulating all servers failing");
+$sender->{user} = "test_user";
+$mocked_ua->mock("post",
+ sub {
+ my $r = Test::MockObject->new();
+ $r->set_false( "is_success" );
+ return $r;
+ }
+);
+$rc = $sender->send_sms( "000", "Test text", { sender => "Altinity" } );
+is($rc, 0, "No server available");
+is($sender->last_error, "Could not get valid response from any server",
+ "Correct error message");
+is($sender->last_status, 0, "Error state");
+
+
+diag("Testing sending text, simulating success");
+$mocked_ua->mock("post", \&send_text);
+$rc = $sender->send_sms("000", "Testing text", { sender => "Altinity" });
+is($rc, 1, "Successful send");
+is($sender->last_response, "AQSMS-OK:1", "Got reply correctly");
+is($sender->last_response_text, "OK", "Got text correctly");
+is($sender->last_status, 1, "OK state");
+
+my $message;
+($rc, $message) =
+ $sender->send_sms("000", "Testing text", { sender => "Altinity" });
+is($rc, 1, "Successful send on an array interface");
+is($message, "OK", "With right message");
+is($sender->last_status, 1, "OK state");
+
+sub send_text {
+ my ($self, $server, $postdata) = @_;
+ my $expected = {
+ username => "test_user",
+ password => "test_password",
+ orig => "Altinity",
+ to_num => "000",
+ message => "Testing text"
+ };
+
+ like($server, '/^http:\/\/.*\/sms\/postmsg-concat.php$/',
+ "Server correct format: $server");
+ is_deeply( $postdata, $expected, "Post data correct" );
+
+ my $res = Test::MockObject->new();
+ $res->set_true( "is_success" );
+ $res->mock( "content", sub { "AQSMS-OK:1" } );
+ return $res;
+}
+
+diag("Testing sending text to invalid destination");
+# I could only get an "AQSMS-INVALID_DESTINATION if I set the to_num as "bob".
+# Setting a mobile number with a digit short, or 000 would still go through
+# as AQSMS-OK. However, SMS::AQL tries to cleanup the number, so using bob
+# fails because the postdata return "ob" instead. So for now, it makes sense
+# to just put a dummy number in because this is really a test for AQL's server
+# - we just need to make sure we process this reply correctly.
+
+$mocked_ua->mock("post", \&send_text_invalid_destination);
+$rc = $sender->send_sms( "000", "Testing text to invalid dest", { sender => "Altinity" } );
+is($rc, 0, "Expected error");
+is($sender->last_response, "AQSMS-INVALID_DESTINATION", "Got expected reply");
+is($sender->last_response_text, "Invalid destination", "Got text correctly");
+is($sender->last_status, 0, "Error state");
+
+($rc, $message) = $sender->send_sms( "000", "Testing text to invalid dest", { sender => "Altinity" } );
+is($rc, 0, "Expected error on an array interface");
+is($message, "Invalid destination", "With right message");
+is($sender->last_status, 0, "Error state");
+
+sub send_text_invalid_destination {
+ my ($self, $server, $postdata) = @_;
+ my $expected = { username => "test_user", password => "test_password", orig => "Altinity", to_num => "000", message=>"Testing text to invalid dest" };
+
+ like( $server, '/^http:\/\/.*\/sms\/postmsg-concat.php$/', "Server correct format: $server");
+ is_deeply( $postdata, $expected, "Post data correct" );
+
+ my $res = Test::MockObject->new();
+ $res->set_true( "is_success" );
+ $res->mock( "content", sub { "AQSMS-INVALID_DESTINATION" } );
+ return $res;
+}
+
+
+diag("Testing sending text, simulating failure due to no credit");
+$mocked_ua->mock("post", \&send_text_no_credits);
+$rc = $sender->send_sms(
+ "000", "Testing text to invalid dest", { sender => "Altinity" }
+);
+is($rc, 0, "Expected error");
+is($sender->last_response, "AQSMS-NOCREDIT", "Got expected reply");
+is($sender->last_response_text, "Out of credits", "Got text correctly");
+is($sender->last_status, 0, "Error state");
+
+($rc, $message) = $sender->send_sms(
+ "000", "Testing text to invalid dest", { sender => "Altinity" }
+);
+is($rc, 0, "Expected error on an array interface");
+is($message, "Out of credits", "With right message");
+is($sender->last_status, 0, "Error state");
+
+sub send_text_no_credits {
+ my ($self, $server, $postdata) = @_;
+ my $expected = {
+ username => "test_user",
+ password => "test_password",
+ orig => "Altinity",
+ to_num => "000",
+ message => "Testing text to invalid dest"
+ };
+
+ like($server, qr{^http://.*/sms/postmsg-concat.php$},
+ "Server correct format: $server");
+ is_deeply( $postdata, $expected, "Post data correct" );
+
+ my $res = Test::MockObject->new();
+ $res->set_true( "is_success" );
+ $res->mock( "content", sub { "AQSMS-NOCREDIT" } );
+ return $res;
+}
+
+diag("Testing sending text, simulating unexected response");
+$mocked_ua->mock("post", \&send_text_unexpected_response);
+$rc = $sender->send_sms(
+ "000", "Testing text to invalid dest", { sender => "Altinity" }
+);
+is($rc, 0, "Expected error");
+is($sender->last_response, "AQSMS-NOTPROPER", "Got expected reply");
+is($sender->last_response_text,
+ "Unrecognised response from server: AQSMS-NOTPROPER", "Got text correctly");
+is($sender->last_status, 0, "Error state");
+
+
+diag("Testing sending text, simulating invalid destination");
+($rc, $message) = $sender->send_sms(
+ "000", "Testing text to invalid dest", { sender => "Altinity" }
+);
+is($rc, 0, "Expected error on an array interface");
+is($message, "Unrecognised response from server: AQSMS-NOTPROPER",
+ "With right message");
+is($sender->last_status, 0, "Error state");
+
+sub send_text_unexpected_response {
+ my ($self, $server, $postdata) = @_;
+ my $expected = {
+ username => "test_user",
+ password => "test_password",
+ orig => "Altinity",
+ to_num => "000",
+ message => "Testing text to invalid dest"
+ };
+
+ like($server, qr{^http://.*/sms/postmsg-concat.php$},
+ "Server correct format: $server");
+ is_deeply( $postdata, $expected, "Post data correct" );
+
+ my $res = Test::MockObject->new();
+ $res->set_true( "is_success" );
+ $res->mock( "content", sub { "AQSMS-NOTPROPER" } );
+ return $res;
+}
+
+
+$mocked_ua->mock( "post",
+ sub {
+ my $r = Test::MockObject->new();
+ $r->set_false( "is_success" );
+ return $r;
+ }
+);
+$rc = $sender->send_sms(
+ "000", "Testing text to invalid dest", { sender => "Altinity" }
+);
+is($rc, 0, "Expected error: No server available");
+is($sender->last_error, "Could not get valid response from any server",
+ "Correct error message");
+is($sender->last_status, 0, "Error state");
+
+diag("Testing sending text, simulating all servers failing");
+($rc, $message) = $sender->send_sms(
+ "000", "Testing text to invalid dest", { sender => "Altinity" }
+);
+is($rc, 0, "Expected error: No server available");
+is($message, "Could not get valid response from any server",
+ "With right message");
+is($sender->last_status, 0, "Error state");
+
+
+
+
+# now test new voice push functionality
+diag("Testing voice push functionality");
+$mocked_ua->mock("post", \&voice_push);
+$rc = $sender->voice_push("000", "Testing voice");
+is($rc, 1, 'Successful voice push send');
+is($sender->last_response, "VP_OK", "Got reply correctly" );
+is($sender->last_response_text, "OK", "Got text correctly" );
+is($sender->last_status, 1, "OK state" );
+
+($rc, $message) = $sender->voice_push( "000", "Testing voice");
+is($rc, 1, "Successful send on an array interface");
+is($message, "OK", "With right message" );
+is($sender->last_status, 1, "OK state" );
+
+sub voice_push {
+ my ($self, $server, $postdata) = @_;
+ my $expected = {
+ username => "test_user",
+ password => "test_password",
+ msisdn => "000",
+ message => "Testing voice"
+ };
+
+ like( $server, qr{^http://vp\d\.aql\.com/voice_push.php$},
+ "Server correct format: $server");
+ is_deeply( $postdata, $expected, "Post data correct" );
+
+ my $res = Test::MockObject->new();
+ $res->set_true( "is_success" );
+ $res->mock( "content", sub { "VP_OK" } );
+ return $res;
+}
+
+# TODO: write further tests for the voice push functionality, to ensure it
+# handles all possible AQL responses correctly.
\ No newline at end of file
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libsms-aql-perl.git
More information about the Pkg-perl-cvs-commits
mailing list