diff options
Diffstat (limited to 'lib/TFL/Bus.pm')
-rw-r--r-- | lib/TFL/Bus.pm | 307 |
1 files changed, 307 insertions, 0 deletions
diff --git a/lib/TFL/Bus.pm b/lib/TFL/Bus.pm new file mode 100644 index 0000000..1c98236 --- /dev/null +++ b/lib/TFL/Bus.pm @@ -0,0 +1,307 @@ +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; + + use Data::Printer;p $json; + + 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) { + warn "lookinf a $field\n"; + 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; |