mirror of
https://github.com/derf/travelynx
synced 2024-11-26 14:30:18 +00:00
switch to internal station database; add out-of-service stations for old journeys
This commit is contained in:
parent
d791825123
commit
2f9ba6e017
9 changed files with 3035 additions and 188 deletions
|
@ -31,7 +31,7 @@ however this method is untested.
|
|||
In the project root directory (where `cpanfile` resides), run
|
||||
|
||||
```
|
||||
carton install
|
||||
carton install --deployment
|
||||
```
|
||||
|
||||
and set `PERL5LIB=.../local/lib/perl5` before executing any travelynx
|
||||
|
@ -87,6 +87,7 @@ or not.
|
|||
|
||||
```
|
||||
git pull
|
||||
carton install --deployment # if you are using carton: update dependencies
|
||||
chmod -R a+rX . # only needed if travelynx is running under a different user
|
||||
if perl index.pl database has-current-schema; then
|
||||
systemctl reload travelynx
|
||||
|
|
132
lib/Travelynx.pm
132
lib/Travelynx.pm
|
@ -20,7 +20,6 @@ use List::Util;
|
|||
use List::UtilsBy qw(uniq_by);
|
||||
use List::MoreUtils qw(first_index);
|
||||
use Travel::Status::DE::DBWagenreihung;
|
||||
use Travel::Status::DE::IRIS::Stations;
|
||||
use Travelynx::Helper::DBDB;
|
||||
use Travelynx::Helper::HAFAS;
|
||||
use Travelynx::Helper::IRIS;
|
||||
|
@ -29,6 +28,7 @@ use Travelynx::Helper::Traewelling;
|
|||
use Travelynx::Model::InTransit;
|
||||
use Travelynx::Model::Journeys;
|
||||
use Travelynx::Model::JourneyStatsCache;
|
||||
use Travelynx::Model::Stations;
|
||||
use Travelynx::Model::Traewelling;
|
||||
use Travelynx::Model::Users;
|
||||
|
||||
|
@ -55,27 +55,6 @@ 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 startup {
|
||||
my ($self) = @_;
|
||||
|
||||
|
@ -227,19 +206,11 @@ sub startup {
|
|||
$self->attr(
|
||||
coordinates_by_station => sub {
|
||||
my $legacy_names = $self->app->renamed_station;
|
||||
my %location;
|
||||
for
|
||||
my $station ( Travel::Status::DE::IRIS::Stations::get_stations() )
|
||||
{
|
||||
if ( $station->[3] ) {
|
||||
$location{ $station->[1] }
|
||||
= [ $station->[4], $station->[3] ];
|
||||
}
|
||||
}
|
||||
my $location = $self->stations->get_latlon_by_name;
|
||||
while ( my ( $old_name, $new_name ) = each %{$legacy_names} ) {
|
||||
$location{$old_name} = $location{$new_name};
|
||||
$location->{$old_name} = $location->{$new_name};
|
||||
}
|
||||
return \%location;
|
||||
return $location;
|
||||
}
|
||||
);
|
||||
|
||||
|
@ -261,18 +232,6 @@ sub startup {
|
|||
}
|
||||
);
|
||||
|
||||
$self->attr(
|
||||
station_by_eva => sub {
|
||||
my %map;
|
||||
for
|
||||
my $station ( Travel::Status::DE::IRIS::Stations::get_stations() )
|
||||
{
|
||||
$map{ $station->[2] } = $station;
|
||||
}
|
||||
return \%map;
|
||||
}
|
||||
);
|
||||
|
||||
if ( not $self->app->config->{base_url} ) {
|
||||
$self->app->log->error(
|
||||
"travelynx.conf: 'base_url' is missing. Links in maintenance/work/worker-generated E-Mails will be incorrect. This variable was introduced in travelynx 1.22; see examples/travelynx.conf for documentation."
|
||||
|
@ -369,7 +328,7 @@ sub startup {
|
|||
in_transit => $self->in_transit,
|
||||
stats_cache => $self->journey_stats_cache,
|
||||
renamed_station => $self->app->renamed_station,
|
||||
station_by_eva => $self->app->station_by_eva,
|
||||
stations => $self->stations,
|
||||
);
|
||||
}
|
||||
);
|
||||
|
@ -409,6 +368,14 @@ sub startup {
|
|||
}
|
||||
);
|
||||
|
||||
$self->helper(
|
||||
stations => sub {
|
||||
my ($self) = @_;
|
||||
state $stations
|
||||
= Travelynx::Model::Stations->new( pg => $self->pg );
|
||||
}
|
||||
);
|
||||
|
||||
$self->helper(
|
||||
users => sub {
|
||||
my ($self) = @_;
|
||||
|
@ -457,7 +424,8 @@ sub startup {
|
|||
|
||||
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 );
|
||||
}
|
||||
|
@ -689,7 +657,7 @@ sub startup {
|
|||
($train) = List::Util::first { $_->train_id eq $train_id }
|
||||
@{ $status->{results} };
|
||||
if ( $train
|
||||
and $self->app->station_by_eva->{ $train->station_uic } )
|
||||
and $self->stations->get_by_eva( $train->station_uic ) )
|
||||
{
|
||||
$new_checkout_station_id = $train->station_uic;
|
||||
}
|
||||
|
@ -1426,17 +1394,17 @@ sub startup {
|
|||
if ($in_transit) {
|
||||
|
||||
if ( my $station
|
||||
= $self->app->station_by_eva->{ $in_transit->{dep_eva} } )
|
||||
= $self->stations->get_by_eva( $in_transit->{dep_eva} ) )
|
||||
{
|
||||
$in_transit->{dep_ds100} = $station->[0];
|
||||
$in_transit->{dep_name} = $station->[1];
|
||||
$in_transit->{dep_ds100} = $station->{ds100};
|
||||
$in_transit->{dep_name} = $station->{name};
|
||||
}
|
||||
if ( $in_transit->{arr_eva}
|
||||
and my $station
|
||||
= $self->app->station_by_eva->{ $in_transit->{arr_eva} } )
|
||||
= $self->stations->get_by_eva( $in_transit->{arr_eva} ) )
|
||||
{
|
||||
$in_transit->{arr_ds100} = $station->[0];
|
||||
$in_transit->{arr_name} = $station->[1];
|
||||
$in_transit->{arr_ds100} = $station->{ds100};
|
||||
$in_transit->{arr_name} = $station->{name};
|
||||
}
|
||||
|
||||
my @route = @{ $in_transit->{route} // [] };
|
||||
|
@ -1664,22 +1632,22 @@ sub startup {
|
|||
|
||||
if ( $latest_cancellation and $latest_cancellation->{cancelled} ) {
|
||||
if (
|
||||
my $station = $self->app->station_by_eva->{
|
||||
my $station = $self->stations->get_by_eva(
|
||||
$latest_cancellation->{dep_eva}
|
||||
}
|
||||
)
|
||||
)
|
||||
{
|
||||
$latest_cancellation->{dep_ds100} = $station->[0];
|
||||
$latest_cancellation->{dep_name} = $station->[1];
|
||||
$latest_cancellation->{dep_ds100} = $station->{ds100};
|
||||
$latest_cancellation->{dep_name} = $station->{name};
|
||||
}
|
||||
if (
|
||||
my $station = $self->app->station_by_eva->{
|
||||
my $station = $self->stations->get_by_eva(
|
||||
$latest_cancellation->{arr_eva}
|
||||
}
|
||||
)
|
||||
)
|
||||
{
|
||||
$latest_cancellation->{arr_ds100} = $station->[0];
|
||||
$latest_cancellation->{arr_name} = $station->[1];
|
||||
$latest_cancellation->{arr_ds100} = $station->{ds100};
|
||||
$latest_cancellation->{arr_name} = $station->{name};
|
||||
}
|
||||
}
|
||||
else {
|
||||
|
@ -1690,16 +1658,16 @@ sub startup {
|
|||
my $ts = $latest->{checkout_ts};
|
||||
my $action_time = epoch_to_dt($ts);
|
||||
if ( my $station
|
||||
= $self->app->station_by_eva->{ $latest->{dep_eva} } )
|
||||
= $self->stations->get_by_eva( $latest->{dep_eva} ) )
|
||||
{
|
||||
$latest->{dep_ds100} = $station->[0];
|
||||
$latest->{dep_name} = $station->[1];
|
||||
$latest->{dep_ds100} = $station->{ds100};
|
||||
$latest->{dep_name} = $station->{name};
|
||||
}
|
||||
if ( my $station
|
||||
= $self->app->station_by_eva->{ $latest->{arr_eva} } )
|
||||
= $self->stations->get_by_eva( $latest->{arr_eva} ) )
|
||||
{
|
||||
$latest->{arr_ds100} = $station->[0];
|
||||
$latest->{arr_name} = $station->[1];
|
||||
$latest->{arr_ds100} = $station->{ds100};
|
||||
$latest->{arr_name} = $station->{name};
|
||||
}
|
||||
return {
|
||||
checked_in => 0,
|
||||
|
@ -1816,28 +1784,18 @@ sub startup {
|
|||
}
|
||||
|
||||
if ( $status->{dep_eva} ) {
|
||||
my @station_descriptions
|
||||
= Travel::Status::DE::IRIS::Stations::get_station(
|
||||
$status->{dep_eva} );
|
||||
if ( @station_descriptions == 1 ) {
|
||||
(
|
||||
undef, undef, undef,
|
||||
$ret->{fromStation}{longitude},
|
||||
$ret->{fromStation}{latitude}
|
||||
) = @{ $station_descriptions[0] };
|
||||
if ( my $s = $self->stations->get_by_eva( $status->{dep_eva} ) )
|
||||
{
|
||||
$ret->{fromStation}{longitude} = $s->{lon};
|
||||
$ret->{fromStation}{latitude} = $s->{lat};
|
||||
}
|
||||
}
|
||||
|
||||
if ( $status->{arr_ds100} ) {
|
||||
my @station_descriptions
|
||||
= Travel::Status::DE::IRIS::Stations::get_station(
|
||||
$status->{arr_ds100} );
|
||||
if ( @station_descriptions == 1 ) {
|
||||
(
|
||||
undef, undef, undef,
|
||||
$ret->{toStation}{longitude},
|
||||
$ret->{toStation}{latitude}
|
||||
) = @{ $station_descriptions[0] };
|
||||
if ( $status->{arr_eva} ) {
|
||||
if ( my $s = $self->stations->get_by_eva( $status->{arr_eva} ) )
|
||||
{
|
||||
$ret->{toStation}{longitude} = $s->{lon};
|
||||
$ret->{toStation}{latitude} = $s->{lat};
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
|
|
@ -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)
|
||||
},
|
||||
);
|
||||
|
|
|
@ -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 ) = @_;
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
88
lib/Travelynx/Model/Stations.pm
Normal file
88
lib/Travelynx/Model/Stations.pm
Normal file
|
@ -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;
|
2603
share/old_stations.json
Normal file
2603
share/old_stations.json
Normal file
File diff suppressed because it is too large
Load diff
|
@ -1,5 +1,18 @@
|
|||
<h1>Changelog</h1>
|
||||
|
||||
<div class="row">
|
||||
<div class="col s12 m1 l1">
|
||||
1.28
|
||||
</div>
|
||||
<div class="col s12 m11 l11">
|
||||
<p>
|
||||
<i class="material-icons left" aria-label="Bugfix">build</i>
|
||||
Behandlung von nicht mehr im IRIS eingepflegten Stationen bei vergangenen Reisen.
|
||||
Bislang hatten diese zu unvollständigen Reisestatistiken geführt.
|
||||
</p>
|
||||
</div>
|
||||
</div>
|
||||
|
||||
<div class="row">
|
||||
<div class="col s12 m1 l1">
|
||||
1.27
|
||||
|
@ -219,7 +232,7 @@
|
|||
href="/account/privacy">Privatsphäre-Einstellungen</a> aktiv ist.
|
||||
</p>
|
||||
<p>
|
||||
<i class="material-icons left" aria-label="Bugfix">star</i>
|
||||
<i class="material-icons left" aria-label="Bugfix">build</i>
|
||||
Behandlung von Haltausfällen während der Reise bzw. nach dem Checkin.
|
||||
</p>
|
||||
</div>
|
||||
|
|
Loading…
Reference in a new issue