summaryrefslogtreecommitdiff
path: root/lib/TFL/Bus.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/TFL/Bus.pm')
-rw-r--r--lib/TFL/Bus.pm307
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;