[www-oxontime.git] / lib / WWW / Oxontime.pm

package WWW::Oxontime;

use 5.014000;
use strict;
use warnings;
use parent qw/Exporter/;

use constant +{
	NEXTBUS_FROM_HEADINGTON_CAMPUS => 'headington',
	NEXTBUS_FROM_HARCOURT_HILL     => 'harcourt',
	NEXTBUS_FROM_MARSTON_ROAD      => 'marston',
	NEXTBUS_FROM_WHEATLEY_CAMPUS   => 'wheatley',
	NEXTBUS_FROM_CRESCENT_HALL     => 'crescent',
	NEXTBUS_FROM_PAUL_KENT_HALL    => 'paulkent',
	NEXTBUS_FROM_SLADE_PARK        => 'sladepark',
	NEXTBUS_FROM_CITY_CENTRE       => 'citycentre',
};

my @CONSTANTS =
  qw/NEXTBUS_FROM_HEADINGTON_CAMPUS
     NEXTBUS_FROM_HARCOURT_HILL
     NEXTBUS_FROM_MARSTON_ROAD
     NEXTBUS_FROM_WHEATLEY_CAMPUS
     NEXTBUS_FROM_CRESCENT_HALL
     NEXTBUS_FROM_PAUL_KENT_HALL
     NEXTBUS_FROM_SLADE_PARK
     NEXTBUS_FROM_CITY_CENTRE/;

our $VERSION = '0.002';
our @EXPORT_OK = (qw/stops_for_route departures_for_stop nextbus_from_to/, @CONSTANTS);
our @EXPORT = ();
our %EXPORT_TAGS = (all => [@EXPORT_OK], constants => [@CONSTANTS]);

use HTML::TreeBuilder;
use HTTP::Tiny;
use JSON::MaybeXS;
use Time::Piece;

our $STOPS_URL = 'http://www.buscms.com/Nimbus/operatorpages/widgets/departureboard/ssi.aspx?method=updateRouteStops&routeid=%d&callback=cb&_=%d';
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';
our $DEPART_TIME_FORMAT = '%d/%m/%Y %T';
our $NEXTBUS_URL = 'http://nextbus.brookes.ac.uk/%s?format=json&%s';

our $ht = HTTP::Tiny->new(agent => "WWW-Oxontime/$VERSION");

sub stops_for_route {
	my ($route_id) = @_;
	my $url = sprintf $STOPS_URL, int $route_id, time;
	my $result = $ht->get($url);
	die $result->{reason} unless $result->{success};
	my $json = $result->{content};
	$json = substr $json, 3, (length $json) - 5;
	my $stops = decode_json($json)->{stops};
	wantarray ? @$stops : $stops
}

sub departures_for_stop {
	my ($stop_id) = @_;
	my $url = sprintf $DEPARTS_URL, int $stop_id, time;
	my $result = $ht->get($url);
	die $result->{reason} unless $result->{success};
	my $content = $result->{content};
	$content =~ s/\s/ /g; # replaces tabs with spaces
	$content = JSON->new->allow_nonref(1)->decode(qq/"$content"/);
	my $html = HTML::TreeBuilder->new_from_content($content);

	my @lines = $html->look_down(class => qr/\browServiceDeparture\b/);
	my @result = map {
		my @cells = $_->find('td');
		my $departs = $cells[2]->attr('data-departureTime');
		+{
			service     => $cells[0]->as_trimmed_text,
			destination => $cells[1]->as_trimmed_text,
			departs     => Time::Piece->strptime($departs, $DEPART_TIME_FORMAT),
		}
	} @lines;
	wantarray ? @result : \@result
}

sub nextbus_from_to {
	my ($from, $to) = @_;
	my $data = $ht->www_form_urlencode({ destination => $to});
	my $url = sprintf $NEXTBUS_URL, $from, $data;
	my $result = $ht->get($url);
	die $result->{reason} unless $result->{success};
	my $content = $result->{content};
	my $departures = JSON->new->decode($content)->{departures};
	wantarray ? @$departures : $departures
}

1;
__END__

=encoding utf-8

=head1 NAME

WWW::Oxontime - live Oxford bus departures from Oxontime

=head1 SYNOPSIS

  use WWW::Oxontime qw/stops_for_route departures_for_stop nextbus_from_to :constants/;
  my @stops_on_8_outbound = stops_for_route 15957;
  my $queens_lane = $stops_on_8_outbound[2]->{stopId};
  my @from_queens_lane = departures_for_stop $queens_lane;
  for my $entry (@from_queens_lane) {
    say $entry->{service}, ' towards ', $entry->{destination}, ' departs at ', $entry->{departs};
  }
  my @from_city_centre_to_headington_campus =
    nextbus_from_to NEXTBUS_FROM_CITY_CENTRE, 'Headington Campus';
  for my $line (@from_city_centre_to_headington_campus) {
    my ($from, $service, $departs_in, $departs_in_mins) = @$line;
    say "Bus $service leaves from $from in $departs_in";
  }

=head1 DESCRIPTION

This module wraps L<http://www.oxontime.com> to provide live bus
departures in Oxford.

Two methods can be exported (none by default):

=over

=item B<stops_for_route>(I<$route_id>)

Given a route ID (these can be obtained by inspecting the homepage of
Oxontime), returns in list context a list of hashrefs having the keys
C<stopName> (name of stop) and C<stopId> (ID of stop, suitable for
passing to C<departures_for_stop>). In scalar context, an arrayref
containing this list is returned.

=item B<departures_for_stop>(I<$stop_id>)

Given a stop ID (these can be obtained by inspecting the homepage of
Oxontime or by calling C<stops_for_route>), returns in list context a
list of hashrefs having the keys C<service> (name of service and
company that runs it), C<destination> (where the service is finishing)
and C<departs> (L<Time::Piece> object representing the time when the
service departs). In scalar context, an arrayref containing the list
is returned.

Note that C<departs> is in the time zone of Oxford, but Time::Piece
interprets it as being in local time. If local time is different from
time in Oxford, this needs to be taken into account.

=item B<nextbus_from_to>(I<$from>, I<$to>)

Given a place to start from and a place to arrive at this method
returns a list of the next buses to serve that route. I<$from> must be
one of the 8 provided constants:

  NEXTBUS_FROM_HEADINGTON_CAMPUS
  NEXTBUS_FROM_HARCOURT_HILL
  NEXTBUS_FROM_MARSTON_ROAD
  NEXTBUS_FROM_WHEATLEY_CAMPUS
  NEXTBUS_FROM_CRESCENT_HALL
  NEXTBUS_FROM_PAUL_KENT_HALL
  NEXTBUS_FROM_SLADE_PARK
  NEXTBUS_FROM_CITY_CENTRE

whereas I<$to> is the name of an important station.

This function calls the Nextbus service at
L<http://nextbus.brookes.ac.uk/>. It is unclear what values for I<$to>
are implemented by Nextbus; it is probably best to inspect the website
to see what destinations are available.

=back

=head1 AUTHOR

Marius Gavrilescu, E<lt>marius@ieval.roE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2017 by Marius Gavrilescu

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.26.1 or,
at your option, any later version of Perl 5 you may have available.


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