diff options
Diffstat (limited to 'lib/TFL')
| -rw-r--r-- | lib/TFL/Bus.pm | 304 |
1 files changed, 0 insertions, 304 deletions
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; |