File Coverage

blib/lib/SMS/Send/UK/AA.pm
Criterion Covered Total %
statement 55 56 98.2
branch 10 14 71.4
condition 4 5 80.0
subroutine 12 12 100.0
pod 2 2 100.0
total 83 89 93.2


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