File Coverage

blib/lib/SMS/Send/UK/AA.pm
Criterion Covered Total %
statement 57 58 98.2
branch 12 16 75.0
condition 4 5 80.0
subroutine 12 12 100.0
pod 2 2 100.0
total 87 93 93.5


line stmt bran cond sub pod time code
1             package SMS::Send::UK::AA;
2             {
3             $SMS::Send::UK::AA::VERSION = '0.004';
4             }
5             # ABSTRACT: Send SMS messages using Andrews and Arnold's gateway
6 2     2   2525 use strict;
  2         6  
  2         96  
7 2     2   3721 use parent qw(SMS::Send::Driver);
  2         475  
  2         15  
8              
9 2     2   267 use Carp qw(croak);
  2         4  
  2         294  
10 2     2   3043 use LWP::UserAgent 6.00; # We need proper SSL support
  2         89115  
  2         76  
11 2     2   3259 use HTTP::Request::Common;
  2         7672  
  2         237  
12 2     2   21 use URI 1.53; # ->secure
  2         68  
  2         52  
13              
14 2     2   1927 use SMS::Send::UK::AA::Response;
  2         5  
  2         61  
15              
16 2     2   14 use constant DEFAULT_ENDPOINT => "https://sms.aa.net.uk/sms.cgi";
  2         3  
  2         1576  
17              
18             my @supported_params = qw(
19             limit sendtime replace flash report costcentre private originator udh iccid
20             );
21              
22             sub new {
23 3     3 1 13338 my($class, %args) = @_;
24              
25 3   100     48 my $self = bless {
26             _endpoint => delete $args{_endpoint} || DEFAULT_ENDPOINT,
27             _username => delete $args{_login},
28             _password => delete $args{_password},
29             }, $class;
30              
31 3 50       17 my $ssl_verify = exists $args{_ssl_verify} ? delete $args{_ssl_verify} : 1;
32 3         12 $self->{ua} = $self->_create_ua($ssl_verify);
33              
34 3         13 for my $param(@supported_params) {
35 30 50       178 if(exists $args{"_" . $param}) {
36 0         0 $self->{"_" . $param} = delete $args{"_" . $param};
37             }
38             }
39              
40 3 100       15 if(%args) {
41 1         294 croak "Unknown arguments: ", join ",", keys %args;
42             }
43              
44 2         18 return $self;
45             }
46              
47             sub send_sms {
48 3     3 1 1347 my $self = shift;
49              
50             # send_sms params can also be set in the constructor
51 3         23 my $request = _construct_request(%$self, @_);
52              
53 3         2681 my $response = $self->{ua}->request($request);
54 3   66     10002 my $okay = $response->is_success && $response->content =~ /^OK:/m;
55              
56             # This is rather yuck -- the SMS::Send API is basically true/false, I could
57             # just stick the error in $@ but that seems a bit untidy, so instead return a
58             # magic thing that can be false but still contain a string.
59 3         97 return SMS::Send::UK::AA::Response->new($okay, $response->content);
60             }
61              
62             sub _create_ua {
63 3     3   6 my($self, $ssl_verify) = @_;
64              
65 3         33 my $ua = LWP::UserAgent->new;
66 3         9576 $ua->env_proxy;
67              
68 3 100       56065 if(URI->new($self->{_endpoint})->secure) {
69 2         18163 require LWP::Protocol::https;
70 2 50       179825 require CACertOrg::CA if $ssl_verify;
71              
72 2 50       511 $ua->ssl_opts(
73             verify_hostname => $ssl_verify,
74             $ssl_verify ? (SSL_ca_file => CACertOrg::CA::SSL_ca_file()) : ()
75             );
76             }
77              
78 3         9917 return $ua;
79             }
80              
81             sub _construct_request {
82 3     3   19 my(%params) = @_;
83              
84 3         11 my $endpoint = delete $params{_endpoint};
85              
86 3         6 my %data;
87 3         13 $data{message} = delete $params{text};
88 3         9 $data{destination} = delete $params{to};
89              
90 3         11 for my $name(keys %params) {
91 10 100       40 next unless $name =~ /^_/;
92 7         28 $data{substr $name, 1} = $params{$name};
93             }
94              
95 3 100       37 if(exists $data{iccid}) {
96 1         3 delete $data{destination};
97             }
98              
99 3         21 return POST $endpoint, \%data;
100             }
101              
102             1;
103              
104              
105             __END__