handle /map requests asynchronously

2 files changed, 160 insertions, 54 deletions

diff --git a/lib/DBInfoscreen/Controller/Map.pm b/lib/DBInfoscreen/Controller/Map.pm
index 92f3644..36075f1 100644
--- a/lib/DBInfoscreen/Controller/Map.pm
+++ b/lib/DBInfoscreen/Controller/Map.pm
@@ -868,12 +868,11 @@ sub search {
 	my $t1_data;
 	my $t2_data;
 
-	if ( $t1 and $t1 =~ m{^\S+\s+\d+$} ) {
-		$t1_data = $self->hafas->trainsearch(
-			train_no => $t1,
-		);
-	}
-	else {
+	my @requests;
+
+	if ( not( $t1 and $t1 =~ m{^\S+\s+\d+$} )
+		or ( $t2 and not $t2 =~ m{^\S+\s+\d+$} ) )
+	{
 		$self->render(
 			'trainsearch',
 			title     => 'Fahrtverlauf',
@@ -885,58 +884,43 @@ sub search {
 		return;
 	}
 
-	if ( $t2 and $t2 =~ m{^\S+\s+\d+$} ) {
-		$t2_data = $self->hafas->trainsearch( train_no => $t2 );
-	}
-	elsif ($t2) {
-		$self->render(
-			'trainsearch',
-			title     => 'Fahrtverlauf',
-			hide_opts => 1,
-			error =>
-"Züge müssen im Format 'Zugtyp Nummer' angegeben werden, z.B. 'RE 1234'",
-		);
-		return;
-	}
+	$self->render_later;
 
-	if ( not $t1_data ) {
-		$self->render(
-			'trainsearch',
-			title     => 'Fahrtverlauf',
-			hide_opts => 1,
-			error     => "Zug $t1 nicht gefunden"
-		);
-		return;
-	}
+	push( @requests, $self->hafas->trainsearch_p( train_no => $t1 ) );
 
-	if ( $t2 and not $t2_data ) {
-		$self->render(
-			'trainsearch',
-			title     => 'Fahrtverlauf',
-			hide_opts => 1,
-			error     => "Zug $t2 nicht gefunden"
-		);
-		return;
+	if ($t2) {
+		push( @requests, $self->hafas->trainsearch_p( train_no => $t2 ) );
 	}
 
-	if ( $t1 and not $t2 ) {
-		$self->redirect_to( sprintf( "/map/%s/0", $t1_data->{trip_id}, ) );
-	}
-	elsif ( $t1 and $t2 ) {
-		$self->redirect_to(
-			sprintf(
-				"/intersection/%s,0;%s,0",
-				$t1_data->{trip_id}, $t2_data->{trip_id},
-			)
-		);
-	}
-	else {
-		$self->render(
-			'trainsearch',
-			title     => 'Fahrtverlauf',
-			hide_opts => 1,
-		);
-	}
+	Mojo::Promise->all(@requests)->then(
+		sub {
+			my ( $t1_data, $t2_data ) = @_;
+
+			if ($t2_data) {
+				$self->redirect_to(
+					sprintf(
+						"/intersection/%s,0;%s,0",
+						$t1_data->[0]{trip_id},
+						$t2_data->[0]{trip_id},
+					)
+				);
+			}
+			else {
+				$self->redirect_to(
+					sprintf( "/map/%s/0", $t1_data->[0]{trip_id}, ) );
+			}
+		}
+	)->catch(
+		sub {
+			my ($err) = @_;
+			$self->render(
+				'trainsearch',
+				title     => 'Fahrtverlauf',
+				hide_opts => 1,
+				error     => $err
+			);
+		}
+	)->wait;
 }
 
 sub search_form {
diff --git a/lib/DBInfoscreen/Helper/HAFAS.pm b/lib/DBInfoscreen/Helper/HAFAS.pm
index c4f0883..d5d9a66 100644
--- a/lib/DBInfoscreen/Helper/HAFAS.pm
+++ b/lib/DBInfoscreen/Helper/HAFAS.pm
@@ -56,6 +56,54 @@ sub hafas_json_req {
 	return $json;
 }
 
+sub get_json_p {
+	my ( $self, $cache, $url ) = @_;
+
+	my $promise = Mojo::Promise->new;
+
+	if ( my $content = $cache->thaw($url) ) {
+		$promise->resolve($content);
+		return $promise;
+	}
+
+	$self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} )
+	  ->then(
+		sub {
+			my ($tx) = @_;
+
+			if ( my $err = $tx->error ) {
+				$self->{log}->warn(
+					"hafas->get_json_p($url): HTTP $err->{code} $err->{message}"
+				);
+				$promise->reject(
+					"GET $url returned HTTP $err->{code} $err->{message}");
+				return;
+			}
+			my $body
+			  = encode( 'utf-8', decode( 'ISO-8859-15', $tx->res->body ) );
+
+			$body =~ s{^TSLs[.]sls = }{};
+			$body =~ s{;$}{};
+			$body =~ s{(}{(}g;
+			$body =~ s{)}{)}g;
+
+			my $json = decode_json($body);
+
+			$cache->freeze( $url, $json );
+
+			$promise->resolve($json);
+		}
+	)->catch(
+		sub {
+			my ($err) = @_;
+			$self->{log}->warn("get($url): $err");
+			$promise->reject($err);
+		}
+	)->wait;
+
+	return $promise;
+}
+
 sub hafas_xml_req {
 	my ( $self, $cache, $url ) = @_;
 
@@ -188,6 +236,80 @@ sub trainsearch {
 	return $result;
 }
 
+sub trainsearch_p {
+	my ( $self, %opt ) = @_;
+
+	my $base
+	  = 'https://reiseauskunft.bahn.de/bin/trainsearch.exe/dn?L=vs_json&start=yes&rt=1';
+
+	if ( not $opt{date_yy} ) {
+		my $now = DateTime->now( time_zone => 'Europe/Berlin' );
+		$opt{date_yy}   = $now->strftime('%d.%m.%y');
+		$opt{date_yyyy} = $now->strftime('%d.%m.%Y');
+	}
+
+	my $promise = Mojo::Promise->new;
+
+	$self->get_json_p( $self->{realtime_cache},
+		"${base}&date=$opt{date_yy}&trainname=$opt{train_no}" )->then(
+		sub {
+			my ($trainsearch) = @_;
+
+			# Fallback: Take first result
+			my $result = $trainsearch->{suggestions}[0];
+
+			# Try finding a result for the current date
+			for my $suggestion ( @{ $trainsearch->{suggestions} // [] } ) {
+
+       # Drunken API, sail with care. Both date formats are used interchangeably
+				if (
+					exists $suggestion->{depDate}
+					and (  $suggestion->{depDate} eq $opt{date_yy}
+						or $suggestion->{depDate} eq $opt{date_yyyy} )
+				  )
+				{
+            # Train numbers are not unique, e.g. IC 149 refers both to the
+            # InterCity service Amsterdam -> Berlin and to the InterCity service
+            # Koebenhavns Lufthavn st -> Aarhus.  One workaround is making
+            # requests with the stationFilter=80 parameter.  Checking the origin
+            # station seems to be the more generic solution, so we do that
+            # instead.
+					if (    $opt{train_origin}
+						and $suggestion->{dep} eq $opt{train_origin} )
+					{
+						$result = $suggestion;
+						last;
+					}
+				}
+			}
+
+			if ($result) {
+
+         # The trip_id's date part doesn't seem to matter -- so far, HAFAS is
+         # happy as long as the date part starts with a number. HAFAS-internal
+         # tripIDs use this format (withouth leading zero for day of month < 10)
+         # though, so let's stick with it.
+				my $date_map = $opt{date_yyyy};
+				$date_map =~ tr{.}{}d;
+				$result->{trip_id} = sprintf( '1|%d|%d|%d|%s',
+					$result->{id},   $result->{cycle},
+					$result->{pool}, $date_map );
+				$promise->resolve($result);
+			}
+			else {
+				$promise->reject("Zug $opt{train_no} nicht gefunden");
+			}
+		}
+	)->catch(
+		sub {
+			my ($err) = @_;
+			$promise->reject($err);
+		}
+	)->wait;
+
+	return $promise;
+}
+
 sub get_route_timestamps {
 	my ( $self, %opt ) = @_;