File Coverage

blib/lib/Mojar/Message/BulkSms.pm
Criterion Covered Total %
statement 43 61 70.4
branch 8 22 36.3
condition 6 9 66.6
subroutine 10 13 76.9
pod 1 5 20.0
total 68 110 61.8


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