| 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__ |