File Coverage

blib/lib/NetSDS/Kannel.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             #===============================================================================
2             #
3             # MODULE: NetSDS::Kannel
4             #
5             # DESCRIPTION: This module provides API to Kannel message structure.
6             #
7             # NOTES: This is NetSDS specific API implementation.
8             # It's expected that kannel configuration is standard for NetSDS.
9             #
10             # AUTHOR: Michael Bochkaryov (Rattler), <misha@rattler.kiev.ua>
11             # COMPANY: Net.Style
12             #
13             #===============================================================================
14              
15             =head1 NAME
16              
17             NetSDS::Kannel - Kannel SMS gateway API
18              
19             =head1 SYNOPSIS
20              
21             #!/usr/bin/env perl
22            
23             use 5.8.0;
24             use warnings;
25             use strict;
26              
27             use NetSDS::Kannel;
28              
29             my $kannel = NetSDS::Kannel->new(
30             sendsms_url => 'http://localhost:1234/sendsms',
31             sendsms_user => 'sender',
32             sendsms_passwd => 'secret',
33             default_smsc => 'esme-megafon',
34             );
35              
36             $res = $kannel->send(
37             from => '1234',
38             to => '380672222111',
39             text => 'Hallo there!',
40             smsc => 'emse-mts',
41             priority => 3,
42             );
43              
44             1;
45              
46             =head1 DESCRIPTION
47              
48             C<NetSDS::Kannel> module provides API to Kannel SMS gateway.
49              
50             To decrease innecessary problems we use a lot of predefined parameters
51             while sending and receiving messages via Kannel HTTP API. It's not so flexible
52             as direct HTTP processing but less expensive in development time ;-)
53              
54             This modules uses LWP to send messages and CGI.pm to process messages from Kannel.
55              
56             =cut
57              
58             package NetSDS::Kannel;
59              
60 2     2   47697 use 5.8.0;
  2         9  
  2         100  
61 2     2   12 use strict;
  2         5  
  2         92  
62 2     2   12 use warnings;
  2         8  
  2         64  
63              
64 2     2   964 use NetSDS::Util::Convert;
  0            
  0            
