]>
Commit | Line | Data |
---|---|---|
1 | package WWW::Oxontime; | |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | use parent qw/Exporter/; | |
7 | ||
8 | use constant +{ | |
9 | NEXTBUS_FROM_HEADINGTON_CAMPUS => 'headington', | |
10 | NEXTBUS_FROM_HARCOURT_HILL => 'harcourt', | |
11 | NEXTBUS_FROM_MARSTON_ROAD => 'marston', | |
12 | NEXTBUS_FROM_WHEATLEY_CAMPUS => 'wheatley', | |
13 | NEXTBUS_FROM_CRESCENT_HALL => 'crescent', | |
14 | NEXTBUS_FROM_PAUL_KENT_HALL => 'paulkent', | |
15 | NEXTBUS_FROM_SLADE_PARK => 'sladepark', | |
16 | NEXTBUS_FROM_CITY_CENTRE => 'citycentre', | |
17 | }; | |
18 | ||
19 | my @CONSTANTS = | |
20 | qw/NEXTBUS_FROM_HEADINGTON_CAMPUS | |
21 | NEXTBUS_FROM_HARCOURT_HILL | |
22 | NEXTBUS_FROM_MARSTON_ROAD | |
23 | NEXTBUS_FROM_WHEATLEY_CAMPUS | |
24 | NEXTBUS_FROM_CRESCENT_HALL | |
25 | NEXTBUS_FROM_PAUL_KENT_HALL | |
26 | NEXTBUS_FROM_SLADE_PARK | |
27 | NEXTBUS_FROM_CITY_CENTRE/; | |
28 | ||
29 | our $VERSION = '0.002'; | |
30 | our @EXPORT_OK = (qw/stops_for_route departures_for_stop nextbus_from_to/, @CONSTANTS); | |
31 | our @EXPORT = (); | |
32 | our %EXPORT_TAGS = (all => [@EXPORT_OK], constants => [@CONSTANTS]); | |
33 | ||
34 | use HTML::TreeBuilder; | |
35 | use HTTP::Tiny; | |
36 | use JSON::MaybeXS; | |
37 | use Time::Piece; | |
38 | ||
39 | our $STOPS_URL = 'http://www.buscms.com/Nimbus/operatorpages/widgets/departureboard/ssi.aspx?method=updateRouteStops&routeid=%d&callback=cb&_=%d'; | |
40 | our $DEPARTS_URL = 'http://www.buscms.com/api/REST/html/departureboard.aspx?clientid=Nimbus&stopid=%d&format=jsonp&cachebust=123&sourcetype=siri&requestor=Netescape&includeTimestamp=true&_=%d'; | |
41 | our $DEPART_TIME_FORMAT = '%d/%m/%Y %T'; | |
42 | our $NEXTBUS_URL = 'http://nextbus.brookes.ac.uk/%s?format=json&%s'; | |
43 | ||
44 | our $ht = HTTP::Tiny->new(agent => "WWW-Oxontime/$VERSION"); | |
45 | ||
46 | sub stops_for_route { | |
47 | my ($route_id) = @_; | |
48 | my $url = sprintf $STOPS_URL, int $route_id, time; | |
49 | my $result = $ht->get($url); | |
50 | die $result->{reason} unless $result->{success}; | |
51 | my $json = $result->{content}; | |
52 | $json = substr $json, 3, (length $json) - 5; | |
53 | my $stops = decode_json($json)->{stops}; | |
54 | wantarray ? @$stops : $stops | |
55 | } | |
56 | ||
57 | sub departures_for_stop { | |
58 | my ($stop_id) = @_; | |
59 | my $url = sprintf $DEPARTS_URL, int $stop_id, time; | |
60 | my $result = $ht->get($url); | |
61 | die $result->{reason} unless $result->{success}; | |
62 | my $content = $result->{content}; | |
63 | $content =~ s/\s/ /g; # replaces tabs with spaces | |
64 | $content = JSON->new->allow_nonref(1)->decode(qq/"$content"/); | |
65 | my $html = HTML::TreeBuilder->new_from_content($content); | |
66 | ||
67 | my @lines = $html->look_down(class => qr/\browServiceDeparture\b/); | |
68 | my @result = map { | |
69 | my @cells = $_->find('td'); | |
70 | my $departs = $cells[2]->attr('data-departureTime'); | |
71 | +{ | |
72 | service => $cells[0]->as_trimmed_text, | |
73 | destination => $cells[1]->as_trimmed_text, | |
74 | departs => Time::Piece->strptime($departs, $DEPART_TIME_FORMAT), | |
75 | } | |
76 | } @lines; | |
77 | wantarray ? @result : \@result | |
78 | } | |
79 | ||
80 | sub nextbus_from_to { | |
81 | my ($from, $to) = @_; | |
82 | my $data = $ht->www_form_urlencode({ destination => $to}); | |
83 | my $url = sprintf $NEXTBUS_URL, $from, $data; | |
84 | my $result = $ht->get($url); | |
85 | die $result->{reason} unless $result->{success}; | |
86 | my $content = $result->{content}; | |
87 | my $departures = JSON->new->decode($content)->{departures}; | |
88 | wantarray ? @$departures : $departures | |
89 | } | |
90 | ||
91 | 1; | |
92 | __END__ | |
93 | ||
94 | =encoding utf-8 | |
95 | ||
96 | =head1 NAME | |
97 | ||
98 | WWW::Oxontime - live Oxford bus departures from Oxontime | |
99 | ||
100 | =head1 SYNOPSIS | |
101 | ||
102 | use WWW::Oxontime qw/stops_for_route departures_for_stop nextbus_from_to :constants/; | |
103 | my @stops_on_8_outbound = stops_for_route 15957; | |
104 | my $queens_lane = $stops_on_8_outbound[2]->{stopId}; | |
105 | my @from_queens_lane = departures_for_stop $queens_lane; | |
106 | for my $entry (@from_queens_lane) { | |
107 | say $entry->{service}, ' towards ', $entry->{destination}, ' departs at ', $entry->{departs}; | |
108 | } | |
109 | my @from_city_centre_to_headington_campus = | |
110 | nextbus_from_to NEXTBUS_FROM_CITY_CENTRE, 'Headington Campus'; | |
111 | for my $line (@from_city_centre_to_headington_campus) { | |
112 | my ($from, $service, $departs_in, $departs_in_mins) = @$line; | |
113 | say "Bus $service leaves from $from in $departs_in"; | |
114 | } | |
115 | ||
116 | =head1 DESCRIPTION | |
117 | ||
118 | This module wraps L<http://www.oxontime.com> to provide live bus | |
119 | departures in Oxford. | |
120 | ||
121 | Two methods can be exported (none by default): | |
122 | ||
123 | =over | |
124 | ||
125 | =item B<stops_for_route>(I<$route_id>) | |
126 | ||
127 | Given a route ID (these can be obtained by inspecting the homepage of | |
128 | Oxontime), returns in list context a list of hashrefs having the keys | |
129 | C<stopName> (name of stop) and C<stopId> (ID of stop, suitable for | |
130 | passing to C<departures_for_stop>). In scalar context, an arrayref | |
131 | containing this list is returned. | |
132 | ||
133 | =item B<departures_for_stop>(I<$stop_id>) | |
134 | ||
135 | Given a stop ID (these can be obtained by inspecting the homepage of | |
136 | Oxontime or by calling C<stops_for_route>), returns in list context a | |
137 | list of hashrefs having the keys C<service> (name of service and | |
138 | company that runs it), C<destination> (where the service is finishing) | |
139 | and C<departs> (L<Time::Piece> object representing the time when the | |
140 | service departs). In scalar context, an arrayref containing the list | |
141 | is returned. | |
142 | ||
143 | Note that C<departs> is in the time zone of Oxford, but Time::Piece | |
144 | interprets it as being in local time. If local time is different from | |
145 | time in Oxford, this needs to be taken into account. | |
146 | ||
147 | =item B<nextbus_from_to>(I<$from>, I<$to>) | |
148 | ||
149 | Given a place to start from and a place to arrive at this method | |
150 | returns a list of the next buses to serve that route. I<$from> must be | |
151 | one of the 8 provided constants: | |
152 | ||
153 | NEXTBUS_FROM_HEADINGTON_CAMPUS | |
154 | NEXTBUS_FROM_HARCOURT_HILL | |
155 | NEXTBUS_FROM_MARSTON_ROAD | |
156 | NEXTBUS_FROM_WHEATLEY_CAMPUS | |
157 | NEXTBUS_FROM_CRESCENT_HALL | |
158 | NEXTBUS_FROM_PAUL_KENT_HALL | |
159 | NEXTBUS_FROM_SLADE_PARK | |
160 | NEXTBUS_FROM_CITY_CENTRE | |
161 | ||
162 | whereas I<$to> is the name of an important station. | |
163 | ||
164 | This function calls the Nextbus service at | |
165 | L<http://nextbus.brookes.ac.uk/>. It is unclear what values for I<$to> | |
166 | are implemented by Nextbus; it is probably best to inspect the website | |
167 | to see what destinations are available. | |
168 | ||
169 | =back | |
170 | ||
171 | =head1 AUTHOR | |
172 | ||
173 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
174 | ||
175 | =head1 COPYRIGHT AND LICENSE | |
176 | ||
177 | Copyright (C) 2017 by Marius Gavrilescu | |
178 | ||
179 | This library is free software; you can redistribute it and/or modify | |
180 | it under the same terms as Perl itself, either Perl version 5.26.1 or, | |
181 | at your option, any later version of Perl 5 you may have available. | |
182 | ||
183 | ||
184 | =cut |