Add lat/lon to pre-2.7.8 journeys; add eva where missing

This speeds up the map significantly and makes coordinates_by_station obsolete

4 files changed, 191 insertions, 51 deletions

diff --git a/lib/Travelynx.pm b/lib/Travelynx.pm
index 37afd9a..0c5a5ae 100755
--- a/lib/Travelynx.pm
+++ b/lib/Travelynx.pm
@@ -177,17 +177,6 @@ sub startup {
 		}
 	);
 
-	$self->attr(
-		coordinates_by_station => sub {
-			my $legacy_names = $self->app->renamed_station;
-			my $location     = $self->stations->get_latlon_by_name;
-			while ( my ( $old_name, $new_name ) = each %{$legacy_names} ) {
-				$location->{$old_name} = $location->{$new_name};
-			}
-			return $location;
-		}
-	);
-
 	# https://de.wikipedia.org/wiki/Liste_nach_Gemeinden_und_Regionen_benannter_IC/ICE-Fahrzeuge#Namensgebung_ICE-Triebz%C3%BCge_nach_Gemeinden
 	# via https://github.com/marudor/bahn.expert/blob/main/src/server/coachSequence/TrainNames.ts
 	$self->attr(
@@ -297,13 +286,12 @@ sub startup {
 		journeys => sub {
 			my ($self) = @_;
 			state $journeys = Travelynx::Model::Journeys->new(
-				log               => $self->app->log,
-				pg                => $self->pg,
-				in_transit        => $self->in_transit,
-				stats_cache       => $self->journey_stats_cache,
-				renamed_station   => $self->app->renamed_station,
-				latlon_by_station => $self->app->coordinates_by_station,
-				stations          => $self->stations,
+				log             => $self->app->log,
+				pg              => $self->pg,
+				in_transit      => $self->in_transit,
+				stats_cache     => $self->journey_stats_cache,
+				renamed_station => $self->app->renamed_station,
+				stations        => $self->stations,
 			);
 		}
 	);
@@ -2041,8 +2029,6 @@ sub startup {
 			my $route_type     = $opt{route_type} // 'polybee';
 			my $include_manual = $opt{include_manual} ? 1 : 0;
 
-			my $location = $self->app->coordinates_by_station;
-
 			my $with_polyline = $route_type eq 'beeline' ? 0 : 1;
 
 			if ( not @journeys ) {
@@ -2058,12 +2044,19 @@ sub startup {
 			my $first_departure = $journeys[-1]->{rt_departure};
 			my $last_departure  = $journeys[0]->{rt_departure};
 
-			my @stations = List::Util::uniq map { $_->{to_name} } @journeys;
-			push( @stations,
-				List::Util::uniq map { $_->{from_name} } @journeys );
-			@stations = List::Util::uniq @stations;
-			my @station_coordinates = map { [ $location->{$_}, $_ ] }
-			  grep { exists $location->{$_} } @stations;
+			my @stations = uniq_by { $_->{name} } map {
+				{
+					name   => $_->{to_name},
+					latlon => $_->{to_latlon}
+				},
+				  {
+					name   => $_->{from_name},
+					latlon => $_->{from_latlon}
+				  }
+			} @journeys;
+
+			my @station_coordinates
+			  = map { [ $_->{latlon}, $_->{name} ] } @stations;
 
 			my @station_pairs;
 			my @polylines;
@@ -2127,23 +2120,26 @@ sub startup {
 
 			for my $journey (@beeline_journeys) {
 
-				my @route = map { $_->[0] } @{ $journey->{route} };
+				my @route = @{ $journey->{route} };
 
 				my $from_index
-				  = first_index { $_ eq $journey->{from_name} } @route;
-				my $to_index = first_index { $_ eq $journey->{to_name} } @route;
+				  = first_index { $_->[0] eq $journey->{from_name} } @route;
+				my $to_index
+				  = first_index { $_->[0] eq $journey->{to_name} } @route;
 
 				if ( $from_index == -1 ) {
 					my $rename = $self->app->renamed_station;
 					$from_index = first_index {
-						( $rename->{$_} // $_ ) eq $journey->{from_name}
+						( $rename->{ $_->[0] } // $_->[0] ) eq
+						  $journey->{from_name}
 					}
 					@route;
 				}
 				if ( $to_index == -1 ) {
 					my $rename = $self->app->renamed_station;
 					$to_index = first_index {
-						( $rename->{$_} // $_ ) eq $journey->{to_name}
+						( $rename->{ $_->[0] } // $_->[0] ) eq
+						  $journey->{to_name}
 					}
 					@route;
 				}
@@ -2177,7 +2173,7 @@ sub startup {
 
 				@route = @route[ $from_index .. $to_index ];
 
-				my $key = join( '|', @route );
+				my $key = join( '|', map { $_->[0] } @route );
 
 				if ( $seen{$key} ) {
 					next;
@@ -2186,7 +2182,7 @@ sub startup {
 				$seen{$key} = 1;
 
 				# direction does not matter at the moment
-				$seen{ join( '|', reverse @route ) } = 1;
+				$seen{ join( '|', reverse map { $_->[0] } @route ) } = 1;
 
 				my $prev_station = shift @route;
 				for my $station (@route) {
@@ -2195,14 +2191,17 @@ sub startup {
 				}
 			}
 
-			@station_pairs = uniq_by { $_->[0] . '|' . $_->[1] } @station_pairs;
-			@station_pairs = grep {
-				      exists $location->{ $_->[0] }
-				  and exists $location->{ $_->[1] }
-			} @station_pairs;
 			@station_pairs
-			  = map { [ $location->{ $_->[0] }, $location->{ $_->[1] } ] }
+			  = uniq_by { $_->[0][0] . '|' . $_->[1][0] } @station_pairs;
+			@station_pairs
+			  = grep { defined $_->[0][2]{lat} and defined $_->[1][2]{lat} }
 			  @station_pairs;
+			@station_pairs = map {
+				[
+					[ $_->[0][2]{lat}, $_->[0][2]{lon} ],
+					[ $_->[1][2]{lat}, $_->[1][2]{lon} ]
+				]
+			} @station_pairs;
 
 			my $ret = {
 				skipped_journeys    => \@skipped_journeys,
diff --git a/lib/Travelynx/Command/database.pm b/lib/Travelynx/Command/database.pm
index fb5ee80..ae17f64 100644
--- a/lib/Travelynx/Command/database.pm
+++ b/lib/Travelynx/Command/database.pm
@@ -1948,7 +1948,7 @@ my @migrations = (
 	},
 
 	# v51 -> v52
-	# Explicitly encode backend type; preparation for multiple hAFAS backends
+	# Explicitly encode backend type; preparation for multiple HAFAS backends
 	sub {
 		my ($db) = @_;
 		$db->query(
@@ -2050,6 +2050,9 @@ my @migrations = (
 			}
 		);
 	},
+
+	# v52 -> v53
+	# Extend train_id to be compatible with more recent HAFAS versions
 	sub {
 		my ($db) = @_;
 		$db->query(
@@ -2166,6 +2169,147 @@ my @migrations = (
 			}
 		);
 	},
+
+	# v53 -> v54
+	# Retrofit lat/lon data onto routes logged before v2.7.8; ensure
+	# consistent name and eva entries as well.
+	sub {
+		my ($db) = @_;
+
+		say
+'Adding lat/lon to routes of journeys logged before v2.7.8 and improving consistency of name/eva data in very old route entries.';
+		say 'This may take a while ...';
+
+		my %legacy_to_new;
+		if ( -r 'share/old_station_names.json' ) {
+			%legacy_to_new = %{ JSON->new->utf8->decode(
+					scalar read_file('share/old_station_names.json')
+				)
+			};
+		}
+
+		my %latlon_by_eva;
+		my %latlon_by_name;
+		my $res = $db->select( 'stations', [ 'name', 'eva', 'lat', 'lon' ] );
+		while ( my $row = $res->hash ) {
+			$latlon_by_eva{ $row->{eva} }   = $row;
+			$latlon_by_name{ $row->{name} } = $row;
+		}
+
+		my $total
+		  = $db->select( 'journeys', 'count(*) as count' )->hash->{count};
+		my $count           = 0;
+		my $total_no_eva    = 0;
+		my $total_no_latlon = 0;
+
+		my $json = JSON->new;
+
+		$res = $db->select( 'journeys_str', [ 'route', 'journey_id' ] );
+		while ( my $row = $res->expand->hash ) {
+			my $no_eva    = 0;
+			my $no_latlon = 0;
+			my $changed   = 0;
+			my @route     = @{ $row->{route} };
+			for my $stop (@route) {
+				my $name = $stop->[0];
+				my $eva  = $stop->[1];
+
+				if ( not $eva and $stop->[2]{eva} ) {
+					$eva = $stop->[1] = 0 + $stop->[2]{eva};
+				}
+
+				if ( $stop->[2]{eva} and $eva and $eva == $stop->[2]{eva} ) {
+					delete $stop->[2]{eva};
+				}
+
+				if ( $stop->[2]{name} and $name eq $stop->[2]{name} ) {
+					delete $stop->[2]{name};
+				}
+
+				if ( not $eva ) {
+					if ( $latlon_by_name{$name} ) {
+						$eva     = $stop->[1] = $latlon_by_name{$name}{eva};
+						$changed = 1;
+					}
+					elsif ( $legacy_to_new{$name}
+						and $latlon_by_name{ $legacy_to_new{$name} } )
+					{
+						$eva = $stop->[1]
+						  = $latlon_by_name{ $legacy_to_new{$name} }{eva};
+						$stop->[2]{lat}
+						  = $latlon_by_name{ $legacy_to_new{$name} }{lat};
+						$stop->[2]{lon}
+						  = $latlon_by_name{ $legacy_to_new{$name} }{lon};
+						$changed = 1;
+					}
+					else {
+						$no_eva = 1;
+					}
+				}
+
+				if ( $stop->[2]{lat} and $stop->[2]{lon} ) {
+					next;
+				}
+
+				if ( $eva and $latlon_by_eva{$eva} ) {
+					$stop->[2]{lat} = $latlon_by_eva{$eva}{lat};
+					$stop->[2]{lon} = $latlon_by_eva{$eva}{lon};
+					$changed        = 1;
+				}
+				elsif ( $latlon_by_name{$name} ) {
+					$stop->[2]{lat} = $latlon_by_name{$name}{lat};
+					$stop->[2]{lon} = $latlon_by_name{$name}{lon};
+					$changed        = 1;
+				}
+				elsif ( $legacy_to_new{$name}
+					and $latlon_by_name{ $legacy_to_new{$name} } )
+				{
+					$stop->[2]{lat}
+					  = $latlon_by_name{ $legacy_to_new{$name} }{lat};
+					$stop->[2]{lon}
+					  = $latlon_by_name{ $legacy_to_new{$name} }{lon};
+					$changed = 1;
+				}
+				else {
+					$no_latlon = 1;
+				}
+			}
+			if ($no_eva) {
+				$total_no_eva += 1;
+			}
+			if ($no_latlon) {
+				$total_no_latlon += 1;
+			}
+			if ($changed) {
+				$db->update(
+					'journeys',
+					{
+						route => $json->encode( \@route ),
+					},
+					{ id => $row->{journey_id} }
+				);
+			}
+			if ( $count++ % 10000 == 0 ) {
+				printf( "    %2.0f%% complete\n", $count * 100 / $total );
+			}
+		}
+		say '    done';
+		if ($total_no_eva) {
+			printf( "    (%d of %d routes still lack some EVA IDs)\n",
+				$total_no_eva, $total );
+		}
+		if ($total_no_latlon) {
+			printf( "    (%d of %d routes still lack some lat/lon data)\n",
+				$total_no_latlon, $total );
+		}
+
+		$db->query(
+			qq{
+				update schema_version set version = 54;
+			}
+		);
+	},
+
 );
 
 sub sync_stations {
diff --git a/lib/Travelynx/Controller/Traveling.pm b/lib/Travelynx/Controller/Traveling.pm
index f9bc2d5..2b86688 100755
--- a/lib/Travelynx/Controller/Traveling.pm
+++ b/lib/Travelynx/Controller/Traveling.pm
@@ -1323,8 +1323,6 @@ sub commute {
 sub map_history {
 	my ($self) = @_;
 
-	my $location = $self->app->coordinates_by_station;
-
 	if ( not $self->param('route_type') ) {
 		$self->param( route_type => 'polybee' );
 	}
diff --git a/lib/Travelynx/Model/Journeys.pm b/lib/Travelynx/Model/Journeys.pm
index 8c29e7d..b067d78 100755
--- a/lib/Travelynx/Model/Journeys.pm
+++ b/lib/Travelynx/Model/Journeys.pm
@@ -1120,9 +1120,8 @@ sub get_travel_distance {
 	my $distance_beeline      = 0;
 	my $skipped               = 0;
 	my $geo                   = GIS::Distance->new();
-	my @stations              = map { $_->[0] } @{$route_ref};
-	my @route                 = after_incl { $_ eq $from } @stations;
-	@route = before_incl { $_ eq $to } @route;
+	my @route                 = after_incl { $_->[0] eq $from } @{$route_ref};
+	@route = before_incl { $_->[0] eq $to } @route;
 
 	if ( @route < 2 ) {
 
@@ -1144,16 +1143,16 @@ sub get_travel_distance {
 		$prev_station = $station;
 	}
 
-	$prev_station = $self->{latlon_by_station}->{ shift @route };
-	if ( not $prev_station ) {
+	if ( not( defined $route[0][2]{lat} and defined $route[0][2]{lon} ) ) {
 		return ( $distance_polyline, 0, 0 );
 	}
 
-	for my $station_name (@route) {
-		if ( my $station = $self->{latlon_by_station}->{$station_name} ) {
+	$prev_station = shift @route;
+	for my $station (@route) {
+		if ( defined $station->[2]{lat} and defined $station->[2]{lon} ) {
 			$distance_intermediate += $geo->distance_metal(
-				$prev_station->[0], $prev_station->[1],
-				$station->[0],      $station->[1]
+				$prev_station->[2]{lat}, $prev_station->[2]{lon},
+				$station->[2]{lat},      $station->[2]{lon}
 			);
 			$prev_station = $station;
 		}