File Coverage

blib/lib/SMS/API/QuickTelecom.pm
Criterion Covered Total %
statement 56 73 76.7
branch 21 32 65.6
condition 12 19 63.1
subroutine 12 13 92.3
pod 4 4 100.0
total 105 141 74.4


line stmt bran cond sub pod time code
1             package SMS::API::QuickTelecom;
2              
3 4     4   123688 use 5.006;
  4         12  
4 4     4   14 use strict;
  4         5  
  4         74  
5 4     4   13 use warnings;
  4         10  
  4         114  
6 4     4   15 use Carp qw( croak ) ;
  4         4  
  4         219  
7 4     4   2270 use LWP::UserAgent;
  4         150575  
  4         128  
8 4     4   2022 use POSIX qw(strftime);
  4         20873  
  4         24  
9              
10             =head1 NAME
11              
12             SMS::API::QuickTelecom - QuickTelecom SMS service on qtelecom.ru
13              
14             =head1 VERSION
15              
16             Version 0.04
17              
18             =cut
19              
20             our $VERSION = '0.04';
21              
22             my @fields = qw(
23             user pass host path ssl test
24             CLIENTADR comment HTTP_ACCEPT_LANGUAGE sender );
25              
26             sub _set {
27 12     12   49 my $self = shift;
28 12         12 my $k = shift;
29 12         41 $self->{$k} = shift;
30             }
31              
32             sub _get {
33 9     9   10 my $self = shift;
34 9         368 $self->{shift()};
35             }
36              
37             sub _get_post_request {
38 4     4   7 my $class = shift;
39 4         10 my %arg = @_;
40              
41             my $post = {
42             user => $class->{user},
43             pass => $class->{pass},
44 4   50     25 gzip => $class->{gzip} || '',
45             };
46 4         12 map { $post->{$_}=$arg{$_} } keys %arg;
  8         17  
47              
48 4 50 50     74 my $url = 'http'.($class->{ssl} ? 's':'').'://'.$class->{host}.':'.($class->{port} ? $class->{port} : ($class->{ssl} ? 443 : 80)).($class->{path}||'').'/';
    50          
    50          
49              
50 4         34 my $ua = LWP::UserAgent->new( agent => 'Mozilla/5.0 (X11; Linux i586; rv:41.0) Gecko/20120101 Firefox/41.0' );
51              
52 4         4727 my $res = $ua->post( $url, $post, 'Content-Type' => 'application/x-www-form-urlencoded; charset=UTF-8', );
53              
54 4 50       2278971 if ($res->is_success) {
55 4         75 $res = $res->content;
56             } else {
57 0         0 $res = ' 58 0         0 $res .= $class->{user};
59 0         0 $res .= '" DATE_REPORT="';
60 0         0 $res .= (strftime "%d.%m.%Y %T", localtime);
61 0         0 $res .= '"> 62 0         0 $res .= $res->code();
63 0         0 $res .= '" description="';
64 0         0 $res .= $res->message();
65 0         0 $res .= '"/>';
66             }
67              
68 4         340 $res;
69             }
70              
71             =head1 SYNOPSIS
72              
73             use SMS::API::QuickTelecom;
74              
75             my $qtsms = SMS::API::QuickTelecom->new(
76             user => 'account-login',
77             pass => 'account-password',
78             );
79              
80             $qtsms->send_sms(message=>'Test-SMS', target=>'+799912345678');
81              
82             print "Balance-XML:\n".$qtsms->balance();
83              
84              
85             =head2 Overview
86              
87             A quick perl port of few classes from official PHP QTSMS.class for SMS sending.
88              
89             Default settings are set to use HTTPS for communication.
90              
91             =head1 METHODS
92              
93             =cut
94              
95             =head2 B<< SMS::API::QuickTelecom->new(%options) >>
96              
97             Instantiate and initialise object with the following options:
98              
99             =over 4
100              
101             =item C<< user => $account_name >>
102              
103             Account username you receive during your registration. Mandatory.
104              
105             =item C<< pass => $password >>
106              
107             Account password you receive during your registration. Mandatory.
108              
109             =item C<< host => $hostname // 'go.qtelecom.ru' >>
110              
111             Optional.
112              
113             Host name to perform POST/GET requests to. When using SSL (by default) it's default to L.
114              
115             If you are willing to use insecure communication via plain HTTP then host must be set to L and C=0.
116              
117             =item C<< path => $path // '/public/http' >>
118              
119             Optional.
120              
121             Path on server to perform requests. Default is C.
122              
123             =item C<< ssl => $ssl // '1' >>
124              
125             Optional.
126              
127             Flag to use SSL, default is C<1> (on). Optional.
128              
129             =item C<< gzip => $gzip // 'none' >>
130              
131             Optional.
132              
133             Flag to enable|disable gzip-encoding of data, possible values are: C or C, default is C.
134              
135             Optional
136              
137             =item C<< comment => $comment // '' >>
138              
139             Optional.
140              
141             Connection description.
142              
143             =item C<< HTTP_ACCEPT_LANGUAGE => $lang // 'en' >>
144              
145             Optional.
146              
147             Langage to use for the returned data content.
148              
149             =item C<< CLIENTADR => $ip // '127.0.0.1' >>
150              
151             Optional.
152              
153             IP-address of the sender. If not specified will be set to C<127.0.0.1> internally.
154              
155             =item C<< sender => $sender // default >>
156              
157             Optional.
158              
159             Name of the sender, registered in system on L.
160              
161             If not specified default setting from system will be used.
162              
163             =back
164              
165             =cut
166              
167             sub new {
168 5     5 1 161685 my $class = shift;
169 5         25 my $self = {
170             'version' => $VERSION,
171             'path' => '/public/http',
172             'host' => 'go.qtelecom.ru',
173             'ssl' => 1,
174             'gzip' => 'none',
175             };
176 5         22 my %arg = @_;
177              
178 5         10 bless $self, $class;
179              
180 5         14 foreach my $field (@fields) {
181 50 100       123 $self->_set($field, $arg{$field}) if exists $arg{$field};
182             }
183              
184 5         10 foreach my $field (qw/ user pass /) {
185 9 100       20 croak "new() $field is mandatory" unless defined $self->_get($field);
186             }
187              
188 3         10 $self;
189             }
190              
191             =head2 balance
192              
193             Returns an XML describing account balance and overdraft in the national currency.
194              
195             Takes no parameters.
196              
197             =cut
198              
199             sub balance {
200 1     1 1 7 shift->_get_post_request( action => 'balance' );
201             }
202              
203             =head2 send_sms
204              
205             Sends a text SMS to one or more recipients.
206              
207             Return XML with report.
208              
209             =over 4
210              
211             =item C<< message => $message >>
212              
213             Mandatory.
214              
215             Message text to send. Enconding must be ASCII or UTF-8. Internally module is using UTF-8 encoding.
216              
217             =item C<< target => $recipients >>
218              
219             Mandatory.
220              
221             List of recipients to send message, comma delimited if there are more than one recipient:
222              
223             "+70010001212, 80009990000"
224              
225             Mutualy exclusive with C
226              
227             =item C<< phl_codename => $phl_codename // '' >>
228              
229             Mutualy exclusive with C, one or other is mandatory.
230              
231             Codename of a recipient via contact-list created on L.
232              
233             =item C<< sender => $sender // '' >>
234              
235             Optional.
236              
237             Sender's nickname, one of the registered on L.
238              
239             =item C<< period => $period // '' >>
240              
241             Optional.
242              
243             Time-to-Live for a message, units are second. Message will be discarded if system fails to deliver message over this period of time.
244              
245             Caution: this service may not work for some routes, like a CDMA phones.
246              
247             =item C<< time_period => $time_period // '' >>
248              
249             Optional.
250              
251             Timeperiod during which message shall be delivered to the recipients (like 10:00-21:00).
252             Use of this option allows to skip delivery of messages during night hours.
253             For this service to work correctly you may specify L timezone.
254              
255             =item C<< time_local => $time_local // '' >>
256              
257             Optional.
258              
259             Selection of time zone for C option:
260             1 - means C is local time for the recipient,
261             0 - means C was specified according to the sender settings.
262              
263             =item C<< autotrimtext => $autotrimtext // '' >>
264              
265             Optional.
266              
267             Automatically trim leading and trailign spaces from a message.
268              
269             =back
270              
271             =cut
272              
273             sub send_sms {
274 0     0 1 0 my $class = shift;
275 0         0 my %arg = @_;
276              
277 0         0 $arg{action}='post_sms';
278 0         0 $arg{sms_type}='';
279              
280 0 0       0 $arg{post_id}=(strftime '%s', localtime).'td'.$$ unless $arg{post_id};
281 0 0       0 $arg{CLIENTADR}='127.0.0.1' unless $arg{CLIENTADR};
282 0 0       0 $arg{HTTP_ACCEPT_LANGUAGE}='en-us;q=0.5,en;q=0.5' unless $arg{HTTP_ACCEPT_LANGUAGE};
283              
284 0         0 $class->_get_post_request( %arg );
285             }
286              
287             =head2 status
288              
289             my $status_xml = $qtsms->status( sms_id => '359900000000000080' );
290              
291             Returns an XML describing status of operation.
292              
293             There are three ways to get a status: by C, or by C or by pair C and C.
294              
295             =over 4
296              
297             =item C<< sms_id => $sms_id >>
298              
299             ID of the sms, taken from the tag C in responce of sending SMS.
300              
301             =item C<< sms_group_id => $sms_group_id >>
302              
303             ID of a group of sent messages, taken from tag C in responce of sendin one SMS or group of SMS.
304              
305             =item C<< date_from => $date_from, date_to => $date_to >>
306              
307             Get status of all the messages sent during the timeframe given by C and C.
308              
309             Format of the date is C.
310              
311             Period must start in less than 4 days before the current date.
312              
313             =back
314              
315             =cut
316              
317             sub status {
318 7     7 1 10717 my $class = shift;
319 7         27 my %arg = @_;
320              
321 7         50 my %d = ( action => 'status' );
322 7         20 foreach my $d (qw/ sms_id sms_group_id date_from date_to /) {
323 28 100       72 $d{$d} = $arg{$d} if $arg{$d};
324             }
325              
326 7 100       19 if (defined $d{'date_from'}) {
327 4 100       229 croak "date_from and date_to fields both must be defined" unless defined $d{'date_to'};
328 3 100       7 do { croak "wrong format: $_" unless $d{$_} =~ /^\d\d\.\d\d\.\d{4}\s\d\d:\d\d:\d\d$/; } foreach (qw/ date_from date_to/);
  5         89  
329             } else {
330 3 100 100     142 croak "sms_id or sms_group_id field is mandatory" unless defined $d{sms_id} or defined $d{sms_group_id};
331             }
332              
333             croak "use sms_id or sms_group_id or date_from/date_to to select data"
334 4 100 66     254 if (defined $d{sms_id} and (defined $d{sms_group_id} or defined $d{date_from}));
      66        
335             croak "use sms_id or sms_group_id or date_from/date_to to select data"
336 3 50 33     16 if (defined $d{sms_group_id} and (defined $d{sms_id} or defined $d{date_from}));
      66        
337              
338 3         14 $class->_get_post_request( %d );
339             }
340              
341             =head1 AUTHOR
342              
343             Pasichnichenko Konstantin, C<< >>
344              
345             =head1 BUGS
346              
347             Please report any bugs or feature requests to C, or through
348             the web interface at L. I will be notified, and then you'll
349             automatically be notified of progress on your bug as I make changes.
350              
351             =head1 SUPPORT
352              
353             You can find documentation for this module with the perldoc command.
354              
355             perldoc SMS::API::QuickTelecom
356              
357              
358             You can also look for information at:
359              
360             =over 4
361              
362             =item * RT: CPAN's request tracker (report bugs here)
363              
364             L
365              
366             =item * AnnoCPAN: Annotated CPAN documentation
367              
368             L
369              
370             =item * CPAN Ratings
371              
372             L
373              
374             =item * Search CPAN
375              
376             L
377              
378             =back
379              
380              
381             =head1 ACKNOWLEDGEMENTS
382              
383              
384             =head1 LICENSE AND COPYRIGHT
385              
386             Copyright 2016 Pasichnichenko Konstantin.
387              
388             This program is free software; you can redistribute it and/or modify it
389             under the terms of the the Artistic License (2.0). You may obtain a
390             copy of the full license at:
391              
392             L
393              
394             Any use, modification, and distribution of the Standard or Modified
395             Versions is governed by this Artistic License. By using, modifying or
396             distributing the Package, you accept this license. Do not use, modify,
397             or distribute the Package, if you do not accept this license.
398              
399             If your Modified Version has been derived from a Modified Version made
400             by someone other than you, you are nevertheless required to ensure that
401             your Modified Version complies with the requirements of this license.
402              
403             This license does not grant you the right to use any trademark, service
404             mark, tradename, or logo of the Copyright Holder.
405              
406             This license includes the non-exclusive, worldwide, free-of-charge
407             patent license to make, have made, use, offer to sell, sell, import and
408             otherwise transfer the Package with respect to any patent claims
409             licensable by the Copyright Holder that are necessarily infringed by the
410             Package. If you institute patent litigation (including a cross-claim or
411             counterclaim) against any party alleging that the Package constitutes
412             direct or contributory patent infringement, then this Artistic License
413             to you shall terminate on the date that such litigation is filed.
414              
415             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
416             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
417             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
418             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
419             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
420             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
421             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
422             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
423              
424              
425             =cut
426              
427             1; # End of SMS::API::QuickTelecom