summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordakkar <dakkar@thenautilus.net>2023-12-09 14:07:20 +0000
committerdakkar <dakkar@thenautilus.net>2023-12-09 14:07:20 +0000
commit1a37c7e52d5433e8182d444d12a55fdd9b8a2770 (patch)
tree2f0ed93dd07e6c078a5fb03cb9539ec93772fe23
parentbump perl (diff)
parentsort buses (diff)
downloadHomePanel-1a37c7e52d5433e8182d444d12a55fdd9b8a2770.tar.gz
HomePanel-1a37c7e52d5433e8182d444d12a55fdd9b8a2770.tar.bz2
HomePanel-1a37c7e52d5433e8182d444d12a55fdd9b8a2770.zip
Merge branch 'new-api'
-rw-r--r--cpanfile9
-rwxr-xr-xdriver-async.pl4
-rw-r--r--forecast.html.tt12
-rwxr-xr-xhomepanel-control49
-rw-r--r--lib/HomePanel/AsyncUA.pm32
-rw-r--r--lib/HomePanel/Driver.pm74
-rw-r--r--lib/HomePanel/Render.pm1
-rw-r--r--lib/Types/DateTime.pm20
-rw-r--r--lib/Types/URI.pm15
-rw-r--r--lib/WebService/ForecastIo.pm42
-rw-r--r--lib/WebService/ForecastIo/Alert.pm8
-rw-r--r--lib/WebService/ForecastIo/DataBlock.pm2
-rw-r--r--lib/WebService/ForecastIo/DataPoint.pm8
-rw-r--r--lib/WebService/ForecastIo/DataSpan.pm12
-rw-r--r--lib/WebService/ForecastIo/Response.pm2
-rw-r--r--lib/WebService/ForecastIo/Types.pm2
-rw-r--r--lib/WebService/TFL/Bus.pm41
-rw-r--r--lib/WebService/TFL/Bus/Fields.pm77
-rw-r--r--lib/WebService/TFL/Bus/Prediction.pm26
-rw-r--r--lib/WebService/TFL/Bus/Request.pm38
-rw-r--r--lib/WebService/TFL/Bus/Response.pm62
-rw-r--r--lib/WebService/TFL/Bus/Response/BaseVersion.pm15
-rw-r--r--lib/WebService/TFL/Bus/Response/FlexibleMessage.pm7
-rw-r--r--lib/WebService/TFL/Bus/Response/Prediction.pm7
-rw-r--r--lib/WebService/TFL/Bus/Response/Stop.pm7
-rw-r--r--lib/WebService/TFL/Bus/Response/URAVersion.pm17
-rw-r--r--lib/WebService/TFL/Bus/ResponseTypeRole.pm38
-rw-r--r--lib/WebService/TFL/Bus/Types.pm14
-rw-r--r--lib/WebService/TFL/TubeStatus.pm43
-rw-r--r--lib/WebService/TFL/TubeStatus/Response.pm27
-rw-r--r--lib/WebService/TFL/TubeStatus/Response/Line.pm25
-rw-r--r--lib/WebService/TFL/TubeStatus/Response/LineStatus.pm24
-rw-r--r--lib/WebService/TFL/TubeStatus/Types.pm11
33 files changed, 198 insertions, 573 deletions
diff --git a/cpanfile b/cpanfile
index f5e5350..97ed0e9 100644
--- a/cpanfile
+++ b/cpanfile
@@ -1,21 +1,22 @@
-requires perl => "5.014";
+requires perl => "5.036";
requires "Class::Load";
requires "Config::Any";
requires "Config::General";
requires "curry::weak";
-requires "Daemon::Control";
requires "Data::Printer";
requires "DateTime";
requires "DateTime::Format::Duration";
requires "DateTime::Format::ISO8601";
requires "DateTime::TimeZone";
+requires "Future::AsyncAwait";
requires "IO::Async::Loop";
+requires "IO::Async::SSL";
requires "IO::Async::Timer::Periodic";
requires "JSON";
requires "LWP::UserAgent";
requires "LWP::Protocol::https";
requires "Moo";
-requires "namespace::autoclean";
+requires "namespace::clean";
requires "Net::Async::HTTP";
requires "Package::Variant";
requires "Path::Class";
@@ -33,5 +34,3 @@ requires "Types::Standard";
requires "Types::URI";
requires "Type::Utils";
requires "URI";
-requires "XML::LibXML";
-requires "XML::LibXML::XPathContext";
diff --git a/driver-async.pl b/driver-async.pl
index 0d8e86a..701a8cd 100755
--- a/driver-async.pl
+++ b/driver-async.pl
@@ -2,6 +2,7 @@
use strict;
use warnings;
use 5.014;
+use lib 'local/lib/perl5';
use lib 'lib';
use HomePanel::Driver;
use Path::Tiny;
@@ -18,6 +19,9 @@ my $hp = HomePanel::Driver->new({
template_file => ($config{template} || path(__FILE__)->parent->child('forecast.html.tt')),
output_file => ($config{output_file} || path(__FILE__)->parent->child('forecast.html')),
forecast_key => $config{forecast_key},
+ forecast_latitude => $config{forecast_latitude},
+ forecast_longitude => $config{forecast_longitude},
+ bus_stop_id => $config{bus_stop_id},
});
$hp->start;
diff --git a/forecast.html.tt b/forecast.html.tt
index 0decb3b..8d02648 100644
--- a/forecast.html.tt
+++ b/forecast.html.tt
@@ -150,11 +150,11 @@
<tr><th>Line</th><th>Destination</th><th>When</th></tr>
</thead>
<tbody>
- [% FOREACH p IN b.Prediction %]
+ [% FOREACH p IN b.predictions %]
<tr>
- <td class="line">[% p.LineName %]</td>
- <td class="destination">[% p.DestinationText %]</td>
- <td class="eta">[% minsec_until(p.EstimatedTime) %]</td>
+ <td class="line">[% p.lineName %]</td>
+ <td class="destination">[% p.towards %]</td>
+ <td class="eta">[% minsec_until(p.expectedArrival) %]</td>
</tr>
[% END %]
</tbody>
@@ -180,8 +180,8 @@
[% FOREACH line IN t.lines %]
<tr>
<td class="line">[% line.name %]</td>
- <td class="status">[% line.status.description %]</td>
- <td class="details">[% line.status.details %]</td>
+ <td class="status">[% line.status.statusSeverityDescription %]</td>
+ <td class="details">[% line.status.reason %]</td>
</tr>
[% END %]
</tbody>
diff --git a/homepanel-control b/homepanel-control
deleted file mode 100755
index f8a20ad..0000000
--- a/homepanel-control
+++ /dev/null
@@ -1,49 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Daemon::Control;
-use Path::Tiny;
-use Config::Any;
-
-my $basedir = path(__FILE__)->parent->realpath;
-
-my $config_file = $basedir->child('homepanel.conf');
-my $cfg_set = Config::Any->load_files({
- files => [$config_file],
- use_ext => 1,
-});
-my %config = map { %{(values %$_)[0]} } @$cfg_set;
-my $dest_dir = path($config{output_file})->parent->realpath;
-my $icons = $basedir->child('icons');
-
-exit Daemon::Control->new(
- init_code => <<"INIT",
-if [ ! -d $dest_dir/icons ]; then
- mkdir -p $dest_dir
- mount -t tmpfs none $dest_dir
- cp -a $icons $dest_dir/
-fi
-
-export PERL5LIB="/home/dakkar/.perlbrew/libs/perl-5.30.2\@HomePanel/lib/perl5"
-export PATH="/home/dakkar/.perlbrew/libs/perl-5.30.2\@HomePanel/bin:/home/dakkar/perl5/perlbrew/bin:/home/dakkar/perl5/perlbrew/perls/perl-5.30.2/bin:\$PATH"
-INIT
-
- name => "HomePanel",
- lsb_sdesc => 'Home info panel',
- lsb_desc => 'Show forecast, tube, bus status.',
- path => path(__FILE__)->realpath,
-
- program => $basedir->child('driver-async.pl'),
- program_args => [ $config_file ],
-
- user => 'dakkar',
- group => 'users',
- directory => $basedir,
-
- pid_file => $basedir->child('homepanel.pid'),
- stderr_file => $basedir->child('homepanel.err'),
- stdout_file => $basedir->child('homepanel.out'),
-
- fork => 2,
-
-)->run;
diff --git a/lib/HomePanel/AsyncUA.pm b/lib/HomePanel/AsyncUA.pm
deleted file mode 100644
index d74e4aa..0000000
--- a/lib/HomePanel/AsyncUA.pm
+++ /dev/null
@@ -1,32 +0,0 @@
-package HomePanel::AsyncUA;
-use Moo;
-use namespace::autoclean;
-use Net::Async::HTTP;
-
-has loop => (
- is => 'ro',
- required => 1,
- weak => 1,
-);
-
-has agent => (
- is => 'lazy',
-);
-sub _build_agent {
- my ($self) = @_;
-
- my $agent = Net::Async::HTTP->new(
- max_connections_per_host => 1,
- stall_timeout => 10,
- );
- $self->loop->add($agent);
- return $agent;
-}
-
-sub get {
- my ($self,$uri) = @_;
-
- return $self->agent->GET($uri)->get
-}
-
-1;
diff --git a/lib/HomePanel/Driver.pm b/lib/HomePanel/Driver.pm
index f5a253d..ce3026a 100644
--- a/lib/HomePanel/Driver.pm
+++ b/lib/HomePanel/Driver.pm
@@ -1,39 +1,39 @@
package HomePanel::Driver;
use Moo;
-use 5.10.0;
+use v5.36;
use IO::Async::Loop;
use IO::Async::Timer::Periodic;
-use HomePanel::AsyncUA;
+use Net::Async::HTTP;
+use Future::AsyncAwait;
use WebService::ForecastIo;
use WebService::TFL::Bus;
-use WebService::TFL::Bus::Request;
use WebService::TFL::TubeStatus;
use HomePanel::Render;
use Types::Path::Tiny qw(AbsFile AbsPath);
use Try::Tiny;
-#use Devel::Cycle;
use curry::weak;
-use namespace::autoclean;
+use namespace::clean;
+use Data::Dumper;
has loop => ( is => 'lazy' );
sub _build_loop { IO::Async::Loop->new() }
has user_agent => ( is => 'lazy' );
sub _build_user_agent {
- #HomePanel::AsyncUA->new({loop=>$_[0]->loop});
- require LWP::UserAgent;
- return LWP::UserAgent->new(timeout=>20);
+ my ($self) = @_;
+ my $ua = Net::Async::HTTP->new(
+ max_connections_per_host => 1,
+ stall_timeout => 10,
+ decode_content => 1,
+ );
+ $self->loop->add($ua);
+ return $ua;
}
-has forecast_request => (
+has [qw(forecast_latitude forecast_longitude)] => (
is => 'ro',
- default => sub { +{
- latitude => 51.54,
- longitude => -0.37,
- exclude => ['flags','sources'],
- }; },
+ required => 1,
);
-has forecast_response => ( is => 'rw' );
has forecast_key => (
is => 'ro',
required => 1,
@@ -46,6 +46,7 @@ sub _build_forecast {
user_agent => $self->user_agent,
});
}
+has forecast_response => ( is => 'rw' );
has forecast_timer => ( is => 'lazy' );
sub _build_forecast_timer {
my ($self) = @_;
@@ -56,24 +57,15 @@ sub _build_forecast_timer {
}
sub forecast_timer_cb {
my ($self) = @_;
- $self->forecast_response(
- $self->forecast->request(
- $self->forecast_request
- )
- );
+
+ $self->forecast->request({
+ latitude => $self->forecast_latitude,
+ longitude => $self->forecast_longitude,
+ exclude => ['flags','sources'],
+ })->then(sub { $self->forecast_response(shift) })->retain;
}
-has bus_request => (
- is => 'ro',
- default => sub {
- WebService::TFL::Bus::Request->new({
- StopPointName => 'Hotspur Road',
- #Towards => 'Islip Manor',
- ReturnList => [qw(StopID StopCode1 VisitNumber TripID VehicleID LineID LineName DirectionID DestinationText DestinationName EstimatedTime)],
-});
- },
-);
-has bus_response => ( is => 'rw' );
+has bus_stop_id => ( is => 'ro', required => 1 );
has bus => (
is => 'lazy',
);
@@ -82,6 +74,7 @@ sub _build_bus {
user_agent => $_[0]->user_agent,
});
}
+has bus_response => ( is => 'rw' );
has bus_timer => ( is => 'lazy' );
sub _build_bus_timer {
my ($self) = @_;
@@ -92,11 +85,10 @@ sub _build_bus_timer {
}
sub bus_timer_cb {
my ($self) = @_;
- $self->bus_response(
- $self->bus->request(
- $self->bus_request
- )
- );
+
+ $self->bus->request(
+ $self->bus_stop_id
+ )->then(sub { $self->bus_response(shift) })->retain;
};
has tube => (
@@ -118,9 +110,9 @@ sub _build_tube_timer {
}
sub tube_timer_cb {
my ($self) = @_;
- $self->tube_response(
- $self->tube->request()
- );
+
+ $self->tube->request(
+ )->then(sub { $self->tube_response(shift) })->retain;
}
has writer_timer => ( is => 'lazy' );
@@ -170,6 +162,8 @@ sub _build_render {
sub write_page {
my ($self) = @_;
+ return unless $self->forecast_response;
+
my $output = $self->render->render({
forecast => $self->forecast_response,
bus => $self->bus_response,
@@ -177,8 +171,6 @@ sub write_page {
});
$self->output_file->spew_utf8($output);
-
- #find_cycle($self);
}
sub start {
diff --git a/lib/HomePanel/Render.pm b/lib/HomePanel/Render.pm
index fe165e3..34a220b 100644
--- a/lib/HomePanel/Render.pm
+++ b/lib/HomePanel/Render.pm
@@ -6,6 +6,7 @@ use Template::Stash::ForceUTF8;
use Template;
use DateTime;
use DateTime::Format::Duration;
+use namespace::clean;
has [qw(provider stash template)] => (
is => 'lazy',
diff --git a/lib/Types/DateTime.pm b/lib/Types/DateTime.pm
deleted file mode 100644
index d13f0d5..0000000
--- a/lib/Types/DateTime.pm
+++ /dev/null
@@ -1,20 +0,0 @@
-package Types::DateTime;
-use strict;
-use warnings;
-use namespace::autoclean;
-use Type::Library -base, -declare => 'DateTimeT';
-use Type::Utils -all;
-use Types::Standard -types;
-
-class_type DateTimeT, { class => 'DateTime' };
-coerce DateTimeT, from Num, via {
- require DateTime;
- DateTime->from_epoch(epoch => $_ );
-};
-coerce DateTimeT, from Str, via {
- require DateTime::Format::ISO8601;
- s{([+-])(\d\d)(\d\d)\z}{$1$2:$3};
- DateTime::Format::ISO8601->new->parse_datetime($_)
-};
-
-1;
diff --git a/lib/Types/URI.pm b/lib/Types/URI.pm
deleted file mode 100644
index 0bb4ae5..0000000
--- a/lib/Types/URI.pm
+++ /dev/null
@@ -1,15 +0,0 @@
-package Types::URI;
-use strict;
-use warnings;
-use namespace::autoclean;
-use Type::Library -base, -declare => 'Uri';
-use Type::Utils -all;
-use Types::Standard -types;
-
-class_type Uri, { class => 'URI' };
-coerce Uri, from Str, via {
- require URI;
- URI->new($_);
-};
-
-1;
diff --git a/lib/WebService/ForecastIo.pm b/lib/WebService/ForecastIo.pm
index c329ad0..f3bf109 100644
--- a/lib/WebService/ForecastIo.pm
+++ b/lib/WebService/ForecastIo.pm
@@ -2,18 +2,18 @@ package WebService::ForecastIo;
use Moo;
use 5.10.0;
use Types::Standard -types,'slurpy';
-use Type::Utils qw(duck_type enum);
use Types::URI 'Uri';
-use Types::DateTime 'DateTimeT';
+use Types::DateTime -all;
use Type::Params;
+use Future::AsyncAwait;
use WebService::ForecastIo::Response;
use DateTime::TimeZone;
-use namespace::autoclean;
+use namespace::clean;
has base_uri => (
is => 'ro',
isa => Uri,
- default => 'https://api.forecast.io/forecast',
+ default => 'https://api.pirateweather.net/forecast',
coerce => Uri->coercion,
);
@@ -24,19 +24,10 @@ has api_key => (
);
has user_agent => (
- is => 'lazy',
- isa => duck_type(['get']),
+ is => 'ro',
+ isa => HasMethods['do_request'],
+ required => 1,
);
-sub _build_user_agent {
- require LWP::UserAgent;
- my $agent = LWP::UserAgent->new(
- agent => __PACKAGE__ . ' version ' . ($WebService::ForecastIo::VERSION // 'devel' ),
- env_proxy => 1,
- keep_alive => 1,
- );
- $agent->default_header( 'Accept-Encoding' => 'gzip' );
- return $agent;
-}
sub _make_request_uri {
my ($self,$opts) = @_;
@@ -74,36 +65,33 @@ sub _make_request_uri {
return $req_uri;
}
-my $units_type = enum [qw(us si ca uk auto)];
-my $block_type = enum [qw(currently minutely hourly daily alerts flags sources)];
+my $units_type = Enum [qw(us si ca uk auto)];
+my $block_type = Enum [qw(currently minutely hourly daily alerts flags sources)];
-sub request {
+async sub request {
state $argcheck = compile(
Object, Dict[
latitude => Num,
longitude => Num,
- time => Optional[DateTimeT],
+ time => Optional[DateTimeUTC],
units => Optional[$units_type],
exclude => Optional[ArrayRef[$block_type]],
- raw => Optional[Bool],
],
);
my ($self,$opts) = $argcheck->(@_);
$opts->{units} //= 'si';
$opts->{exclude} //= [];
- $opts->{raw} //= 0;
my $uri = $self->_make_request_uri({%$opts});
- my $response = $self->user_agent->get($uri);
+ my $response = await $self->user_agent->do_request(uri => $uri);
+
if ($response->is_success) {
my $json = $response->decoded_content;
- return $json if $opts->{raw};
- my $res = WebService::ForecastIo::Response->new($json);
- return wantarray ? ($res,$json) : $res
+ return WebService::ForecastIo::Response->new($json);
}
else {
- die $response->status_line
+ die $response->status_line;
}
}
diff --git a/lib/WebService/ForecastIo/Alert.pm b/lib/WebService/ForecastIo/Alert.pm
index af826d8..73f7200 100644
--- a/lib/WebService/ForecastIo/Alert.pm
+++ b/lib/WebService/ForecastIo/Alert.pm
@@ -1,9 +1,9 @@
package WebService::ForecastIo::Alert;
use Moo;
-use namespace::autoclean;
use Types::Standard -all;
use Types::URI 'Uri';
-use Types::DateTime 'DateTimeT';
+use Types::DateTime -all;
+use namespace::clean;
has title => (
is => 'ro',
@@ -12,8 +12,8 @@ has title => (
has expires => (
is => 'ro',
- isa => DateTimeT,
- coerce => DateTimeT->coercion,
+ isa => DateTimeUTC,
+ coerce => 1,
);
has uri => (
diff --git a/lib/WebService/ForecastIo/DataBlock.pm b/lib/WebService/ForecastIo/DataBlock.pm
index 1994fa8..0f57ab2 100644
--- a/lib/WebService/ForecastIo/DataBlock.pm
+++ b/lib/WebService/ForecastIo/DataBlock.pm
@@ -1,9 +1,9 @@
package WebService::ForecastIo::DataBlock;
use Moo;
-use namespace::autoclean;
use Types::Standard -all;
use WebService::ForecastIo::Types -all;
use WebService::ForecastIo::DataSpan;
+use namespace::clean;
has [qw(summary icon)] => (
is => 'ro',
diff --git a/lib/WebService/ForecastIo/DataPoint.pm b/lib/WebService/ForecastIo/DataPoint.pm
index 47ef659..13c60dd 100644
--- a/lib/WebService/ForecastIo/DataPoint.pm
+++ b/lib/WebService/ForecastIo/DataPoint.pm
@@ -1,16 +1,16 @@
package WebService::ForecastIo::DataPoint;
use Moo;
-use namespace::autoclean;
-use Types::DateTime 'DateTimeT';
+use Types::DateTime -all;
use Types::Standard -all;
+use namespace::clean;
has [qw( time
sunriseTime sunsetTime
precipIntensityMaxTime
temperatureMinTime temperatureMaxTime )] => (
is => 'ro',
- isa => DateTimeT,
- coerce => DateTimeT->coercion,
+ isa => DateTimeUTC,
+ coerce => 1,
);
has [qw(summary icon precipType)] => (
diff --git a/lib/WebService/ForecastIo/DataSpan.pm b/lib/WebService/ForecastIo/DataSpan.pm
index 4911442..f2e6c0d 100644
--- a/lib/WebService/ForecastIo/DataSpan.pm
+++ b/lib/WebService/ForecastIo/DataSpan.pm
@@ -1,20 +1,20 @@
package WebService::ForecastIo::DataSpan;
use Moo;
-use namespace::autoclean;
-use Types::DateTime 'DateTimeT';
+use Types::DateTime -all;
+use namespace::clean;
has start_time => (
is => 'ro',
- isa => DateTimeT,
- coerce => DateTimeT->coercion,
+ isa => DateTimeUTC,
+ coerce => 1,
required => 1,
);
has stop_time => (
is => 'ro',
writer => '_set_stop_time',
- isa => DateTimeT,
- coerce => DateTimeT->coercion,
+ isa => DateTimeUTC,
+ coerce => 1,
required => 1,
);
diff --git a/lib/WebService/ForecastIo/Response.pm b/lib/WebService/ForecastIo/Response.pm
index 24c5324..c723771 100644
--- a/lib/WebService/ForecastIo/Response.pm
+++ b/lib/WebService/ForecastIo/Response.pm
@@ -1,9 +1,9 @@
package WebService::ForecastIo::Response;
use Moo;
-use namespace::autoclean;
use Types::Standard -all;
use WebService::ForecastIo::Types -all;
use JSON;
+use namespace::clean;
has 'currently' => (
is => 'ro',
diff --git a/lib/WebService/ForecastIo/Types.pm b/lib/WebService/ForecastIo/Types.pm
index cc8dac2..4936188 100644
--- a/lib/WebService/ForecastIo/Types.pm
+++ b/lib/WebService/ForecastIo/Types.pm
@@ -1,7 +1,6 @@
package WebService::ForecastIo::Types;
use strict;
use warnings;
-use namespace::autoclean;
use Type::Library -base, -declare =>
qw(
Alert AlertArray
@@ -10,6 +9,7 @@ use Type::Library -base, -declare =>
);
use Type::Utils -all;
use Types::Standard -types;
+use namespace::clean;
class_type Alert, { class => 'WebService::ForecastIo::Alert' };
diff --git a/lib/WebService/TFL/Bus.pm b/lib/WebService/TFL/Bus.pm
index 3559755..8f43c0f 100644
--- a/lib/WebService/TFL/Bus.pm
+++ b/lib/WebService/TFL/Bus.pm
@@ -1,41 +1,44 @@
package WebService::TFL::Bus;
use Moo;
-use namespace::autoclean;
use Types::URI 'Uri';
-use Type::Utils 'duck_type';
+use Types::Standard -types;
+use Future::AsyncAwait;
use WebService::TFL::Bus::Response;
+use namespace::clean;
has user_agent => (
- isa => duck_type(['get']),
- is => 'lazy',
-
+ isa => HasMethods['do_request'],
+ is => 'ro',
+ required => 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 => Uri->coercion,
- default => 'http://countdown.api.tfl.gov.uk/interfaces/ura/instant_V1',
+ default => 'https://api.tfl.gov.uk/StopPoint/__/Arrivals',
);
-sub request {
- my ($self,$request) = @_;
+has parser => (
+ is => 'lazy',
+ builder => sub { JSON->new->utf8 },
+);
+
+async sub request {
+ my ($self,$stop_id) = @_;
- my $http_response = $self->user_agent->get(
- $request->request_uri($self->uri)
+ my $uri = $self->uri->clone;
+ $uri->path_segments(
+ map { $_ eq '__' ? $stop_id : $_ } $uri->path_segments
);
+
+ my $http_response = await $self->user_agent->do_request(uri => $uri);
+
if ($http_response->is_success) {
my $json = $http_response->content;
- return WebService::TFL::Bus::Response->new_from_json(
- $request->ReturnList,
- $json
+ return WebService::TFL::Bus::Response->new_from_response(
+ $self->parser->decode($json)
);
}
else {
diff --git a/lib/WebService/TFL/Bus/Fields.pm b/lib/WebService/TFL/Bus/Fields.pm
deleted file mode 100644
index b3d555f..0000000
--- a/lib/WebService/TFL/Bus/Fields.pm
+++ /dev/null
@@ -1,77 +0,0 @@
-package WebService::TFL::Bus::Fields;
-use strict;
-use warnings;
-
-sub stop_return_fields {
- qw(
- StopPointName
- StopID
- StopCode1
- StopCode2
- StopPointType
- Towards
- Bearing
- StopPointIndicator
- StopPointState
- Latitude
- Longitude
- );
-}
-
-sub prediction_return_fields {
- stop_return_fields(),
- qw(
- VisitNumber
- LineID
- LineName
- DirectionID
- DestinationText
- DestinationName
- VehicleID
- TripID
- RegistrationNumber
- EstimatedTime
- ExpireTime
- ),
-}
-
-sub flexible_return_fields {
- stop_return_fields,
- qw(
- MessageUUID
- MessageType
- MessagePriority
- MessageText
- StartTime
- ExpireTime
- ),
-}
-
-sub 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
- );
-}
-
-1;
diff --git a/lib/WebService/TFL/Bus/Prediction.pm b/lib/WebService/TFL/Bus/Prediction.pm
new file mode 100644
index 0000000..670baf7
--- /dev/null
+++ b/lib/WebService/TFL/Bus/Prediction.pm
@@ -0,0 +1,26 @@
+package WebService::TFL::Bus::Prediction;
+use Moo;
+use Types::Standard -all;
+use Types::DateTime -all;
+use namespace::clean;
+
+has [qw(stationName lineName towards)] => (
+ is => 'ro',
+ isa => Str,
+ required => 1,
+);
+
+has 'expectedArrival' => (
+ is => 'ro',
+ isa => DateTimeUTC->plus_coercions( Format['ISO8601'] ),
+ required => 1,
+ coerce => 1,
+);
+
+sub new_from_response {
+ my ($class,$response_data) = @_;
+
+ return $class->new($response_data);
+}
+
+1;
diff --git a/lib/WebService/TFL/Bus/Request.pm b/lib/WebService/TFL/Bus/Request.pm
deleted file mode 100644
index dda6586..0000000
--- a/lib/WebService/TFL/Bus/Request.pm
+++ /dev/null
@@ -1,38 +0,0 @@
-package WebService::TFL::Bus::Request;
-use Moo;
-use Types::Standard -all;
-use WebService::TFL::Bus::Fields;
-use namespace::autoclean;
-
-for my $field (WebService::TFL::Bus::Fields->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 (WebService::TFL::Bus::Fields->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;
-}
-
-1;
diff --git a/lib/WebService/TFL/Bus/Response.pm b/lib/WebService/TFL/Bus/Response.pm
index e05d49d..0f811fc 100644
--- a/lib/WebService/TFL/Bus/Response.pm
+++ b/lib/WebService/TFL/Bus/Response.pm
@@ -1,55 +1,25 @@
package WebService::TFL::Bus::Response;
use Moo;
-use Class::Load 'load_class';
-use Type::Utils 'class_type';
use Types::Standard -all;
-use JSON;
-use namespace::autoclean;
+use WebService::TFL::Bus::Prediction;
+use namespace::clean;
-sub line_class {
- "WebService::TFL::Bus::Response::$_[0]";
-}
-
-my %line_map = (
- 0 => 'Stop',
- 1 => 'Prediction',
- 2 => 'FlexibleMessage',
- 3 => 'BaseVersion',
- 4 => 'URAVersion',
+has predictions => (
+ is => 'ro',
+ isa => ArrayRef[InstanceOf['WebService::TFL::Bus::Prediction']],
);
-for my $field (values %line_map) {
- my $class = line_class($field);
- load_class($class);
- has $field => (
- is => 'ro',
- isa => ArrayRef[class_type { class => $class }],
- );
-}
-
-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 = line_class($array_type);
- push @{$args{$array_type}},
- $line_class->new_from_array(\%return_set,$array);
-
- substr($json,0,$consumed)='';
- }
-
- return $class->new(\%args);
+sub new_from_response {
+ my ($class,$response_data) = @_;
+
+ return $class->new({
+ predictions => [
+ sort { $a->expectedArrival <=> $b->expectedArrival }
+ map { WebService::TFL::Bus::Prediction->new_from_response($_) }
+ grep { $_->{'$type'} =~ /\bPrediction\b/ }
+ $response_data->@*
+ ],
+ });
}
1;
diff --git a/lib/WebService/TFL/Bus/Response/BaseVersion.pm b/lib/WebService/TFL/Bus/Response/BaseVersion.pm
deleted file mode 100644
index 07edbcb..0000000
--- a/lib/WebService/TFL/Bus/Response/BaseVersion.pm
+++ /dev/null
@@ -1,15 +0,0 @@
-package WebService::TFL::Bus::Response::BaseVersion;
-use Moo;
-use namespace::autoclean;
-
-has Version => (
- is => 'ro',
-);
-
-sub new_from_array {
- my ($class,$return_set,$array) = @_;
-
- return $class->new({Version => $array->[1]});
-}
-
-1;
diff --git a/lib/WebService/TFL/Bus/Response/FlexibleMessage.pm b/lib/WebService/TFL/Bus/Response/FlexibleMessage.pm
deleted file mode 100644
index 603ef6b..0000000
--- a/lib/WebService/TFL/Bus/Response/FlexibleMessage.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package WebService::TFL::Bus::Response::FlexibleMessage;
-use Moo;
-use namespace::autoclean;
-use WebService::TFL::Bus::ResponseTypeRole;
-with ResponseTypeRole('flexible');
-
-1;
diff --git a/lib/WebService/TFL/Bus/Response/Prediction.pm b/lib/WebService/TFL/Bus/Response/Prediction.pm
deleted file mode 100644
index 49a4b76..0000000
--- a/lib/WebService/TFL/Bus/Response/Prediction.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package WebService::TFL::Bus::Response::Prediction;
-use Moo;
-use namespace::autoclean;
-use WebService::TFL::Bus::ResponseTypeRole;
-with ResponseTypeRole('prediction');
-
-1;
diff --git a/lib/WebService/TFL/Bus/Response/Stop.pm b/lib/WebService/TFL/Bus/Response/Stop.pm
deleted file mode 100644
index 30f2f91..0000000
--- a/lib/WebService/TFL/Bus/Response/Stop.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package WebService::TFL::Bus::Response::Stop;
-use Moo;
-use namespace::autoclean;
-use WebService::TFL::Bus::ResponseTypeRole;
-with ResponseTypeRole('stop');
-
-1;
diff --git a/lib/WebService/TFL/Bus/Response/URAVersion.pm b/lib/WebService/TFL/Bus/Response/URAVersion.pm
deleted file mode 100644
index fc0b41f..0000000
--- a/lib/WebService/TFL/Bus/Response/URAVersion.pm
+++ /dev/null
@@ -1,17 +0,0 @@
-package WebService::TFL::Bus::Response::URAVersion;
-use Moo;
-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;
diff --git a/lib/WebService/TFL/Bus/ResponseTypeRole.pm b/lib/WebService/TFL/Bus/ResponseTypeRole.pm
deleted file mode 100644
index 7f48419..0000000
--- a/lib/WebService/TFL/Bus/ResponseTypeRole.pm
+++ /dev/null
@@ -1,38 +0,0 @@
-package WebService::TFL::Bus::ResponseTypeRole;
-use Package::Variant
- importing => [ 'Moo::Role'],
- subs => [ 'has' ];
-use WebService::TFL::Bus::Fields;
-use WebService::TFL::Bus::Types 'DateTimeMillis';
-
-sub make_variant {
- my ($class,$target_package,$type) = @_;
-
- my $method = $type . '_return_fields';
- my @fields = WebService::TFL::Bus::Fields->$method;
-
- for my $field (@fields) {
- has $field => (
- is => 'ro',
- ( $field =~ /Time$/ ? (
- isa => DateTimeMillis,
- coerce => DateTimeMillis->coercion,
- ) : () ),
- );
- }
-
- install new_from_array => sub {
- my ($class,$return_set,$array) = @_;
-
- my %args;
- my $i=1;
- for my $field (@fields) {
- next unless exists $return_set->{$field};
- $args{$field}=$array->[$i];
- ++$i;
- }
- return $class->new(\%args);
- }
-}
-
-1;
diff --git a/lib/WebService/TFL/Bus/Types.pm b/lib/WebService/TFL/Bus/Types.pm
deleted file mode 100644
index e67fe32..0000000
--- a/lib/WebService/TFL/Bus/Types.pm
+++ /dev/null
@@ -1,14 +0,0 @@
-package WebService::TFL::Bus::Types;
-use Type::Library -base, -declare => 'DateTimeMillis';
-use Types::Standard -all;
-use Type::Utils -all;
-use Types::DateTime 'DateTimeT';
-use namespace::autoclean;
-
-declare DateTimeMillis, as DateTimeT;
-coerce DateTimeMillis, from Num, via {
- require DateTime;
- DateTime->from_epoch( epoch => $_ / 1000 )
-};
-
-1;
diff --git a/lib/WebService/TFL/TubeStatus.pm b/lib/WebService/TFL/TubeStatus.pm
index b0ba260..52d573d 100644
--- a/lib/WebService/TFL/TubeStatus.pm
+++ b/lib/WebService/TFL/TubeStatus.pm
@@ -1,39 +1,44 @@
package WebService::TFL::TubeStatus;
use Moo;
-use Type::Utils 'duck_type';
use Types::URI 'Uri';
-use XML::LibXML;
-use XML::LibXML::XPathContext;
+use Types::Standard -types;
+use Future::AsyncAwait;
use WebService::TFL::TubeStatus::Response;
-use namespace::autoclean;
+use namespace::clean;
has user_agent => (
- isa => duck_type(['get']),
- is => 'lazy',
+ isa => HasMethods['do_request'],
+ is => 'ro',
+ required => 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 => Uri->coercion,
- default => 'http://cloud.tfl.gov.uk/TrackerNet/LineStatus',
+ default => 'https://api.tfl.gov.uk/Line/Mode/tube/Status',
);
-sub request {
+has parser => (
+ is => 'lazy',
+ builder => sub { JSON->new->utf8 },
+);
+
+async 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/');
+ my $http_response = await $self->user_agent->do_request(uri => $self->uri);
+
+ if ($http_response->is_success) {
+ my $json = $http_response->content;
- return WebService::TFL::TubeStatus::Response->new_from_xml($doc,$xpath);
+ return WebService::TFL::TubeStatus::Response->new_from_response(
+ $self->parser->decode($json)
+ );
+ }
+ else {
+ die $http_response->status_line;
+ }
}
1;
diff --git a/lib/WebService/TFL/TubeStatus/Response.pm b/lib/WebService/TFL/TubeStatus/Response.pm
index 191abe7..b6b104b 100644
--- a/lib/WebService/TFL/TubeStatus/Response.pm
+++ b/lib/WebService/TFL/TubeStatus/Response.pm
@@ -1,30 +1,25 @@
package WebService::TFL::TubeStatus::Response;
use Moo;
-use WebService::TFL::TubeStatus::Types -all;
use WebService::TFL::TubeStatus::Response::Line;
use Types::Standard -all;
-use namespace::autoclean;
+use namespace::clean;
has lines => (
is => 'ro',
- isa => ArrayRef[LineT],
+ isa => ArrayRef[InstanceOf['WebService::TFL::TubeStatus::Response::Line']],
required => 1,
);
-sub new_from_xml {
- my ($class,$doc,$xpath) = @_;
+sub new_from_response {
+ my ($class,$response_data) = @_;
- 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});
+ return $class->new({
+ lines=> [
+ map { WebService::TFL::TubeStatus::Response::Line->new_from_response($_) }
+ grep { $_->{'$type'} =~ /\bLine\b/ }
+ $response_data->@*
+ ],
+ });
}
1;
diff --git a/lib/WebService/TFL/TubeStatus/Response/Line.pm b/lib/WebService/TFL/TubeStatus/Response/Line.pm
index 9779443..f962418 100644
--- a/lib/WebService/TFL/TubeStatus/Response/Line.pm
+++ b/lib/WebService/TFL/TubeStatus/Response/Line.pm
@@ -1,13 +1,12 @@
package WebService::TFL::TubeStatus::Response::Line;
use Moo;
use Types::Standard -all;
-use WebService::TFL::TubeStatus::Types -all;
use WebService::TFL::TubeStatus::Response::LineStatus;
-use namespace::autoclean;
+use namespace::clean;
has id => (
is => 'ro',
- isa => Num,
+ isa => Str,
required => 1,
);
@@ -19,20 +18,20 @@ has name => (
has status => (
is => 'ro',
- isa => LineStatusT,
+ isa => InstanceOf['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);
+sub new_from_response {
+ my ($class,$response_data) = @_;
- return $class->new(\%init_arg);
+ return $class->new({
+ id => $response_data->{id},
+ name => $response_data->{name},
+ status => WebService::TFL::TubeStatus::Response::LineStatus->new_from_response(
+ $response_data->{lineStatuses}[0],
+ ),
+ });
}
1;
diff --git a/lib/WebService/TFL/TubeStatus/Response/LineStatus.pm b/lib/WebService/TFL/TubeStatus/Response/LineStatus.pm
index 6caa7d6..2e8e22b 100644
--- a/lib/WebService/TFL/TubeStatus/Response/LineStatus.pm
+++ b/lib/WebService/TFL/TubeStatus/Response/LineStatus.pm
@@ -1,33 +1,23 @@
package WebService::TFL::TubeStatus::Response::LineStatus;
use Moo;
use Types::Standard -all;
-use namespace::autoclean;
+use namespace::clean;
-has is_active => (
+has [qw(statusSeverity statusSeverityDescription)] => (
is => 'ro',
- isa => Bool,
+ isa => Str,
required => 1,
);
-has [qw(code class description details)] => (
+has reason => (
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});
+sub new_from_response {
+ my ($class,$response_data) = @_;
- return $class->new(\%init_arg);
+ return $class->new($response_data);
}
1;
diff --git a/lib/WebService/TFL/TubeStatus/Types.pm b/lib/WebService/TFL/TubeStatus/Types.pm
deleted file mode 100644
index d1cb141..0000000
--- a/lib/WebService/TFL/TubeStatus/Types.pm
+++ /dev/null
@@ -1,11 +0,0 @@
-package WebService::TFL::TubeStatus::Types;
-use strict;
-use warnings;
-use Type::Library -base, -declare => qw(LineT LineStatusT);
-use Type::Utils -all;
-use namespace::autoclean;
-
-class_type LineT, { class => 'WebService::TFL::TubeStatus::Response::Line' };
-class_type LineStatusT, { class => 'WebService::TFL::TubeStatus::Response::LineStatus' };
-
-1;