my @stop_return_fields =
qw(
StopPointName
StopID
StopCode1
StopCode2
StopPointType
Towards
Bearing
StopPointIndicator
StopPointState
Latitude
Longitude
);
my @prediction_return_fields = (
@stop_return_fields,
qw(
VisitNumber
LineID
LineName
DirectionID
DestinationText
DestinationName
VehicleID
TripID
RegistrationNumber
EstimatedTime
ExpireTime
),
);
my @flexible_return_fields = (
@stop_return_fields,
qw(
MessageUUID
MessageType
MessagePriority
MessageText
StartTime
ExpireTime
),
);
my @query_fields =
qw(
StopAlso
Circle
StopPointName
StopID
StopCode1
StopCode2
StopPointType
Towards
Bearing
StopPointIndicator
StopPointState
VisitNumber
LineID
LineName
DirectionID
DestinationText
DestinationName
VehicleID
TripID
RegistrationNumber
MessageType
MessagePriority
);
package TFL::Bus {
use Moose;
use Moose::Util::TypeConstraints;
use MooseX::Types::URI 'Uri';
use namespace::autoclean;
has user_agent => (
isa => duck_type(['get']),
is => 'ro',
lazy_build => 1,
);
sub _build_user_agent {
require LWP::UserAgent;
my $ua = LWP::UserAgent->new();
$ua->env_proxy;
return $ua;
}
has uri => (
isa => Uri,
is => 'ro',
coerce => 1,
default => 'http://countdown.api.tfl.gov.uk/interfaces/ura/instant_V1',
);
sub request {
my ($self,$request) = @_;
my $http_response = $self->user_agent->get(
$request->request_uri($self->uri)
);
if ($http_response->is_success) {
my $json = $http_response->content;
return TFL::Bus::Response->new_from_json(
$request->ReturnList,
$json
);
}
else {
die $http_response->status_line;
}
}
}
package TFL::Bus::Request {
use Moose;
use namespace::autoclean;
for my $field (@query_fields) {
has $field => (
is => 'rw',
predicate => "has_$field",
);
}
has ReturnList => (
is => 'rw',
isa => 'ArrayRef',
predicate => 'has_ReturnList',
);
sub request_uri {
my ($self,$base_uri) = @_;
my $uri = $base_uri->clone;
my %form;
for my $field (@query_fields) {
my $pred = "has_$field";
if ($self->$pred) {
$form{$field} = $self->$field;
}
}
if ($self->has_ReturnList) {
$form{ReturnList}=join ',',@{$self->ReturnList}
}
$uri->query_form(\%form);
return $uri;
}
}
package TFL::Bus::Response {
use Moose;
use JSON;
use namespace::autoclean;
my %line_map = (
0 => 'Stop',
1 => 'Prediction',
2 => 'FlexibleMessage',
3 => 'BaseVersion',
4 => 'URAVersion',
);
for my $field (values %line_map) {
has $field => (
is => 'ro',
isa => "ArrayRef[TFL::Bus::Response::$field]",
traits => [ 'Array' ],
);
}
sub new_from_json {
my ($class,$return_list,$json) = @_;
my $parser = JSON->new->utf8;
my %return_set;@return_set{@$return_list}=();
unless (%return_set) {
@return_set{qw(StopPointName LineName EstimatedTime)}=();
}
my %args;
while ($json) {
my ($array,$consumed) = $parser->decode_prefix($json);
my $array_type = $line_map{$array->[0]};
my $line_class = "TFL::Bus::Response::$array_type";
push @{$args{$array_type}},
$line_class->new_from_array(\%return_set,$array);
substr($json,0,$consumed)='';
}
return $class->new(\%args);
}
}
package TFL::Bus::Response::Stop {
use Moose;
use namespace::autoclean;
for my $field (@stop_return_fields) {
has $field => (
is => 'ro',
);
}
sub new_from_array {
my ($class,$return_set,$array) = @_;
my %args;
my $i=1;
for my $field (@stop_return_fields) {
next unless exists $return_set->{$field};
$args{$field}=$array->[$i];
++$i;
}
return $class->new(\%args);
}
}
package TFL::Bus::Response::Prediction {
use Moose;
use namespace::autoclean;
for my $field (@prediction_return_fields) {
has $field => (
is => 'ro',
);
}
sub new_from_array {
my ($class,$return_set,$array) = @_;
my %args;
my $i=1;
for my $field (@prediction_return_fields) {
next unless exists $return_set->{$field};
$args{$field}=$array->[$i];
++$i;
}
return $class->new(\%args);
}
}
package TFL::Bus::Response::FlexibleMessage {
use Moose;
use namespace::autoclean;
for my $field (@flexible_return_fields) {
has $field => (
is => 'ro',
);
}
sub new_from_array {
my ($class,$return_set,$array) = @_;
my %args;
my $i=1;
for my $field (@flexible_return_fields) {
next unless exists $return_set->{$field};
$args{$field}=$array->[$i];
++$i;
}
return $class->new(\%args);
}
}
package TFL::Bus::Response::BaseVersion {
use Moose;
use namespace::autoclean;
has Version => (
is => 'ro',
);
sub new_from_array {
my ($class,$return_set,$array) = @_;
return $class->new({Version => $array->[1]});
}
}
package TFL::Bus::Response::URAVersion {
use Moose;
use namespace::autoclean;
for my $field (qw(Version TimeStamp)) {
has $field => (
is => 'ro',
);
}
sub new_from_array {
my ($class,$return_set,$array) = @_;
return $class->new({Version => $array->[1],TimeStamp => $array->[2]});
}
}
1;