From d4467bf86496d0595f0ac67eb07384560ecd9ae9 Mon Sep 17 00:00:00 2001 From: David Precious Date: Mon, 16 Jul 2007 01:04:25 +0000 Subject: [PATCH] SMS-AQL 0.04 ready to package and release to CPAN. This incoprorates the changes kindly submitted by Tom Voon at Altinity (including documentation, much better parsing of server responses, and tests using Test::MockObject). git-svn-id: file:///shared/svn/scripts/perl/modules/SMS-AQL@158 c1e6fe2f-0919-0410-96f0-e3221d39872c --- Changes | 9 ++ MANIFEST | 1 + META.yml | 24 ++--- README | 11 ++- eg/example.pl | 4 +- lib/SMS/AQL.pm | 153 ++++++++++++++++++++--------- t/4-mock.t | 257 +++++++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 398 insertions(+), 61 deletions(-) create mode 100644 t/4-mock.t diff --git a/Changes b/Changes index e64b20e..6310de3 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,14 @@ Revision history for Perl extension SMS::AQL. +0.04 16/07/2007 +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 26/06/2007 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 diff --git a/MANIFEST b/MANIFEST index 691c9c7..573dbff 100644 --- a/MANIFEST +++ b/MANIFEST @@ -7,5 +7,6 @@ eg/example.pl 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) diff --git a/META.yml b/META.yml index 623ca69..0039b94 100644 --- a/META.yml +++ b/META.yml @@ -1,11 +1,13 @@ -# http://module-build.sourceforge.net/META-spec.html -#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# -name: SMS-AQL -version: 0.02 -version_from: lib/SMS/AQL.pm -installdirs: site -requires: - LWP::UserAgent: 0 - HTTP::Request: 0 -distribution_type: module -generated_by: ExtUtils::MakeMaker version 6.17 +--- #YAML:1.0 +name: SMS-AQL +version: 0.04 +abstract: Perl extension to send SMS text messages via AQ's SMS service +license: ~ +generated_by: ExtUtils::MakeMaker version 6.32 +distribution_type: module +requires: +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.2.html + version: 1.2 +author: + - David Precious diff --git a/README b/README index 868bd3e..df0dda1 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -SMS::AQL version 0.03 +SMS::AQL version 0.04 =========================== SMS::AQL is a simple module which provides a clean @@ -40,11 +40,18 @@ This module requires these other modules and libraries: COPYRIGHT AND LICENCE -Copyright (C) 2006 by David Precious +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/eg/example.pl b/eg/example.pl index ffcea87..44bc77a 100644 --- a/eg/example.pl +++ b/eg/example.pl @@ -12,7 +12,7 @@ my $test_pass = 'sms-aql-test'; use warnings; -use lib './lib/'; +use lib '../lib/'; use SMS::AQL; my $sender = new SMS::AQL({username => $test_user, password => $test_pass}); @@ -20,6 +20,8 @@ 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"; diff --git a/lib/SMS/AQL.pm b/lib/SMS/AQL.pm index 48baf7d..878841c 100644 --- a/lib/SMS/AQL.pm +++ b/lib/SMS/AQL.pm @@ -16,7 +16,10 @@ use LWP::UserAgent; use HTTP::Request; -our $VERSION = '0.03'; +our $VERSION = '0.04'; + +my $UNRECOGNISED_RESPONSE = "Unrecognised response from server"; +my $NO_RESPONSES = "Could not get valid response from any server"; =head1 NAME @@ -123,6 +126,9 @@ sub new { # remember the last server response we saw: $self->{last_response} = ''; + $self->{last_response_text} = ''; + $self->{last_error} = ''; + $self->{last_status} = 0; return $self; } @@ -142,6 +148,7 @@ 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: @@ -172,8 +179,9 @@ sub send_sms { ); if (!$postdata{orig}) { - warn "Cannot send message without sender specified\n"; - return; + $self->{last_error} = "Cannot send message without sender specified"; + warn($self->{last_error}); + return 0; } # try the request to each sever in turn, stop as soon as one succeeds. @@ -186,49 +194,30 @@ sub send_sms { my $resp = $response->content; - # this code wasn't too bad to start with but has now bloated into - # cruftitude... will refactor this into a half decent lookup table - # in the next version, but it works for now, to get the initial - # version out the door. - $self->{last_response} = $resp; - - for ($resp) { - - if (/AQSMS-OK/) { - # the aqsms gateway, he say YES - return wantarray? - (1, 'OK') : 1; - - } elsif (/AQSMS-NOCREDIT/) { - # uh-oh, we're out of credit! - return wantarray? - (0, 'Out of credits') : 0; - - } elsif (/AQSMS-INVALID_DESTINATION/) { - return wantarray? - (0, 'Invalid destination') : 0; - - } else { - # didn't recognise the response - return wantarray? - (0, 'Unrecognised response from server') : 0; - } - } + $self->_check_aql_response_code($response); + + return wantarray ? ($self->last_status, $self->last_response_text) : $self->last_status; } # end of while loop through servers # if we reach this point without returning, then we tried all 4 SMS gateway # servers and couldn't connect to any of them - this is pretty unlikely, if # it does happen it's almost certainly our own connectivity that's gone! - return 'FAIL|NOSERVERS'; + $self->_set_no_valid_response; + return wantarray ? (0, $self->last_error) : 0; } # end of sub send_sms +sub _set_no_valid_response { + my $self = shift; + $self->{last_error} = $NO_RESPONSES; + $self->{last_status} = 0; +} =item credit() -Returns the current account credit +Returns the current account credit. Returns undef if any errors occurred =cut @@ -251,7 +240,7 @@ sub credit { next unless ($response->is_success); # try next server if we failed. - my $resp = $response->content; + $self->_check_aql_response_code($response); my ($credit) = $response->content =~ /AQSMS-CREDIT=(\d+)/; @@ -259,37 +248,56 @@ sub 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. +gateway in a readable format. Possible codes are: =over -=item AQSMS-NOAUTHDETAILS - -The username and password were not supplied - =item AQSMS-AUTHERROR The username and password supplied were incorrect =item AQSMS-NOCREDIT -The account specified did not have sufficient credit +Out of credits (The account specified did not have sufficient credit) =item AQSMS-OK -The message was queued on our system successfully +OK (The message was queued on our system successfully) =item AQSMS-NOMSG @@ -299,11 +307,56 @@ No message or no destination number were supplied =cut -sub last_error { - - shift->{last_error} +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, + }, + + # This one looks deprecated. A 401 error appears if username or password is missing from request + # but this module should always add that, so not needed to check against + #"AQSMS-NOAUTHDETAILS" => { text => "The username and password were not supplied", error => 1 }, + ); + +sub _check_aql_response_code { + my ($self, $res) = @_; + my $r = $self->{last_response} = $res->content; + $r =~ s/^([\w\-]+).*/$1/; # Strip everything after initial alphanumerics and hyphen + 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}; + } +} -} +sub last_response_text { shift->{last_response_text} } # fix up the number @@ -343,11 +396,17 @@ All bug reports, feature requests, patches etc welcome. =head1 COPYRIGHT AND LICENSE -Copyright (C) 2006 by David Precious +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. +=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/4-mock.t b/t/4-mock.t new file mode 100644 index 0000000..910f5b9 --- /dev/null +++ b/t/4-mock.t @@ -0,0 +1,257 @@ +#!/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 warnings; + +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 => 81; + + +# 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 +# + +$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"); + + +$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; +} + + +# 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; +} + + +$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, '/^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; +} + + +$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"); + +($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, '/^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"); + +($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"); + +