line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package WWW::PTV; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
30622
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
64
|
|
4
|
2
|
|
|
2
|
|
10
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
43
|
|
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
6951
|
use LWP; |
|
2
|
|
|
|
|
114945
|
|
|
2
|
|
|
|
|
69
|
|
7
|
2
|
|
|
2
|
|
2392
|
use WWW::Mechanize; |
|
2
|
|
|
|
|
238944
|
|
|
2
|
|
|
|
|
82
|
|
8
|
2
|
|
|
2
|
|
2381
|
use HTML::TreeBuilder; |
|
2
|
|
|
|
|
51569
|
|
|
2
|
|
|
|
|
20
|
|
9
|
2
|
|
|
2
|
|
76
|
use Carp qw(croak); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
127
|
|
10
|
2
|
|
|
2
|
|
1400
|
use WWW::PTV::Area; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
55
|
|
11
|
2
|
|
|
2
|
|
1144
|
use WWW::PTV::Stop; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
60
|
|
12
|
2
|
|
|
2
|
|
1065
|
use WWW::PTV::Route; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
5174
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our $VERSION = '0.07'; |
15
|
|
|
|
|
|
|
our $CACHE; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub new { |
18
|
0
|
|
|
0
|
1
|
|
my ( $class, %args ) = @_; |
19
|
|
|
|
|
|
|
|
20
|
0
|
|
|
|
|
|
my $self = bless {}, $class; |
21
|
0
|
0
|
|
|
|
|
$self->{uri} = 'http://' . ( defined $args{uri} ? $args{uri} : 'ptv.vic.gov.au' ) . '/'; |
22
|
0
|
|
|
|
|
|
$self->{ua} = LWP::UserAgent->new; |
23
|
0
|
|
|
|
|
|
$self->{tree} = HTML::TreeBuilder->new; |
24
|
0
|
0
|
|
|
|
|
$self->{cache}++ if $args{cache}; |
25
|
|
|
|
|
|
|
|
26
|
0
|
|
|
|
|
|
return $self |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub __request { |
30
|
0
|
|
|
0
|
|
|
my ( $self, $uri ) = @_; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
my $res = ( $uri !~ /^http:/ |
33
|
|
|
|
|
|
|
? $self->{ua}->get( $self->{uri} . $uri ) |
34
|
0
|
0
|
|
|
|
|
: $self->{ua}->get( $uri ) ); |
35
|
|
|
|
|
|
|
|
36
|
0
|
0
|
|
|
|
|
$res->is_success and return $res->content; |
37
|
|
|
|
|
|
|
|
38
|
0
|
|
|
|
|
|
croak 'Unable to retrieve content: ' . $res->status_line |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub __tl_request { |
42
|
0
|
|
|
0
|
|
|
my ( $self, $tag_id ) = @_; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
my $r = ( ( $self->{cache} and $CACHE->{timetables}->{master} ) |
45
|
|
|
|
|
|
|
? $CACHE->{timetables}->{master} |
46
|
0
|
0
|
0
|
|
|
|
: $self->__request( 'http://ptv.vic.gov.au/timetables' ) |
47
|
|
|
|
|
|
|
); |
48
|
|
|
|
|
|
|
|
49
|
0
|
0
|
|
|
|
|
$CACHE->{timetables}->{master} = $r if $self->{cache}; |
50
|
|
|
|
|
|
|
|
51
|
0
|
|
|
|
|
|
my $t = HTML::TreeBuilder->new_from_content( $r ); |
52
|
0
|
|
|
|
|
|
$t = $t->look_down( _tag => 'select', id => $tag_id ); |
53
|
0
|
|
|
|
|
|
my @routes = $t->look_down( _tag => 'option' ); |
54
|
|
|
|
|
|
|
|
55
|
0
|
|
|
|
|
|
return my %routes = map { $_->attr( 'value' ) => $_->as_text } grep { $_->attr( 'value' ) ne '' } @routes |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
0
|
|
|
0
|
1
|
|
sub cache { $_[0]->{cache}++ } |
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
0
|
1
|
|
sub nocache { $_[0]->{cache} = 0 } |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub get_metropolitan_bus_routes { |
63
|
0
|
|
|
0
|
1
|
|
return $_[0]->__tl_request( 'RouteForm1_RouteUrl' ); |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub get_metropolitan_train_routes { |
67
|
0
|
|
|
0
|
1
|
|
return $_[0]->__tl_request( 'RouteForm2_RouteUrl' ) |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub get_metropolitan_tram_routes { |
71
|
0
|
|
|
0
|
1
|
|
return $_[0]->__tl_request( 'RouteForm3_RouteUrl' ); |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub get_vline_bus_routes { |
75
|
0
|
|
|
0
|
1
|
|
return $_[0]->__tl_request( 'RouteForm4_RouteUrl' ) |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub get_vline_train_routes { |
79
|
0
|
|
|
0
|
1
|
|
return $_[0]->__tl_request( 'RouteForm5_RouteUrl' ) |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub get_regional_bus_routes { |
83
|
0
|
|
|
0
|
1
|
|
return $_[0]->__tl_request( 'RouteForm6_RouteUrl' ) |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub get_route_by_id { |
87
|
0
|
|
|
0
|
1
|
|
my ( $self, $id ) = @_; |
88
|
|
|
|
|
|
|
|
89
|
0
|
0
|
|
|
|
|
$id or return "Mandatory parameter id not given"; |
90
|
|
|
|
|
|
|
|
91
|
0
|
0
|
0
|
|
|
|
return $CACHE->{ROUTE}->{$id} if ( $self->{cache} and $CACHE->{ROUTE}->{$id} ); |
92
|
|
|
|
|
|
|
|
93
|
0
|
|
|
|
|
|
my $r = $self->__request( "/route/view/$id" ); |
94
|
0
|
|
|
|
|
|
my $t = HTML::TreeBuilder->new_from_content( $r ); |
95
|
0
|
|
|
|
|
|
my %route = (id => $id); |
96
|
0
|
|
|
|
|
|
my $r_link = $t->look_down( _tag => 'div', id => 'content' ); |
97
|
0
|
|
|
|
|
|
$route{name} = $t->look_down( _tag => 'h1' )->as_text; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
( $route{direction_in}, $route{direction_out} ) |
100
|
0
|
|
|
|
|
|
= $r_link->look_down( _tag => 'ul' )->look_down( _tag => "a" ); |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
( $route{direction_in_link}, $route{direction_out_link} ) |
103
|
0
|
|
|
|
|
|
= map { $_->attr( 'href' ) } $r_link->look_down( _tag => 'ul' )->look_down( _tag => "a" ); |
|
0
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
( $route{direction_in}, $route{direction_out} ) |
106
|
0
|
|
|
|
|
|
= map { $_->as_text } ( $route{direction_in}, $route{direction_out} ); |
|
0
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
( $route{description_in}, $route{description_out} ) |
109
|
0
|
|
|
|
|
|
= map { $_->as_text } $r_link->look_down( _tag => 'p' ); |
|
0
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
0
|
|
|
|
|
|
my $operator = $t->look_down( _tag => 'div', class => 'operator' )->as_text; |
112
|
0
|
|
|
|
|
|
$operator =~ s/(Contact|Website|:)/,/g; |
113
|
0
|
|
|
|
|
|
$operator =~ s/\s//g; |
114
|
0
|
|
|
|
|
|
( $route{operator} ,$route{operator_ph} ) = ( split /,/, $operator )[0,2]; |
115
|
0
|
|
|
|
|
|
$route{ua} = $self->{ua}; |
116
|
0
|
|
|
|
|
|
$route{uri} = $self->{uri}; |
117
|
0
|
|
|
|
|
|
my $route = WWW::PTV::Route->new( %route ); |
118
|
0
|
0
|
|
|
|
|
$CACHE->{ROUTE}->{$id} = $route if ( $self->{cache} ); |
119
|
|
|
|
|
|
|
|
120
|
0
|
|
|
|
|
|
return $route |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
sub get_stop_by_id { |
126
|
0
|
|
|
0
|
1
|
|
my ( $self, $id ) = @_; |
127
|
|
|
|
|
|
|
|
128
|
0
|
0
|
|
|
|
|
$id or return "Mandatory parameter id not given"; |
129
|
|
|
|
|
|
|
|
130
|
0
|
0
|
0
|
|
|
|
return $CACHE->{STOP}->{$id} if ( $self->{cache} and $CACHE->{STOP}->{$id} ); |
131
|
|
|
|
|
|
|
|
132
|
0
|
|
|
|
|
|
my $r = $self->__request( "/stop/view/$id" ); |
133
|
0
|
|
|
|
|
|
my $t = HTML::TreeBuilder->new_from_content( $r ); |
134
|
0
|
|
|
|
|
|
my %stop = (id => $id ); |
135
|
0
|
|
|
|
|
|
my $s_type = $t->look_down( _tag => 'img', class => 'stopModeImage' ); |
136
|
0
|
|
|
|
|
|
$stop{address} = $t->look_down( _tag => 'div', id => 'container' ) |
137
|
|
|
|
|
|
|
->look_down( _tag => 'p' ) |
138
|
|
|
|
|
|
|
->as_text; |
139
|
|
|
|
|
|
|
|
140
|
0
|
|
|
|
|
|
$stop{transport_type} = $s_type->attr('src'); |
141
|
0
|
|
|
|
|
|
$stop{transport_type} =~ s|themes/transport-site/images/jp/icons/icon||; |
142
|
0
|
|
|
|
|
|
$stop{transport_type} =~ s|\.png||; |
143
|
0
|
|
|
|
|
|
( $stop{street}, $stop{locality} ) = ( split /,/, $stop{address} ); |
144
|
0
|
|
|
|
|
|
( $stop{postcode} ) = $stop{locality} =~ /\b(\d{4})\b/; |
145
|
0
|
|
|
|
|
|
$stop{municipiality} = $t->look_down( _tag => 'table', class => 'stationSummary' ) |
146
|
|
|
|
|
|
|
->look_down( _tag => 'a' ) |
147
|
|
|
|
|
|
|
->as_text; |
148
|
|
|
|
|
|
|
|
149
|
0
|
|
|
|
|
|
( $stop{municipiality_id} ) = $t->look_down( _tag => 'table', class => 'stationSummary' ) |
150
|
|
|
|
|
|
|
->look_down( _tag => 'a' ) |
151
|
|
|
|
|
|
|
->attr( 'href' ); |
152
|
0
|
|
|
|
|
|
( $stop{municipiality_id} ) = $stop{municipiality_id} =~ /\/(\d.*)$/; |
153
|
|
|
|
|
|
|
|
154
|
0
|
|
|
|
|
|
$stop{zone} = ( $t->look_down( _tag => 'table', class => 'stationSummary' ) |
155
|
|
|
|
|
|
|
->look_down( _tag => 'td' ) |
156
|
|
|
|
|
|
|
)[2]->as_text; |
157
|
|
|
|
|
|
|
|
158
|
0
|
|
|
|
|
|
$stop{map_ref} = $t->look_down( _tag => 'div', class => 'aside' ) |
159
|
|
|
|
|
|
|
->look_down( _tag => 'a' ) |
160
|
|
|
|
|
|
|
->attr( 'href' ); |
161
|
|
|
|
|
|
|
|
162
|
0
|
|
|
|
|
|
( $stop{latitude} ) = $stop{map_ref} =~ /=(-?\d.*),/; |
163
|
|
|
|
|
|
|
|
164
|
0
|
|
|
|
|
|
( $stop{longitude} ) = $stop{map_ref} =~ /,(-?\d.*)$/; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
( $stop{phone_feedback}, $stop{phone_station} ) |
167
|
0
|
|
|
|
|
|
= map { $_->as_text } $t->look_down( _tag => 'div', class => 'expander phone-numbers' ) |
|
0
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
->look_down( _tag => 'dd' ); |
169
|
|
|
|
|
|
|
|
170
|
0
|
|
|
|
|
|
$stop{staff_hours} = $t->look_down( _tag => 'div', 'data-cookie' => 'stop-staff' ) |
171
|
|
|
|
|
|
|
->look_down( _tag => 'dd' )->as_text; |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
( $stop{myki_machines}, $stop{myki_checks}, $stop{vline_bookings} ) |
174
|
0
|
|
|
|
|
|
= map { $_->as_text } $t->look_down( _tag => 'div', 'data-cookie' => 'stop-ticketing' ) |
|
0
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
->look_down( _tag => 'dd' ); |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
( $stop{car_parking}, $stop{_bicycles}, $stop{taxi_rank} ) |
178
|
0
|
|
|
|
|
|
= map { $_->as_text } $t->look_down( _tag => 'div', 'data-cookie' => 'stop-other-transport-links' ) |
|
0
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
->look_down( _tag => 'dd' ); |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
( $stop{bicycle_racks}, $stop{bicycle_lockers}, $stop{bicycle_cage} ) |
182
|
0
|
|
|
|
|
|
= map { s/.*://; $_ } split /,/, $stop{_bicycles}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
( $stop{wheelchair_accessible}, $stop{stairs}, $stop{escalator}, $stop{lift}, $stop{tactile_paths}, $stop{hearing_loop} ) |
185
|
0
|
|
|
|
|
|
= map { $_->as_text } $t->look_down( _tag => 'div', 'data-cookie' => 'stop-accessibility' ) |
|
0
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
->look_down( _tag => 'dd' ); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
( $stop{seating}, $stop{lighting}, $stop{lockers}, $stop{public_phone}, $stop{public_toilet}, $stop{_waiting_area} ) |
189
|
0
|
|
|
|
|
|
= map { $_->as_text } $t->look_down( _tag => 'div', 'data-cookie' => 'stop-general-facilities' ) |
|
0
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
->look_down( _tag => 'dd' ); |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
( $stop{waiting_area_indoor}, $stop{waiting_area_sheltered} ) |
193
|
0
|
|
|
|
|
|
= map { s/.*://; $_ } split /,/, $stop{_waiting_area}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
|
195
|
0
|
|
|
|
|
|
foreach my $line ( $t->look_down( _tag => 'div', 'data-cookie' => 'stop-line-timetables' ) |
196
|
|
|
|
|
|
|
->look_down( _tag => 'div', class => 'timetable-row' ) ) { |
197
|
0
|
|
|
|
|
|
my $ref = { id => $line->look_down( _tag => 'a' )->attr( 'href' ) =~ /^.*\/(.*)/ }; |
198
|
0
|
|
|
|
|
|
$ref->{ name } = $line->look_down( _tag => 'a' )->as_text; |
199
|
0
|
|
|
|
|
|
$ref->{ type } = _get_line_type( $line->look_down( _tag => 'img' )->attr( 'src' ) ); |
200
|
0
|
|
|
|
|
|
push @{ $stop{routes} }, $ref |
|
0
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
0
|
|
|
|
|
|
$stop{ua} = $self->{ua}; |
204
|
|
|
|
|
|
|
|
205
|
0
|
|
|
|
|
|
my $stop = WWW::PTV::Stop->new( %stop ); |
206
|
0
|
0
|
|
|
|
|
$CACHE->{STOP}->{$id} = $stop if ( $self->{cache} ); |
207
|
|
|
|
|
|
|
|
208
|
0
|
|
|
|
|
|
return $stop |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
sub get_area_by_id { |
212
|
0
|
|
|
0
|
1
|
|
my ( $self, $id ) = @_; |
213
|
|
|
|
|
|
|
|
214
|
0
|
0
|
|
|
|
|
$id or return "Mandatory parameter id not given"; |
215
|
|
|
|
|
|
|
|
216
|
0
|
0
|
0
|
|
|
|
return $CACHE->{AREA}->{$id} if ( $self->{cache} and $CACHE->{AREA}->{$id} ); |
217
|
|
|
|
|
|
|
|
218
|
0
|
|
|
|
|
|
my $r = $self->__request( "/location/view/$id" ); |
219
|
0
|
|
|
|
|
|
my $t = HTML::TreeBuilder->new_from_content( $r ); |
220
|
0
|
|
|
|
|
|
my %area = ( id => $id ); |
221
|
0
|
|
|
|
|
|
$area{name} = $t->look_down( _tag => 'h1' )->as_text; |
222
|
0
|
|
|
|
|
|
@{ $area{suburbs}} = split /, /, $t->look_down( _tag => 'p' )->as_text; |
|
0
|
|
|
|
|
|
|
223
|
0
|
|
|
|
|
|
my $t_type; |
224
|
|
|
|
|
|
|
|
225
|
0
|
|
|
|
|
|
foreach my $service ( $t->look_down( _tag => 'div', id => 'content' )->look_down( _tag => 'div' ) ) { |
226
|
0
|
|
|
|
|
|
my $type = $service->look_down( _tag => 'h3' ); |
227
|
|
|
|
|
|
|
|
228
|
0
|
0
|
|
|
|
|
if ( $type->as_text ne '' ) { $t_type = $type->as_text } |
|
0
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
|
230
|
0
|
|
|
|
|
|
@{ $area{service}{names}{$t_type} } |
231
|
0
|
|
|
|
|
|
= map { $_->as_text } $service->look_down( _tag => 'li' ); |
|
0
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
|
233
|
0
|
|
|
|
|
|
@{ $area{service}{links}{$t_type} } |
234
|
0
|
|
|
|
|
|
= map { $_->attr( 'href' ) } $service->look_down( _tag => 'a' ); |
|
0
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
0
|
|
|
|
|
|
my $area = WWW::PTV::Area->new( %area ); |
238
|
0
|
0
|
|
|
|
|
$CACHE->{AREA}->{$id} = $area if ( $self->{cache} ); |
239
|
|
|
|
|
|
|
|
240
|
0
|
|
|
|
|
|
return $area |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
sub get_local_areas { |
244
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
245
|
|
|
|
|
|
|
|
246
|
0
|
|
|
|
|
|
my $r = $self->__request( '/getting-around/local-areas/' ); |
247
|
0
|
|
|
|
|
|
my $t = HTML::TreeBuilder->new_from_content( $r ); |
248
|
0
|
|
|
|
|
|
$t = $t->look_down( _tag => 'div', id => 'content' ); |
249
|
|
|
|
|
|
|
|
250
|
0
|
|
|
|
|
|
@{ $self->{local_areas}{names} } |
251
|
0
|
|
|
|
|
|
= map { $_->as_text } $t->look_down( _tag => 'li' ); |
|
0
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
|
253
|
0
|
|
|
|
|
|
@{ $self->{local_areas}{links} } |
254
|
0
|
|
|
|
|
|
= map { $_->attr( 'href' ) } $t->look_down( _tag => 'a' ); |
|
0
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
|
256
|
0
|
|
|
|
|
|
my %res; |
257
|
0
|
|
|
|
|
|
@res{ @{ $self->{local_areas}{names} } } = @{ $self->{local_areas}{links} }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
|
259
|
0
|
|
|
|
|
|
return %res |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub _get_line_type { |
263
|
0
|
|
|
0
|
|
|
my $obj = shift; |
264
|
|
|
|
|
|
|
|
265
|
0
|
|
|
|
|
|
$obj =~ s/^.*\/icon//; |
266
|
0
|
|
|
|
|
|
$obj =~ s/\..*$//; |
267
|
|
|
|
|
|
|
|
268
|
0
|
|
|
|
|
|
return lc $obj |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
1; |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
__END__ |