line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package SMS::Send::NL::MyVodafone; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
37527
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
31
|
|
4
|
1
|
|
|
1
|
|
4
|
use base 'SMS::Send::Driver'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
77
|
|
5
|
1
|
|
|
1
|
|
1191
|
use WWW::Mechanize (); |
|
1
|
|
|
|
|
803533
|
|
|
1
|
|
|
|
|
31
|
|
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
12
|
use vars qw{$VERSION}; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
83
|
|
8
|
|
|
|
|
|
|
BEGIN { |
9
|
1
|
|
|
1
|
|
1208
|
$VERSION = '0.04'; |
10
|
|
|
|
|
|
|
} |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# Starting URI |
13
|
|
|
|
|
|
|
my $START = 'https://my.vodafone.nl/prive/my_vodafone/'; |
14
|
|
|
|
|
|
|
my $FORM = 'https://my.vodafone.nl/prive/my_vodafone/gratis_sms_versturen_smoothbox'; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
######################################################################## |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub new { |
19
|
0
|
|
|
0
|
1
|
|
my ($class, %params) = @_; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# Get the login |
22
|
0
|
|
|
|
|
|
my $login = $class->_LOGIN( delete $params{_login} ); |
23
|
0
|
|
|
|
|
|
my $password = $class->_PASSWORD( delete $params{_password} ); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# Create our mechanise object |
26
|
0
|
|
|
|
|
|
my $mech = WWW::Mechanize->new; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# Create the object, saving any private params for later |
29
|
0
|
|
|
|
|
|
my $self = bless { |
30
|
|
|
|
|
|
|
mech => $mech, |
31
|
|
|
|
|
|
|
login => $login, |
32
|
|
|
|
|
|
|
password => $password, |
33
|
|
|
|
|
|
|
private => \%params, |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# State variables |
36
|
|
|
|
|
|
|
logged_in => '', |
37
|
|
|
|
|
|
|
}, $class; |
38
|
|
|
|
|
|
|
|
39
|
0
|
|
|
|
|
|
return $self; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub _get_login { |
44
|
0
|
|
|
0
|
|
|
my $self = shift; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# Get to the login form |
47
|
0
|
|
|
|
|
|
$self->{mech}->get( $START ); |
48
|
0
|
0
|
|
|
|
|
unless ( $self->{mech}->success ) { |
49
|
0
|
|
|
|
|
|
Carp::croak("HTTP Error: Failed to connect to MyVodafone website"); |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
0
|
|
|
|
|
|
return 1; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub _send_login { |
56
|
0
|
|
|
0
|
|
|
my $self = shift; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# Shortcut if logged in |
59
|
0
|
0
|
|
|
|
|
return 1 if $self->{logged_in}; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# Get to the login page |
62
|
0
|
|
|
|
|
|
$self->_get_login; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# Submit the login form |
65
|
0
|
|
|
|
|
|
$self->{mech}->submit_form( |
66
|
|
|
|
|
|
|
form_name => 'login', |
67
|
|
|
|
|
|
|
fields => { |
68
|
|
|
|
|
|
|
username => $self->{login}, |
69
|
|
|
|
|
|
|
password => $self->{password}, |
70
|
|
|
|
|
|
|
}, |
71
|
|
|
|
|
|
|
); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# Did we login? |
74
|
0
|
0
|
|
|
|
|
if ( $self->{mech}->base =~ /errormessage=/ ) { |
75
|
0
|
|
|
|
|
|
Carp::croak("Invalid login and password"); |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
0
|
|
|
|
|
|
$self->{logged_in} = 1; |
79
|
0
|
|
|
|
|
|
return 1; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub send_sms { |
83
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
84
|
0
|
|
|
|
|
|
my %params = @_; |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
# Get the message and destination |
87
|
0
|
|
|
|
|
|
my $message = $self->_MESSAGE( delete $params{text} ); |
88
|
0
|
|
|
|
|
|
my $recipient = $self->_TO ( delete $params{to} ); |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# Make sure we are logged in |
91
|
0
|
|
|
|
|
|
$self->_send_login; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# Get to the Web2TXT form |
94
|
0
|
|
|
|
|
|
$self->{mech}->get( $FORM ); |
95
|
0
|
0
|
|
|
|
|
unless ( $self->{mech}->content =~ /gratis sms'en/ ) { |
96
|
0
|
|
|
|
|
|
Carp::croak("Could not locate the SMS send form"); |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# Fill out the message form |
100
|
0
|
0
|
|
|
|
|
my $form = $self->{mech}->form_number(1) |
101
|
|
|
|
|
|
|
or Carp::croak("Failed to find message form on page"); |
102
|
0
|
|
|
|
|
|
$form->value(phoneNumber => $recipient); |
103
|
0
|
|
|
|
|
|
$form->value(body => $message); |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# Send the form |
106
|
0
|
|
|
|
|
|
$self->{mech}->submit(); |
107
|
0
|
0
|
|
|
|
|
unless ( $self->{mech}->success ) { |
108
|
0
|
|
|
|
|
|
Carp::croak("HTTP request returned failure when sending SMS request"); |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# Fire-and-forget, we don't know for sure. |
112
|
0
|
|
|
|
|
|
return 1; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub _LOGIN { |
116
|
0
|
0
|
|
0
|
|
|
my $class = ref $_[0] ? ref shift : shift; |
117
|
0
|
|
|
|
|
|
my $login = shift; |
118
|
0
|
0
|
0
|
|
|
|
unless ( defined $login and ! ref $login and length $login ) { |
|
|
|
0
|
|
|
|
|
119
|
0
|
|
|
|
|
|
Carp::croak("Did not provide a login"); |
120
|
|
|
|
|
|
|
} |
121
|
0
|
|
|
|
|
|
return $login; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub _PASSWORD { |
125
|
0
|
0
|
|
0
|
|
|
my $class = ref $_[0] ? ref shift : shift; |
126
|
0
|
|
|
|
|
|
my $password = shift; |
127
|
0
|
0
|
0
|
|
|
|
unless ( defined $password and ! ref $password and length $password ) { |
|
|
|
0
|
|
|
|
|
128
|
0
|
|
|
|
|
|
Carp::croak("Did not provide a password"); |
129
|
|
|
|
|
|
|
} |
130
|
0
|
0
|
|
|
|
|
unless ( length($password) >= 6 ) { |
131
|
0
|
|
|
|
|
|
Carp::croak("Password must be at least 6 characters"); |
132
|
|
|
|
|
|
|
} |
133
|
0
|
0
|
|
|
|
|
unless ( $password =~ /[a-zA-Z]/) { |
134
|
0
|
|
|
|
|
|
Carp::croak("Password must contain at least 1 letter"); |
135
|
|
|
|
|
|
|
} |
136
|
0
|
0
|
|
|
|
|
unless ( $password =~ /[0-9]/) { |
137
|
0
|
|
|
|
|
|
Carp::croak("Password must contain at least 1 digit"); |
138
|
|
|
|
|
|
|
} |
139
|
0
|
0
|
|
|
|
|
unless ( $password !~ /[^a-zA-Z0-9]/) { |
140
|
0
|
|
|
|
|
|
Carp::croak("Password cannot contain non-alphanumeric characters"); |
141
|
|
|
|
|
|
|
} |
142
|
0
|
|
|
|
|
|
return $password; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub _MESSAGE { |
146
|
0
|
0
|
|
0
|
|
|
my $class = ref $_[0] ? ref shift : shift; |
147
|
0
|
|
|
|
|
|
my $message = shift; |
148
|
0
|
0
|
|
|
|
|
unless ( length($message) <= 125 ) { |
149
|
0
|
|
|
|
|
|
Carp::croak("Message length limit is 125 characters"); |
150
|
|
|
|
|
|
|
} |
151
|
0
|
|
|
|
|
|
return $message; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
sub _TO { |
155
|
0
|
0
|
|
0
|
|
|
my $class = ref $_[0] ? ref shift : shift; |
156
|
0
|
|
|
|
|
|
my $to = shift; |
157
|
0
|
|
|
|
|
|
$to =~ s/[\s-]//g; # Strip whitespaces and hyphens |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# We only want the last 8 digits, 06,+316,00316 prefixes will be stripped |
160
|
0
|
0
|
|
|
|
|
if($to =~ /(?:(?:0|(?:00|\+)31))6(\d{8})/) { |
161
|
0
|
|
|
|
|
|
return $1; |
162
|
|
|
|
|
|
|
} else { |
163
|
0
|
|
|
|
|
|
Carp::croak("Regional number is not a Dutch mobile phone number"); |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
#################### main pod documentation begin ################### |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head1 NAME |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
SMS::Send::NL::MyVodafone - An SMS::Send driver for the my.vodafone.nl website |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=head1 SYNOPSIS |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
use SMS::Send; |
175
|
|
|
|
|
|
|
# Get the sender and login |
176
|
|
|
|
|
|
|
my $sender = SMS::Send->new('NL::MyVodafone', |
177
|
|
|
|
|
|
|
_login => '0612345678', # phone number or loginname |
178
|
|
|
|
|
|
|
_password => 'mypasswd', # your reqistered password from my.vodafone.nl |
179
|
|
|
|
|
|
|
); |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
# Send a message to ourself |
182
|
|
|
|
|
|
|
my $sent = $sender->send_sms( |
183
|
|
|
|
|
|
|
text => 'Messages have a limit of 125 chars', |
184
|
|
|
|
|
|
|
to => '0687654321', |
185
|
|
|
|
|
|
|
); |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# Did it send? |
188
|
|
|
|
|
|
|
if ( $sent ) { |
189
|
|
|
|
|
|
|
print "Sent test message\n"; |
190
|
|
|
|
|
|
|
} else { |
191
|
|
|
|
|
|
|
print "Test message failed\n"; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=head1 DESCRIPTION |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
SMS::Send::NL::MyVodafone is a L driver which allows you to send |
198
|
|
|
|
|
|
|
messages through L |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=head1 METHODS |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=head2 new |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
The C method takes a few parameters. C<_login> and C<_password> |
205
|
|
|
|
|
|
|
are mandatory. |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
The C<_login> parameter can be your phone number or the username |
208
|
|
|
|
|
|
|
you've set on L |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
The C<_password> parameter is the password you've set at the site, and |
211
|
|
|
|
|
|
|
should contain only alphanumeric characters with a minimum of 6. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=head2 send_sms |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
Takes C as recipient phonenumber, and C as the text that's |
216
|
|
|
|
|
|
|
supposed to be delivered. |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
C can be in three formats, I<0612345678>, I<+31612345678>, or |
219
|
|
|
|
|
|
|
I<0031612345678>. Whitespaces and hyphens are ignored. |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
C has a limit of 125 characters. |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=head1 SEE ALSO |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=over 5 |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=item * L |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=item * L |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=back |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=head1 BUGS |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
Please report any bugs to L |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=head1 AUTHOR |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
M. Blom |
240
|
|
|
|
|
|
|
Eblom@cpan.orgE |
241
|
|
|
|
|
|
|
L |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
Unfortunately, the author is not allowed to use L... ;-) |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=head1 COPYRIGHT |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
This program is free software; you can redistribute |
248
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
The full text of the license can be found in the |
251
|
|
|
|
|
|
|
LICENSE file included with this module. |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=cut |
254
|
|
|
|
|
|
|
#################### main pod documentation end ################### |
255
|
|
|
|
|
|
|
1; |