File Coverage

blib/lib/SMS/API/QuickTelecom.pm
Criterion Covered Total %
statement 43 60 71.6
branch 8 18 44.4
condition 2 4 50.0
subroutine 11 12 91.6
pod 3 3 100.0
total 67 97 69.0


line stmt bran cond sub pod time code
1             package SMS::API::QuickTelecom;
2              
3 3     3   27678 use 5.006;
  3         9  
4 3     3   11 use strict;
  3         5  
  3         50  
5 3     3   9 use warnings;
  3         7  
  3         79  
6 3     3   8 use Carp qw( croak ) ;
  3         3  
  3         167  
7 3     3   1634 use LWP::UserAgent;
  3         105966  
  3         92  
8 3     3   1601 use POSIX qw(strftime);
  3         13666  
  3         16  
9              
10             =head1 NAME
11              
12             SMS::API::QuickTelecom - QuickTelecom SMS service on qtelecom.ru
13              
14             =head1 VERSION
15              
16             Version 0.03
17              
18             =cut
19              
20             our $VERSION = '0.03';
21              
22             my @fields = qw(
23             user pass host path ssl test
24             CLIENTADR comment HTTP_ACCEPT_LANGUAGE sender );
25              
26             sub _set {
27 9     9   9 my $self = shift;
28 9         9 my $k = shift;
29 9         25 $self->{$k} = shift;
30             }
31              
32             sub _get {
33 7     7   7 my $self = shift;
34 7         275 $self->{shift()};
35             }
36              
37             sub _get_post_request {
38 1     1   2 my $class = shift;
39 1         3 my %arg = @_;
40              
41             my $post = {
42             user => $class->{user},
43             pass => $class->{pass},
44 1   50     7 gzip => $class->{gzip} || '',
45             };
46 1         3 map { $post->{$_}=$arg{$_} } keys %arg;
  1         3  
47              
48 1 50 50     11 my $url = 'http'.($class->{ssl} ? 's':'').'://'.$class->{host}.':'.($class->{port} ? $class->{port} : ($class->{ssl} ? 443 : 80)).($class->{path}||'').'/';
    50          
    50          
49              
50 1         9 my $ua = LWP::UserAgent->new( agent => 'Mozilla/5.0 (X11; Linux i586; rv:41.0) Gecko/20120101 Firefox/41.0' );
51              
52 1         2494 my $res = $ua->post( $url, $post, 'Content-Type' => 'application/x-www-form-urlencoded; charset=UTF-8', );
53              
54 1 50       679578 if ($res->is_success) {
55 1         22 $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 1         58 $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 new
96              
97             Instantiate and initialise object with the following:
98              
99             =over 4
100              
101             =item * user
102              
103             Account username you receive during your registration. Mandatory.
104              
105             =item * pass
106              
107             Account password you receive during your registration. Mandatory.
108              
109             =item * host
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 * path
118              
119             Optional.
120              
121             Path on server to perform requests. Default is C.
122              
123             =item * ssl
124              
125             Optional.
126              
127             Flag to use SSL, default is C<1> (on). Optional.
128              
129             =item * gzip
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 * comment
138              
139             Optional.
140              
141             Connection description.
142              
143             =item * HTTP_ACCEPT_LANGUAGE
144              
145             Optional.
146              
147             Langage to use for the returned data content.
148              
149             =item * CLIENTADR
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 * sender
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 4     4 1 1903 my $class = shift;
169 4         15 my $self = {
170             'version' => $VERSION,
171             'path' => '/public/http',
172             'host' => 'go.qtelecom.ru',
173             'ssl' => 1,
174             'gzip' => 'none',
175             };
176 4         12 my %arg = @_;
177              
178 4         7 bless $self, $class;
179              
180 4         5 foreach my $field (@fields) {
181 40 100       75 $self->_set($field, $arg{$field}) if exists $arg{$field};
182             }
183              
184 4         6 foreach my $field (qw/ user pass /) {
185 7 100       10 croak "new() $field is mandatory" unless defined $self->_get($field);
186             }
187              
188 2         7 $self;
189             }
190              
191             =head2 balance
192              
193             Returns an XML desribing account balance and overdraft in the national currency.
194              
195             Takes no parameters.
196              
197             =cut
198              
199             sub balance {
200 1     1 1 5 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             =over 4
208              
209             =item * message
210              
211             Mandatory.
212              
213             Message text to send. Enconding must be ASCII or UTF-8. Internally module is using UTF-8 encoding.
214              
215             =item * target
216              
217             Mandatory.
218              
219             List of recipients to send message, comma delimited if there are more than one recipient:
220              
221             "+70010001212, 80009990000"
222              
223             Mutualy exclusive with C
224              
225             =item * phl_codename
226              
227             Mutualy exclusive with C, one or other is mandatory.
228              
229             Codename of a recipient via contact-list created on L.
230              
231             =item * sender
232              
233             Optional.
234              
235             Sender's nickname, one of the registered on L.
236              
237             =item * period
238              
239             Optional.
240              
241             Time-to-Live for a message, units are second. Message will be discarded if system fails to deliver message over this period of time.
242              
243             Caution: this service may not work for some routes, like a CDMA phones.
244              
245             =item * time_period
246              
247             Optional.
248              
249             Timeperiod during which message shall be delivered to the recipients (like 10:00-21:00).
250             Use of this option allows to skip delivery of messages during night hours.
251             For this service to work correctly you may specify L timezone.
252              
253             =item * time_local
254              
255             Optional.
256              
257             Selection of time zone for C option:
258             1 - means C is local time for the recipient,
259             0 - means C was spcified according to the sender settings.
260              
261             =item * autotrimtext
262              
263             Optional.
264              
265             Automatically trim leading and trailign spaces from a message.
266              
267             =back
268              
269             =cut
270              
271             sub send_sms {
272 0     0 1   my $class = shift;
273 0           my %arg = @_;
274              
275 0           $arg{action}='post_sms';
276 0           $arg{sms_type}='';
277              
278 0 0         $arg{post_id}='1458868327'.'td'.$$ unless $arg{post_id};
279 0 0         $arg{CLIENTADR}='127.0.0.1' unless $arg{CLIENTADR};
280 0 0         $arg{HTTP_ACCEPT_LANGUAGE}='ru-ru,ru;q=0.8,en-us;q=0.5,en;q=0.3' unless $arg{HTTP_ACCEPT_LANGUAGE};
281              
282 0           $class->_get_post_request( %arg );
283             }
284              
285             =head1 AUTHOR
286              
287             Pasichnichenko Konstantin, C<< >>
288              
289             =head1 BUGS
290              
291             Please report any bugs or feature requests to C, or through
292             the web interface at L. I will be notified, and then you'll
293             automatically be notified of progress on your bug as I make changes.
294              
295             =head1 SUPPORT
296              
297             You can find documentation for this module with the perldoc command.
298              
299             perldoc SMS::API::QuickTelecom
300              
301              
302             You can also look for information at:
303              
304             =over 4
305              
306             =item * RT: CPAN's request tracker (report bugs here)
307              
308             L
309              
310             =item * AnnoCPAN: Annotated CPAN documentation
311              
312             L
313              
314             =item * CPAN Ratings
315              
316             L
317              
318             =item * Search CPAN
319              
320             L
321              
322             =back
323              
324              
325             =head1 ACKNOWLEDGEMENTS
326              
327              
328             =head1 LICENSE AND COPYRIGHT
329              
330             Copyright 2016 Pasichnichenko Konstantin.
331              
332             This program is free software; you can redistribute it and/or modify it
333             under the terms of the the Artistic License (2.0). You may obtain a
334             copy of the full license at:
335              
336             L
337              
338             Any use, modification, and distribution of the Standard or Modified
339             Versions is governed by this Artistic License. By using, modifying or
340             distributing the Package, you accept this license. Do not use, modify,
341             or distribute the Package, if you do not accept this license.
342              
343             If your Modified Version has been derived from a Modified Version made
344             by someone other than you, you are nevertheless required to ensure that
345             your Modified Version complies with the requirements of this license.
346              
347             This license does not grant you the right to use any trademark, service
348             mark, tradename, or logo of the Copyright Holder.
349              
350             This license includes the non-exclusive, worldwide, free-of-charge
351             patent license to make, have made, use, offer to sell, sell, import and
352             otherwise transfer the Package with respect to any patent claims
353             licensable by the Copyright Holder that are necessarily infringed by the
354             Package. If you institute patent litigation (including a cross-claim or
355             counterclaim) against any party alleging that the Package constitutes
356             direct or contributory patent infringement, then this Artistic License
357             to you shall terminate on the date that such litigation is filed.
358              
359             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
360             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
361             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
362             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
363             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
364             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
365             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
366             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
367              
368              
369             =cut
370              
371             1; # End of SMS::API::QuickTelecom