File Coverage

blib/lib/Mojar/Message/BulkSms.pm
Criterion Covered Total %
statement 37 55 67.2
branch 8 22 36.3
condition 6 9 66.6
subroutine 8 11 72.7
pod 1 5 20.0
total 60 102 58.8


line stmt bran cond sub pod time code
1             package Mojar::Message::BulkSms;
2 3     3   435025 use Mojo::Base -base;
  3         25  
  3         16  
3              
4             our $VERSION = 1.002;
5              
6 3     3   1649 use Mojar::Log;
  3         125654  
  3         17  
7 3     3   1445 use Mojo::Parameters;
  3         5995  
  3         18  
8 3     3   1563 use Mojo::UserAgent;
  3         612527  
  3         35  
9              
10             # Attributes
11              
12             has protocol => 'http';
13             has address => 'www.bulksms.co.uk';
14             has port => '5567';
15             has path => 'eapi/submission/send_sms/2/2.0';
16             has gateway => sub {
17             my $self = shift;
18             $self->path;
19             $self->{path} =~ s{^/}{};
20             sprintf '%s://%s:%s/%s',
21             $self->protocol, $self->address, $self->port, $self->path
22             };
23              
24             has 'username';
25             has 'password';
26             has 'recipient';
27             has 'sender';
28             has international_prefix => '44';
29 10     10 0 478 sub msisdn { $_[0]->{recipient} } # read-only alias
30              
31             has 'message';
32             has ua => sub { Mojo::UserAgent->new(request_timeout => 15) };
33             has log => sub { Mojar::Log->new };
34              
35             # Public methods
36              
37             sub send {
38 12     12 1 19561 my $self = shift;
39 12 100 100     64 my $cb = @_ && ref $_[-1] eq 'CODE' ? pop : undef;
40 12 50       40 return $self->handle_error({
41             message => sprintf('Unhandled args (%s)', join ',', @_),
42             advice => -1
43             } => $cb) unless @_ % 2 == 0;
44 12 100       75 %$self = (%$self, @_) if @_;
45              
46 12         52 my @missing = grep +(not exists $self->{$_}),
47             qw(username password recipient message);
48 12 100       56 return $self->handle_error({
49             message => sprintf('Missing parameters (%s)', join ',', @missing),
50             advice => -2
51             } => $cb) if @missing;
52              
53             # Clean up recipient
54 10         28 my $original_recipient = $self->{recipient};
55 10         28 my $prefix = $self->international_prefix;
56 10         76 $self->{recipient} =~ s/\D//g; # collapse non-digits
57 10         22 $self->{recipient} =~ s/^00//; # international
58 10         17 $self->{recipient} =~ s/^0/$prefix/; # national
59             $self->log->debug(sprintf 'Preparing to send SMS to %s (%s)',
60 10         24 $original_recipient, $self->{recipient});
61              
62             # Clean up message
63 10         1876 $self->trim_message;
64              
65 10         50 my $p = Mojo::Parameters->new;
66 10         117 $p->append($_ => $self->$_) for qw(username password msisdn sender message);
67              
68 10         459 return $self->submit(sprintf('%s?%s', $self->gateway, $p->to_string) => $cb);
69             }
70              
71             sub submit {
72 0     0 0 0 my ($self, $url, $cb) = @_;
73             # Call the gateway
74 0         0 local $ENV{MOJO_USERAGENT_DEBUG} = !! $ENV{MOJAR_SMS_DEBUG};
75 0 0       0 if ($cb) {
76 0     0   0 $self->ua->get($url => sub { _check_status($self, $cb, @_) });
  0         0  
77 0         0 return $self;
78             }
79             else {
80 0         0 my $tx = $self->ua->get($url);
81 0         0 return _check_status($self, $cb, undef, $tx);
82             }
83             }
84              
85             sub _check_status {
86 0     0   0 my ($self, $cb, undef, $tx) = (@_);
87              
88             # Check http errors
89 0         0 my ($error, $advice);
90 0 0       0 return $self->handle_error($error => $cb) if $error = $tx->error;
91              
92             # Check service errors
93             eval {
94 0         0 @$error{'advice', 'message'} = split /\|/, $tx->res->body;
95 0 0 0     0 length($advice = $error->{advice} //= '-3') == 1 and $advice == 0;
96             }
97 0 0       0 or do {
98 0 0       0 @$error{'advice', 'message'} = (-4, $@) if $@;
99 0         0 return $self->handle_error($error => $cb);
100             };
101              
102 0         0 $self->log->debug('Sent to '. $self->recipient);
103 0 0       0 return $cb ? $cb->($self) : $self;
104             }
105              
106             sub handle_error {
107 4     4 0 631 my ($self, $error, $cb) = @_;
108             $self->log->error(sprintf 'Failed with %u:%s',
109 4   100     15 $error->{advice} //= 418, $error->{message} //= 'coded failure');
      50        
110 4 50       917 return $cb ? $cb->($self, $error) : undef;
111             }
112              
113             sub trim_message {
114 10     10 0 16 my $self = $_[0];
115 10         40 $self->{message} =~ s/^\s+//;
116 10         40 $self->{message} =~ s/\s+$//;
117 10         23 $self->{message} =~ s/\s\s+/ /g;
118 10         13 return $self;
119             }
120              
121             1;
122             __END__