line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Net::SMS::Web::Action utility module |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
package Net::SMS::Web::Action; |
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
7345
|
use Class::Struct; |
|
1
|
|
|
|
|
2299
|
|
|
1
|
|
|
|
|
6
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
struct( |
12
|
|
|
|
|
|
|
'Net::SMS::Web::Action' => { |
13
|
|
|
|
|
|
|
url => '$', |
14
|
|
|
|
|
|
|
method => '$', |
15
|
|
|
|
|
|
|
agent => '$', |
16
|
|
|
|
|
|
|
params => '%', |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
package Net::SMS::Web; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
$VERSION = '0.015'; |
23
|
|
|
|
|
|
|
|
24
|
1
|
|
|
1
|
|
185
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
29
|
|
25
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
32
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
28
|
|
|
|
|
|
|
# |
29
|
|
|
|
|
|
|
# Standard pragmas |
30
|
|
|
|
|
|
|
# |
31
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
32
|
|
|
|
|
|
|
|
33
|
1
|
|
|
1
|
|
980
|
use LWP::UserAgent; |
|
1
|
|
|
|
|
61962
|
|
|
1
|
|
|
|
|
38
|
|
34
|
1
|
|
|
1
|
|
1696
|
use CGI::Enurl; |
|
1
|
|
|
|
|
37
|
|
|
1
|
|
|
|
|
139
|
|
35
|
1
|
|
|
1
|
|
5152
|
use CGI::Lite; |
|
1
|
|
|
|
|
85
|
|
|
1
|
|
|
|
|
94
|
|
36
|
1
|
|
|
1
|
|
1385
|
use URI; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
54
|
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
39
|
|
|
|
|
|
|
# |
40
|
|
|
|
|
|
|
# POD |
41
|
|
|
|
|
|
|
# |
42
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=head1 NAME |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
Net::SMS::Web - a generic module for sending SMS messages using web2sms |
47
|
|
|
|
|
|
|
gateways (e.g. L or L). |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head1 DESCRIPTION |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
A perl module to send SMS messages, using web2sms gateways. This module |
52
|
|
|
|
|
|
|
should be subclassed for a particular gateway (see L or |
53
|
|
|
|
|
|
|
L). |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
When you subclass this class, you need to make a series of calls to the |
56
|
|
|
|
|
|
|
L method, passing a L object which should |
57
|
|
|
|
|
|
|
correspond to the web form acions that are required to send an SMS message via |
58
|
|
|
|
|
|
|
the web gateway in question. |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
The HTTP requests are sent using the LWP::UserAgent module. If you are using a |
61
|
|
|
|
|
|
|
proxy, you may need to set the HTTP_PROXY environment variable for this to |
62
|
|
|
|
|
|
|
work (see L). |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=cut |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
67
|
|
|
|
|
|
|
# |
68
|
|
|
|
|
|
|
# Package globals |
69
|
|
|
|
|
|
|
# |
70
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
71
|
|
|
|
|
|
|
|
72
|
1
|
|
|
1
|
|
6
|
use vars qw( $DEFAULT_AGENT ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1044
|
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
$DEFAULT_AGENT = 'Mozilla/4.0 (compatible; MSIE 4.01; Windows NT)'; |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
77
|
|
|
|
|
|
|
# |
78
|
|
|
|
|
|
|
# More POD ... |
79
|
|
|
|
|
|
|
# |
80
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
The constructor of this class can be overridden in a subclass as follows: |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub new |
87
|
|
|
|
|
|
|
{ |
88
|
|
|
|
|
|
|
my $class = shift; |
89
|
|
|
|
|
|
|
my $self = $class->SUPER::new( @_ ); |
90
|
|
|
|
|
|
|
$self->_init( @_ ); |
91
|
|
|
|
|
|
|
return $self; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=cut |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub new |
97
|
|
|
|
|
|
|
{ |
98
|
0
|
|
|
0
|
0
|
|
my $class = shift; |
99
|
0
|
|
|
|
|
|
my $self = bless {}, $class; |
100
|
0
|
|
|
|
|
|
$self->{COOKIES} = {}; |
101
|
0
|
|
|
|
|
|
return $self; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub _get_cookies |
105
|
|
|
|
|
|
|
{ |
106
|
0
|
|
|
0
|
|
|
my $self = shift; |
107
|
0
|
|
|
|
|
|
my $response = shift; |
108
|
|
|
|
|
|
|
|
109
|
0
|
|
|
|
|
|
for ( grep s{;.*}{}, $response->header( 'Set-Cookie' ) ) |
110
|
|
|
|
|
|
|
{ |
111
|
0
|
0
|
|
|
|
|
if ( /^(.*?)=(.*)$/ ) |
112
|
|
|
|
|
|
|
{ |
113
|
0
|
|
|
|
|
|
$self->{COOKIES}{$1} = $2; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
119
|
|
|
|
|
|
|
# |
120
|
|
|
|
|
|
|
# More POD ... |
121
|
|
|
|
|
|
|
# |
122
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head1 METHODS |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=cut |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head2 cookie( $key ) |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
This method gets the value of a cookie that has been set either in a |
131
|
|
|
|
|
|
|
previous action, or in a redirected Location resulting from one of those |
132
|
|
|
|
|
|
|
actions. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=cut |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub cookie |
137
|
|
|
|
|
|
|
{ |
138
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
139
|
0
|
|
|
|
|
|
my $key = shift; |
140
|
0
|
|
|
|
|
|
return $self->{COOKIES}{$key}; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=head2 response() |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
This method gets the body of the response to the previous action. |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=cut |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
sub response |
150
|
|
|
|
|
|
|
{ |
151
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
152
|
0
|
|
|
|
|
|
return $self->{RESPONSE}; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=head2 action |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
This method takes an L object as an argument, and |
158
|
|
|
|
|
|
|
performs the corresponding action. It takes care of retention of cookies set by |
159
|
|
|
|
|
|
|
previous actions, and follows any redirection that result from the submission |
160
|
|
|
|
|
|
|
of the action. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=cut |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub action |
165
|
|
|
|
|
|
|
{ |
166
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
167
|
0
|
|
|
|
|
|
my $action = shift; |
168
|
|
|
|
|
|
|
|
169
|
0
|
0
|
|
|
|
|
die "Action should be a Net::SMS::Web::Action object\n" |
170
|
|
|
|
|
|
|
unless ref( $action ) eq 'Net::SMS::Web::Action' |
171
|
|
|
|
|
|
|
; |
172
|
|
|
|
|
|
|
|
173
|
0
|
|
|
|
|
|
my $url = $action->url; |
174
|
0
|
0
|
|
|
|
|
my %params = $action->params ? %{ $action->params } : (); |
|
0
|
|
|
|
|
|
|
175
|
0
|
|
0
|
|
|
|
my $method = $action->method || 'GET'; |
176
|
0
|
|
0
|
|
|
|
my $agent = $action->agent || $DEFAULT_AGENT; |
177
|
0
|
|
|
|
|
|
my $params = enurl \%params; |
178
|
|
|
|
|
|
|
|
179
|
0
|
|
|
|
|
|
my $request; |
180
|
|
|
|
|
|
|
|
181
|
0
|
0
|
|
|
|
|
if ( $method =~ /^(GET|HEAD)$/ ) |
|
|
0
|
|
|
|
|
|
182
|
|
|
|
|
|
|
{ |
183
|
0
|
0
|
|
|
|
|
$url .= "?$params" if $params; |
184
|
0
|
|
|
|
|
|
$request = HTTP::Request->new( $method, $url ); |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
elsif ( $method eq 'POST' ) |
187
|
|
|
|
|
|
|
{ |
188
|
0
|
|
|
|
|
|
$request = HTTP::Request->new( $method, $url ); |
189
|
0
|
0
|
|
|
|
|
$request->content( $params ) if $params; |
190
|
0
|
|
|
|
|
|
$request->content_type( 'application/x-www-form-urlencoded' ); |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
else |
193
|
|
|
|
|
|
|
{ |
194
|
0
|
|
|
|
|
|
die "Unknown method $method - should be GET or POST\n"; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
0
|
|
|
|
|
|
$request->header( 'Accept' => 'text/html' ); |
198
|
0
|
0
|
|
|
|
|
$request->header( 'Referer' => $self->{REFERER} ) if $self->{REFERER}; |
199
|
0
|
|
|
|
|
|
$request->header( |
200
|
|
|
|
|
|
|
'Cookie' => |
201
|
|
|
|
|
|
|
join( ';', |
202
|
0
|
|
|
|
|
|
map { "$_=$self->{COOKIES}{$_}" } keys %{$self->{COOKIES}} |
|
0
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
) |
204
|
0
|
0
|
0
|
|
|
|
) if $self->{COOKIES} and %{$self->{COOKIES}} |
205
|
|
|
|
|
|
|
; |
206
|
0
|
0
|
|
|
|
|
if ( $self->{verbose} ) |
207
|
|
|
|
|
|
|
{ |
208
|
0
|
|
|
|
|
|
my $r = $request->as_string(); |
209
|
0
|
|
|
|
|
|
$r =~ s/^(\S)/\t$1/gm; |
210
|
0
|
|
|
|
|
|
print STDERR "REQUEST\n$r\n\n"; |
211
|
|
|
|
|
|
|
} |
212
|
0
|
|
|
|
|
|
my $ua = LWP::UserAgent->new; |
213
|
0
|
|
|
|
|
|
$ua->env_proxy(); |
214
|
0
|
|
|
|
|
|
$ua->agent( $agent ); |
215
|
0
|
|
|
|
|
|
my $response = $ua->simple_request( $request ); |
216
|
0
|
|
|
|
|
|
$self->{RESPONSE} = $response->content(); |
217
|
0
|
|
|
|
|
|
$self->{REFERER} = $url; |
218
|
0
|
0
|
|
|
|
|
if ( $self->{verbose} ) |
219
|
|
|
|
|
|
|
{ |
220
|
0
|
|
|
|
|
|
my $r = $response->headers_as_string(); |
221
|
0
|
|
|
|
|
|
$r =~ s/^/\t/gm; |
222
|
|
|
|
|
|
|
} |
223
|
0
|
0
|
|
|
|
|
if ( $response->is_error ) |
224
|
|
|
|
|
|
|
{ |
225
|
0
|
|
|
|
|
|
die |
226
|
|
|
|
|
|
|
ref($self), ": ", $request->uri, |
227
|
|
|
|
|
|
|
" failed:\n\t", |
228
|
|
|
|
|
|
|
$response->status_line, |
229
|
|
|
|
|
|
|
"\n" |
230
|
|
|
|
|
|
|
; |
231
|
|
|
|
|
|
|
} |
232
|
0
|
0
|
0
|
|
|
|
if ( $self->{audit_trail} and -d $self->{audit_trail} ) |
233
|
|
|
|
|
|
|
{ |
234
|
0
|
|
|
|
|
|
$self->{audit_count}++; |
235
|
0
|
|
|
|
|
|
my $audit_file = "$self->{audit_trail}/$self->{audit_count}.html"; |
236
|
0
|
0
|
|
|
|
|
open( FH, ">$audit_file" ) and print FH $self->{RESPONSE}; |
237
|
0
|
|
|
|
|
|
close( FH ); |
238
|
|
|
|
|
|
|
} |
239
|
0
|
|
|
|
|
|
$self->_get_cookies( $response ); |
240
|
0
|
|
|
|
|
|
my $location = $response->header( 'Location' ); |
241
|
0
|
0
|
|
|
|
|
if ( $location ) |
242
|
|
|
|
|
|
|
{ |
243
|
0
|
|
|
|
|
|
$action->url( URI->new_abs( $location, $action->url ) ); |
244
|
0
|
|
|
|
|
|
return $self->action( $action ); |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
249
|
|
|
|
|
|
|
# |
250
|
|
|
|
|
|
|
# More POD ... |
251
|
|
|
|
|
|
|
# |
252
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=head1 BUGS |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
Bugs can be submitted to the CPAN RT bug tracker either via email |
257
|
|
|
|
|
|
|
(bug-net-sms-web@rt.cpan.org) or web |
258
|
|
|
|
|
|
|
L. There is also a |
259
|
|
|
|
|
|
|
sourceforge project at L. |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=head1 AUTHOR |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
Ave Wrigley |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=head1 COPYRIGHT |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
Copyright (c) 2001 Ave Wrigley. All rights reserved. This program is free |
268
|
|
|
|
|
|
|
software; you can redistribute it and/or modify it under the same terms as Perl |
269
|
|
|
|
|
|
|
itself. |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=cut |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
274
|
|
|
|
|
|
|
# |
275
|
|
|
|
|
|
|
# End of POD |
276
|
|
|
|
|
|
|
# |
277
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
280
|
|
|
|
|
|
|
# |
281
|
|
|
|
|
|
|
# True ... |
282
|
|
|
|
|
|
|
# |
283
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
1; |