| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package SMS::API::CMTelecom; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 5 |  |  | 5 |  | 66062 | use 5.006; | 
|  | 5 |  |  |  |  | 22 |  | 
| 4 | 5 |  |  | 5 |  | 35 | use strict; | 
|  | 5 |  |  |  |  | 11 |  | 
|  | 5 |  |  |  |  | 126 |  | 
| 5 | 5 |  |  | 5 |  | 27 | use warnings; | 
|  | 5 |  |  |  |  | 20 |  | 
|  | 5 |  |  |  |  | 150 |  | 
| 6 | 5 |  |  | 5 |  | 2973 | use LWP::UserAgent; | 
|  | 5 |  |  |  |  | 207147 |  | 
|  | 5 |  |  |  |  | 200 |  | 
| 7 | 5 |  |  | 5 |  | 2644 | use JSON; | 
|  | 5 |  |  |  |  | 38333 |  | 
|  | 5 |  |  |  |  | 36 |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | =head1 NAME | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | SMS::API::CMTelecom - SMS API for cmtelecom.com | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | =head1 VERSION | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | Version 0.01 | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | =cut | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | our $VERSION = '0.03'; | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | use SMS::API::CMTelecom; | 
| 25 |  |  |  |  |  |  | my $sms = SMS::API::CMTelecom->new( | 
| 26 |  |  |  |  |  |  | product_token => '00000000-0000-0000-0000-000000000000', | 
| 27 |  |  |  |  |  |  | ); | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | $sms->send( | 
| 30 |  |  |  |  |  |  | sender     => '00480000111111111', | 
| 31 |  |  |  |  |  |  | message    => 'please call me!', | 
| 32 |  |  |  |  |  |  | recipients => '00490000000000000', | 
| 33 |  |  |  |  |  |  | reference  => 293854, | 
| 34 |  |  |  |  |  |  | ); | 
| 35 |  |  |  |  |  |  |  | 
| 36 |  |  |  |  |  |  | # bulk send to many recipients: | 
| 37 |  |  |  |  |  |  | $sms->send( | 
| 38 |  |  |  |  |  |  | sender     => '00480000111111111', | 
| 39 |  |  |  |  |  |  | message    => 'please call me!', | 
| 40 |  |  |  |  |  |  | recipients => ['00490000000000000', '00480000000000', '004300021651202'], | 
| 41 |  |  |  |  |  |  | reference  => 293854, | 
| 42 |  |  |  |  |  |  | ); | 
| 43 |  |  |  |  |  |  |  | 
| 44 |  |  |  |  |  |  | my $number = '00480000111111111'; | 
| 45 |  |  |  |  |  |  | if ($sms->validate_number($number)) { | 
| 46 |  |  |  |  |  |  | print "$number is a valid phone number.\n" | 
| 47 |  |  |  |  |  |  | } else { | 
| 48 |  |  |  |  |  |  | print "$number is no valid phone number.\n" | 
| 49 |  |  |  |  |  |  | } | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | my $number_details = $sms->number_details($number); | 
| 52 |  |  |  |  |  |  | print "$number was ported.\n" if $number_details->{ported}; | 
| 53 |  |  |  |  |  |  |  | 
| 54 |  |  |  |  |  |  |  | 
| 55 |  |  |  |  |  |  | =head1 METHODS | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | =head2 new(%options) | 
| 58 |  |  |  |  |  |  |  | 
| 59 |  |  |  |  |  |  | Instantiate and initialise object with the following options: | 
| 60 |  |  |  |  |  |  |  | 
| 61 |  |  |  |  |  |  | =over 4 | 
| 62 |  |  |  |  |  |  |  | 
| 63 |  |  |  |  |  |  | =item C<< product_token => $product_token >> | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | The product token is required to authenticate with the CM Telecom API. | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | =item C<< sender => $sender >> | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | Optional. SMS sender number. | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | =back | 
| 72 |  |  |  |  |  |  |  | 
| 73 |  |  |  |  |  |  | =cut | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | sub new { | 
| 76 | 9 |  |  | 9 | 1 | 8183 | my $class = shift; | 
| 77 | 9 |  |  |  |  | 34 | my %params = @_; | 
| 78 | 9 | 100 |  |  |  | 41 | die $class.'->new requires product_token parameter' if not exists $params{product_token}; | 
| 79 | 8 |  |  |  |  | 19 | my $self = \%params; | 
| 80 | 8 |  |  |  |  | 19 | bless $self, $class; | 
| 81 |  |  |  |  |  |  |  | 
| 82 | 8 |  |  |  |  | 58 | $self->{_ua} = LWP::UserAgent::->new(); | 
| 83 | 8 |  |  |  |  | 7026 | $self->{_ua}->agent('SMS::API::CMTelecom/'.$VERSION); | 
| 84 | 8 | 50 |  |  |  | 533 | if ($self->{_ua}->can('ssl_opts')) { | 
| 85 | 8 |  |  |  |  | 32 | $self->{_ua}->ssl_opts( verify_hostname => 0, ); | 
| 86 |  |  |  |  |  |  | } | 
| 87 |  |  |  |  |  |  |  | 
| 88 | 8 |  |  |  |  | 200 | return $self; | 
| 89 |  |  |  |  |  |  | } | 
| 90 |  |  |  |  |  |  |  | 
| 91 |  |  |  |  |  |  | =head2 send | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | =over 4 | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  | =item C<< message => $message >> | 
| 96 |  |  |  |  |  |  |  | 
| 97 |  |  |  |  |  |  | Mandatory. Message text to send. | 
| 98 |  |  |  |  |  |  |  | 
| 99 |  |  |  |  |  |  | =item C<< recipients => $recipients >> | 
| 100 |  |  |  |  |  |  |  | 
| 101 |  |  |  |  |  |  | Mandatory. May be a scalar containing one phone number or an array reference | 
| 102 |  |  |  |  |  |  | holding multiple scalars containing one phone number each. | 
| 103 |  |  |  |  |  |  |  | 
| 104 |  |  |  |  |  |  | =item C<< sender => $sender >> | 
| 105 |  |  |  |  |  |  |  | 
| 106 |  |  |  |  |  |  | Optional if already given as parameter to C. Can also be set globally when construction the object with C. | 
| 107 |  |  |  |  |  |  |  | 
| 108 |  |  |  |  |  |  | =back | 
| 109 |  |  |  |  |  |  |  | 
| 110 |  |  |  |  |  |  | If sending fails, C is returned, otherwise a hashref with some status information: | 
| 111 |  |  |  |  |  |  |  | 
| 112 |  |  |  |  |  |  | { | 
| 113 |  |  |  |  |  |  | messages => [ | 
| 114 |  |  |  |  |  |  | { | 
| 115 |  |  |  |  |  |  | messageDetails => undef, | 
| 116 |  |  |  |  |  |  | parts          => 1, | 
| 117 |  |  |  |  |  |  | reference      => 51314, | 
| 118 |  |  |  |  |  |  | status         => "Accepted", | 
| 119 |  |  |  |  |  |  | to             => "0049123456784510", | 
| 120 |  |  |  |  |  |  | }, | 
| 121 |  |  |  |  |  |  | ], | 
| 122 |  |  |  |  |  |  | } | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | You can retrieve the error message via | 
| 125 |  |  |  |  |  |  |  | 
| 126 |  |  |  |  |  |  | my $msg = $sms->error_message(); | 
| 127 |  |  |  |  |  |  |  | 
| 128 |  |  |  |  |  |  | =cut | 
| 129 |  |  |  |  |  |  |  | 
| 130 |  |  |  |  |  |  | sub send { | 
| 131 | 8 |  |  | 8 | 1 | 1432 | my $self = shift; | 
| 132 | 8 |  |  |  |  | 41 | my %params = @_; | 
| 133 |  |  |  |  |  |  |  | 
| 134 | 8 |  |  |  |  | 27 | $self->_reset_error_message(); | 
| 135 |  |  |  |  |  |  |  | 
| 136 | 8 | 100 | 66 |  |  | 42 | my @recipients = ref $params{recipients} eq 'ARRAY' ? @{ $params{recipients} } : ($params{recipients} || ()); | 
|  | 3 |  |  |  |  | 6 |  | 
| 137 |  |  |  |  |  |  |  | 
| 138 | 8 | 100 |  |  |  | 28 | return $self->_set_error_message(ref($self).'->send requires at least one recipient number') if !@recipients; | 
| 139 | 6 |  |  |  |  | 16 | for my $recipient (@recipients) { | 
| 140 | 9 | 100 |  |  |  | 24 | return $self->_set_error_message('recipient may not be undefined') if !defined $recipient; | 
| 141 | 8 | 100 |  |  |  | 21 | return $self->_set_error_message('recipient must be a telephone number') if ref $recipient; | 
| 142 | 7 | 100 |  |  |  | 38 | return $self->_set_error_message('recipient may not be an empty string') if $recipient eq ''; | 
| 143 |  |  |  |  |  |  | } | 
| 144 |  |  |  |  |  |  |  | 
| 145 | 3 |  | 66 |  |  | 16 | my $sender = $params{sender} // $self->{sender}; | 
| 146 | 3 | 100 |  |  |  | 21 | return $self->_set_error_message(ref($self).'->send requires a sender number') if !defined $sender; | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  | my $payload = { | 
| 149 |  |  |  |  |  |  | messages => { | 
| 150 |  |  |  |  |  |  | authentication => { | 
| 151 |  |  |  |  |  |  | producttoken => $self->{product_token}, | 
| 152 |  |  |  |  |  |  | }, | 
| 153 |  |  |  |  |  |  | msg => [ | 
| 154 |  |  |  |  |  |  | { | 
| 155 |  |  |  |  |  |  | from => $sender, | 
| 156 | 1 |  |  |  |  | 4 | to   => [ map { +{ number => $self->_clean_number($_) } } @recipients ], | 
| 157 |  |  |  |  |  |  | body => { | 
| 158 |  |  |  |  |  |  | type    => 'AUTO', | 
| 159 |  |  |  |  |  |  | content => $params{message}, | 
| 160 |  |  |  |  |  |  | }, | 
| 161 | 1 | 50 |  |  |  | 6 | exists $params{reference} ? (reference => $params{reference}) : (), | 
| 162 |  |  |  |  |  |  | }, | 
| 163 |  |  |  |  |  |  | ], | 
| 164 |  |  |  |  |  |  | }, | 
| 165 |  |  |  |  |  |  | }; | 
| 166 |  |  |  |  |  |  |  | 
| 167 | 1 |  |  |  |  | 29 | my $req = HTTP::Request->new( | 
| 168 |  |  |  |  |  |  | POST => 'https://gw.cmtelecom.com/v1.0/message', | 
| 169 |  |  |  |  |  |  | ['Content-Type' => 'application/json'], | 
| 170 |  |  |  |  |  |  | encode_json $payload, | 
| 171 |  |  |  |  |  |  | ); | 
| 172 | 1 |  |  |  |  | 6662 | my $res = $self->{_ua}->request( $req ); | 
| 173 |  |  |  |  |  |  |  | 
| 174 | 1 | 50 |  |  |  | 322015 | if ($res->code == 200) { | 
| 175 | 0 |  |  |  |  | 0 | my $result = decode_json $res->content(); | 
| 176 |  |  |  |  |  |  | return { | 
| 177 |  |  |  |  |  |  | messages => $result->{messages}, | 
| 178 | 0 |  |  |  |  | 0 | }; | 
| 179 |  |  |  |  |  |  | } | 
| 180 |  |  |  |  |  |  |  | 
| 181 | 1 |  |  |  |  | 13 | my $result = eval { decode_json $res->content() }; | 
|  | 1 |  |  |  |  | 53 |  | 
| 182 | 1 | 50 |  |  |  | 33 | return $self->_set_error_message($result->{details}) if ref $result eq 'HASH'; | 
| 183 |  |  |  |  |  |  |  | 
| 184 | 0 |  |  |  |  | 0 | return $self->_set_error_message('HTTP request returned with status '.$res->code); | 
| 185 |  |  |  |  |  |  | } | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  | sub _clean_number { | 
| 188 | 1 |  |  | 1 |  | 3 | my ($self, $number) = @_; | 
| 189 |  |  |  |  |  |  |  | 
| 190 |  |  |  |  |  |  | # strip all non-number chars | 
| 191 | 1 |  |  |  |  | 3 | $number =~ s/\D//g; | 
| 192 |  |  |  |  |  |  |  | 
| 193 | 1 |  |  |  |  | 12 | return $number; | 
| 194 |  |  |  |  |  |  | } | 
| 195 |  |  |  |  |  |  |  | 
| 196 |  |  |  |  |  |  | sub _set_error_message { | 
| 197 | 8 |  |  | 8 |  | 21 | my ($self, $message) = @_; | 
| 198 | 8 |  |  |  |  | 27 | $self->{error_message} = $message; | 
| 199 | 8 |  |  |  |  | 61 | return; | 
| 200 |  |  |  |  |  |  | } | 
| 201 |  |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  | sub _reset_error_message { | 
| 203 | 8 |  |  | 8 |  | 24 | my ($self, $message) = @_; | 
| 204 | 8 |  |  |  |  | 15 | $self->{error_message} = undef; | 
| 205 | 8 |  |  |  |  | 16 | return; | 
| 206 |  |  |  |  |  |  | } | 
| 207 |  |  |  |  |  |  |  | 
| 208 |  |  |  |  |  |  | =head2 validate_number $number | 
| 209 |  |  |  |  |  |  |  | 
| 210 |  |  |  |  |  |  | Checks if the given phone number is valid and provides additional information, | 
| 211 |  |  |  |  |  |  | e.g. how the number should be formatted. Returns 1 if the number is valid, a | 
| 212 |  |  |  |  |  |  | false value otherwise. | 
| 213 |  |  |  |  |  |  |  | 
| 214 |  |  |  |  |  |  | =cut | 
| 215 |  |  |  |  |  |  |  | 
| 216 |  |  |  |  |  |  | sub validate_number { | 
| 217 | 0 |  |  | 0 | 1 | 0 | my ($self, $number) = @_; | 
| 218 |  |  |  |  |  |  |  | 
| 219 |  |  |  |  |  |  | my $req = HTTP::Request->new( | 
| 220 |  |  |  |  |  |  | POST => 'https://api.cmtelecom.com/v1.1/numbervalidation', | 
| 221 |  |  |  |  |  |  | [ | 
| 222 |  |  |  |  |  |  | 'Content-Type'      => 'application/json', | 
| 223 |  |  |  |  |  |  | 'X-CM-PRODUCTTOKEN' => $self->{product_token}, | 
| 224 | 0 |  |  |  |  | 0 | ], | 
| 225 |  |  |  |  |  |  | encode_json { phonenumber => $number }, | 
| 226 |  |  |  |  |  |  | ); | 
| 227 |  |  |  |  |  |  |  | 
| 228 | 0 |  |  |  |  | 0 | my $res = $self->{_ua}->request( $req ); | 
| 229 | 0 | 0 |  |  |  | 0 | if ($res->code == 200) { | 
| 230 | 0 |  |  |  |  | 0 | my $result = decode_json $res->content(); | 
| 231 | 0 | 0 | 0 |  |  | 0 | return 1 if JSON::is_bool($result->{valid_number}) and $result->{valid_number}; | 
| 232 | 0 |  |  |  |  | 0 | return 0; | 
| 233 |  |  |  |  |  |  | } | 
| 234 | 0 |  |  |  |  | 0 | return $self->_set_error_message('HTTP request returned with status '.$res->code); | 
| 235 |  |  |  |  |  |  | } | 
| 236 |  |  |  |  |  |  |  | 
| 237 |  |  |  |  |  |  | =head2 number_details $number | 
| 238 |  |  |  |  |  |  |  | 
| 239 |  |  |  |  |  |  | Returns carrier, country, timezone and number type information about the given number. | 
| 240 |  |  |  |  |  |  |  | 
| 241 |  |  |  |  |  |  | =cut | 
| 242 |  |  |  |  |  |  |  | 
| 243 |  |  |  |  |  |  | sub number_details { | 
| 244 | 0 |  |  | 0 | 1 | 0 | my ($self, $number) = @_; | 
| 245 |  |  |  |  |  |  |  | 
| 246 |  |  |  |  |  |  | my $req = HTTP::Request->new( | 
| 247 |  |  |  |  |  |  | POST => 'https://api.cmtelecom.com/v1.1/numbervalidation', | 
| 248 |  |  |  |  |  |  | [ | 
| 249 |  |  |  |  |  |  | 'Content-Type'      => 'application/json', | 
| 250 |  |  |  |  |  |  | 'X-CM-PRODUCTTOKEN' => $self->{product_token}, | 
| 251 | 0 |  |  |  |  | 0 | ], | 
| 252 |  |  |  |  |  |  | encode_json { phonenumber => $number }, | 
| 253 |  |  |  |  |  |  | ); | 
| 254 |  |  |  |  |  |  |  | 
| 255 | 0 |  |  |  |  | 0 | my $res = $self->{_ua}->request( $req ); | 
| 256 |  |  |  |  |  |  |  | 
| 257 | 0 | 0 |  |  |  | 0 | if ($res->code == 200) { | 
| 258 | 0 |  |  |  |  | 0 | return decode_json $res->content(); | 
| 259 |  |  |  |  |  |  | } | 
| 260 | 0 |  |  |  |  | 0 | return $self->_set_error_message('HTTP request returned with status '.$res->code); | 
| 261 |  |  |  |  |  |  | } | 
| 262 |  |  |  |  |  |  |  | 
| 263 |  |  |  |  |  |  | =head2 error_message | 
| 264 |  |  |  |  |  |  |  | 
| 265 |  |  |  |  |  |  | Returns the last set error message. | 
| 266 |  |  |  |  |  |  |  | 
| 267 |  |  |  |  |  |  | =cut | 
| 268 |  |  |  |  |  |  |  | 
| 269 |  |  |  |  |  |  | sub error_message { | 
| 270 | 7 |  |  | 7 | 1 | 3146 | return shift()->{error_message}; | 
| 271 |  |  |  |  |  |  | } | 
| 272 |  |  |  |  |  |  |  | 
| 273 |  |  |  |  |  |  |  | 
| 274 |  |  |  |  |  |  | =head1 AUTHOR | 
| 275 |  |  |  |  |  |  |  | 
| 276 |  |  |  |  |  |  | Dominic Sonntag, C<<  >> | 
| 277 |  |  |  |  |  |  |  | 
| 278 |  |  |  |  |  |  | =head1 BUGS AND SUPPORT | 
| 279 |  |  |  |  |  |  |  | 
| 280 |  |  |  |  |  |  | Please report any bugs or feature requests on Github: L | 
| 281 |  |  |  |  |  |  |  | 
| 282 |  |  |  |  |  |  |  | 
| 283 |  |  |  |  |  |  | =head1 LICENSE AND COPYRIGHT | 
| 284 |  |  |  |  |  |  |  | 
| 285 |  |  |  |  |  |  | Copyright 2017 Dominic Sonntag. | 
| 286 |  |  |  |  |  |  |  | 
| 287 |  |  |  |  |  |  | This program is free software; you can redistribute it and/or modify it | 
| 288 |  |  |  |  |  |  | under the terms of the the Artistic License (2.0). You may obtain a | 
| 289 |  |  |  |  |  |  | copy of the full license at: | 
| 290 |  |  |  |  |  |  |  | 
| 291 |  |  |  |  |  |  | L | 
| 292 |  |  |  |  |  |  |  | 
| 293 |  |  |  |  |  |  | =cut | 
| 294 |  |  |  |  |  |  |  | 
| 295 |  |  |  |  |  |  | 1; # End of SMS::API::CMTelecom |