summaryrefslogtreecommitdiff
path: root/lib/Travel/Status
diff options
context:
space:
mode:
authorDaniel Friesel <derf@finalrewind.org>2022-01-29 22:55:34 +0100
committerDaniel Friesel <derf@finalrewind.org>2022-01-29 22:55:34 +0100
commitfb5d3e665bc06b6ff8282c5d798074bafd2595e8 (patch)
tree9edd3a64f08cd6ec7a4b4dbddabf4c30a0344c73 /lib/Travel/Status
parentd0f6ffdbfee3b594adf58ce8a83d0564e2181639 (diff)
IRIS->new_p: Support with_related=>1
Diffstat (limited to 'lib/Travel/Status')
-rw-r--r--lib/Travel/Status/DE/IRIS.pm108
1 files changed, 82 insertions, 26 deletions
diff --git a/lib/Travel/Status/DE/IRIS.pm b/lib/Travel/Status/DE/IRIS.pm
index 1c21339..219de12 100644
--- a/lib/Travel/Status/DE/IRIS.pm
+++ b/lib/Travel/Status/DE/IRIS.pm
@@ -31,6 +31,7 @@ sub try_load_xml {
return ( $tree, undef );
}
+# "station" parameter must be an EVA or DS100 ID.
sub new_p {
my ( $class, %opt ) = @_;
my $promise = $opt{promise}->new;
@@ -51,34 +52,90 @@ sub new_p {
$lookbehind_steps++;
}
- $self->get_station_p(
- name => $opt{station},
- )->then(
- sub {
- my ($station) = @_;
- $self->{station} = $station;
- $self->{related_stations} = [];
-
- my $dt_req = $self->{datetime}->clone;
- my @subreq
- = ( $self->get_timetable_p( $self->{station}{uic}, $dt_req ) );
- for ( 1 .. $lookahead_steps ) {
- $dt_req->add( hours => 1 );
- push( @subreq,
- $self->get_timetable_p( $self->{station}{uic}, $dt_req ) );
- }
- $dt_req = $self->{datetime}->clone;
- for ( 1 .. $lookbehind_steps ) {
- $dt_req->subtract( hours => 1 );
- push( @subreq,
- $self->get_timetable_p( $self->{station}{uic}, $dt_req ) );
+ my @candidates = $opt{get_station}( $opt{station} );
+
+ if ( @candidates == 0 ) {
+ return $promise->reject('station not found');
+ }
+ if ( @candidates >= 2 ) {
+ return $promise->reject('station identifier is ambiguous');
+ }
+
+ $self->{station} = {
+ ds100 => $candidates[0][0],
+ name => $candidates[0][1],
+ uic => $candidates[0][2],
+ };
+ $self->{related_stations} = [];
+
+ my @queue = ( $self->{station}{uic} );
+ my @related_reqs;
+ my @related_stations;
+ my %seen = ( $self->{station}{uic} => 1 );
+ my $iter_depth = 0;
+
+ while ( @queue and $iter_depth < 12 and $opt{with_related} ) {
+ my $eva = shift(@queue);
+ $iter_depth++;
+ for my $ref ( @{ $opt{meta}{$eva} // [] } ) {
+ if ( not $seen{$ref} ) {
+ push( @related_stations, $ref );
+ $seen{$ref} = 1;
+ push( @queue, $ref );
}
+ }
+ }
+
+ for my $eva (@related_stations) {
+ @candidates = $opt{get_station}( $opt{station} );
- return $self->{promise}->all(@subreq);
+ if ( @candidates == 1 ) {
+ push(
+ @{ $self->{related_stations} },
+ {
+ ds100 => $candidates[0][0],
+ name => $candidates[0][1],
+ uic => $candidates[0][2],
+ }
+ );
}
- )->then(
+ }
+
+ my $dt_req = $self->{datetime}->clone;
+ my @timetable_reqs
+ = ( $self->get_timetable_p( $self->{station}{uic}, $dt_req ) );
+
+ for my $eva (@related_stations) {
+ push( @timetable_reqs, $self->get_timetable_p( $eva, $dt_req ) );
+ }
+
+ for ( 1 .. $lookahead_steps ) {
+ $dt_req->add( hours => 1 );
+ push( @timetable_reqs,
+ $self->get_timetable_p( $self->{station}{uic}, $dt_req ) );
+ for my $eva (@related_stations) {
+ push( @timetable_reqs, $self->get_timetable_p( $eva, $dt_req ) );
+ }
+ }
+
+ $dt_req = $self->{datetime}->clone;
+ for ( 1 .. $lookbehind_steps ) {
+ $dt_req->subtract( hours => 1 );
+ push( @timetable_reqs,
+ $self->get_timetable_p( $self->{station}{uic}, $dt_req ) );
+ for my $eva (@related_stations) {
+ push( @timetable_reqs, $self->get_timetable_p( $eva, $dt_req ) );
+ }
+ }
+
+ $self->{promise}->all(@timetable_reqs)->then(
sub {
- return $self->get_realtime_p;
+ my @realtime_reqs
+ = ( $self->get_realtime_p( $self->{station}{uic} ) );
+ for my $eva (@related_stations) {
+ push( @realtime_reqs, $self->get_realtime_p( $eva, $dt_req ) );
+ }
+ return $self->{promise}->all(@realtime_reqs);
}
)->then(
sub {
@@ -619,11 +676,10 @@ sub get_timetable {
}
sub get_realtime_p {
- my ($self) = @_;
+ my ( $self, $eva ) = @_;
my $promise = $self->{promise}->new;
- my $eva = $self->{station}{uic};
$self->get_with_cache_p( $self->{rt_cache},
$self->{iris_base} . "/fchg/${eva}" )->then(
sub {