DBRIS: show connections while still checked in

4 files changed, 136 insertions, 38 deletions

diff --git a/lib/Travelynx/Command/work.pm b/lib/Travelynx/Command/work.pm
index 69e9bd2..35c90c2 100644
--- a/lib/Travelynx/Command/work.pm
+++ b/lib/Travelynx/Command/work.pm
@@ -190,16 +190,52 @@ sub run {
 				  )->wait;
 
 				if (    $arr
-					and $entry->{real_arr_ts}
-					and $now->epoch - $entry->{real_arr_ts} > 900 )
+					and $entry->{real_arr_ts} )
 				{
-					$self->app->checkout_p(
-						station => $arr,
-						force   => 2,
-						dep_eva => $dep,
-						arr_eva => $arr,
-						uid     => $uid
-					)->wait;
+					if ( $now->epoch - $entry->{real_arr_ts} > 900 ) {
+						$self->app->checkout_p(
+							station => $arr,
+							force   => 2,
+							dep_eva => $dep,
+							arr_eva => $arr,
+							uid     => $uid
+						)->wait;
+					}
+					elsif ( $entry->{real_arr_ts} - $now->epoch < 900 ) {
+						my @destinations
+						  = $self->app->journeys->get_connection_targets(
+							uid        => $uid,
+							backend_id => $entry->{backend_id},
+							eva        => $arr,
+							exclude    => $dep,
+						  );
+						$self->app->dbris->get_connections_p(
+							station      => $arr,
+							timestamp    => $entry->{real_arr},
+							destinations => \@destinations
+						)->then(
+							sub {
+								my ($suggestions) = @_;
+								$self->app->in_transit->update_data(
+									uid      => $uid,
+									train_id => $train_id,
+									data     => {
+										connection_suggestions_dbris =>
+										  $suggestions
+									},
+								);
+								return;
+							}
+						)->catch(
+							sub {
+								my ($err) = @_;
+								$self->app->log->debug(
+"work($uid) @ DBRIS $entry->{backend_name}: get_departures_p($arr): $err"
+								);
+								return;
+							}
+						)->wait;
+					}
 				}
 			};
 			if ($@) {
diff --git a/lib/Travelynx/Controller/Traveling.pm b/lib/Travelynx/Controller/Traveling.pm
index e48dd2b..f328ba8 100755
--- a/lib/Travelynx/Controller/Traveling.pm
+++ b/lib/Travelynx/Controller/Traveling.pm
@@ -878,15 +878,6 @@ sub station {
 				  sort { $b->[1] <=> $a->[1] }
 				  map { [ $_, $_->dep->epoch ] } $status->results;
 
-				$status = {
-					station_eva      => $station,
-					related_stations => [],
-				};
-
-				if ( $station =~ m{ [@] O = (?<name> [^@]+ ) [@] }x ) {
-					$status->{station_name} = $+{name};
-				}
-
 				my ($eva) = ( $station =~ m{ [@] L = (\d+) }x );
 				my $backend_id
 				  = $self->stations->get_backend_id( dbris => $dbris_service );
@@ -895,28 +886,22 @@ sub station {
 					backend_id => $backend_id,
 					eva        => $eva
 				);
+				@suggestions = $self->dbris->grep_suggestions(
+					status       => $status,
+					destinations => \@destinations
+				);
 
-				for my $dep (@results) {
-					destination: for my $dest (@destinations) {
-						if (    $dep->destination
-							and $dep->destination eq $dest->{name} )
-						{
-							push( @suggestions, [ $dep, $dest ] );
-							next destination;
-						}
-						for my $via_name ( $dep->via ) {
-							if ( $via_name eq $dest->{name} ) {
-								push( @suggestions, [ $dep, $dest ] );
-								next destination;
-							}
-						}
-					}
-				}
+				@suggestions = sort { $a->[0]{sort_ts} <=> $b->[0]{sort_ts} }
+				  grep { $_->[0]{sort_ts} >= $now - 300 } @suggestions;
 
-				@suggestions = map { $_->[0] }
-				  sort { $a->[1] <=> $b->[1] }
-				  grep { $_->[1] >= $now - 300 }
-				  map  { [ $_, $_->[0]->dep->epoch ] } @suggestions;
+				$status = {
+					station_eva      => $station,
+					related_stations => [],
+				};
+
+				if ( $station =~ m{ [@] O = (?<name> [^@]+ ) [@] }x ) {
+					$status->{station_name} = $+{name};
+				}
 			}
 			elsif ($hafas_service) {
 
diff --git a/lib/Travelynx/Helper/DBRIS.pm b/lib/Travelynx/Helper/DBRIS.pm
index deeed65..e1f52eb 100644
--- a/lib/Travelynx/Helper/DBRIS.pm
+++ b/lib/Travelynx/Helper/DBRIS.pm
@@ -127,6 +127,39 @@ sub get_departures_p {
 	);
 }
 
+sub get_connections_p {
+	my ( $self, %opt ) = @_;
+	my $promise      = Mojo::Promise->new;
+	my $destinations = $opt{destinations};
+
+	$self->get_departures_p(
+		station    => '@L=' . $opt{station},
+		timestamp  => $opt{timestamp},
+		lookbehind => 0,
+		lookahead  => 60,
+	)->then(
+		sub {
+			my ($status) = @_;
+			my @suggestions = $self->grep_suggestions(
+				status       => $status,
+				destinations => $destinations,
+				max_per_dest => 2
+			);
+			@suggestions
+			  = sort { $a->[0]{sort_ts} <=> $b->[0]{sort_ts} } @suggestions;
+			$promise->resolve( \@suggestions );
+			return;
+		}
+	)->catch(
+		sub {
+			my ($err) = @_;
+			$promise->reject("get_departures_p($opt{station}): $err");
+			return;
+		}
+	)->wait;
+	return $promise;
+}
+
 sub get_journey_p {
 	my ( $self, %opt ) = @_;
 
@@ -186,4 +219,47 @@ sub get_wagonorder_p {
 	);
 }
 
+sub grep_suggestions {
+	my ( $self, %opt ) = @_;
+	my $status       = $opt{status};
+	my $destinations = $opt{destinations};
+	my $max_per_dest = $opt{max_per_dest};
+
+	my @suggestions;
+	my %via_count;
+
+	for my $dep ( $status->results ) {
+		my $dep_json = {
+			id            => $dep->id,
+			ts            => ( $dep->sched_dep // $dep->dep )->epoch,
+			sort_ts       => $dep->dep->epoch,
+			is_cancelled  => $dep->is_cancelled,
+			stop_eva      => $dep->{stop_eva},
+			maybe_line_no => $dep->{maybe_line_no},
+			sched_hhmm    => $dep->sched_dep->strftime('%H:%M'),
+			rt_hhmm       => $dep->dep->strftime('%H:%M'),
+			delay         => $dep->delay,
+			platform      => $dep->platform,
+			type          => $dep->type,
+			line          => $dep->line,
+		};
+		destination: for my $dest ( @{$destinations} ) {
+			if (    $dep->destination
+				and $dep->destination eq $dest->{name} )
+			{
+				push( @suggestions, [ $dep_json, $dest ] );
+				next destination;
+			}
+			for my $via_name ( $dep->via ) {
+				if ( $via_name eq $dest->{name} ) {
+					push( @suggestions, [ $dep_json, $dest ] );
+					next destination;
+				}
+			}
+		}
+	}
+
+	return @suggestions;
+}
+
 1;
diff --git a/lib/Travelynx/Helper/EFA.pm b/lib/Travelynx/Helper/EFA.pm
index 2f3ff1f..f717f1e 100644
--- a/lib/Travelynx/Helper/EFA.pm
+++ b/lib/Travelynx/Helper/EFA.pm
@@ -56,6 +56,7 @@ sub grep_suggestions {
 
 	my @suggestions;
 	my %via_count;
+
 	for my $dep ( $status->results ) {
 		destination: for my $dest ( @{$destinations} ) {
 			for my $stop ( $dep->route_post ) {