diff options
Diffstat (limited to 'lib/Travelynx')
| -rw-r--r-- | lib/Travelynx/Command/database.pm | 239 | ||||
| -rwxr-xr-x | lib/Travelynx/Controller/Api.pm | 26 | ||||
| -rw-r--r-- | lib/Travelynx/Helper/IRIS.pm | 1 | ||||
| -rwxr-xr-x | lib/Travelynx/Model/Journeys.pm | 116 | ||||
| -rw-r--r-- | lib/Travelynx/Model/Stations.pm | 88 |
5 files changed, 371 insertions, 99 deletions
diff --git a/lib/Travelynx/Command/database.pm b/lib/Travelynx/Command/database.pm index 33612c3..d3a5006 100644 --- a/lib/Travelynx/Command/database.pm +++ b/lib/Travelynx/Command/database.pm @@ -6,12 +6,27 @@ package Travelynx::Command::database; use Mojo::Base 'Mojolicious::Command'; use DateTime; +use File::Slurp qw(read_file); +use JSON; use Travel::Status::DE::IRIS::Stations; has description => 'Initialize or upgrade database layout'; has usage => sub { shift->extract_usage }; +sub get_iris_version { + my ($db) = @_; + my $version; + + eval { $version = $db->select( 'schema_version', ['iris'] )->hash->{iris}; }; + if ($@) { + + # If it failed, the version table does not exist -> run setup first. + return undef; + } + return $version; +} + sub get_schema_version { my ($db) = @_; my $version; @@ -1106,8 +1121,212 @@ my @migrations = ( } ); }, + + # v26 -> v27 + # add list of stations that are not (or no longer) present in T-S-DE-IRIS + # (in this case, stations that were removed up to 1.74) + sub { + my ($db) = @_; + $db->query( + qq{ + alter table schema_version + add column iris varchar(12); + create table stations ( + eva int not null primary key, + ds100 varchar(16) not null, + name varchar(64) not null, + lat real not null, + lon real not null, + source smallint not null, + archived bool not null + ); + update schema_version set version = 27; + update schema_version set iris = '0'; + } + ); + }, ); +sub sync_stations { + my ( $db, $iris_version ) = @_; + + $db->update( 'schema_version', + { iris => $Travel::Status::DE::IRIS::Stations::VERSION } ); + + say 'Updating stations table, this may take a while ...'; + my $total = scalar Travel::Status::DE::IRIS::Stations::get_stations(); + my $count = 0; + for my $s ( Travel::Status::DE::IRIS::Stations::get_stations() ) { + my ( $ds100, $name, $eva, $lon, $lat ) = @{$s}; + $db->insert( + 'stations', + { + eva => $eva, + ds100 => $ds100, + name => $name, + lat => $lat, + lon => $lon, + source => 0, + archived => 0 + }, + { + on_conflict => \ + '(eva) do update set archived = false, source = 0' + } + ); + if ( $count++ % 1000 == 0 ) { + printf( " %2.0f%% complete\n", $count * 100 / $total ); + } + } + say ' done'; + + my $res1 = $db->query( + qq{ + select checkin_station_id + from journeys + left join stations on journeys.checkin_station_id = stations.eva + where stations.eva is null + limit 1; + } + )->hash; + + my $res2 = $db->query( + qq{ + select checkout_station_id + from journeys + left join stations on journeys.checkout_station_id = stations.eva + where stations.eva is null + limit 1; + } + )->hash; + + if ( $res1 or $res2 ) { + say 'Dropping stats cache for archived stations ...'; + $db->query('truncate journey_stats;'); + } + + say 'Updating archived stations ...'; + my $old_stations + = JSON->new->utf8->decode( scalar read_file('share/old_stations.json') ); + for my $s ( @{$old_stations} ) { + $db->insert( + 'stations', + { + eva => $s->{eva}, + ds100 => $s->{ds100}, + name => $s->{name}, + lat => $s->{latlong}[0], + lon => $s->{latlong}[1], + source => 0, + archived => 1 + }, + { on_conflict => undef } + ); + } + + if ( $iris_version == 0 ) { + say 'Applying EVA ID changes ...'; + for my $change ( + [ 721394, 301002, 'RKBP: Kronenplatz (U), Karlsruhe' ], + [ + 721356, 901012, + 'RKME: Ettlinger Tor/Staatstheater (U), Karlsruhe' + ], + ) + { + my ( $old, $new, $desc ) = @{$change}; + my $rows = $db->update( + 'journeys', + { checkout_station_id => $new }, + { checkout_station_id => $old } + )->rows; + $rows += $db->update( + 'journeys', + { checkin_station_id => $new }, + { checkin_station_id => $old } + )->rows; + if ($rows) { + say "$desc ($old -> $new) : $rows rows"; + } + } + } + + say 'Checking for unknown EVA IDs ...'; + my $found = 0; + + $res1 = $db->query( + qq{ + select checkin_station_id + from journeys + left join stations on journeys.checkin_station_id = stations.eva + where stations.eva is null; + } + ); + + $res2 = $db->query( + qq{ + select checkout_station_id + from journeys + left join stations on journeys.checkout_station_id = stations.eva + where stations.eva is null; + } + ); + + my %notified; + while ( my $row = $res1->hash ) { + my $eva = $row->{checkin_station_id}; + if ( not $found ) { + $found = 1; + say ''; + say '------------8<----------'; + say 'Travel::Status::DE::IRIS v' + . $Travel::Status::DE::IRIS::Stations::VERSION; + } + if ( not $notified{$eva} ) { + say $eva; + $notified{$eva} = 1; + } + } + + while ( my $row = $res2->hash ) { + my $eva = $row->{checkout_station_id}; + if ( not $found ) { + $found = 1; + say ''; + say '------------8<----------'; + say 'Travel::Status::DE::IRIS v' + . $Travel::Status::DE::IRIS::Stations::VERSION; + } + if ( not $notified{$eva} ) { + say $eva; + $notified{$eva} = 1; + } + } + + if ($found) { + say '------------8<----------'; + say ''; + say +'Due to a conceptual flaw in past travelynx releases, your database contains unknown EVA IDs.'; + say +'Please file a bug report titled "Missing EVA IDs after DB migration" at https://github.com/derf/travelynx/issues'; + say 'and include the list shown above in the bug report.'; + say +'If you do not have a GitHub account, please send an E-Mail to derf+travelynx@finalrewind.org instead.'; + say ''; + say 'This issue does not affect usability or long-term data integrity,'; + say 'and handling it is not time-critical.'; + say +'Past journeys referencing unknown EVA IDs may have inaccurate distance statistics,'; + say +'but this will be resolved once a future release handles those EVA IDs.'; + say 'Note that this issue was already present in previous releases.'; + } + else { + say 'None found.'; + } +} + sub setup_db { my ($db) = @_; my $tx = $db->begin; @@ -1129,7 +1348,7 @@ sub migrate_db { say "Found travelynx schema v${schema_version}"; if ( $schema_version == @migrations ) { - say "Database layout is up-to-date"; + say 'Database layout is up-to-date'; } eval { @@ -1144,6 +1363,24 @@ sub migrate_db { exit(1); } + my $iris_version = get_iris_version($db); + say "Found IRIS station database v${iris_version}"; + if ( $iris_version eq $Travel::Status::DE::IRIS::Stations::VERSION ) { + say 'Station database is up-to-date'; + } + else { + eval { + say +"Synchronizing with Travel::Status::DE::IRIS $Travel::Status::DE::IRIS::Stations::VERSION"; + sync_stations( $db, $iris_version ); + }; + if ($@) { + say STDERR "Synchronization failed: $@"; + say STDERR "Rolling back to v${schema_version}"; + exit(1); + } + } + if ( get_schema_version($db) == @migrations ) { $tx->commit; } diff --git a/lib/Travelynx/Controller/Api.pm b/lib/Travelynx/Controller/Api.pm index 3e9c5eb..f686222 100755 --- a/lib/Travelynx/Controller/Api.pm +++ b/lib/Travelynx/Controller/Api.pm @@ -7,7 +7,6 @@ use Mojo::Base 'Mojolicious::Controller'; use DateTime; use List::Util; -use Travel::Status::DE::IRIS::Stations; use UUID::Tiny qw(:std); # Internal Helpers @@ -184,41 +183,24 @@ sub travel_v1 { return; } - if ( - @{ - [ - Travel::Status::DE::IRIS::Stations::get_station( - $from_station) - ] - } != 1 - ) - { + if ( not $self->stations->search($from_station) ) { $self->render( json => { success => \0, deprecated => \0, - error => 'fromStation is ambiguous', + error => 'Unknown fromStation', status => $self->get_user_status_json_v1($uid) }, ); return; } - if ( - $to_station - and @{ - [ - Travel::Status::DE::IRIS::Stations::get_station( - $to_station) - ] - } != 1 - ) - { + if ( $to_station and not $self->stations->search($to_station) ) { $self->render( json => { success => \0, deprecated => \0, - error => 'toStation is ambiguous', + error => 'Unknown toStation', status => $self->get_user_status_json_v1($uid) }, ); diff --git a/lib/Travelynx/Helper/IRIS.pm b/lib/Travelynx/Helper/IRIS.pm index ef179c8..3222dad 100644 --- a/lib/Travelynx/Helper/IRIS.pm +++ b/lib/Travelynx/Helper/IRIS.pm @@ -13,6 +13,7 @@ use utf8; use Mojo::Promise; use Mojo::UserAgent; use Travel::Status::DE::IRIS; +use Travel::Status::DE::IRIS::Stations; sub new { my ( $class, %opt ) = @_; diff --git a/lib/Travelynx/Model/Journeys.pm b/lib/Travelynx/Model/Journeys.pm index a8ca299..3706916 100755 --- a/lib/Travelynx/Model/Journeys.pm +++ b/lib/Travelynx/Model/Journeys.pm @@ -6,7 +6,6 @@ package Travelynx::Model::Journeys; use GIS::Distance; use List::MoreUtils qw(after_incl before_incl); -use Travel::Status::DE::IRIS::Stations; use strict; use warnings; @@ -35,33 +34,12 @@ sub epoch_to_dt { ); } -sub get_station { - my ( $station_name, $exact_match ) = @_; - - my @candidates - = Travel::Status::DE::IRIS::Stations::get_station($station_name); - - if ( @candidates == 1 ) { - if ( not $exact_match ) { - return $candidates[0]; - } - if ( $candidates[0][0] eq $station_name - or $candidates[0][1] eq $station_name - or $candidates[0][2] eq $station_name ) - { - return $candidates[0]; - } - return undef; - } - return undef; -} - sub grep_unknown_stations { - my (@stations) = @_; + my ( $self, @stations ) = @_; my @unknown_stations; for my $station (@stations) { - my $station_info = get_station($station); + my $station_info = $self->{stations}->get_by_name($station); if ( not $station_info ) { push( @unknown_stations, $station ); } @@ -100,8 +78,8 @@ sub add { my $db = $opt{db}; my $uid = $opt{uid}; my $now = DateTime->now( time_zone => 'Europe/Berlin' ); - my $dep_station = get_station( $opt{dep_station} ); - my $arr_station = get_station( $opt{arr_station} ); + my $dep_station = $self->{stations}->search( $opt{dep_station} ); + my $arr_station = $self->{stations}->search( $opt{arr_station} ); if ( not $dep_station ) { return ( undef, 'Unbekannter Startbahnhof' ); @@ -134,10 +112,14 @@ sub add { my $route_has_stop = 0; for my $station ( @{ $opt{route} || [] } ) { - if ( $station eq $dep_station->[1] or $station eq $dep_station->[0] ) { + if ( $station eq $dep_station->{name} + or $station eq $dep_station->{ds100} ) + { $route_has_start = 1; } - if ( $station eq $arr_station->[1] or $station eq $arr_station->[0] ) { + if ( $station eq $arr_station->{name} + or $station eq $arr_station->{ds100} ) + { $route_has_stop = 1; } } @@ -145,15 +127,15 @@ sub add { my @route; if ( not $route_has_start ) { - push( @route, [ $dep_station->[1], {}, undef ] ); + push( @route, [ $dep_station->{name}, {}, undef ] ); } if ( $opt{route} ) { my @unknown_stations; for my $station ( @{ $opt{route} } ) { - my $station_info = get_station($station); + my $station_info = $self->{stations}->search($station); if ($station_info) { - push( @route, [ $station_info->[1], {}, undef ] ); + push( @route, [ $station_info->{name}, {}, undef ] ); } else { push( @route, [ $station, {}, undef ] ); @@ -175,7 +157,7 @@ sub add { } if ( not $route_has_stop ) { - push( @route, [ $arr_station->[1], {}, undef ] ); + push( @route, [ $arr_station->{name}, {}, undef ] ); } my $entry = { @@ -184,11 +166,11 @@ sub add { train_line => $opt{train_line}, train_no => $opt{train_no}, train_id => 'manual', - checkin_station_id => $dep_station->[2], + checkin_station_id => $dep_station->{eva}, checkin_time => $now, sched_departure => $opt{sched_departure}, real_departure => $opt{rt_departure}, - checkout_station_id => $arr_station->[2], + checkout_station_id => $arr_station->{eva}, sched_arrival => $opt{sched_arrival}, real_arrival => $opt{rt_arrival}, checkout_time => $now, @@ -252,14 +234,14 @@ sub update { eval { if ( exists $opt{from_name} ) { - my $from_station = get_station( $opt{from_name}, 1 ); + my $from_station = $self->{stations}->search( $opt{from_name} ); if ( not $from_station ) { die("Unbekannter Startbahnhof\n"); } $rows = $db->update( 'journeys', { - checkin_station_id => $from_station->[2], + checkin_station_id => $from_station->{eva}, edited => $journey->{edited} | 0x0004, }, { @@ -268,14 +250,14 @@ sub update { )->rows; } if ( exists $opt{to_name} ) { - my $to_station = get_station( $opt{to_name}, 1 ); + my $to_station = $self->{stations}->search( $opt{to_name} ); if ( not $to_station ) { die("Unbekannter Zielbahnhof\n"); } $rows = $db->update( 'journeys', { - checkout_station_id => $to_station->[2], + checkout_station_id => $to_station->{eva}, edited => $journey->{edited} | 0x0400, }, { @@ -559,13 +541,13 @@ sub get { $ref->{polyline} = $entry->{polyline}; } - if ( my $station = $self->{station_by_eva}->{ $ref->{from_eva} } ) { - $ref->{from_ds100} = $station->[0]; - $ref->{from_name} = $station->[1]; + if ( my $station = $self->{stations}->get_by_eva( $ref->{from_eva} ) ) { + $ref->{from_ds100} = $station->{ds100}; + $ref->{from_name} = $station->{name}; } - if ( my $station = $self->{station_by_eva}->{ $ref->{to_eva} } ) { - $ref->{to_ds100} = $station->[0]; - $ref->{to_name} = $station->[1]; + if ( my $station = $self->{stations}->get_by_eva( $ref->{to_eva} ) ) { + $ref->{to_ds100} = $station->{ds100}; + $ref->{to_name} = $station->{name}; } if ( $opt{with_datetime} ) { @@ -938,7 +920,8 @@ sub sanity_check { } if ( $journey->{edited} & 0x0010 and not $lax ) { my @unknown_stations - = grep_unknown_stations( map { $_->[0] } @{ $journey->{route} } ); + = $self->grep_unknown_stations( map { $_->[0] } + @{ $journey->{route} } ); if (@unknown_stations) { return 'Unbekannte Station(en): ' . join( ', ', @unknown_stations ); } @@ -989,8 +972,6 @@ sub get_travel_distance { my $prev_station = shift @polyline; for my $station (@polyline) { - - #lonlatlonlat $distance_polyline += $geo->distance_metal( $prev_station->[1], $prev_station->[0], $station->[1], $station->[0] @@ -998,45 +979,30 @@ sub get_travel_distance { $prev_station = $station; } - $prev_station = get_station( shift @route ); + $prev_station = $self->{stations}->get_by_name( shift @route ); if ( not $prev_station ) { return ( $distance_polyline, 0, 0 ); } - # Geo-coordinates for stations outside Germany are not available - # at the moment. When calculating distance with intermediate stops, - # these are simply left out (as if they were not part of the route). - # For beeline distance calculation, we use the route's first and last - # station with known geo-coordinates. my $from_station_beeline; my $to_station_beeline; - # $#{$station} >= 4 iff $station has geocoordinates for my $station_name (@route) { - if ( my $station = get_station($station_name) ) { - if ( not $from_station_beeline and $#{$prev_station} >= 4 ) { - $from_station_beeline = $prev_station; - } - if ( $#{$station} >= 4 ) { - $to_station_beeline = $station; - } - if ( $#{$prev_station} >= 4 and $#{$station} >= 4 ) { - $distance_intermediate += $geo->distance_metal( - $prev_station->[4], $prev_station->[3], - $station->[4], $station->[3] - ); - } - else { - $skipped++; - } + if ( my $station = $self->{stations}->get_by_name($station_name) ) { + $from_station_beeline //= $prev_station; + $to_station_beeline = $station; + $distance_intermediate += $geo->distance_metal( + $prev_station->{lat}, $prev_station->{lon}, + $station->{lat}, $station->{lon} + ); $prev_station = $station; } } if ( $from_station_beeline and $to_station_beeline ) { $distance_beeline = $geo->distance_metal( - $from_station_beeline->[4], $from_station_beeline->[3], - $to_station_beeline->[4], $to_station_beeline->[3] + $from_station_beeline->{lat}, $from_station_beeline->{lon}, + $to_station_beeline->{lat}, $to_station_beeline->{lon} ); } @@ -1264,10 +1230,8 @@ sub get_connection_targets { my @destinations = $res->hashes->grep( sub { shift->{count} >= $min_count } ) ->map( sub { shift->{dest} } )->each; - @destinations - = grep { $self->{station_by_eva}{$_} } @destinations; - @destinations - = map { $self->{station_by_eva}{$_}->[1] } @destinations; + @destinations = $self->{stations}->get_by_evas(@destinations); + @destinations = map { $_->{name} } @destinations; return @destinations; } diff --git a/lib/Travelynx/Model/Stations.pm b/lib/Travelynx/Model/Stations.pm new file mode 100644 index 0000000..6c898b1 --- /dev/null +++ b/lib/Travelynx/Model/Stations.pm @@ -0,0 +1,88 @@ +package Travelynx::Model::Stations; + +# Copyright (C) 2022 Daniel Friesel +# +# SPDX-License-Identifier: AGPL-3.0-or-later + +use strict; +use warnings; +use 5.020; + +sub new { + my ( $class, %opt ) = @_; + + return bless( \%opt, $class ); +} + +# Fast +sub get_by_eva { + my ( $self, $eva, %opt ) = @_; + + if ( not $eva ) { + return; + } + + my $db = $opt{db} // $self->{pg}->db; + + return $db->select( 'stations', '*', { eva => $eva } )->hash; +} + +# Fast +sub get_by_evas { + my ( $self, @evas ) = @_; + + my @ret + = $self->{pg}->db->select( 'stations', '*', { eva => { '=', \@evas } } ) + ->hashes->each; + return @ret; +} + +# Slow +sub get_latlon_by_name { + my ( $self, %opt ) = @_; + + my $db = $opt{db} // $self->{pg}->db; + + my %location; + my $res = $db->select( 'stations', [ 'name', 'lat', 'lon' ] ); + while ( my $row = $res->hash ) { + $location{ $row->{name} } = [ $row->{lat}, $row->{lon} ]; + } + return \%location; +} + +# Slow +sub get_by_name { + my ( $self, $name, %opt ) = @_; + + my $db = $opt{db} // $self->{pg}->db; + + return $db->select( 'stations', '*', { name => $name }, { limit => 1 } ) + ->hash; +} + +# Slow +sub get_by_ds100 { + my ( $self, $ds100, %opt ) = @_; + + my $db = $opt{db} // $self->{pg}->db; + + return $db->select( 'stations', '*', { ds100 => $ds100 }, { limit => 1 } ) + ->hash; +} + +# Can be slow +sub search { + my ( $self, $identifier, %opt ) = @_; + + if ( $identifier =~ m{ ^ \d+ $ }x ) { + return $self->get_by_eva( $identifier, %opt ) + // $self->get_by_ds100( $identifier, %opt ) + // $self->get_by_name( $identifier, %opt ); + } + + return $self->get_by_ds100( $identifier, %opt ) + // $self->get_by_name( $identifier, %opt ); +} + +1; |