summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--driver.pl4
-rw-r--r--forecast.html.tt16
-rw-r--r--lib/WebService/TFL/TubeStatus.pm40
-rw-r--r--lib/WebService/TFL/TubeStatus/Response.pm28
-rw-r--r--lib/WebService/TFL/TubeStatus/Response/Line.pm36
-rw-r--r--lib/WebService/TFL/TubeStatus/Response/LineStatus.pm32
6 files changed, 155 insertions, 1 deletions
diff --git a/driver.pl b/driver.pl
index 561b253..df8e1fa 100644
--- a/driver.pl
+++ b/driver.pl
@@ -5,6 +5,7 @@ use 5.014;
use WebService::ForecastIo::Response;
use WebService::TFL::Bus;
use WebService::TFL::Bus::Request;
+use WebService::TFL::TubeStatus;
use HomePanel::Render;
use Path::Class;
@@ -18,6 +19,7 @@ my $bus = WebService::TFL::Bus->new()->request(
ReturnList => [qw(StopID StopCode1 VisitNumber TripID VehicleID LineID LineName DirectionID DestinationText DestinationName EstimatedTime)],
}),
);
+my $tube = WebService::TFL::TubeStatus->new()->request();
my $template = file(__FILE__)->parent->file('forecast.html.tt');
binmode STDOUT,':utf8';
@@ -27,5 +29,5 @@ print
template_file => $template,
forecast => $forecast,
bus => $bus,
- tube => '',
+ tube => $tube,
})->render;
diff --git a/forecast.html.tt b/forecast.html.tt
index 82d8412..eedc078 100644
--- a/forecast.html.tt
+++ b/forecast.html.tt
@@ -143,5 +143,21 @@
</tbody>
</table>
</div>
+ <div class="tube">
+ <table class="status">
+ <thead>
+ <tr><th>Line</th><th>Status</th><th>Details</th></tr>
+ </thead>
+ <tbody>
+ [% FOREACH line IN t.lines %]
+ <tr>
+ <td>[% line.name %]</td>
+ <td>[% line.status.description %]</td>
+ <td>[% line.status.details %]</td>
+ </tr>
+ [% END %]
+ </tbody>
+ </table>
+ </div>
</body>
</html>
diff --git a/lib/WebService/TFL/TubeStatus.pm b/lib/WebService/TFL/TubeStatus.pm
new file mode 100644
index 0000000..79230ce
--- /dev/null
+++ b/lib/WebService/TFL/TubeStatus.pm
@@ -0,0 +1,40 @@
+package WebService::TFL::TubeStatus;
+use Moose;
+use Moose::Util::TypeConstraints;
+use MooseX::Types::URI 'Uri';
+use XML::LibXML;
+use XML::LibXML::XPathContext;
+use WebService::TFL::TubeStatus::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://cloud.tfl.gov.uk/TrackerNet/LineStatus',
+);
+
+sub request {
+ my ($self) = @_;
+
+ my $doc = XML::LibXML->load_xml(location => $self->uri)
+ or die "Couldn't fetch tube status";
+ my $xpath=XML::LibXML::XPathContext->new($doc);
+ $xpath->registerNs('ws','http://webservices.lul.co.uk/');
+
+ return WebService::TFL::TubeStatus::Response->new_from_xml($doc,$xpath);
+}
+
+1;
diff --git a/lib/WebService/TFL/TubeStatus/Response.pm b/lib/WebService/TFL/TubeStatus/Response.pm
new file mode 100644
index 0000000..f8cd8bf
--- /dev/null
+++ b/lib/WebService/TFL/TubeStatus/Response.pm
@@ -0,0 +1,28 @@
+package WebService::TFL::TubeStatus::Response;
+use Moose;
+use WebService::TFL::TubeStatus::Response::Line;
+use namespace::autoclean;
+
+has lines => (
+ is => 'ro',
+ isa => 'ArrayRef[WebService::TFL::TubeStatus::Response::Line]',
+ required => 1,
+);
+
+sub new_from_xml {
+ my ($class,$doc,$xpath) = @_;
+
+ my @lines;
+
+ for my $ls ($xpath->findnodes(q{/ws:ArrayOfLineStatus/ws:LineStatus},$doc)) {
+ my ($line)=$xpath->findnodes(q{ws:Line},$ls);
+
+ my $line_object = WebService::TFL::TubeStatus::Response::Line->new_from_xml($line,$ls,$xpath);
+
+ push @lines,$line_object;
+ }
+
+ return $class->new({lines=>\@lines});
+}
+
+1;
diff --git a/lib/WebService/TFL/TubeStatus/Response/Line.pm b/lib/WebService/TFL/TubeStatus/Response/Line.pm
new file mode 100644
index 0000000..11d3538
--- /dev/null
+++ b/lib/WebService/TFL/TubeStatus/Response/Line.pm
@@ -0,0 +1,36 @@
+package WebService::TFL::TubeStatus::Response::Line;
+use Moose;
+use WebService::TFL::TubeStatus::Response::LineStatus;
+use namespace::autoclean;
+
+has id => (
+ is => 'ro',
+ isa => 'Num',
+ required => 1,
+);
+
+has name => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+);
+
+has status => (
+ is => 'ro',
+ isa => 'WebService::TFL::TubeStatus::Response::LineStatus',
+ required => 1,
+);
+
+sub new_from_xml {
+ my ($class,$line,$status,$xpath) = @_;
+
+ my %init_arg;
+
+ $init_arg{id} = $line->findvalue(q{@ID});
+ $init_arg{name} = $line->findvalue(q{@Name});
+ $init_arg{status} = WebService::TFL::TubeStatus::Response::LineStatus->new_from_xml($status,$xpath);
+
+ return $class->new(\%init_arg);
+}
+
+1;
diff --git a/lib/WebService/TFL/TubeStatus/Response/LineStatus.pm b/lib/WebService/TFL/TubeStatus/Response/LineStatus.pm
new file mode 100644
index 0000000..e223bb6
--- /dev/null
+++ b/lib/WebService/TFL/TubeStatus/Response/LineStatus.pm
@@ -0,0 +1,32 @@
+package WebService::TFL::TubeStatus::Response::LineStatus;
+use Moose;
+use namespace::autoclean;
+
+has is_active => (
+ is => 'ro',
+ isa => 'Bool',
+ required => 1,
+);
+
+has [qw(code class description details)] => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+);
+
+sub new_from_xml {
+ my ($class,$ls,$xpath) = @_;
+
+ my %init_arg;
+
+ my ($status) = $xpath->findnodes(q{ws:Status},$ls);
+ $init_arg{code} = $status->findvalue(q{@ID});
+ $init_arg{is_active} = $status->findvalue(q{@IsActive}) eq 'true';
+ $init_arg{class} = $status->findvalue(q{@CssClass});
+ $init_arg{description} = $status->findvalue(q{@Description});
+ $init_arg{details} = $ls->findvalue(q{@StatusDetails});
+
+ return $class->new(\%init_arg);
+}
+
+1;