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