| 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 |