File Coverage

blib/lib/WWW/Velib.pm
Criterion Covered Total %
statement 116 182 63.7
branch 28 66 42.4
condition 4 20 20.0
subroutine 23 28 82.1
pod 15 15 100.0
total 186 311 59.8


line stmt bran cond sub pod time code
1             # Velib.pm - WWW::Velib
2             #
3             # Copyright (c) 2007 David Landgren
4             # All rights reserved
5              
6             package WWW::Velib;
7 3     3   109337 use strict;
  3         8  
  3         151  
8              
9 3     3   19 use vars qw/$VERSION/;
  3         6  
  3         202  
10             $VERSION = '0.05';
11              
12 3     3   4329 use WWW::Mechanize;
  3         971456  
  3         130  
13 3     3   2627 use WWW::Velib::Trip;
  3         9  
  3         86  
14              
15 3     3   21 use constant HOST => 'https://abo-paris.cyclocity.fr/';
  3         4  
  3         252  
16 3     3   14 use constant LOGIN_URL => HOST . 'service/login';
  3         5  
  3         204  
17 3     3   15 use constant ACCT_URL => HOST . 'service/myaccount';
  3         21  
  3         153  
18 3     3   14 use constant MONTH_URL => HOST . 'service/myaccount/month';
  3         3  
  3         6932  
