diff options
-rw-r--r-- | driver.pl | 15 | ||||
-rw-r--r-- | lib/TFL/Bus.pm | 304 | ||||
-rw-r--r-- | lib/WebService/TFL/Bus.pm | 46 | ||||
-rw-r--r-- | lib/WebService/TFL/Bus/Fields.pm | 77 | ||||
-rw-r--r-- | lib/WebService/TFL/Bus/Request.pm | 37 | ||||
-rw-r--r-- | lib/WebService/TFL/Bus/Response.pm | 54 | ||||
-rw-r--r-- | lib/WebService/TFL/Bus/Response/BaseVersion.pm | 15 | ||||
-rw-r--r-- | lib/WebService/TFL/Bus/Response/FlexibleMessage.pm | 5 | ||||
-rw-r--r-- | lib/WebService/TFL/Bus/Response/Prediction.pm | 5 | ||||
-rw-r--r-- | lib/WebService/TFL/Bus/Response/Stop.pm | 5 | ||||
-rw-r--r-- | lib/WebService/TFL/Bus/Response/URAVersion.pm | 17 | ||||
-rw-r--r-- | lib/WebService/TFL/Bus/ResponseTypeRole.pm | 40 | ||||
-rw-r--r-- | lib/WebService/TFL/Bus/Types.pm | 12 |
13 files changed, 322 insertions, 310 deletions
@@ -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; |