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

package SMS::Send::UK::AA;
{
  $SMS::Send::UK::AA::VERSION = '0.004';
}
# ABSTRACT: Send SMS messages using Andrews and Arnold's gateway
use strict;
use parent qw(SMS::Send::Driver);

use Carp qw(croak);
use LWP::UserAgent 6.00; # We need proper SSL support
use HTTP::Request::Common;
use URI 1.53; # ->secure

use SMS::Send::UK::AA::Response;

use constant DEFAULT_ENDPOINT => "https://sms.aa.net.uk/sms.cgi";

my @supported_params = qw(
  limit sendtime replace flash report costcentre private originator udh iccid
);

sub new {
  my($class, %args) = @_;

  my $self = bless {
    _endpoint => delete $args{_endpoint} || DEFAULT_ENDPOINT,
    _username => delete $args{_login},
    _password => delete $args{_password},
  }, $class;

  my $ssl_verify = exists $args{_ssl_verify} ? delete $args{_ssl_verify} : 1;
  $self->{ua} = $self->_create_ua($ssl_verify);

  for my $param(@supported_params) {
    if(exists $args{"_" . $param}) {
      $self->{"_" . $param} = delete $args{"_" . $param};
    }
  }

  if(%args) {
    croak "Unknown arguments: ", join ",", keys %args;
  }

  return $self;
}

sub send_sms {
  my $self = shift;

  # send_sms params can also be set in the constructor
  my $request = _construct_request(%$self, @_);

  my $response = $self->{ua}->request($request);
  my $okay = $response->is_success && $response->content =~ /^OK:/m;

  # This is rather yuck -- the SMS::Send API is basically true/false, I could
  # just stick the error in $@ but that seems a bit untidy, so instead return a
  # magic thing that can be false but still contain a string.
  return SMS::Send::UK::AA::Response->new($okay, $response->content);
}

sub _create_ua {
  my($self, $ssl_verify) = @_;

  my $ua = LWP::UserAgent->new;
  $ua->env_proxy;

  if(URI->new($self->{_endpoint})->secure) {
    require LWP::Protocol::https;
    require CACertOrg::CA if $ssl_verify;

    $ua->ssl_opts(
      verify_hostname => $ssl_verify,
      $ssl_verify ? (SSL_ca_file => CACertOrg::CA::SSL_ca_file()) : ()
    );
  }

  return $ua;
}

sub _construct_request {
  my(%params) = @_;

  my $endpoint = delete $params{_endpoint};

  my %data;
  $data{message}     = delete $params{text};
  $data{destination} = delete $params{to};

  for my $name(keys %params) {
    next unless $name =~ /^_/;
    $data{substr $name, 1} = $params{$name};
  }

  if(exists $data{iccid}) {
    delete $data{destination};
  }

  return POST $endpoint, \%data;
}

1;


__END__