Bus API module

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;