From cabf159f46e5027e6191f82d3621b9ba9898cb61 Mon Sep 17 00:00:00 2001
From: Daniel Friesel <derf@finalrewind.org>
Date: Sun, 15 Dec 2019 13:42:11 +0100
Subject: Handle Berlin Ringbahn and other transfer-at-destination trains

Requires Travel::Status::DE::IRIS v1.38 (not released yet)
---
 lib/Travelynx.pm              | 14 +++++++++++++-
 lib/Travelynx/Command/work.pm | 25 +++++++++++++++----------
 2 files changed, 28 insertions(+), 11 deletions(-)

diff --git a/lib/Travelynx.pm b/lib/Travelynx.pm
index 73c221a..9f1a3a8 100755
--- a/lib/Travelynx.pm
+++ b/lib/Travelynx.pm
@@ -272,6 +272,7 @@ sub startup {
 					station        => $station,
 					main_cache     => $self->app->cache_iris_main,
 					realtime_cache => $self->app->cache_iris_rt,
+					keep_transfers => 1,
 					lookbehind     => 20,
 					datetime => DateTime->now( time_zone => 'Europe/Berlin' )
 					  ->subtract( minutes => $lookbehind ),
@@ -627,7 +628,18 @@ sub startup {
 			my $journey
 			  = $db->select( 'in_transit', '*', { user_id => $uid } )
 			  ->expand->hash;
-			my ($train) = List::Util::first { $_->train_id eq $train_id }
+
+			# Note that a train may pass the same station several times.
+			# Notable example: S41 / S42 ("Ringbahn") both starts and
+			# terminates at Berlin Südkreuz
+			my ($train) = List::Util::first {
+				$_->train_id eq $train_id
+				  and $_->sched_arrival
+				  and $_->sched_arrival->epoch > $user->{sched_departure}->epoch
+			}
+			@{ $status->{results} };
+
+			$train //= List::Util::first { $_->train_id eq $train_id }
 			@{ $status->{results} };
 
           # When a checkout is triggered by a checkin, there is an edge case
diff --git a/lib/Travelynx/Command/work.pm b/lib/Travelynx/Command/work.pm
index b9a8520..00eefc6 100644
--- a/lib/Travelynx/Command/work.pm
+++ b/lib/Travelynx/Command/work.pm
@@ -3,7 +3,7 @@ use Mojo::Base 'Mojolicious::Command';
 
 use DateTime;
 use JSON;
-use List::Util qw(first);
+use List::Util;
 
 has description =>
   'Perform automatic checkout when users arrive at their destination';
@@ -27,8 +27,6 @@ sub run {
 		my $arr      = $entry->{arr_ds100};
 		my $train_id = $entry->{train_id};
 
-		$self->app->log->debug("Processing $uid");
-
 		# Note: IRIS data is not always updated in real-time. Both departure and
 		# arrival delays may take several minutes to appear, especially in case
 		# of large-scale disturbances. We work around this by continuing to
@@ -37,14 +35,13 @@ sub run {
 
 		eval {
 			if ( $now->epoch - $entry->{real_dep_ts} < 900 ) {
-				$self->app->log->debug("  - updating departure");
 				my $status = $self->app->get_departures( $dep, 30, 30 );
 				if ( $status->{errstr} ) {
 					die("get_departures($dep): $status->{errstr}\n");
 				}
 
-				my ($train)
-				  = first { $_->train_id eq $train_id } @{ $status->{results} };
+				my ($train) = List::Util::first { $_->train_id eq $train_id }
+				@{ $status->{results} };
 
 				if ( not $train ) {
 					die("could not find train $train_id at $dep\n");
@@ -80,14 +77,23 @@ sub run {
 					or $now->epoch - $entry->{real_arr_ts} < 600 )
 			  )
 			{
-				$self->app->log->debug("  - updating arrival");
 				my $status = $self->app->get_departures( $arr, 20, 220 );
 				if ( $status->{errstr} ) {
 					die("get_departures($arr): $status->{errstr}\n");
 				}
 
-				my ($train)
-				  = first { $_->train_id eq $train_id } @{ $status->{results} };
+				# Note that a train may pass the same station several times.
+				# Notable example: S41 / S42 ("Ringbahn") both starts and
+				# terminates at Berlin Südkreuz
+				my ($train) = List::Util::first {
+					$_->train_id eq $train_id
+					  and $_->sched_arrival
+					  and $_->sched_arrival->epoch > $entry->{sched_dep_ts}
+				}
+				@{ $status->{results} };
+
+				$train //= List::Util::first { $_->train_id eq $train_id }
+				@{ $status->{results} };
 
 				if ( not $train ) {
 
@@ -116,7 +122,6 @@ sub run {
 				$self->app->add_route_timestamps( $uid, $train, 0 );
 			}
 			elsif ( $entry->{real_arr_ts} ) {
-				$self->app->log->debug("  - checking out");
 				my ( undef, $error ) = $self->app->checkout( $arr, 1, $uid );
 				if ($error) {
 					die("${error}\n");
-- 
cgit v1.2.3