File Coverage

blib/lib/SMS/Send/AT/TMobile.pm
Criterion Covered Total %
statement 21 33 63.6
branch 1 8 12.5
condition 2 2 100.0
subroutine 7 7 100.0
pod 2 2 100.0
total 33 52 63.4


line stmt bran cond sub pod time code
1 1     1   49397 use strict;
  1         2  
  1         30  
2 1     1   4 use warnings;
  1         1  
  1         39  
3             package SMS::Send::AT::TMobile;
4             $SMS::Send::AT::TMobile::VERSION = '0.002';
5             # ABSTRACT: SMS::Send driver for the T-Mobile Austria SMSC service
6              
7 1     1   4 use Carp;
  1         4  
  1         296  
8 1     1   706 use HTTP::Tiny;
  1         42215  
  1         59  
9              
10 1     1   10 use base 'SMS::Send::Driver';
  1         1  
  1         434  
11              
12              
13             sub new {
14 4     4 1 2997 my $class = shift;
15 4         13 my $self = { @_ };
16              
17             $self->{$_}
18             or croak "$_ missing"
19 4   100     72 for qw( _login _password );
20              
21 1         4 return bless $self, $class;
22             }
23              
24             sub send_sms {
25 1     1 1 457 my ($self, %args) = @_;
26              
27 1 50       12 defined $args{_from}
28             or croak "_from missing";
29              
30 0           my $http = HTTP::Tiny->new( timeout => 3 );
31              
32             # default to numeric sender id
33 0           my $oa_ton = 1;
34 0           my $oa_npi = 1;
35             # alphanumerical sender id
36 0 0         if ( $args{_from} !~ /^\d+$/ ) {
37 0           $oa_ton = 5;
38 0           $oa_npi = 0;
39             }
40             # the API expects the recipient without a leading +
41 0           ( my $to = $args{to} ) =~ s/^\+//;
42              
43 0           my $response = $http->post_form(
44             'http://213.162.67.5/cgi-bin/sendsms.fcgi',
45             [
46             id => $self->{_login},
47             passwd => $self->{_password},
48             rcpt_req => 0,
49             # sender
50             oa => $args{_from},
51             oa_ton => $oa_ton,
52             oa_npi => $oa_npi,
53             # recipient
54             da => $to,
55             da_ton => 1,
56             da_npi => 1,
57             text => $args{text},
58             ]
59             );
60              
61             # for example a timeout error
62 0 0         die $response->{content}
63             unless $response->{success};
64              
65             # known response messages:
66             # +OK 01 message(s) successfully sent to 43676012345678:msgid=0::
67             # -ERR 04 Currently unavailable ::
68             # -ERR 20 Unknown error ::
69 0 0         return 1
70             if $response->{content} =~ /^\+OK 01/;
71              
72 0           $@ = {
73             as_string => $response->{content},
74             };
75              
76 0           return 0;
77             }
78              
79             1;
80              
81             __END__