File Coverage

blib/lib/WWW/Oxontime.pm

Criterion	Covered	Total	%
statement	34	56	60.7
branch	2	12	16.6
condition			n/a
subroutine	10	12	83.3
pod	3	3	100.0
total	49	83	59.0

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__