From c099b757579129a454739f6e13fc4c5fea4e062e Mon Sep 17 00:00:00 2001 From: Gianni Ceccarelli Date: Thu, 30 May 2013 08:00:41 +0100 Subject: tube status --- driver.pl | 4 ++- forecast.html.tt | 16 +++++++++ lib/WebService/TFL/TubeStatus.pm | 40 ++++++++++++++++++++++ lib/WebService/TFL/TubeStatus/Response.pm | 28 +++++++++++++++ lib/WebService/TFL/TubeStatus/Response/Line.pm | 36 +++++++++++++++++++ .../TFL/TubeStatus/Response/LineStatus.pm | 32 +++++++++++++++++ 6 files changed, 155 insertions(+), 1 deletion(-) create mode 100644 lib/WebService/TFL/TubeStatus.pm create mode 100644 lib/WebService/TFL/TubeStatus/Response.pm create mode 100644 lib/WebService/TFL/TubeStatus/Response/Line.pm create mode 100644 lib/WebService/TFL/TubeStatus/Response/LineStatus.pm 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 @@ +
+ + + + + + [% FOREACH line IN t.lines %] + + + + + + [% END %] + +
LineStatusDetails
[% line.name %][% line.status.description %][% line.status.details %]
+
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; -- cgit v1.2.3