summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--driver.pl15
-rw-r--r--lib/TFL/Bus.pm304
-rw-r--r--lib/WebService/TFL/Bus.pm46
-rw-r--r--lib/WebService/TFL/Bus/Fields.pm77
-rw-r--r--lib/WebService/TFL/Bus/Request.pm37
-rw-r--r--lib/WebService/TFL/Bus/Response.pm54
-rw-r--r--lib/WebService/TFL/Bus/Response/BaseVersion.pm15
-rw-r--r--lib/WebService/TFL/Bus/Response/FlexibleMessage.pm5
-rw-r--r--lib/WebService/TFL/Bus/Response/Prediction.pm5
-rw-r--r--lib/WebService/TFL/Bus/Response/Stop.pm5
-rw-r--r--lib/WebService/TFL/Bus/Response/URAVersion.pm17
-rw-r--r--lib/WebService/TFL/Bus/ResponseTypeRole.pm40
-rw-r--r--lib/WebService/TFL/Bus/Types.pm12
13 files changed, 322 insertions, 310 deletions
diff --git a/driver.pl b/driver.pl
index dacda01..54a04ab 100644
--- a/driver.pl
+++ b/driver.pl
@@ -3,18 +3,21 @@ use strict;
use warnings;
use 5.014;
use WebService::ForecastIo::Response;
-use TFL::Bus;
+use WebService::TFL::Bus;
+use WebService::TFL::Bus::Request;
use HomePanel::Render;
use Path::Class;
my $forecast = WebService::ForecastIo::Response->new(
file($ARGV[0])->slurp(iomode=>'<:raw')
);
-my $bus = TFL::Bus->new()->request(TFL::Bus::Request->new({
- StopPointName => 'Hotspur Road',
- #Towards => 'Islip Manor',
- ReturnList => [qw(StopID StopCode1 VisitNumber TripID VehicleID LineID LineName DirectionID DestinationText DestinationName EstimatedTime)],
-}));
+my $bus = WebService::TFL::Bus->new()->request(
+ WebService::TFL::Bus::Request->new({
+ StopPointName => 'Hotspur Road',
+ #Towards => 'Islip Manor',
+ ReturnList => [qw(StopID StopCode1 VisitNumber TripID VehicleID LineID LineName DirectionID DestinationText DestinationName EstimatedTime)],
+ }),
+);
my $template = file(__FILE__)->parent->file('forecast.html.tt');
print
diff --git a/lib/TFL/Bus.pm b/lib/TFL/Bus.pm
deleted file mode 100644
index 820d630..0000000
--- a/lib/TFL/Bus.pm
+++ /dev/null
@@ -1,304 +0,0 @@
-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;
diff --git a/lib/WebService/TFL/Bus.pm b/lib/WebService/TFL/Bus.pm
new file mode 100644
index 0000000..60ec5c9
--- /dev/null
+++ b/lib/WebService/TFL/Bus.pm
@@ -0,0 +1,46 @@
+package WebService::TFL::Bus;
+use Moose;
+use Moose::Util::TypeConstraints;
+use MooseX::Types::URI 'Uri';
+use WebService::TFL::Bus::Response;
+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 WebService::TFL::Bus::Response->new_from_json(
+ $request->ReturnList,
+ $json
+ );
+ }
+ else {
+ die $http_response->status_line;
+ }
+}
+
+1;
diff --git a/lib/WebService/TFL/Bus/Fields.pm b/lib/WebService/TFL/Bus/Fields.pm
new file mode 100644
index 0000000..b3d555f
--- /dev/null
+++ b/lib/WebService/TFL/Bus/Fields.pm
@@ -0,0 +1,77 @@
+package WebService::TFL::Bus::Fields;
+use strict;
+use warnings;
+
+sub stop_return_fields {
+ qw(
+ StopPointName
+ StopID
+ StopCode1
+ StopCode2
+ StopPointType
+ Towards
+ Bearing
+ StopPointIndicator
+ StopPointState
+ Latitude
+ Longitude
+ );
+}
+
+sub prediction_return_fields {
+ stop_return_fields(),
+ qw(
+ VisitNumber
+ LineID
+ LineName
+ DirectionID
+ DestinationText
+ DestinationName
+ VehicleID
+ TripID
+ RegistrationNumber
+ EstimatedTime
+ ExpireTime
+ ),
+}
+
+sub flexible_return_fields {
+ stop_return_fields,
+ qw(
+ MessageUUID
+ MessageType
+ MessagePriority
+ MessageText
+ StartTime
+ ExpireTime
+ ),
+}
+
+sub 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
+ );
+}
+
+1;
diff --git a/lib/WebService/TFL/Bus/Request.pm b/lib/WebService/TFL/Bus/Request.pm
new file mode 100644
index 0000000..cf35459
--- /dev/null
+++ b/lib/WebService/TFL/Bus/Request.pm
@@ -0,0 +1,37 @@
+package WebService::TFL::Bus::Request;
+use Moose;
+use WebService::TFL::Bus::Fields;
+use namespace::autoclean;
+
+for my $field (WebService::TFL::Bus::Fields->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 (WebService::TFL::Bus::Fields->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;
+}
+
+1;
diff --git a/lib/WebService/TFL/Bus/Response.pm b/lib/WebService/TFL/Bus/Response.pm
new file mode 100644
index 0000000..a4aa056
--- /dev/null
+++ b/lib/WebService/TFL/Bus/Response.pm
@@ -0,0 +1,54 @@
+package WebService::TFL::Bus::Response;
+use Moose;
+use Class::Load 'load_class';
+use JSON;
+use namespace::autoclean;
+
+sub line_class {
+ "WebService::TFL::Bus::Response::$_[0]";
+}
+
+my %line_map = (
+ 0 => 'Stop',
+ 1 => 'Prediction',
+ 2 => 'FlexibleMessage',
+ 3 => 'BaseVersion',
+ 4 => 'URAVersion',
+);
+
+for my $field (values %line_map) {
+ my $class = line_class($field);
+ load_class($class);
+ has $field => (
+ is => 'ro',
+ isa => "ArrayRef[$class]",
+ 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 = line_class($array_type);
+ push @{$args{$array_type}},
+ $line_class->new_from_array(\%return_set,$array);
+
+ substr($json,0,$consumed)='';
+ }
+
+ return $class->new(\%args);
+}
+
+1;
diff --git a/lib/WebService/TFL/Bus/Response/BaseVersion.pm b/lib/WebService/TFL/Bus/Response/BaseVersion.pm
new file mode 100644
index 0000000..37b2ddb
--- /dev/null
+++ b/lib/WebService/TFL/Bus/Response/BaseVersion.pm
@@ -0,0 +1,15 @@
+package WebService::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]});
+}
+
+1;
diff --git a/lib/WebService/TFL/Bus/Response/FlexibleMessage.pm b/lib/WebService/TFL/Bus/Response/FlexibleMessage.pm
new file mode 100644
index 0000000..11b7b1a
--- /dev/null
+++ b/lib/WebService/TFL/Bus/Response/FlexibleMessage.pm
@@ -0,0 +1,5 @@
+package WebService::TFL::Bus::Response::FlexibleMessage;
+use Moose;
+with 'WebService::TFL::Bus::ResponseTypeRole' => { type => 'flexible' };
+
+1;
diff --git a/lib/WebService/TFL/Bus/Response/Prediction.pm b/lib/WebService/TFL/Bus/Response/Prediction.pm
new file mode 100644
index 0000000..d3ea931
--- /dev/null
+++ b/lib/WebService/TFL/Bus/Response/Prediction.pm
@@ -0,0 +1,5 @@
+package WebService::TFL::Bus::Response::Prediction;
+use Moose;
+with 'WebService::TFL::Bus::ResponseTypeRole' => { type => 'prediction' };
+
+1;
diff --git a/lib/WebService/TFL/Bus/Response/Stop.pm b/lib/WebService/TFL/Bus/Response/Stop.pm
new file mode 100644
index 0000000..3c98ca5
--- /dev/null
+++ b/lib/WebService/TFL/Bus/Response/Stop.pm
@@ -0,0 +1,5 @@
+package WebService::TFL::Bus::Response::Stop;
+use Moose;
+with 'WebService::TFL::Bus::ResponseTypeRole' => { type => 'stop' };
+
+1;
diff --git a/lib/WebService/TFL/Bus/Response/URAVersion.pm b/lib/WebService/TFL/Bus/Response/URAVersion.pm
new file mode 100644
index 0000000..38c8a62
--- /dev/null
+++ b/lib/WebService/TFL/Bus/Response/URAVersion.pm
@@ -0,0 +1,17 @@
+package WebService::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;
diff --git a/lib/WebService/TFL/Bus/ResponseTypeRole.pm b/lib/WebService/TFL/Bus/ResponseTypeRole.pm
new file mode 100644
index 0000000..6cfd460
--- /dev/null
+++ b/lib/WebService/TFL/Bus/ResponseTypeRole.pm
@@ -0,0 +1,40 @@
+package WebService::TFL::Bus::ResponseTypeRole;
+use MooseX::Role::Parameterized;
+use WebService::TFL::Bus::Fields;
+use WebService::TFL::Bus::Types 'DateTimeMillis';
+
+parameter type => (
+ isa => 'Str',
+ required => 1,
+);
+
+role {
+ my $p = shift;
+ my $method = $p->type . '_return_fields';
+ my @fields = WebService::TFL::Bus::Fields->$method;
+
+ for my $field (@fields) {
+ has $field => (
+ is => 'ro',
+ ( $field =~ /Time$/ ? (
+ isa => DateTimeMillis,
+ coerce => 1,
+ ) : () ),
+ );
+ }
+
+ method new_from_array => sub {
+ my ($class,$return_set,$array) = @_;
+
+ my %args;
+ my $i=1;
+ for my $field (@fields) {
+ next unless exists $return_set->{$field};
+ $args{$field}=$array->[$i];
+ ++$i;
+ }
+ return $class->new(\%args);
+ }
+};
+
+1;
diff --git a/lib/WebService/TFL/Bus/Types.pm b/lib/WebService/TFL/Bus/Types.pm
new file mode 100644
index 0000000..9b569f5
--- /dev/null
+++ b/lib/WebService/TFL/Bus/Types.pm
@@ -0,0 +1,12 @@
+package WebService::TFL::Bus::Types;
+use MooseX::Types -declare => [
+ 'DateTimeMillis'
+];
+use MooseX::Types::Moose 'Num';
+use MooseX::Types::DateTime 'DateTime';
+
+subtype DateTimeMillis, as DateTime;
+coerce DateTimeMillis, from Num,
+ via { 'DateTime'->from_epoch( epoch => $_ / 1000 ) };
+
+1;