19              
20             sub new {
21 2     2 1 3876 my $class = shift;
22 2         8 my $self = {};
23              
24 2 50       14 pop @_ if @_ % 2; # discard last odd garbage element so we can hashify
25 2         11 my %arg = @_;
26              
27 2 100       11 if (@_ == 2) {
28 1         10 for (1..2) {
29 2         3 my $value = shift;
30 2 50       8 $value =~ /\A(\d{10})\z/ and $self->{login} = $1;
31 2 50       9 $value =~ /\A(\d{4})\z/ and $self->{pin} = $1;
32             }
33             }
34              
35 2 100       14 exists $arg{login} and $self->{login} = delete $arg{login};
36 2 50       14 exists $arg{defer} and $self->{defer} = delete $arg{defer};
37 2 50       10 exists $arg{cache_dir} and $self->{cache_dir} = delete $arg{cache_dir};
38              
39             # pin takes priority over password as a named param
40 2 50       7 exists $arg{password} and $self->{pin} = delete $arg{password};
41 2 100       9 exists $arg{pin} and $self->{pin} = delete $arg{pin};
42              
43 2         7 for my $key (qw(login pin)) {
44 4 50 66     34 exists $self->{$key} or $self->{defer} or do {
45 0         0 require Carp;
46 0         0 Carp::croak("No $key parameter specified in new()\n");
47             };
48             }
49 2 50       27 $self->{mech} = WWW::Mechanize->new or do {
50 0         0 require Carp;
51 0         0 Carp::croak("Failed to build WWW::Mechanizer object\n");
52             };
53 2         44962 $self->{mech}->env_proxy();
54 2         168 $self->{connected} = 0;
55              
56 2         9 bless $self, $class;
57 2 50       20 if ($self->{defer}) {
58 2 50       34 $arg{myaccount} and $self->myaccount(delete $arg{myaccount});
59 2 50       41 $arg{month} and $self->get_month(delete $arg{month});
60             }
61             else {
62 0         0 $self->_connect();
63             }
64              
65 2         11 return $self;
66             }
67              
68             sub _slurp {
69 3     3   4 my $file = shift;
70 3         13 local $/ = undef;
71 3 50       158 open IN, $file or do {
72 0         0 require Carp;
73 0         0 Carp::croak("Cannot open $file for input: $!\n");
74             };
75 3         201 my $contents = ;
76 3         43 close IN;
77 3         19 return $contents;
78             }
79              
80             {
81             my $timestamp;
82             sub _out {
83 0     0   0 my $html = shift;
84 0         0 my $cache_dir = shift;
85 0         0 my $prefix = shift;
86 0     0   0 $timestamp ||= sub {sprintf "%04d%02d%02d-%02d%02d%02d",
87 0   0     0 $_[5]+1900, $_[4]+1, reverse(@_[0..3])}->(localtime);
88 0         0 my $file = "$cache_dir/$prefix.$timestamp";
89 0         0 open my $out, '>', $file;
90 0 0       0 if ($out) {
91 0         0 print $out $html;
92 0         0 close $out;
93             }
94             }
95             }
96              
97             sub _connect {
98 0     0   0 my $self = shift;
99 0         0 my $m = $self->{mech};
100              
101 0         0 $m->get(HOST . '/service/login');
102 0         0 $self->{html}{initial} = $m->content;
103 0         0 $self->{connected} = 1;
104              
105 0         0 $m->form_number(4);
106 0         0 $m->current_form->value('Login', $self->{login});
107 0         0 $m->current_form->value('Password', $self->{pin});
108 0         0 $m->click('LoginButton');
109              
110 0         0 $m->get(HOST . '/service/myaccount');
111 0         0 $self->{html}{myaccount} = $m->content;
112 0 0 0     0 if ($self->{cache_dir} and -d $self->{cache_dir}) {
113 0         0 _out($self->{html}{myaccount}, $self->{cache_dir}, 'myaccount');
114             }
115              
116 0         0 $self->_myaccount_parse;
117             }
118              
119             sub get_month {
120 1     1 1 2 my $self = shift;
121 1 50       4 if (defined(my $file = shift)) {
122 1         4 $self->{html}{month} = _slurp($file);
123             }
124             else {
125 0         0 my $m = $self->{mech};
126 0 0       0 $self->_connect unless $self->{connected};
127 0         0 $m->get(MONTH_URL);
128 0         0 $self->{html}{month} = $m->content;
129 0 0 0     0 if ($self->{cache_dir} and -d $self->{cache_dir}) {
130 0         0 _out($self->{html}{month}, $self->{cache_dir}, 'month');
131             }
132             }
133              
134 1         6 my $month_isolate_re = qr{)+)}; };
135             \s*
136             \s* Date
137             \s* Trajet
138             \s* Durée
139             \s* Montant
140             \s*
141             ((?:\s*
142             \s* [^<]+
143             \s*[^<]+
144             \s*[^<]+
145             \s*\S+ €
146             \s*
147              
148 1         323 my ($month_detail) = ($self->{html}{month} =~ /$month_isolate_re/);
149 1 50       6 return unless defined $month_detail;
150              
151 1         5 my $detail_re = qr{\s*
152             \s* (\d{2}/\d{2}/\d{4})
153             \s*(.*?) -> ([^<]+)
154             \s*(\d+)h (\d+)min
155             \s*(\d+,\d+) €
156             \s*
157              
158 1 50       337 if (my @match = $month_detail =~ /$detail_re/g) {
159 1         4 while (@match) {
160 62         133 my @trip = splice(@match, 0, 6);
161 62         323 (my $datestamp = $trip[0]) =~ s{^(\d{2})/(\d{2})/(\d{4})$}{$3$2$1};
162 62         127 unshift @{$self->{trip}{$datestamp}}, WWW::Velib::Trip->make(@trip);
  62         244  
163             }
164             }
165             }
166              
167             sub myaccount {
168 2     2 1 916 my $self = shift;
169 2         5 my $file = shift;
170 2         9 $self->{html}{myaccount} = _slurp($file);
171 2         9 $self->_myaccount_parse;
172             }
173              
174             sub _myaccount_parse {
175 2     2   4 my $self = shift;
176 2         5 my $html = $self->{html}{myaccount};
177              
178 2         8 my $solde_re = qr{
179             \s*Mon paiement en ligne
180             \s*
181             \s*
182             \s*

Solde :(\S+) €

};
183 2 50       27 if ($html =~ /$solde_re/) {
184 2         7 $self->{balance} = $1;
185 2         7 $self->{balance} =~ tr/,/./;
186             }
187              
188 2         6 my $abo_re = qr{
189             \s*
190             \s*

Mon abonnement
191             \s*
192             \s*
(?:\s*

Solde :(\S+) €

)?
193             \s*

Votre compte prend fin le : ([^<]+)
194             \s*

Il vous reste encore (\d+) jours d'abonnement
195             \s*

\s+Vous (n'avez pas de|avez un) vélo en cours de location\.};

196              
197 2 50       36 if ($html =~ /$abo_re/) {
198 2 50 33     10 if (!$self->{balance} and defined $1) {
199 0         0 $self->{balance} = $1;
200 0         0 $self->{balance} =~ tr/,/./;
201             }
202 2         6 $self->{end_date} = $2;
203 2         5 $self->{remain} = $3;
204 2 100       12 $self->{in_use} = ($4 eq 'avez un') ? 1 : 0;
205             }
206             else {
207 0         0 $self->{end_date} = '';
208 0         0 $self->{remain} = 0;
209 0         0 $self->{in_use} = 0;
210             }
211              
212 2         7 my $conso_re = qr{

Ma consommation en (\S+) (\d+)
213             \s*
214             \s*
215             \s*};
216             \s*
217             \s*Nbre de trajets
218             \s*Temps cumulé
219             \s*Montant
220             \s*
221             \s*
222             \s*(\d+)
223             \s*(?:(\d+)h )?(\d+)min
224             \s*(\S+) €
225              
226 2 50       28 if ($html =~ /$conso_re/) {
227 2         6 $self->{conso_month} = $1;
228 2         5 $self->{conso_year} = $2;
229 2         5 $self->{conso_trips} = $3;
230 2   50     18 $self->{conso_time} = ($4 || 0) * 60 + $5;
231 2         6 $self->{conso_bal} = $6;
232 2         9 $self->{conso_bal} =~ tr/,/./;
233             }
234             else {
235 0         0 $self->{conso_month} = '';
236 0         0 $self->{conso_year} = 0;
237 0         0 $self->{conso_trips} = 0;
238 0         0 $self->{conso_time} = 0;
239 0         0 $self->{conso_bal} = 0;
240             }
241             }
242              
243             sub end_date {
244 1     1 1 6 my $self = shift;
245 1         7 return $self->{end_date};
246             }
247              
248             sub remain {
249 1     1 1 2 my $self = shift;
250 1         6 return $self->{remain};
251             }
252              
253             sub in_use {
254 2     2 1 5 my $self = shift;
255 2         10 return $self->{in_use};
256             }
257              
258             sub balance {
259 2     2 1 6 my $self = shift;
260 2         11 return $self->{balance};
261             }
262              
263             sub conso_month {
264 1     1 1 3 my $self = shift;
265 1         5 return $self->{conso_month};
266             }
267              
268             sub conso_year {
269 1     1 1 3 my $self = shift;
270 1         6 return $self->{conso_year};
271             }
272              
273             sub conso_trips {
274 1     1 1 3 my $self = shift;
275 1         6 return $self->{conso_trips};
276             }
277              
278             sub conso_time {
279 1     1 1 3 my $self = shift;
280 1         6 return $self->{conso_time};
281             }
282              
283             sub conso_bal {
284 1     1 1 3 my $self = shift;
285 1         5 return $self->{conso_bal};
286             }
287              
288             sub trips {
289 1     1 1 2 my $self = shift;
290 1 50       5 return () unless $self->{trip};
291 1         2 my @trip;
292 1         2 push @trip, @{$self->{trip}{$_}} for sort keys %{$self->{trip}};
  1         16  
  22         49  
293 1         14 return @trip;
294             }
295              
296             sub next_trip {
297 0     0 1   my $self = shift;
298 0 0         return unless $self->{trip};
299              
300 0 0 0       if (not (exists $self->{trip_day} and exists $self->{trip_day_n})) {
301 0           $self->reset_trip;
302 0           return $self->{trip}{$self->{trip_day}[0]}[$self->{trip_day_n}];
303             }
304              
305 0 0         if (++$self->{trip_day_n} <= $#{$self->{trip}{$self->{trip_day}[0]}}) {
  0            
306 0           return $self->{trip}{$self->{trip_day}[0]}[$self->{trip_day_n}];
307             }
308              
309 0           shift @{$self->{trip_day}};
  0            
310 0 0         return unless scalar @{$self->{trip_day}};
  0            
311 0           $self->{trip_day_n} = 0;
312              
313 0           return $self->{trip}{$self->{trip_day}[0]}[$self->{trip_day_n}];
314             }
315              
316             sub reset_trip {
317 0     0 1   my $self = shift;
318 0 0         return unless $self->{trip};
319              
320 0           $self->{trip_day} = [sort keys %{$self->{trip}}];
  0            
321 0           $self->{trip_day_n} = 0;
322             }
323              
324             'The Lusty Decadent Delights of Imperial Pompeii';
325             __END__