65             use NetSDS::Util::String;
66             use NetSDS::Util::Types;
67             use LWP::UserAgent;
68             use URI::Escape;
69             use XML::LibXML;
70              
71             use base qw(
72             NetSDS::Class::Abstract
73             Exporter
74             );
75              
76             use version; our $VERSION = "1.300";
77              
78             use constant USER_AGENT => 'NetSDS Kannel API';
79              
80             our @EXPORT = qw(
81             STATE_DELIVERED
82             STATE_UNDELIVERABLE
83             STATE_ENROUTE
84             STATE_ACCEPTED
85             STATE_REJECTED
86             ESME_RINVMSGLEN
87             ESME_RINVCMDID
88             ESME_RINVBNDSTS
89             ESME_RSYSERR
90             ESME_RINVDSTADR
91             ESME_RMSGQFUL
92             ESME_RTHROTTLED
93             ESME_RUNKNOWNERR
94             ESME_RTIMEOUT
95             ESME_LICENSE
96             ESME_CHARGING
97             );
98              
99             # SMS delivery states
100             use constant STATE_DELIVERED => 1; # Delivered to MS
101             use constant STATE_UNDELIVERABLE => 2; # Undeliverable
102             use constant STATE_ENROUTE => 4; # Queued on SMSC
103             use constant STATE_ACCEPTED => 8; # Received by SMSC
104             use constant STATE_REJECTED => 16; # Rejected by SMSC
105              
106             # Reject codes from SMSC
107              
108             use constant ESME_RINVMSGLEN => 1; # Wrong length
109             use constant ESME_RINVCMDID => 3; # Wrong SMPP command
110             use constant ESME_RINVBNDSTS => 4;
111             use constant ESME_RSYSERR => 8;
112             use constant ESME_RINVDSTADR => 11; # Invalid destination address
113             use constant ESME_RMSGQFUL => 20;
114             use constant ESME_RTHROTTLED => 88;
115             use constant ESME_RUNKNOWNERR => 255;
116             use constant ESME_RTIMEOUT => 1057;
117             use constant ESME_LICENSE => 1058; # License restriction (vendor specific)
118             use constant ESME_CHARGING => 1059; # Low billing balance (vendor specific)
119             use constant ESME_CHARGING_PP => 1111; # Low billing balance on prepaid (vendor specific)
120              
121             #===============================================================================
122              
123             =head1 CLASS API
124              
125             =over
126              
127             =item B<new(%params)> - class constructor
128              
129             Constructor creates Kannel API handler and set it's configuration.
130             Most of these parameters may be overriden while object method calls.
131              
132             B<Admin API parameters:>
133              
134             * admin_url - Kannel admin API URL
135              
136             * admin_passwd - password to admin API
137              
138             B<Sending SMS API parameters:>
139              
140             * sendsms_url - URL of Kannel sendsms HTTP API
141              
142             * sendsms_user - user name for sending SMS
143              
144             * sendsms_passwd - password for sending SMS
145              
146             * dlr_url - base URL for DLR retrieving
147              
148             * default_smsc - default SMSC identifier for sending SMS
149              
150             * default_timeout - default sending TCP timeout
151              
152             =back
153              
154             =cut
155              
156             #-----------------------------------------------------------------------
157             sub new {
158              
159             my ( $class, %params ) = @_;
160              
161             my $self = $class->SUPER::new(
162             admin_url => 'http://127.0.0.1:13000/',
163             admin_passwd => '',
164             sendsms_url => 'http://127.0.0.1:13013/cgi-bin/sendsms',
165             sendsms_user => 'netsds',
166             sendsms_passwd => '',
167             dlr_url => 'http://127.0.0.1/smsc/kannel_receiver.fcgi',
168             default_smsc => undef,
169             default_timeout => 30, # 30 seconds enough for sending timeout
170             %params,
171             );
172              
173             # Initialize LWP user agent
174             $self->{_ua} = LWP::UserAgent->new();
175             $self->{_ua}->agent( USER_AGENT . "/$VERSION" );
176              
177             # Initialize XML parser
178             $self->{_xml} = XML::LibXML->new();
179             $self->{_xml}->validation(0);
180             $self->{_xml}->recover(1);
181              
182             return $self;
183              
184             } ## end sub new
185              
186             __PACKAGE__->mk_accessors('admin_url');
187             __PACKAGE__->mk_accessors('admin_passwd');
188             __PACKAGE__->mk_accessors('sendsms_url');
189             __PACKAGE__->mk_accessors('sendsms_user');
190             __PACKAGE__->mk_accessors('sendsms_passwd');
191             __PACKAGE__->mk_accessors('dlr_url');
192             __PACKAGE__->mk_accessors('default_smsc');
193             __PACKAGE__->mk_accessors('default_timeout');
194              
195             #***********************************************************************
196              
197             =head1 OBJECT METHODS
198              
199             =over
200              
201             =item B<send(%parameters)> - send MT SM message to Kannel
202              
203             This method allows to send SMS message via Kannel SMS gateway.
204              
205             Parameters (mostly the same as in Kannel sendsms API):
206              
207             * from - source address (overrides message)
208              
209             * to - destination address (overrides message)
210              
211             * text - message text (byte string)
212              
213             * udh - user data header (byte string)
214              
215             * charset - charset of text
216              
217             * coding - 0 for GSM 03.38, 1 for binary, 2 for UCS2
218              
219             * smsc - target SMSC (overrides default one)
220              
221             * mclass - message class if necessary (0 for flash sms)
222              
223             * validity - TTL for MO SM in minutes
224              
225             * deferred - timeout for delayed delivery
226              
227             Example:
228              
229             $kannel->send_sms(
230             from => '1234',
231             to => '380672206770',
232             text => 'Wake up!!!',
233             smsc => 'nokia_modem',
234             );
235              
236             =cut
237              
238             #-----------------------------------------------------------------------
239              
240             sub send {
241              
242             my ( $self, %params ) = @_;
243              
244             my %send = (
245             'username' => $self->sendsms_user,
246             'password' => $self->sendsms_passwd,
247             'charset' => 'UTF-8', # Local text representation
248             'coding' => 0, # 7 bit GSM 03.38
249             );
250              
251             # Then we override message parameters
252              
253             # Set sendsms URL
254             my $send_url = $self->sendsms_url;
255             if ( $params{sendsms_url} ) {
256             $send_url = $params{sendsms_url};
257             }
258              
259             # Set sendsms username
260             if ( $params{sendsms_user} ) {
261             $send{username} = $params{sendsms_user};
262             }
263              
264             # Set sendsms password
265             if ( $params{sendsms_passwd} ) {
266             $send{password} = $params{sendsms_passwd};
267             }
268              
269             # Set source address
270             if ( $params{from} ) {
271             $send{from} = uri_escape( $params{from} );
272             }
273              
274             # Set destination address
275             if ( $params{to} ) {
276             $send{to} = uri_escape( $params{to} );
277             }
278              
279             # Set message text
280             if ( $params{text} ) {
281             $send{text} = uri_escape( $params{text} );
282             }
283              
284             # Set message UDH
285             if ( $params{udh} ) {
286             $send{udh} = uri_escape( $params{udh} );
287             }
288              
289             # Set message charset
290             if ( $params{charset} ) {
291             $send{charset} = $params{charset};
292             }
293              
294             # Set message mclass
295             if ( defined $params{mclass} ) {
296             $send{mclass} = $params{mclass};
297             }
298              
299             # Set data coding
300             if ( $params{coding} ) {
301             $send{coding} = $params{coding};
302             }
303              
304             # Set message TTL in minutes
305             if ( $params{validity} and ( is_int( $params{validity} ) ) ) {
306             $send{validity} = $params{validity};
307             }
308              
309             # Set deferred delivery in minutes
310             if ( $params{deferred} and ( is_int( $params{deferred} ) ) ) {
311             $send{deferred} = $params{deferred};
312             }
313              
314             # Set message priority (0 to 3)
315             if ( defined $params{priority} and ( is_int( $params{priority} ) and ( $params{priority} <= 3 ) and ( $params{priority} >= 0 ) ) ) {
316             $send{priority} = $params{priority};
317             }
318              
319             # Set SMSC id
320             if ( $params{smsc} ) {
321             $send{smsc} = $params{smsc};
322             }
323              
324             # Set DLR fetching mask (see kannel documentation)
325             if ( $params{dlr_id} ) {
326             $send{'dlr-url'} = $self->make_dlr_url( msgid => $params{dlr_id} );
327              
328             # Set DLR fetching mask (see kannel documentation)
329             if ( $params{dlr_mask} ) {
330             $send{'dlr-mask'} = $params{dlr_mask};
331             } else {
332             $send{'dlr-mask'} = 3; # default mask (delivered and undeliverable)
333             }
334             }
335              
336             # Set meta data
337             if ( $params{meta} ) {
338             $send{'meta-data'} = $self->make_meta( %{ $params{meta} } );
339             }
340              
341             # Set HTTP request timeout
342             my $timeout = $self->default_timeout;
343             if ( $params{timeout} ) {
344             $timeout = $params{timeout};
345             }
346             $self->{_ua}->timeout($timeout);
347              
348             # Prepare HTTP request
349             my @pairs = map $_ . '=' . $send{$_}, keys %send;
350             my $req = HTTP::Request->new( GET => $send_url . "?" . join '&', @pairs );
351              
352             # Send request
353             my $res = $self->{_ua}->request($req);
354              
355             # Analyze response
356             if ( $res->is_success ) {
357             return $res->content;
358             } else {
359             return $self->error( $res->status_line );
360             }
361              
362             } ## end sub send
363              
364             #***********************************************************************
365              
366             =item B<receive($cgi)> - receive MO or DLR from CGI object
367              
368             This method provides import message structure from CGI request .
369             This method is just wrapper around C<receive_mo()> and C<receive_dlr()> methods.
370              
371             Message type (MO or DLR) recognized by C<type> CGI parameter that may be C<mo> or C<dlr>.
372              
373             my $cgi = CGI::Fast->new();
374             my %ret = $kannel->receive($cgi);
375              
376              
377             =cut
378              
379             #-----------------------------------------------------------------------
380              
381             sub receive {
382              
383             my ( $self, $cgi ) = @_;
384              
385             my %ret = ();
386              
387             # Set message type (MO or DLR)
388             if ( $cgi->param('type') ) {
389             if ( $cgi->param('type') eq 'mo' ) {
390             %ret = $self->receive_mo($cgi);
391             } elsif ( $cgi->param('type') eq 'dlr' ) {
392             %ret = $self->receive_dlr($cgi);
393             }
394              
395             return %ret;
396              
397             } else {
398             return $self->error("Unknown message type received");
399             }
400              
401             } ## end sub receive
402              
403             #***********************************************************************
404              
405             =item B<receive_mo($cgi)> - import MO message from CGI object
406              
407             This method provides import message structure from CGI request .
408              
409             Imported MO message parameters returned as hash with the following keys:
410              
411             * smsc - Kannel's SMSC Id
412              
413             * smsid - SMSC message ID
414              
415             * from - subscriber's MSISDN
416              
417             * to - service address (short code)
418              
419             * time - SMS receive time
420              
421             * unixtime SMS receive time as UNIX timestamp
422              
423             * text - MO SM text
424              
425             * bin - MO SM as binary string
426              
427             * udh - SMS UDH (User Data Headers)
428              
429             * coding - SMS encoding (0 - 7 bit GSM 03.38; 2 - UCS2-BE)
430              
431             * charset - charset of MO SM text while receiving from Kannel
432              
433             * binfo - SMPP C<service_type> parameter for billing puroses
434              
435             =cut
436              
437             #-----------------------------------------------------------------------
438              
439             sub receive_mo {
440              
441             my ( $self, $cgi ) = @_;
442              
443             my %ret = (
444             type => 'mo',
445             );
446              
447             # Set SMSC Id (smsc=%i)
448             if ( $cgi->param('smsc') ) {
449             $ret{smsc} = $cgi->param('smsc');
450             } else {
451             $ret{smsc} = undef;
452             }
453              
454             # Set SMSC message Id (smsid=%I)
455             if ( $cgi->param('smsid') ) {
456             $ret{smsid} = $cgi->param('smsid');
457             } else {
458             $ret{smsid} = undef;
459             }
460              
461             # Set source (subscriber) address (from=%p)
462             if ( $cgi->param('from') ) {
463             $ret{from} = $cgi->param('from');
464             }
465              
466             # Set destination (service) address (to=%P)
467             if ( $cgi->param('to') ) {
468             $ret{to} = $cgi->param('to');
469             }
470              
471             # Set timestamp information (time=%t)
472             if ( $cgi->param('time') ) {
473             $ret{time} = $cgi->param('time');
474             }
475              
476             # Set UNIX timestamp information (unixtime=%T)
477             if ( $cgi->param('unixtime') ) {
478             $ret{unixtime} = $cgi->param('unixtime');
479             }
480              
481             # Set message text (text=%a)
482             if ( $cgi->param('text') ) {
483             $ret{text} = $cgi->param('text');
484             }
485              
486             # Set binary message (bin=%b)
487             if ( $cgi->param('bin') ) {
488             $ret{bin} = $cgi->param('bin');
489             }
490              
491             # Set UDH (udh=%u)
492             if ( $cgi->param('udh') ) {
493             $ret{udh} = $cgi->param('udh');
494             }
495              
496             # Set coding (coding=%c)
497             if ( defined $cgi->param('coding') ) {
498             $ret{coding} = $cgi->param('coding') + 0;
499             }
500              
501             # Set charset (charset=%C)
502             if ( $cgi->param('charset') ) {
503             $ret{charset} = $cgi->param('charset');
504             }
505              
506             # Set message class (mclass=%m)
507             if ( $cgi->param('mclass') ) {
508             $ret{mclass} = $cgi->param('mclass');
509             }
510              
511             # Set billing information (binfo=%B)
512             if ( $cgi->param('binfo') ) {
513             $ret{binfo} = $cgi->param('binfo');
514             }
515              
516             # Convert message text to UTF-8
517             if ( 1 != $ret{coding} ) {
518             # It's text message
519             $ret{text} = str_recode( $ret{text}, $ret{charset} );
520             $ret{text} = str_encode( $ret{text} );
521             }
522              
523             # Process optional SMPP TLV (meta=%D)
524             if ( $cgi->param('meta') ) {
525             my $meta_str = $cgi->param('meta');
526             $ret{meta} = {};
527             if ( $meta_str =~ /^\?smpp\?(.*)$/ ) {
528             foreach my $tlv_par ( split /\&/, $1 ) {
529             my ( $tag, $val ) = split /\=/, $tlv_par;
530             $ret{meta}->{$tag} = $val;
531             }
532             }
533             }
534              
535             return %ret;
536              
537             } ## end sub receive_mo
538              
539             #***********************************************************************
540              
541             =item B<receive_dlr($cgi)> - import message from CGI object
542              
543             This method provides import message structure from CGI request .
544              
545             C<receive_dlr> method returns hash with the following keys:
546              
547             * smsc - kannel SMSC id
548              
549             * msgid - original MT SM message id for DLR identification
550              
551             * smsid - SMSC message ID
552              
553             * from - subscriber's MSISDN (phone number)
554              
555             * to - service address (short code)
556              
557             * time - delivery time
558              
559             * unixtime - delivery time as UNIX timestamp
560              
561             * dlr - DLR state
562              
563             * dlrmsg - DLR message from SMSC
564              
565             Example:
566              
567             my $cgi = CGI->new();
568              
569             my %dlr = $kannel->receive_dlr($cgi);
570              
571             print "DLR received for MSISDN: " . $dlr{from};
572              
573             =cut
574              
575             #-----------------------------------------------------------------------
576              
577             sub receive_dlr {
578              
579             my ( $self, $cgi ) = @_;
580              
581             my %ret = (
582             type => 'dlr',
583             );
584              
585             # Set SMSC Id (smsc=%i)
586             if ( $cgi->param('smsc') ) {
587             $ret{smsc} = $cgi->param('smsc');
588             } else {
589             $ret{smsc} = undef;
590             }
591              
592             # Set VASP message Id (msgid=our_id)
593             if ( $cgi->param('msgid') ) {
594             $ret{msgid} = $cgi->param('msgid');
595             } else {
596             $ret{msgid} = undef;
597             }
598              
599             # Set SMSC message Id (smsid=%I)
600             if ( $cgi->param('smsid') ) {
601             $ret{smsid} = $cgi->param('smsid');
602             } else {
603             $ret{smsid} = undef;
604             }
605              
606             # Set source (subscriber) address (from=%p)
607             if ( $cgi->param('from') ) {
608             $ret{from} = $cgi->param('from');
609             }
610              
611             # Set destination (service) address (to=%P)
612             if ( $cgi->param('to') ) {
613             $ret{to} = $cgi->param('to');
614             }
615              
616             # Set timestamp information (time=%t)
617             if ( $cgi->param('time') ) {
618             $ret{time} = $cgi->param('time');
619             }
620              
621             # Set UNIX timestamp information (unixtime=%T)
622             if ( $cgi->param('unixtime') ) {
623             $ret{unixtime} = $cgi->param('unixtime');
624             }
625              
626             # Set DLR state (dlr=%d)
627             $ret{dlr_state} = $cgi->param('dlr');
628              
629             # Set DLR message (dlrmsg=%A)
630             $ret{dlr_msg} = $cgi->param('dlrmsg');
631              
632             # Process return code if not success
633             if ( $ret{dlr_msg} =~ /^NACK\/(\d+)\// ) {
634             $self->{reject_code} = $1;
635             }
636              
637             return %ret;
638              
639             } ## end sub receive_dlr
640              
641             #***********************************************************************
642              
643             =item B<make_dlr_url(%params)> - prepare DLR URL
644              
645             This method creates URI escaped string with URL template for DLR notification.
646              
647             Paramters: hash (dlr_url, msgid)
648              
649             Returns: URI escaped DLR URL
650              
651             =cut
652              
653             #-----------------------------------------------------------------------
654              
655             sub make_dlr_url {
656              
657             my ( $self, %params ) = @_;
658              
659             # Set reference to MT message Id for identification
660             my $msgid = $params{msgid};
661              
662             # Set DLR base URL from object property or method parameter
663             my $dlr_url = $self->{dlr_url};
664             if ( $params{dlr_url} ) { $dlr_url = $params{dlr_url}; }
665              
666             $dlr_url .= "?type=dlr&msgid=$msgid&smsid=%I&from=%p&to=%P&time=%t&unixtime=%T&dlr=%d&dlrmsg=%A";
667              
668             return conv_str_uri($dlr_url);
669              
670             }
671              
672             #***********************************************************************
673              
674             =item B<make_meta(%params)> - prepare SMPP optional TLV
675              
676             This method creates URI escaped string with optional SMPP tag-lenght-value (TLV)
677             parameters to send them in C<meta-data> CGI paramter of Kannel's C<sendsms> HTTP API.
678              
679             Format of C<meta-data> parameter value:
680              
681             ?smpp?tag1=value1&tag2=value2&...tagN=valueN
682              
683             Paramters: hash of TLV pairs
684              
685             Returns: URI escaped string
686              
687             Example:
688              
689             my $meta = $self->make_meta(
690             charging_id => '0',
691             );
692              
693             This will return: %3Fsmpp%3Fcharging_id%3D0
694              
695             =cut
696              
697             #-----------------------------------------------------------------------
698              
699             sub make_meta {
700              
701             my ( $self, %params ) = @_;
702              
703             my $meta_str = '?smpp?'; # FIXME: only 'smpp' group allowed
704              
705             my @pairs = map $_ . '=' . $params{$_}, keys %params;
706             $meta_str .= join '&', @pairs;
707              
708             return conv_str_uri($meta_str);
709              
710             }
711              
712             #***********************************************************************
713              
714             =item B<status()> - retrieve Kannel status
715              
716             =cut
717              
718             #-----------------------------------------------------------------------
719              
720             sub status {
721              
722             my ($self) = @_;
723              
724             my $res = $self->{_ua}->get( $self->admin_url . "status.xml" );
725             if ( $res->is_success ) {
726              
727             # Parse XML and retrieve DOM structure
728             #
729             # NOTE: we use eval{} because of XML::LibXML calls die() on parser errors
730             my $doc = undef;
731             eval { $doc = $self->{_xml}->parse_string( $res->content )->documentElement(); };
732              
733             # Catch exceptions
734             if ($@) {
735             return $self->error("Can't parse XML from Kannel API");
736             }
737              
738             # ==========================
739             # Preparing result structure
740              
741             # Version string
742             my $result = {
743             version => $doc->findvalue('/gateway/version'),
744             };
745              
746             # Total Kannel status and uptime
747             #
748             # Sample XML part from status.xml API
749             # <status>suspended, uptime 32d 7h 26m 43s</status>
750             if ( $doc->findvalue('/gateway/status') =~ /^(\S+),\s+uptime\s+(.+)$/ ) {
751             $result->{status} = $1;
752             $result->{uptime} = $2;
753             }
754              
755             # Common SMS information
756             $result->{sms} = {
757             received_total => $doc->findvalue('/gateway/sms/received/total'),
758             received_queued => $doc->findvalue('/gateway/sms/received/queued'),
759             sent_total => $doc->findvalue('/gateway/sms/sent/total'),
760             sent_queued => $doc->findvalue('/gateway/sms/sent/queued'),
761             storesize => $doc->findvalue('/gateway/sms/storesize'),
762             inbound => $doc->findvalue('/gateway/sms/inbound'),
763             outbound => $doc->findvalue('/gateway/sms/outbound'),
764             };
765              
766             # Common DLR information
767             $result->{dlr} = {
768             queued => $doc->findvalue('/gateway/dlr/queued'),
769             storage => $doc->findvalue('/gateway/dlr/storage'),
770             };
771              
772             # SMSC connections information
773             $result->{'smsc'} = [];
774              
775             foreach ( $doc->findnodes('/gateway/smscs/smsc') ) {
776             my $smsc = {
777             name => $_->findvalue('name'),
778             id => $_->findvalue('id'),
779             status => $_->findvalue('status'),
780             received => $_->findvalue('received'),
781             sent => $_->findvalue('sent'),
782             failed => $_->findvalue('failed'),
783             queued => $_->findvalue('queued'),
784             };
785             if ( $smsc->{status} =~ /online\s+(.+)/ ) {
786             $smsc->{status} = 'online';
787             $smsc->{uptime} = $1;
788             }
789              
790             push @{ $result->{'smsc'} }, $smsc;
791             }
792              
793             return $result;
794              
795             } ## end if ( $res->is_success )
796              
797             else {
798             return $self->error( "Can't retrieve Kannel status: " . $res->status_line );
799             }
800              
801             } ## end sub status
802              
803             #***********************************************************************
804              
805             =item B<store_status()> - retrieve message queue status
806              
807             Not implemented yet.
808              
809             =cut
810              
811             #-----------------------------------------------------------------------
812              
813             sub store_status {
814              
815             my ($self) = @_;
816              
817             }
818              
819             #***********************************************************************
820              
821             =item B<shutdown()> - bring down Kannel
822              
823             =cut
824              
825             #-----------------------------------------------------------------------
826              
827             sub shutdown {
828              
829             my ($self) = @_;
830              
831             return $self->_send_cmd('shutdown');
832              
833             }
834              
835             #***********************************************************************
836              
837             =item B<suspend()> - switch Kannel to 'suspended' state
838              
839             =cut
840              
841             #-----------------------------------------------------------------------
842              
843             sub suspend {
844              
845             my ($self) = @_;
846              
847             return $self->_send_cmd('suspend');
848              
849             }
850              
851             #***********************************************************************
852              
853             =item B<isolate()> - switch Kannel to 'isolated' state
854              
855             =cut
856              
857             #-----------------------------------------------------------------------
858              
859             sub isolate {
860              
861             my ($self) = @_;
862              
863             return $self->_send_cmd('isolate');
864              
865             }
866              
867             #***********************************************************************
868              
869             =item B<resume()> - resume Kannel to 'online' state
870              
871             =cut
872              
873             #-----------------------------------------------------------------------
874              
875             sub resume {
876              
877             my ($self) = @_;
878              
879             return $self->_send_cmd('resume');
880              
881             }
882              
883             #***********************************************************************
884              
885             =item B<restart()> - whole bearerbox restart
886              
887             =cut
888              
889             #-----------------------------------------------------------------------
890              
891             sub restart {
892              
893             my ($self) = @_;
894              
895             return $self->_send_cmd('restart');
896              
897             }
898              
899             #***********************************************************************
900              
901             =item B<flush_dlr()> - flush queued DLR if Kannel in 'suspended' state
902              
903             =cut
904              
905             #-----------------------------------------------------------------------
906              
907             sub flush_dlr {
908              
909             my ($self) = @_;
910              
911             return $self->_send_cmd('flush-dlr');
912              
913             }
914              
915             #***********************************************************************
916              
917             =item B<reload_lists()> - reload black/white lists
918              
919             =cut
920              
921             #-----------------------------------------------------------------------
922              
923             sub reload_lists {
924              
925             my ($self) = @_;
926              
927             return $self->_send_cmd('reload-lists');
928              
929             }
930              
931             #***********************************************************************
932              
933             =item B<log_level($level)> - change Kannel log-level
934              
935             =cut
936              
937             #-----------------------------------------------------------------------
938              
939             sub log_level {
940              
941             my ( $self, $level ) = @_;
942              
943             return $self->_send_cmd( 'log-level', level => $level );
944              
945             }
946              
947             #***********************************************************************
948              
949             =item B<start_smsc($smsc)> - switch on SMSC connection
950              
951             =cut
952              
953             #-----------------------------------------------------------------------
954              
955             sub start_smsc {
956              
957             my ( $self, $smsc ) = @_;
958              
959             return $self->_send_cmd( 'start-smsc', smsc => $smsc );
960              
961             }
962              
963             #***********************************************************************
964              
965             =item B<stop_smsc($smsc)> - switch off SMSC connection
966              
967             =cut
968              
969             #-----------------------------------------------------------------------
970              
971             sub stop_smsc {
972              
973             my ( $self, $smsc ) = @_;
974              
975             return $self->_send_cmd( 'stop-smsc', smsc => $smsc );
976              
977             }
978              
979             #***********************************************************************
980              
981             =item B<add_smsc($smsc)> - add new SMSC connection
982              
983             =cut
984              
985             #-----------------------------------------------------------------------
986              
987             sub add_smsc {
988              
989             my ( $self, $smsc ) = @_;
990              
991             return $self->_send_cmd( 'add-smsc', smsc => $smsc );
992              
993             }
994              
995             #***********************************************************************
996              
997             =item B<remove_smsc($smsc)> - remove SMSC connection
998              
999             =cut
1000              
1001             #-----------------------------------------------------------------------
1002              
1003             sub remove_smsc {
1004              
1005             my ( $self, $smsc ) = @_;
1006              
1007             return $self->_send_cmd( 'remove-smsc', smsc => $smsc );
1008              
1009             }
1010              
1011             sub _send_cmd {
1012              
1013             my ( $self, $cmd, %params ) = @_;
1014              
1015             # Prepare base URL with administrative URL and password
1016             my $url = $self->admin_url . "$cmd?password=" . $self->admin_passwd;
1017              
1018             # Add optional parameters
1019             foreach ( keys %params ) {
1020             $url .= "&" . $_ . "=" . $params{$_};
1021             }
1022              
1023             # Prepare and send HTTP request to Kannel admin API
1024             my $req = HTTP::Request->new( GET => $url );
1025             my $res = $self->{_ua}->request($req);
1026              
1027             # Analyze HTTP response
1028             if ( $res->is_success ) {
1029             # OK - send result data "as is"
1030             return $res->content;
1031             } else {
1032             # Error - send error string
1033             return $self->error( $res->status_line );
1034             }
1035              
1036             } ## end sub _send_cmd
1037              
1038             1;
1039              
1040             __END__
1041              
1042             =back
1043              
1044             =head1 EXAMPLES
1045              
1046             See Nibelite kannel API
1047              
1048             =head1 SEE ALSO
1049              
1050             =over
1051            
1052             =item * L<NetSDS::Class::Abstract> - base NetSDS class
1053              
1054             =item * L<http://www.kannel.org/download/1.4.3/userguide-1.4.3/userguide.html> - Kannel User Guide
1055              
1056             =back
1057              
1058             =head1 TODO
1059              
1060             1. Add PPG support.
1061              
1062             2. Add OTA support.
1063              
1064             =head1 AUTHOR
1065              
1066             Michael Bochkaryov <misha@rattler.kiev.ua>
1067              
1068             =head1 LICENSE
1069              
1070             Copyright (C) 2008-2009 Net Style Ltd.
1071              
1072             This program is free software; you can redistribute it and/or modify
1073             it under the terms of the GNU General Public License as published by
1074             the Free Software Foundation; either version 2 of the License, or
1075             (at your option) any later version.
1076              
1077             This program is distributed in the hope that it will be useful,
1078             but WITHOUT ANY WARRANTY; without even the implied warranty of
1079             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1080             GNU General Public License for more details.
1081              
1082             You should have received a copy of the GNU General Public License
1083             along with this program; if not, write to the Free Software
1084             Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
1085              
1086             =cut
1087