Use Travel::Status::DE::HAFAS instead of traininfo.exe for journey details

4 files changed, 92 insertions, 196 deletions

diff --git a/cpanfile b/cpanfile
index ffb0ed5..17a84b8 100644
--- a/cpanfile
+++ b/cpanfile
@@ -13,6 +13,7 @@ requires 'Mojolicious::Plugin::Authentication';
 requires 'Mojo::Pg';
 requires 'Text::CSV';
 requires 'Travel::Status::DE::DBWagenreihung';
+requires 'Travel::Status::DE::HAFAS';
 requires 'Travel::Status::DE::IRIS';
 requires 'UUID::Tiny';
 requires 'JSON';
diff --git a/lib/Travelynx.pm b/lib/Travelynx.pm
index a85328f..7f1295e 100755
--- a/lib/Travelynx.pm
+++ b/lib/Travelynx.pm
@@ -719,11 +719,15 @@ sub startup {
 					if ( $station_data->{sched_arr} ) {
 						my $sched_arr
 						  = epoch_to_dt( $station_data->{sched_arr} );
-						my $rt_arr = $sched_arr->clone;
-						if (    $station_data->{adelay}
-							and $station_data->{adelay} =~ m{^\d+$} )
-						{
-							$rt_arr->add( minutes => $station_data->{adelay} );
+						my $rt_arr = epoch_to_dt( $station_data->{rt_arr} );
+						if ( $rt_arr->epoch == 0 ) {
+							$rt_arr = $sched_arr->clone;
+							if (    $station_data->{arr_delay}
+								and $station_data->{arr_delay} =~ m{^\d+$} )
+							{
+								$rt_arr->add(
+									minutes => $station_data->{arr_delay} );
+							}
 						}
 						$self->in_transit->set_arrival_times(
 							uid           => $uid,
@@ -1076,8 +1080,6 @@ sub startup {
 			my $date_yyyy = $train->start->strftime('%d.%m.%Y');
 			my $train_no  = $train->type . ' ' . $train->train_no;
 
-			my ( $trainlink, $route_data );
-
 			$self->hafas->get_json_p(
 				"${base}&date=${date_yy}&trainname=${train_no}")->then(
 				sub {
@@ -1085,7 +1087,6 @@ sub startup {
 
 					# Fallback: Take first result
 					my $result = $trainsearch->{suggestions}[0];
-					$trainlink = $result->{trainLink};
 
 					# Try finding a result for the current date
 					for
@@ -1106,14 +1107,13 @@ sub startup {
             # station seems to be the more generic solution, so we do that
             # instead.
 							if ( $suggestion->{dep} eq $train->origin ) {
-								$result    = $suggestion;
-								$trainlink = $suggestion->{trainLink};
+								$result = $suggestion;
 								last;
 							}
 						}
 					}
 
-					if ( not $trainlink ) {
+					if ( not $result ) {
 						$self->app->log->debug("trainlink not found");
 						return Mojo::Promise->reject("trainlink not found");
 					}
@@ -1135,67 +1135,29 @@ sub startup {
 						data => { trip_id => $trip_id }
 					);
 
-					my $base2
-					  = 'https://reiseauskunft.bahn.de/bin/traininfo.exe/dn';
-					return $self->hafas->get_json_p(
-"${base2}/${trainlink}?rt=1&date=${date_yy}&L=vs_json.vs_hap"
-					);
-				}
-			)->then(
-				sub {
-					my ($traininfo) = @_;
-					if ( not $traininfo or $traininfo->{error} ) {
-						$self->app->log->debug("traininfo error");
-						return Mojo::Promise->reject("traininfo error");
-					}
-					my $routeinfo
-					  = $traininfo->{suggestions}[0]{locations};
-
-					my $strp = DateTime::Format::Strptime->new(
-						pattern   => '%d.%m.%y %H:%M',
-						time_zone => 'Europe/Berlin',
-					);
-
-					$route_data = {};
-
-					for my $station ( @{$routeinfo} ) {
-						my $arr
-						  = $strp->parse_datetime(
-							$station->{arrDate} . ' ' . $station->{arrTime} );
-						my $dep
-						  = $strp->parse_datetime(
-							$station->{depDate} . ' ' . $station->{depTime} );
-						$route_data->{ $station->{name} } = {
-							sched_arr => $arr ? $arr->epoch : 0,
-							sched_dep => $dep ? $dep->epoch : 0,
-							eva       => $station->{evaId},
-						};
-					}
-
-					my $base2
-					  = 'https://reiseauskunft.bahn.de/bin/traininfo.exe/dn';
-					return $self->hafas->get_xml_p(
-						"${base2}/${trainlink}?rt=1&date=${date_yy}&L=vs_java3"
-					);
+					return $self->hafas->get_route_timestamps_p(
+						trip_id => $trip_id );
 				}
 			)->then(
 				sub {
-					my ($traininfo2) = @_;
-
-					for my $station ( keys %{$route_data} ) {
-						for my $key (
-							keys %{ $traininfo2->{station}{$station} // {} } )
-						{
-							$route_data->{$station}{$key}
-							  = $traininfo2->{station}{$station}{$key};
-						}
-					}
+					my ( $route_data, $journey ) = @_;
 
 					for my $station ( @{$route} ) {
 						$station->[1]
 						  = $route_data->{ $station->[0] };
 					}
 
+					my @messages;
+					for my $m ( $journey->messages ) {
+						push(
+							@messages,
+							{
+								header => $m->short,
+								lead   => $m->text,
+							}
+						);
+					}
+
 					$self->in_transit->set_route_data(
 						uid            => $uid,
 						db             => $db,
@@ -1208,7 +1170,7 @@ sub startup {
 							map { [ $_->[0]->epoch, $_->[1] ] }
 							  $train->qos_messages
 						],
-						him_messages => $traininfo2->{messages},
+						him_messages => \@messages,
 					);
 					return;
 				}
@@ -1585,13 +1547,7 @@ sub startup {
 				if ( $dep_info and $dep_info->{sched_arr} ) {
 					$dep_info->{sched_arr}
 					  = epoch_to_dt( $dep_info->{sched_arr} );
-					$dep_info->{rt_arr} = $dep_info->{sched_arr}->clone;
-					if (    $dep_info->{adelay}
-						and $dep_info->{adelay} =~ m{^\d+$} )
-					{
-						$dep_info->{rt_arr}
-						  ->add( minutes => $dep_info->{adelay} );
-					}
+					$dep_info->{rt_arr} = epoch_to_dt( $dep_info->{rt_arr} );
 					$dep_info->{rt_arr_countdown} = $ret->{boarding_countdown}
 					  = $dep_info->{rt_arr}->epoch - $epoch;
 				}
@@ -1610,13 +1566,7 @@ sub startup {
 						{
 							$times->{sched_arr}
 							  = epoch_to_dt( $times->{sched_arr} );
-							$times->{rt_arr} = $times->{sched_arr}->clone;
-							if (    $times->{adelay}
-								and $times->{adelay} =~ m{^\d+$} )
-							{
-								$times->{rt_arr}
-								  ->add( minutes => $times->{adelay} );
-							}
+							$times->{rt_arr} = epoch_to_dt( $times->{rt_arr} );
 							$times->{rt_arr_countdown}
 							  = $times->{rt_arr}->epoch - $epoch;
 						}
@@ -1625,13 +1575,7 @@ sub startup {
 						{
 							$times->{sched_dep}
 							  = epoch_to_dt( $times->{sched_dep} );
-							$times->{rt_dep} = $times->{sched_dep}->clone;
-							if (    $times->{ddelay}
-								and $times->{ddelay} =~ m{^\d+$} )
-							{
-								$times->{rt_dep}
-								  ->add( minutes => $times->{ddelay} );
-							}
+							$times->{rt_dep} = epoch_to_dt( $times->{rt_dep} );
 							$times->{rt_dep_countdown}
 							  = $times->{rt_dep}->epoch - $epoch;
 						}
diff --git a/lib/Travelynx/Helper/HAFAS.pm b/lib/Travelynx/Helper/HAFAS.pm
index c8e0ef4..62814b6 100644
--- a/lib/Travelynx/Helper/HAFAS.pm
+++ b/lib/Travelynx/Helper/HAFAS.pm
@@ -12,8 +12,15 @@ use DateTime;
 use Encode qw(decode);
 use JSON;
 use Mojo::Promise;
+use Travel::Status::DE::HAFAS;
 use XML::LibXML;
 
+sub _epoch {
+	my ($dt) = @_;
+
+	return $dt ? $dt->epoch : 0;
+}
+
 sub new {
 	my ( $class, %opt ) = @_;
 
@@ -167,129 +174,71 @@ sub get_json_p {
 	return $promise;
 }
 
-sub get_xml_p {
-	my ( $self, $url ) = @_;
+sub get_route_timestamps_p {
+	my ( $self, %opt ) = @_;
 
-	my $cache   = $self->{realtime_cache};
 	my $promise = Mojo::Promise->new;
-
-	if ( my $content = $cache->thaw($url) ) {
-		return $promise->resolve($content);
-	}
-
-	$self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} )
-	  ->then(
+	my $now     = DateTime->now( time_zone => 'Europe/Berlin' );
+
+	Travel::Status::DE::HAFAS->new_p(
+		journey => {
+			id => $opt{trip_id},
+
+			# name => $opt{train_no},
+		},
+		cache      => $self->{realtime_cache},
+		promise    => 'Mojo::Promise',
+		user_agent => $self->{user_agent}->request_timeout(10)
+	)->then(
 		sub {
-			my ($tx) = @_;
-
-			if ( my $err = $tx->error ) {
-				$promise->reject(
-"hafas->get_xml_p($url) returned HTTP $err->{code} $err->{message}"
-				);
-				return;
-			}
-
-			my $body = decode( 'ISO-8859-15', $tx->res->body );
-			my $tree;
-
-			my $traininfo = {
-				station  => {},
-				messages => [],
-			};
-
-			# <SDay text="... &gt; ..."> is invalid XML, but present in
-			# regardless. As it is the last tag, we just throw it away.
-			$body =~ s{<SDay [^>]*/>}{}s;
-
-			# More fixes for invalid XML
-			$body =~ s{P&R}{P&amp;R};
-			$body =~ s{& }{&amp; }g;
-
-			# <Attribute [...] text="[...]"[...]"" /> is invalid XML.
-			# Work around it.
-			$body
-			  =~ s{<Attribute([^>]+)text="([^"]*)"([^"=>]*)""}{<Attribute$1text="$2&#042;$3&#042;"}s;
-
-			# Same for <HIMMessage lead="[...]"[...]"[...]" />
-			$body
-			  =~ s{<HIMMessage([^>]+)lead="([^"]*)"([^"=>]*)"([^"]*)"}{<Attribute$1text="$2&#042;$3&#042;$4"}s;
-
-			# ... and <HIMMessage [...] lead="[...]<>[...]">
-			# (replace <> with t$t)
-			while ( $body
-				=~ s{<HIMMessage([^>]+)lead="([^"]*)<>([^"=]*)"}{<HIMMessage$1lead="$2&#11020;$3"}gis
-			  )
-			{
-			}
-
-			# Dito for <HIMMessage [...] lead="[...]<br>[...]">.
-			while ( $body
-				=~ s{<HIMMessage([^>]+)lead="([^"]*)<br/?>([^"=]*)"}{<HIMMessage$1lead="$2 $3"}is
-			  )
-			{
-			}
-
-			# ... and any other HTML tag inside an XML attribute
-			while ( $body
-				=~ s{<HIMMessage([^>]+)lead="([^"]*)<[^>]+>([^"=]*)"}{<HIMMessage$1lead="$2$3"}is
-			  )
-			{
-			}
-
-			eval { $tree = XML::LibXML->load_xml( string => $body ) };
-			if ( my $err = $@ ) {
-				if ( $err =~ m{extra content at the end}i ) {
-
-					# We requested XML, but received an HTML error page
-					# (which was returned with HTTP 200 OK).
-					$self->{log}->debug("load_xml($url): $err");
-				}
-				else {
-					# There is invalid XML which we might be able to fix via
-					# regular expressions, so dump it into the production log.
-					$self->{log}->info("load_xml($url): $err");
-				}
-				$cache->freeze( $url, $traininfo );
-				$promise->reject("hafas->get_xml_p($url): $err");
-				return;
-			}
-
-			for my $station ( $tree->findnodes('/Journey/St') ) {
-				my $name   = $station->getAttribute('name');
-				my $adelay = $station->getAttribute('adelay');
-				my $ddelay = $station->getAttribute('ddelay');
-				$traininfo->{station}{$name} = {
-					adelay => $adelay,
-					ddelay => $ddelay,
+			my ($hafas) = @_;
+			my $journey = $hafas->result;
+			my $ret     = {};
+
+			my $station_is_past = 1;
+			for my $stop ( $journey->route ) {
+				my $name = $stop->{name};
+				$ret->{$name} = {
+					sched_arr   => _epoch( $stop->{sched_arr} ),
+					sched_dep   => _epoch( $stop->{sched_dep} ),
+					rt_arr      => _epoch( $stop->{rt_arr} ),
+					rt_dep      => _epoch( $stop->{rt_dep} ),
+					arr_delay   => $stop->{arr_delay},
+					dep_delay   => $stop->{dep_delay},
+					eva         => $stop->{eva},
+					load        => $stop->{load},
+					isCancelled => (
+						( $stop->{arr_cancelled} or not $stop->{sched_arr} )
+						  and
+						  ( $stop->{dep_cancelled} or not $stop->{sched_dep} )
+					),
 				};
+				if (
+					    $station_is_past
+					and not $ret->{$name}{isCancelled}
+					and $now->epoch < (
+						$ret->{$name}{rt_arr} // $ret->{$name}{rt_dep}
+						  // $ret->{$name}{sched_arr}
+						  // $ret->{$name}{sched_dep} // $now->epoch
+					)
+				  )
+				{
+					$station_is_past = 0;
+				}
+				$ret->{$name}{isPast} = $station_is_past;
 			}
 
-			for my $message ( $tree->findnodes('/Journey/HIMMessage') ) {
-				my $header  = $message->getAttribute('header');
-				my $lead    = $message->getAttribute('lead');
-				my $display = $message->getAttribute('display');
-				push(
-					@{ $traininfo->{messages} },
-					{
-						header  => $header,
-						lead    => $lead,
-						display => $display
-					}
-				);
-			}
-
-			$cache->freeze( $url, $traininfo );
-			$promise->resolve($traininfo);
+			$promise->resolve( $ret, $journey );
 			return;
 		}
 	)->catch(
 		sub {
 			my ($err) = @_;
-			$self->{log}->info("hafas->get_xml_p($url): $err");
-			$promise->reject("hafas->get_xml_p($url): $err");
+			$promise->reject($err);
 			return;
 		}
 	)->wait;
+
 	return $promise;
 }
 
diff --git a/templates/about.html.ep b/templates/about.html.ep
index bced6b6..027d345 100644
--- a/templates/about.html.ep
+++ b/templates/about.html.ep
@@ -3,9 +3,11 @@
 		<a href="https://finalrewind.org/projects/travelynx">travelynx</a> v<%= stash('version') // '???' %><br/>
 		Entwickelt von <a href="https://twitter.com/derfnull">@derfnull</a><br/>
 		<a href="<%= app->config->{ref}{source} // 'https://github.com/derf/travelynx' %>">Quelltext</a> lizensiert unter AGPL v3<br/><br/>
-		Backend:
+		Backends:
 		<a href="https://finalrewind.org/projects/Travel-Status-DE-IRIS/">Travel::Status::DE::IRIS</a>
-		v<%= $Travel::Status::DE::IRIS::VERSION %><br/>
+		v<%= $Travel::Status::DE::IRIS::VERSION %> und
+		<a href="https://finalrewind.org/projects/Travel-Status-DE-DeutscheBahn/">Travel::Status::DE::HAFAS</a>
+		v<%= $Travel::Status::DE::HAFAS::VERSION %><br/>
 		<a href="http://data.deutschebahn.com/dataset/data-haltestellen">Haltestellendaten</a>
 		© DB Station&amp;Service AG,
 		Europaplatz 1,