File Coverage

blib/lib/SMS/Send/Driver/WebService.pm
Criterion Covered Total %
statement 120 129 93.0
branch 51 70 72.8
condition 2 6 33.3
subroutine 31 31 100.0
pod 15 15 100.0
total 219 251 87.2


line stmt bran cond sub pod time code
1             package SMS::Send::Driver::WebService;
2 8     8   266900 use strict;
  8         21  
  8         231  
3 8     8   43 use warnings;
  8         15  
  8         249  
4 8     8   42 use base qw{SMS::Send::Driver};
  8         21  
  8         6804  
5 8     8   9935 use URI qw{};
  8         46293  
  8         170  
6 8     8   8190 use LWP::UserAgent qw{};
  8         333676  
  8         223  
7 8     8   5603 use Path::Class qw{};
  8         403898  
  8         185  
8 8     8   9294 use Config::IniFiles qw{};
  8         89941  
  8         12589  
9              
10             our $VERSION = '0.03';
11             our $PACKAGE = __PACKAGE__;
12              
13             =head1 NAME
14              
15             SMS::Send::Driver::WebService - SMS::Send driver base class for web services
16              
17             =head1 SYNOPSIS
18              
19             package SMS::Send::My::Driver;
20             use base qw{SMS::Send::Driver::WebService};
21             sub send_sms {
22             my $self = shift;
23             my $ua = $self->ua; #isa LWP::UserAgent
24             my $cfg = self->cfg; #isa Config::IniFiles
25             #call web service die on critical error
26             #parse return with a package like XML::Simple or JSON::XS
27             #return 1 for successful or 0 for unsuccessful
28             }
29              
30             =head1 DESCRIPTION
31              
32             The SMS::Send::Driver::WebService package provides an L driver base class to support two common needs. The first need is a base class that provides L as a simple method. The second need is a way to configure various setting for multiple SMS providers without having to rebuild the SMS::Send driver concept.
33              
34             =head1 USAGE
35              
36             use base qw{SMS::Send::Driver::WebService};
37              
38             =head1 METHODS
39              
40             =head2 new
41              
42             SMS::Send API; Note: $service isa SMS::Send object in this syntax
43              
44             my $service = SMS::Send->new("My::Driver",
45             _username => $username,
46             _password => $password,
47             );
48              
49             Driver API; Note: $service isa SMS::Send::My::Driver object in this syntax
50              
51             my $service = SMS::Send::My::Driver->new(
52             username => $username,
53             password => $password,
54             );
55              
56             SMS::Send API with SMS-Send.ini file
57              
58             SMS-Send.ini
59             [My::Driver1]
60             username=user1
61             password=pass1
62              
63             [My::Driver2]
64             username=user2
65             password=pass2
66              
67             my $service1 = SMS::Send->new("My::Driver1"); #username and password read from SMS-Send.ini
68             my $service2 = SMS::Send->new("My::Driver2"); #username and password read from SMS-Send.ini
69              
70             Driver API with SMS-Send.ini file
71              
72             my $service = SMS::Send::My::Driver1->new;
73              
74             =cut
75              
76             sub new {
77 9     9 1 673 my $this=shift;
78 9   33     63 my $class=ref($this) || $this;
79 9         20 my $self={};
80 9         23 bless $self, $class;
81 9         52 $self->initialize(@_);
82 9         27 return $self;
83             }
84              
85             =head2 initialize
86              
87             Initializes data to compensate for the API deltas between SMS::Send and this package (i.e. removes underscore "_" from all parameters passed)
88              
89             In this example
90              
91             SMS::Send->new("My::Driver", _password => "mypassword");
92              
93             _password would be available to the driver as password=>"mypassword";
94              
95             =cut
96              
97             sub initialize {
98 9     9 1 20 my $self=shift;
99 9         99 my %hash=@_;
100             #SMS::Send API deltas
101 9         37 foreach my $key (keys %hash) {
102 23 50       63 if ($key =~ m/^_(.*)/) {
103 0         0 my $newkey=$1;
104 0         0 $hash{$newkey}=delete($hash{$key});
105             }
106             }
107 9         72 %$self=%hash;
108 9         28 return $self;
109             }
110              
111             =head2 send_sms
112              
113             You will need to overload this method in your sub class.
114              
115             Override in sub class (Example from Kannel SMSBox implementation)
116              
117             sub send_sms {
118             my $self = shift;
119             my %argv = @_;
120             my $to = $argv{"to"} or die("Error: to address required");
121             my $text = defined($argv{"text"}) ? $argv{"text"} : ''; #use < 5.10 syntax to support older Perls
122             my $url = $self->url; #isa URI
123             my @form = (
124             username => $self->username,
125             password => $self->password,
126             to => $to,
127             text => $text,
128             );
129             $url->query_form(\@form); #isa URI
130             my $response = $self->ua->get($url); #isa HTTP::Response see LWP::UserAgent->get
131             die(sprintf("HTTP Error: %s", $response->status_line)) unless $response->is_success;
132             my $content = $response->decoded_content;
133             return $content =~ m/^0:/ ? 1 : 0; #0: Accepted for delivery
134             }
135              
136             =head1 PROPERTIES
137              
138             =head2 username
139              
140             Sets and returns the username string value
141              
142             Override in sub class
143              
144             sub _username_default {"myusername"};
145              
146             Override in configuration
147              
148             [My::Driver]
149             username=myusername
150              
151             =cut
152              
153             sub username {
154 6     6 1 3448 my $self=shift;
155 6 100       28 $self->{'username'}=shift if @_;
156 6 100       50 $self->{'username'}=$self->cfg_property('username', $self->_username_default) unless defined $self->{'username'};
157 6 50       128 die('Error: username property required') unless defined $self->{'username'};
158 6         30 return $self->{'username'};
159             }
160              
161 2     2   11 sub _username_default {undef};
162              
163             =head2 password
164              
165             Sets and returns the password string value (passed to the web service as PWD)
166              
167             Override in sub class
168              
169             sub _password_default {"mypassword"};
170              
171             Override in configuration
172              
173             [My::Driver]
174             password=mypassword
175              
176             =cut
177              
178             sub password {
179 4     4 1 10 my $self=shift;
180 4 50       16 $self->{'password'}=shift if @_;
181 4 50       29 $self->{'password'}=$self->cfg_property('password', $self->_password_default) unless defined $self->{'password'};
182 4 50       106 die('Error: password property required') unless defined $self->{'password'};
183 4         19 return $self->{'password'};
184             }
185              
186 2     2   9 sub _password_default {undef};
187              
188             =head2 host
189              
190             Default: 127.0.0.1
191              
192             Override in sub class
193              
194             sub _host_default {"myhost.domain.tld"};
195              
196             Override in configuration
197              
198             [My::Driver]
199             host=myhost.domain.tld
200              
201             =cut
202              
203             sub host {
204 9     9 1 2107 my $self=shift;
205 9 100       38 $self->{'host'}=shift if @_;
206 9 100       51 $self->{'host'}=$self->cfg_property('host', $self->_host_default) unless defined $self->{'host'};
207 9         120 return $self->{'host'};
208             }
209              
210 2     2   8 sub _host_default {'127.0.0.1'};
211              
212             =head2 protocol
213              
214             Default: http
215              
216             Override in sub class
217              
218             sub _protocol_default {"https"};
219              
220             Override in configuration
221              
222             [My::Driver]
223             protocol=https
224              
225             =cut
226              
227             sub protocol {
228 9     9 1 20 my $self=shift;
229 9 100       35 $self->{'protocol'}=shift if @_;
230 9 100       46 $self->{'protocol'}=$self->cfg_property('protocol', $self->_protocol_default) unless defined $self->{'protocol'};
231 9         120 return $self->{'protocol'};
232             }
233              
234 2     2   7 sub _protocol_default {'http'};
235              
236             =head2 port
237              
238             Default: 80
239              
240             Override in sub class
241              
242             sub _port_default {443};
243              
244             Override in configuration
245              
246             [My::Driver]
247             port=443
248              
249             =cut
250              
251             sub port {
252 9     9 1 23 my $self=shift;
253 9 100       38 $self->{'port'}=shift if @_;
254 9 100       49 $self->{'port'}=$self->cfg_property('port', $self->_port_default) unless defined $self->{'port'};
255 9         119 return $self->{'port'};
256             }
257              
258 2     2   6 sub _port_default {'80'};
259              
260             =head2 script_name
261              
262             Default: /cgi-bin/sendsms
263              
264             Override in sub class
265              
266             sub _script_name_default {"/path/file"};
267              
268             Override in configuration
269              
270             [My::Driver]
271             script_name=/path/file
272              
273             =cut
274              
275             sub script_name {
276 10     10 1 23 my $self=shift;
277 10 100       67 $self->{'script_name'}=shift if @_;
278 10 100       50 $self->{'script_name'}=$self->cfg_property('script_name', $self->_script_name_default) unless defined $self->{'script_name'};
279 10         118 return $self->{'script_name'};
280             }
281              
282 2     2   8 sub _script_name_default {'/cgi-bin/sendsms'};
283              
284             =head2 url
285              
286             Returns a L object based on above properties OR returns a string from sub class or configuration file.
287              
288             Override in sub class (Can be a string or any object that stringifies to a URL)
289              
290             sub _url_default {"http://myservice.domain.tld/path/file"};
291              
292             Override in configuration
293              
294             [My::Driver]
295             url=http://myservice.domain.tld/path/file
296              
297             Overriding the url method in the sub class or the configuration makes the protocol, host, port, and script_name methods inoperable.
298              
299             =cut
300              
301             sub url {
302 6     6 1 14 my $self=shift;
303 6 100       24 $self->{'url'}=shift if @_;
304 6 100       47 $self->{'url'}=$self->cfg_property('url', $self->_url_default) unless defined $self->{'url'};
305 6 100       59 unless (defined $self->{'url'}) {
306 1         7 my $url=URI->new();
307 1         4716 $url->scheme($self->protocol);
308 1         3553 $url->host($self->host);
309 1         136 $url->port($self->port);
310 1         53 $url->path($self->script_name);
311 1         46 $self->{'url'}=$url; #object assignment
312             }
313             #print $self->{'url'}, "\n";
314 6         25 return $self->{'url'};
315             }
316              
317 3     3   10 sub _url_default {undef};
318              
319             =head1 OBJECT ACCESSORS
320              
321             =head2 ua
322              
323             Returns a lazy loaded L object
324              
325             =cut
326              
327             sub ua {
328 1     1 1 4 my $self=shift;
329             $self->{'ua'} = LWP::UserAgent->new(agent=>"Mozilla/5.0 (compatible; $PACKAGE/$VERSION; See rt.cpan.org 35173)")
330 1 50       21 unless $self->{'ua'};
331 1         3311 return $self->{'ua'};
332             }
333              
334             =head2 cfg
335              
336             Returns a lazy loaded L object so that you can read settings from the INI file.
337              
338             my $cfg=$driver->cfg; #isa Config::IniFiles
339              
340             =cut
341              
342             sub cfg {
343 58     58 1 4685 my $self=shift;
344 58 100       147 unless (exists $self->{'cfg'}) {
345 5         29 my $file=$self->cfg_file;
346 5 50 33     101 if ($file and -r $file) {
347 5         244 $self->{'cfg'}=Config::IniFiles->new(-file=>"$file")
348             } else {
349 0         0 $self->{'cfg'}=undef;
350             }
351             }
352 58         30638 return $self->{'cfg'};
353             }
354              
355              
356             =head2 cfg_file
357              
358             Sets or returns the profile INI filename
359              
360             my $file=$driver->cfg_file;
361             my $file=$driver->cfg_file("./my.ini");
362              
363             Set on construction
364              
365             my $driver=SMS::Send::My::Driver->new(cfg_file=>"./my.ini");
366              
367             Default: SMS-Send.ini
368              
369             =cut
370              
371             sub cfg_file {
372 9     9 1 21 my $self=shift;
373 9 50       38 if (@_) {
374 0         0 $self->{'cfg_file'}=shift;
375 0 0       0 die(sprintf(qq{Error: Cannot read file "%s".}, $self->{'cfg_file'})) unless -r $self->{'cfg_file'};
376             }
377 9 100       39 unless (defined $self->{'cfg_file'}) {
378 5 50       29 die(sprintf(qq{Error: path method returned a "%s"; expecting an array reference.}, ref($self->cfg_path)))
379             unless ref($self->cfg_path) eq 'ARRAY';
380 5         11 foreach my $path (@{$self->cfg_path}) {
  5         21  
381 5         29 $self->{'cfg_file'}=Path::Class::file($path, $self->_cfg_file_default);
382 5 50       1243 last if -r $self->{'cfg_file'};
383             }
384             }
385             #We may not have a vaild file here? We'll let Config::IniFiles catch the error.
386 9         356 return $self->{'cfg_file'};
387             }
388              
389 5     5   33 sub _cfg_file_default {'SMS-Send.ini'};
390              
391             =head2 cfg_path
392              
393             Sets and returns a list of search paths for the INI file.
394              
395             my $path=$driver->cfg_path; # []
396             my $path=$driver->cfg_path(".", ".."); # []
397              
398             Default: ["."]
399             Default: [".", 'C:\Windows'] on Windows-like systems that have Win32 installed
400             Default: [".", "/etc"] on other systems that have Sys::Path installed
401              
402             override in sub class
403              
404             sub cfg_path {["/my/path"]};
405              
406             =cut
407              
408             sub cfg_path {
409 18     18 1 34 my $self=shift;
410 18 50       51 $self->{'path'}=[@_] if @_;
411 18 100       59 unless (ref($self->{'path'}) eq 'ARRAY') {
412 5         25 my @path=('.');
413 5 50       38 if ($^O eq 'MSWin32') {
414 0         0 eval('use Win32');
415 0 0       0 push @path, eval('Win32::GetFolderPath(Win32::CSIDL_WINDOWS)') unless $@;
416             } else {
417 5     5   2569 eval('use Sys::Path');
  0         0  
  0         0  
  5         413  
418 5 50       25 push @path, eval('Sys::Path->sysconfdir') unless $@;
419             }
420 5         26 $self->{'path'}=\@path;
421             }
422 18         81 return $self->{'path'};
423             }
424              
425             =head2 cfg_section
426              
427             Returns driver name as specified by package namespace
428              
429             Example
430             package SMS::Send::My::Driver;
431              
432             Configuration in SMS-Send.ini file
433              
434             [My::Driver]
435             username=myuser
436             password=mypass
437             host=myserver
438              
439             =cut
440              
441             sub cfg_section {
442 30     30 1 45 my $self=shift;
443 30 50       70 $self->{'cfg_section'}=shift if @_;
444 30 100       72 unless ($self->{'cfg_section'}) {
445 4         9 my $section=ref($self);
446 4         17 $section =~ s/\ASMS::Send:://;
447 4         11 $self->{'cfg_section'}=$section;
448             }
449 30         120 return $self->{'cfg_section'};
450             }
451              
452             =head2 cfg_property
453              
454             my $property=$self->cfg_property("username");
455             my $property=$self->cfg_property("host", "mydefault");
456              
457             =cut
458              
459             sub cfg_property {
460 27     27 1 77 my $self = shift;
461 27 50       74 my $property = shift or die('Error: property name required');
462 27         91 my $default = shift; #|| undef
463 27         65 my $cfg = $self->cfg;
464 27 100       65 if ($cfg) { #if config object
465 26         56 return $self->cfg->val($self->cfg_section, $property, $default);
466             } else {
467 1         2 return $default;
468             }
469             }
470              
471             =head1 BUGS
472              
473             Please log on RT and send an email to the author.
474              
475             =head1 SUPPORT
476              
477             DavisNetworks.com supports all Perl applications including this package.
478              
479             =head1 AUTHOR
480              
481             Michael R. Davis
482             CPAN ID: MRDVT
483             Satellite Tracking of People, LLC
484             mdavis@stopllc.com
485             http://www.stopllc.com/
486              
487             =head1 COPYRIGHT
488              
489             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
490              
491             The full text of the license can be found in the LICENSE file included with this module.
492              
493             =head1 SEE ALSO
494              
495             L
496              
497             =cut
498              
499             1;