diff options
Diffstat (limited to 'lib/Travelynx.pm')
| -rwxr-xr-x | lib/Travelynx.pm | 3208 |
1 files changed, 1837 insertions, 1371 deletions
diff --git a/lib/Travelynx.pm b/lib/Travelynx.pm index 91de1c6..78642ff 100755 --- a/lib/Travelynx.pm +++ b/lib/Travelynx.pm @@ -1,6 +1,7 @@ package Travelynx; -# Copyright (C) 2020 Daniel Friesel +# Copyright (C) 2020-2023 Birte Kristina Friesel +# Copyright (C) 2025 networkException <git@nwex.de> # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -13,30 +14,32 @@ use Cache::File; use Crypt::Eksblowfish::Bcrypt qw(bcrypt en_base64); use DateTime; use DateTime::Format::Strptime; -use Encode qw(decode encode); +use Encode qw(decode encode); use File::Slurp qw(read_file); use JSON; use List::Util; -use List::UtilsBy qw(uniq_by); +use List::UtilsBy qw(uniq_by); use List::MoreUtils qw(first_index); -use Travel::Status::DE::DBWagenreihung; -use Travel::Status::DE::IRIS::Stations; +use Travel::Status::DE::DBRIS::Formation; use Travelynx::Helper::DBDB; +use Travelynx::Helper::DBRIS; +use Travelynx::Helper::EFA; use Travelynx::Helper::HAFAS; use Travelynx::Helper::IRIS; +use Travelynx::Helper::MOTIS; use Travelynx::Helper::Sendmail; 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; -use XML::LibXML; sub check_password { my ( $password, $hash ) = @_; - if ( bcrypt( $password, $hash ) eq $hash ) { + if ( bcrypt( substr( $password, 0, 10000 ), $hash ) eq $hash ) { return 1; } return 0; @@ -56,27 +59,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) = @_; @@ -94,6 +76,7 @@ sub startup { } chomp $self->config->{version}; + $self->defaults( version => $self->config->{version} // 'UNKNOWN' ); $self->plugin( authentication => { @@ -121,6 +104,23 @@ sub startup { }, } ); + + if ( my $oa = $self->config->{traewelling}{oauth} ) { + $self->plugin( + OAuth2 => { + providers => { + traewelling => { + key => $oa->{id}, + secret => $oa->{secret}, + authorize_url => +'https://traewelling.de/oauth/authorize?response_type=code', + token_url => 'https://traewelling.de/oauth/token', + } + } + } + ); + } + $self->sessions->default_expiration( 60 * 60 * 24 * 180 ); # Starting with v8.11, Mojolicious sends SameSite=Lax Cookies by default. @@ -128,7 +128,7 @@ sub startup { # security and usability for websites that want to maintain user's logged-in # session after the user arrives from an external link". In practice, # Safari (both iOS and macOS) does not send a SameSite=lax cookie when - # following a link from an external site. So, marudor.de providing a + # following a link from an external site. So, bahn.expert providing a # checkin link to travelynx.de/s/whatever does not work because the user # is not logged in due to Safari not sending the cookie. # @@ -144,10 +144,10 @@ sub startup { before_dispatch => sub { my ($self) = @_; - # The "theme" cookie is set client-side if the theme we delivered was - # changed by dark mode detection or by using the theme switcher. It's - # not part of Mojolicious' session data (and can't be, due to - # signing and HTTPOnly), so we need to add it here. + # The "theme" cookie is set client-side if the theme we delivered was + # changed by dark mode detection or by using the theme switcher. It's + # not part of Mojolicious' session data (and can't be, due to + # signing and HTTPOnly), so we need to add it here. for my $cookie ( @{ $self->req->cookies } ) { if ( $cookie->name eq 'theme' ) { $self->session( theme => $cookie->value ); @@ -161,11 +161,12 @@ sub startup { cache_iris_main => sub { my ($self) = @_; - return Cache::File->new( + state $cache = Cache::File->new( cache_root => $self->app->config->{cache}->{schedule}, default_expires => '6 hours', lock_level => Cache::File::LOCK_LOCAL(), ); + return $cache; } ); @@ -173,104 +174,79 @@ sub startup { cache_iris_rt => sub { my ($self) = @_; - return Cache::File->new( + state $cache = Cache::File->new( cache_root => $self->app->config->{cache}->{realtime}, default_expires => '70 seconds', lock_level => Cache::File::LOCK_LOCAL(), ); + return $cache; } ); + # 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( - token_type => sub { - return { - status => 1, - history => 2, - travel => 3, - import => 4, + ice_name => sub { + state $id_to_name = { + Travel::Status::DE::DBRIS::Formation::Group::name_to_designation( + ) }; - } - ); - $self->attr( - token_types => sub { - return [qw(status history travel import)]; + return $id_to_name; } ); $self->attr( - account_public_mask => sub { - return { - status_intern => 0x01, - status_extern => 0x02, - status_comment => 0x04, - history_intern => 0x10, - history_latest => 0x20, - history_full => 0x40, - }; + renamed_station => sub { + state $legacy_to_new = JSON->new->utf8->decode( + scalar read_file('share/old_station_names.json') ); + return $legacy_to_new; } ); - $self->attr( - journey_edit_mask => sub { - return { - sched_departure => 0x0001, - real_departure => 0x0002, - from_station => 0x0004, - route => 0x0010, - is_cancelled => 0x0020, - sched_arrival => 0x0100, - real_arrival => 0x0200, - to_station => 0x0400, - }; - } - ); + 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." + ); + } - $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() ) + $self->helper( + base_url_for => sub { + my ( $self, $path ) = @_; + if ( ( my $url = $self->url_for($path) )->base ne q{} + or not $self->app->config->{base_url} ) { - if ( $station->[3] ) { - $location{ $station->[1] } - = [ $station->[4], $station->[3] ]; - } - } - while ( my ( $old_name, $new_name ) = each %{$legacy_names} ) { - $location{$old_name} = $location{$new_name}; + return $url; } - return \%location; + return $self->url_for($path) + ->base( $self->app->config->{base_url} ); } ); -# 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/BahnhofsAbfahrten/blob/master/src/server/Reihung/ICENaming.ts - $self->attr( - ice_name => sub { - my $id_to_name = JSON->new->utf8->decode( - scalar read_file('share/ice_names.json') ); - return $id_to_name; - } - ); - - $self->attr( - renamed_station => sub { - my $legacy_to_new = JSON->new->utf8->decode( - scalar read_file('share/old_station_names.json') ); - return $legacy_to_new; + $self->helper( + efa => sub { + my ($self) = @_; + state $efa = Travelynx::Helper::EFA->new( + log => $self->app->log, + main_cache => $self->app->cache_iris_main, + realtime_cache => $self->app->cache_iris_rt, + root_url => $self->base_url_for('/')->to_abs, + user_agent => $self->ua, + version => $self->app->config->{version}, + ); } ); - $self->attr( - station_by_eva => sub { - my %map; - for - my $station ( Travel::Status::DE::IRIS::Stations::get_stations() ) - { - $map{ $station->[2] } = $station; - } - return \%map; + $self->helper( + dbris => sub { + my ($self) = @_; + state $dbris = Travelynx::Helper::DBRIS->new( + log => $self->app->log, + service_config => $self->app->config->{dbris}, + cache => $self->app->cache_iris_rt, + root_url => $self->base_url_for('/')->to_abs, + user_agent => $self->ua, + version => $self->app->config->{version}, + ); } ); @@ -279,9 +255,10 @@ sub startup { my ($self) = @_; state $hafas = Travelynx::Helper::HAFAS->new( log => $self->app->log, + service_config => $self->app->config->{hafas}, main_cache => $self->app->cache_iris_main, realtime_cache => $self->app->cache_iris_rt, - root_url => $self->url_for('/')->to_abs, + root_url => $self->base_url_for('/')->to_abs, user_agent => $self->ua, version => $self->app->config->{version}, ); @@ -295,13 +272,27 @@ sub startup { log => $self->app->log, main_cache => $self->app->cache_iris_main, realtime_cache => $self->app->cache_iris_rt, - root_url => $self->url_for('/')->to_abs, + root_url => $self->base_url_for('/')->to_abs, version => $self->app->config->{version}, ); } ); $self->helper( + motis => sub { + my ($self) = @_; + state $motis = Travelynx::Helper::MOTIS->new( + log => $self->app->log, + cache => $self->app->cache_iris_rt, + user_agent => $self->ua, + root_url => $self->base_url_for('/')->to_abs, + version => $self->app->config->{version}, + time_zone => 'Europe/Berlin', + ); + } + ); + + $self->helper( traewelling => sub { my ($self) = @_; state $trwl = Travelynx::Model::Traewelling->new( pg => $self->pg ); @@ -314,7 +305,7 @@ sub startup { state $trwl_api = Travelynx::Helper::Traewelling->new( log => $self->app->log, model => $self->traewelling, - root_url => $self->url_for('/')->to_abs, + root_url => $self->base_url_for('/')->to_abs, user_agent => $self->ua, version => $self->app->config->{version}, ); @@ -348,9 +339,10 @@ sub startup { 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, - station_by_eva => $self->app->station_by_eva, + stations => $self->stations, ); } ); @@ -391,6 +383,14 @@ sub startup { ); $self->helper( + stations => sub { + my ($self) = @_; + state $stations + = Travelynx::Model::Stations->new( pg => $self->pg ); + } + ); + + $self->helper( users => sub { my ($self) = @_; state $users = Travelynx::Model::Users->new( pg => $self->pg ); @@ -401,11 +401,12 @@ sub startup { dbdb => sub { my ($self) = @_; state $dbdb = Travelynx::Helper::DBDB->new( - log => $self->app->log, - cache => $self->app->cache_iris_main, - root_url => $self->url_for('/')->to_abs, - user_agent => $self->ua, - version => $self->app->config->{version}, + log => $self->app->log, + main_cache => $self->app->cache_iris_main, + realtime_cache => $self->app->cache_iris_rt, + root_url => $self->base_url_for('/')->to_abs, + user_agent => $self->ua, + version => $self->app->config->{version}, ); } ); @@ -433,87 +434,759 @@ sub startup { ); $self->helper( - 'grep_unknown_stations' => sub { - my ( $self, @stations ) = @_; + 'sprintf_km' => sub { + my ( $self, $km ) = @_; - my @unknown_stations; - for my $station (@stations) { - my $station_info = get_station($station); - if ( not $station_info ) { - push( @unknown_stations, $station ); - } + if ( $km < 1 ) { + return sprintf( '%.f m', $km * 1000 ); + } + if ( $km < 10 ) { + return sprintf( '%.1f km', $km ); + } + return sprintf( '%.f km', $km ); + } + ); + + $self->helper( + 'efa_load_icon' => sub { + my ( $self, $occupancy ) = @_; + + my @symbols + = ( + qw(help_outline person_outline people priority_high not_interested) + ); + + if ( $occupancy eq 'MANY_SEATS' ) { + $occupancy = 1; + } + elsif ( $occupancy eq 'FEW_SEATS' ) { + $occupancy = 2; + } + elsif ( $occupancy eq 'STANDING_ONLY' ) { + $occupancy = 3; + } + elsif ( $occupancy eq 'FULL' ) { + $occupancy = 4; + } + + return $symbols[$occupancy] // 'help_outline'; + } + ); + + $self->helper( + 'load_icon' => sub { + my ( $self, $load ) = @_; + my $first = $load->{FIRST} // 0; + my $second = $load->{SECOND} // 0; + + # DBRIS + if ( $first == 99 ) { + $first = 4; } - return @unknown_stations; + if ( $second == 99 ) { + $second = 4; + } + + my @symbols + = ( + qw(help_outline person_outline people priority_high not_interested) + ); + + return ( $symbols[$first], $symbols[$second] ); } ); $self->helper( - 'checkin' => sub { + 'visibility_icon' => sub { + my ( $self, $visibility ) = @_; + if ( $visibility eq 'public' ) { + return 'language'; + } + if ( $visibility eq 'travelynx' ) { + return 'lock_open'; + } + if ( $visibility eq 'followers' ) { + return 'group'; + } + if ( $visibility eq 'unlisted' ) { + return 'lock_outline'; + } + if ( $visibility eq 'private' ) { + return 'lock'; + } + return 'help_outline'; + } + ); + + $self->helper( + 'checkin_p' => sub { my ( $self, %opt ) = @_; my $station = $opt{station}; my $train_id = $opt{train_id}; + my $ts = $opt{ts}; my $uid = $opt{uid} // $self->current_user->{id}; - my $db = $opt{db} // $self->pg->db; + my $db = $opt{db} // $self->pg->db; + my $hafas; + + my $user = $self->get_user_status( $uid, $db ); + if ( $user->{checked_in} or $user->{cancelled} ) { + return Mojo::Promise->reject('You are already checked in'); + } + + if ( $opt{dbris} ) { + return $self->_checkin_dbris_p(%opt); + } + if ( $opt{efa} ) { + return $self->_checkin_efa_p(%opt); + } + if ( $opt{hafas} ) { + return $self->_checkin_hafas_p(%opt); + } + if ( $opt{motis} ) { + return $self->_checkin_motis_p(%opt); + } - my $status = $self->iris->get_departures( + my $promise = Mojo::Promise->new; + + $self->iris->get_departures_p( station => $station, lookbehind => 140, lookahead => 40 - ); - if ( $status->{errstr} ) { - return ( undef, $status->{errstr} ); - } - else { - my ($train) = List::Util::first { $_->train_id eq $train_id } - @{ $status->{results} }; - if ( not defined $train ) { - return ( undef, "Train ${train_id} not found" ); - } - else { + )->then( + sub { + my ($status) = @_; - my $user = $self->get_user_status( $uid, $db ); - if ( $user->{checked_in} or $user->{cancelled} ) { + if ( $status->{errstr} ) { + $promise->reject( $status->{errstr} ); + return; + } - if ( $user->{train_id} eq $train_id - and $user->{dep_eva} eq $status->{station_eva} ) - { - # checking in twice is harmless - return ( $train, undef ); - } + my $eva = $status->{station_eva}; + my $train = List::Util::first { $_->train_id eq $train_id } + @{ $status->{results} }; - # Otherwise, someone forgot to check out first - $self->checkout( - station => $station, - force => 1, - uid => $uid, - db => $db - ); + if ( not defined $train ) { + $promise->reject("Train ${train_id} not found"); + return; } eval { $self->in_transit->add( uid => $uid, db => $db, - departure_eva => $status->{station_eva}, + departure_eva => $eva, train => $train, - route => [ $self->iris->route_diff($train) ], + route => [ $self->iris->route_diff($train) ], + backend_id => + $self->stations->get_backend_id( iris => 1 ), ); }; if ($@) { $self->app->log->error( "Checkin($uid): INSERT failed: $@"); - return ( undef, 'INSERT failed: ' . $@ ); + $promise->reject( 'INSERT failed: ' . $@ ); + return; } - if ( not $opt{in_transaction} ) { - # mustn't be called during a transaction + # mustn't be called during a transaction + if ( not $opt{in_transaction} ) { $self->add_route_timestamps( $uid, $train, 1 ); + $self->add_wagonorder( + uid => $uid, + train_id => $train->train_id, + is_departure => 1, + eva => $eva, + datetime => $train->sched_departure, + train_type => $train->type, + train_no => $train->train_no + ); + $self->add_stationinfo( $uid, 1, $train->train_id, + $eva ); $self->run_hook( $uid, 'checkin' ); } - return ( $train, undef ); + + $promise->resolve($train); + return; } - } + )->catch( + sub { + my ( $err, $status ) = @_; + $promise->reject( $status->{errstr} ); + return; + } + )->wait; + + return $promise; + } + ); + + $self->helper( + '_checkin_motis_p' => sub { + my ( $self, %opt ) = @_; + + my $station = $opt{station}; + my $train_id = $opt{train_id}; + my $ts = $opt{ts}; + my $uid = $opt{uid} // $self->current_user->{id}; + my $db = $opt{db} // $self->pg->db; + my $hafas; + + my $promise = Mojo::Promise->new; + + $self->motis->get_trip_p( + service => $opt{motis}, + trip_id => $train_id, + )->then( + sub { + my ($trip) = @_; + my $found_stopover; + + for my $stopover ( $trip->stopovers ) { + if ( $stopover->stop->id eq $station ) { + $found_stopover = $stopover; + + # Lines may serve the same stop several times. + # Keep looking until the scheduled departure + # matches the one passed while checking in. + if ( $ts + and $stopover->scheduled_departure->epoch + == $ts ) + { + last; + } + } + } + + if ( not $found_stopover ) { + $promise->reject( +"Did not find stopover at '$station' within trip '$train_id'" + ); + return; + } + + for my $stopover ( $trip->stopovers ) { + $self->stations->add_or_update( + stop => $stopover->stop, + db => $db, + motis => $opt{motis}, + ); + } + + $self->stations->add_or_update( + stop => $found_stopover->stop, + db => $db, + motis => $opt{motis}, + ); + + eval { + $self->in_transit->add( + uid => $uid, + db => $db, + journey => $trip, + stopover => $found_stopover, + data => { trip_id => $train_id }, + backend_id => $self->stations->get_backend_id( + motis => $opt{motis} + ), + ); + }; + + if ($@) { + $self->app->log->error( + "Checkin($uid): INSERT failed: $@"); + $promise->reject( 'INSERT failed: ' . $@ ); + return; + } + + my $polyline; + if ( $trip->polyline ) { + my @station_list; + my @coordinate_list; + for my $coordinate ( $trip->polyline ) { + if ( $coordinate->{stop} ) { + if ( not defined $coordinate->{stop}->{eva} ) { + die(); + } + + push( + @coordinate_list, + [ + $coordinate->{lon}, + $coordinate->{lat}, + $coordinate->{stop}->{eva} + ] + ); + + push( @station_list, + $coordinate->{stop}->name ); + } + else { + push( @coordinate_list, + [ $coordinate->{lon}, $coordinate->{lat} ] + ); + } + } + + # equal length → polyline only consists of straight + # lines between stops. that's not helpful. + if ( @station_list == @coordinate_list ) { + $self->log->debug( 'Ignoring polyline for ' + . $trip->route_name + . ' as it only consists of straight lines between stops.' + ); + } + else { + $polyline = { + from_eva => + ( $trip->stopovers )[0]->stop->{eva}, + to_eva => ( $trip->stopovers )[-1]->stop->{eva}, + coords => \@coordinate_list, + }; + } + } + + if ($polyline) { + $self->in_transit->set_polyline( + uid => $uid, + db => $db, + polyline => $polyline, + ); + } + + # mustn't be called during a transaction + if ( not $opt{in_transaction} ) { + $self->run_hook( $uid, 'checkin' ); + } + + $promise->resolve($trip); + } + )->catch( + sub { + my ($err) = @_; + $promise->reject($err); + return; + } + )->wait; + + return $promise; + } + ); + + $self->helper( + '_checkin_dbris_p' => sub { + my ( $self, %opt ) = @_; + + my $station = $opt{station}; + my $train_id = $opt{train_id}; + my $train_suffix = $opt{train_suffix}; + my $ts = $opt{ts}; + my $uid = $opt{uid} // $self->current_user->{id}; + my $db = $opt{db} // $self->pg->db; + my $hafas; + + my $promise = Mojo::Promise->new; + + $self->dbris->get_journey_p( + trip_id => $train_id, + with_polyline => 1 + )->then( + sub { + my ($journey) = @_; + my $found; + for my $stop ( $journey->route ) { + if ( $stop->eva eq $station ) { + $found = $stop; + + # Lines may serve the same stop several times. + # Keep looking until the scheduled departure + # matches the one passed while checking in. + if ( $ts and $stop->sched_dep->epoch == $ts ) { + last; + } + } + } + if ( not $found ) { + $promise->reject( +"Did not find stop '$station' within journey '$train_id'" + ); + return; + } + for my $stop ( $journey->route ) { + $self->stations->add_or_update( + stop => $stop, + db => $db, + dbris => 'bahn.de', + ); + } + eval { + $self->in_transit->add( + uid => $uid, + db => $db, + journey => $journey, + stop => $found, + data => { trip_id => $train_id }, + backend_id => $self->stations->get_backend_id( + dbris => 'bahn.de' + ), + train_suffix => $train_suffix, + ); + }; + if ($@) { + $self->app->log->error( + "Checkin($uid): INSERT failed: $@"); + $promise->reject( 'INSERT failed: ' . $@ ); + return; + } + + my $polyline; + if ( $journey->polyline ) { + my @station_list; + my @coordinate_list; + for my $coord ( $journey->polyline ) { + if ( $coord->{stop} ) { + push( + @coordinate_list, + [ + $coord->{lon}, $coord->{lat}, + $coord->{stop}->eva + ] + ); + push( @station_list, $coord->{stop}->name ); + } + else { + push( @coordinate_list, + [ $coord->{lon}, $coord->{lat} ] ); + } + } + + # equal length → polyline only consists of straight + # lines between stops. that's not helpful. + if ( @station_list == @coordinate_list ) { + $self->log->debug( 'Ignoring polyline for ' + . $journey->train + . ' as it only consists of straight lines between stops.' + ); + } + else { + $polyline = { + from_eva => ( $journey->route )[0]->eva, + to_eva => ( $journey->route )[-1]->eva, + coords => \@coordinate_list, + }; + } + } + + if ($polyline) { + $self->in_transit->set_polyline( + uid => $uid, + db => $db, + polyline => $polyline, + ); + } + + # mustn't be called during a transaction + if ( not $opt{in_transaction} ) { + $self->run_hook( $uid, 'checkin' ); + $self->add_wagonorder( + uid => $uid, + train_id => $train_id, + is_departure => 1, + eva => $found->eva, + datetime => $found->sched_dep, + train_type => $journey->type, + train_no => $journey->train_no, + ); + $self->add_stationinfo( $uid, 1, $train_id, + $found->eva ); + } + + $promise->resolve($journey); + } + )->catch( + sub { + my ($err) = @_; + $promise->reject($err); + return; + } + )->wait; + + return $promise; + } + ); + + $self->helper( + '_checkin_efa_p' => sub { + my ( $self, %opt ) = @_; + my $station = $opt{station}; + my $trip_id = $opt{train_id}; + my $ts = $opt{ts}; + my $uid = $opt{uid} // $self->current_user->{id}; + my $db = $opt{db} // $self->pg->db; + + my $promise = Mojo::Promise->new; + $self->efa->get_journey_p( + service => $opt{efa}, + trip_id => $trip_id + )->then( + sub { + my ($journey) = @_; + + my $found; + for my $stop ( $journey->route ) { + if ( $stop->id_num == $station ) { + $found = $stop; + + # Lines may serve the same stop several times. + # Keep looking until the scheduled departure + # matches the one passed while checking in. + if ( $ts and $stop->sched_dep->epoch == $ts ) { + last; + } + } + } + if ( not $found ) { + $promise->reject( +"Did not find stop '$station' within journey '$trip_id'" + ); + return; + } + + for my $stop ( $journey->route ) { + $self->stations->add_or_update( + stop => $stop, + db => $db, + efa => $opt{efa}, + ); + } + + eval { + $self->in_transit->add( + uid => $uid, + db => $db, + journey => $journey, + stop => $found, + trip_id => $trip_id, + backend_id => $self->stations->get_backend_id( + efa => $opt{efa} + ), + ); + }; + if ($@) { + $self->app->log->error( + "Checkin($uid): INSERT failed: $@"); + $promise->reject( 'INSERT failed: ' . $@ ); + return; + } + + my $polyline; + if ( $journey->polyline ) { + my @station_list; + my @coordinate_list; + for my $coord ( $journey->polyline ) { + if ( $coord->{stop} ) { + push( + @coordinate_list, + [ + $coord->{lon}, $coord->{lat}, + $coord->{stop}->id_num + ] + ); + push( @station_list, + $coord->{stop}->full_name ); + } + else { + push( @coordinate_list, + [ $coord->{lon}, $coord->{lat} ] ); + } + } + + # equal length → polyline only consists of straight + # lines between stops. that's not helpful. + if ( @station_list == @coordinate_list ) { + $self->log->debug( 'Ignoring polyline for ' + . $journey->line + . ' as it only consists of straight lines between stops.' + ); + } + else { + $polyline = { + from_eva => ( $journey->route )[0]->id_num, + to_eva => ( $journey->route )[-1]->id_num, + coords => \@coordinate_list, + }; + } + } + + if ($polyline) { + $self->in_transit->set_polyline( + uid => $uid, + db => $db, + polyline => $polyline, + ); + } + + # mustn't be called during a transaction + if ( not $opt{in_transaction} ) { + $self->run_hook( $uid, 'checkin' ); + } + + $promise->resolve($journey); + + return; + } + )->catch( + sub { + my ($err) = @_; + $promise->reject($err); + return; + } + )->wait; + return $promise; + } + ); + + $self->helper( + '_checkin_hafas_p' => sub { + my ( $self, %opt ) = @_; + + my $station = $opt{station}; + my $train_id = $opt{train_id}; + my $ts = $opt{ts}; + my $uid = $opt{uid} // $self->current_user->{id}; + my $db = $opt{db} // $self->pg->db; + + my $promise = Mojo::Promise->new; + + $self->hafas->get_journey_p( + service => $opt{hafas}, + trip_id => $train_id, + with_polyline => 1 + )->then( + sub { + my ($journey) = @_; + my $found; + for my $stop ( $journey->route ) { + if ( $stop->loc->name eq $station + or $stop->loc->eva == $station ) + { + $found = $stop; + + # Lines may serve the same stop several times. + # Keep looking until the scheduled departure + # matches the one passed while checking in. + if ( $ts and $stop->sched_dep->epoch == $ts ) { + last; + } + } + } + if ( not $found ) { + $promise->reject( +"Did not find stop '$station' within journey '$train_id'" + ); + return; + } + for my $stop ( $journey->route ) { + $self->stations->add_or_update( + stop => $stop, + db => $db, + hafas => $opt{hafas}, + ); + } + eval { + $self->in_transit->add( + uid => $uid, + db => $db, + journey => $journey, + stop => $found, + data => { trip_id => $journey->id }, + backend_id => $self->stations->get_backend_id( + hafas => $opt{hafas} + ), + ); + }; + if ($@) { + $self->app->log->error( + "Checkin($uid): INSERT failed: $@"); + $promise->reject( 'INSERT failed: ' . $@ ); + return; + } + + my $polyline; + if ( $journey->polyline ) { + my @station_list; + my @coordinate_list; + for my $coord ( $journey->polyline ) { + if ( $coord->{name} ) { + push( + @coordinate_list, + [ + $coord->{lon}, $coord->{lat}, + $coord->{eva} + ] + ); + push( @station_list, $coord->{name} ); + } + else { + push( @coordinate_list, + [ $coord->{lon}, $coord->{lat} ] ); + } + } + + # equal length → polyline only consists of straight + # lines between stops. that's not helpful. + if ( @station_list == @coordinate_list ) { + $self->log->debug( 'Ignoring polyline for ' + . $journey->line + . ' as it only consists of straight lines between stops.' + ); + } + else { + $polyline = { + from_eva => ( $journey->route )[0]->loc->eva, + to_eva => ( $journey->route )[-1]->loc->eva, + coords => \@coordinate_list, + }; + } + } + + if ($polyline) { + $self->in_transit->set_polyline( + uid => $uid, + db => $db, + polyline => $polyline, + ); + } + + # mustn't be called during a transaction + if ( not $opt{in_transaction} ) { + $self->run_hook( $uid, 'checkin' ); + if ( $opt{hafas} eq 'DB' and $journey->class <= 16 ) { + $self->add_wagonorder( + uid => $uid, + train_id => $journey->id, + is_departure => 1, + eva => $found->loc->eva, + datetime => $found->sched_dep, + train_type => $journey->type, + train_no => $journey->number + ); + $self->add_stationinfo( $uid, 1, $journey->id, + $found->loc->eva ); + } + } + + $promise->resolve($journey); + } + )->catch( + sub { + my ($err) = @_; + $promise->reject($err); + return; + } + )->wait; + + return $promise; } ); @@ -554,6 +1227,26 @@ sub startup { delete $journey->{edited}; delete $journey->{id}; + # users may force checkouts at stations that are not part of + # the train's scheduled (or real-time) route. re-adding those + # to in-transit violates the assumption that each train has + # a valid destination. Remove the target in this case. + my $route = JSON->new->decode( $journey->{route} ); + my $found_checkout_id; + for my $stop ( @{$route} ) { + if ( $stop->[1] == $journey->{checkout_station_id} ) { + $found_checkout_id = 1; + last; + } + } + if ( not $found_checkout_id ) { + $journey->{checkout_station_id} = undef; + $journey->{checkout_time} = undef; + $journey->{arr_platform} = undef; + $journey->{sched_arrival} = undef; + $journey->{real_arrival} = undef; + } + $self->in_transit->add_from_journey( db => $db, journey => $journey @@ -587,27 +1280,46 @@ sub startup { ); $self->helper( - 'checkout' => sub { + 'checkout_p' => sub { my ( $self, %opt ) = @_; - my $station = $opt{station}; - my $force = $opt{force}; - my $uid = $opt{uid}; - my $db = $opt{db} // $self->pg->db; - my $status = $self->iris->get_departures( - station => $station, - lookbehind => 120, - lookahead => 120 - ); - $uid //= $self->current_user->{id}; - my $user = $self->get_user_status( $uid, $db ); - my $train_id = $user->{train_id}; + my $station = $opt{station}; + my $dep_eva = $opt{dep_eva}; + my $arr_eva = $opt{arr_eva}; + my $with_related = $opt{with_related} // 0; + my $force = $opt{force}; + my $uid = $opt{uid} // $self->current_user->{id}; + my $db = $opt{db} // $self->pg->db; + my $user = $self->get_user_status( $uid, $db ); + my $train_id = $user->{train_id}; + my $hafas = $opt{hafas}; + + my $promise = Mojo::Promise->new; + + if ( not $station ) { + $self->app->log->error("Checkout($uid): station is empty"); + return $promise->resolve( 1, + 'BUG: Checkout station is empty.' ); + } if ( not $user->{checked_in} and not $user->{cancelled} ) { - return ( 0, 'You are not checked into any train' ); + return $promise->resolve( 0, 'You are not checked in' ); + } + + if ( $dep_eva and $dep_eva != $user->{dep_eva} ) { + return $promise->resolve( 0, 'race condition' ); + } + if ( $arr_eva and $arr_eva != $user->{arr_eva} ) { + return $promise->resolve( 0, 'race condition' ); } - if ( $status->{errstr} and not $force ) { - return ( 1, $status->{errstr} ); + + if ( $user->{is_dbris} + or $user->{is_efa} + or $user->{is_hafas} + or $user->{is_motis} + or $train_id eq 'manual' ) + { + return $self->_checkout_journey_p(%opt); } my $now = DateTime->now( time_zone => 'Europe/Berlin' ); @@ -616,151 +1328,323 @@ sub startup { with_data => 1 ); - # Note that a train may pass the same station several times. - # Notable example: S41 / S42 ("Ringbahn") both starts and - # terminates at Berlin Südkreuz - my ($train) = List::Util::first { - $_->train_id eq $train_id - and $_->sched_arrival - and $_->sched_arrival->epoch > $user->{sched_departure}->epoch - } - @{ $status->{results} }; - - $train //= List::Util::first { $_->train_id eq $train_id } - @{ $status->{results} }; - - my $new_checkout_station_id = $status->{station_eva}; - - # When a checkout is triggered by a checkin, there is an edge case - # with related stations. - # Assume a user travels from A to B1, then from B2 to C. B1 and B2 are - # relatd stations (e.g. "Frankfurt Hbf" and "Frankfurt Hbf(tief)"). - # Now, if they check in for the journey from B2 to C, and have not yet - # checked out of the previous train, $train is undef as B2 is not B1. - # Redo the request with with_related => 1 to avoid this case. - # While at it, we increase the lookahead to handle long journeys as - # well. - if ( not $train ) { - $status = $self->iris->get_departures( - station => $station, - lookbehind => 120, - lookahead => 180, - with_related => 1 - ); - ($train) = List::Util::first { $_->train_id eq $train_id } - @{ $status->{results} }; - if ( $train - and $self->app->station_by_eva->{ $train->station_uic } ) - { - $new_checkout_station_id = $train->station_uic; - } - } + $self->iris->get_departures_p( + station => $station, + lookbehind => 120, + lookahead => 180, + with_related => $with_related, + )->then( + sub { + my ($status) = @_; + + my $new_checkout_station_id = $status->{station_eva}; + + # Store the intended checkout station regardless of this operation's + # success. + # TODO for with_related == 1, the correct EVA may be different + # and should be fetched from $train later on + $self->in_transit->set_arrival_eva( + uid => $uid, + db => $db, + arrival_eva => $new_checkout_station_id + ); - # Store the intended checkout station regardless of this operation's - # success. - $self->in_transit->set_arrival_eva( - uid => $uid, - db => $db, - arrival_eva => $new_checkout_station_id - ); + # If in_transit already contains arrival data for another estimated + # destination, we must invalidate it. + if ( defined $journey->{checkout_station_id} + and $journey->{checkout_station_id} + != $new_checkout_station_id ) + { + $self->in_transit->unset_arrival_data( + uid => $uid, + db => $db + ); + } - # If in_transit already contains arrival data for another estimated - # destination, we must invalidate it. - if ( defined $journey->{checkout_station_id} - and $journey->{checkout_station_id} - != $new_checkout_station_id ) - { - $self->in_transit->unset_arrival_data( - uid => $uid, - db => $db - ); - } + # Note that a train may pass the same station several times. + # Notable example: S41 / S42 ("Ringbahn") both starts and + # terminates at Berlin Südkreuz + my $train = List::Util::first { + $_->train_id eq $train_id + and $_->sched_arrival + and $_->sched_arrival->epoch + > $user->{sched_departure}->epoch + } + @{ $status->{results} }; - if ( not defined $train ) { + $train //= List::Util::first { $_->train_id eq $train_id } + @{ $status->{results} }; - # Arrival time via IRIS is unknown, so the train probably has not - # arrived yet. Fall back to HAFAS. - # TODO support cases where $station is EVA or DS100 code - if ( - my $station_data - = List::Util::first { $_->[0] eq $station } - @{ $journey->{route} } - ) - { - $station_data = $station_data->[1]; - 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+$} ) + if ( not defined $train ) { + + # Arrival time via IRIS is unknown, so the train probably + # has not arrived yet. Fall back to HAFAS. + # TODO support cases where $station is EVA or DS100 code + if ( + my $station_data + = List::Util::first { $_->[0] eq $station } + @{ $journey->{route} } + ) { - $rt_arr->add( minutes => $station_data->{adelay} ); + $station_data = $station_data->[2]; + if ( $station_data->{sched_arr} ) { + my $sched_arr + = epoch_to_dt( $station_data->{sched_arr} ); + 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, + db => $db, + sched_arrival => $sched_arr, + rt_arrival => $rt_arr + ); + } } - $self->in_transit->set_arrival_times( - uid => $uid, - db => $db, - sched_arrival => $sched_arr, - rt_arrival => $rt_arr + if ( not $force ) { + + # mustn't be called during a transaction + if ( not $opt{in_transaction} ) { + $self->run_hook( $uid, 'update' ); + } + $promise->resolve( 1, undef ); + return; + } + } + my $has_arrived = 0; + + eval { + + my $tx; + if ( not $opt{in_transaction} ) { + $tx = $db->begin; + } + + if ( defined $train + and not $train->arrival + and not $force ) + { + my $train_no = $train->train_no; + die("Train ${train_no} has no arrival timestamp\n"); + } + elsif ( defined $train and $train->arrival ) { + $self->in_transit->set_arrival( + uid => $uid, + db => $db, + train => $train, + ); + + $has_arrived + = $train->arrival->epoch < $now->epoch ? 1 : 0; + if ($has_arrived) { + my @unknown_stations + = $self->stations->grep_unknown( + $train->route ); + if (@unknown_stations) { + $self->app->log->warn( + sprintf( +'IRIS: Route of %s %s (%s -> %s) contains unknown stations: %s', + $train->type, + $train->train_no, + $train->origin, + $train->destination, + join( ', ', @unknown_stations ) + ) + ); + } + } + } + + $journey = $self->in_transit->get( + uid => $uid, + db => $db ); + + if ( $has_arrived or $force ) { + $self->journeys->add_from_in_transit( + db => $db, + journey => $journey + ); + $self->in_transit->delete( + uid => $uid, + db => $db + ); + + my $cache_ts = $now->clone; + if ( $journey->{real_departure} + =~ m{ ^ (?<year> \d{4} ) - (?<month> \d{2} ) }x + ) + { + $cache_ts->set( + year => $+{year}, + month => $+{month} + ); + } + $self->journey_stats_cache->invalidate( + ts => $cache_ts, + db => $db, + uid => $uid + ); + } + elsif ( defined $train + and $train->arrival_is_cancelled ) + { + + # This branch is only taken if the deparure was not cancelled, + # i.e., if the train was supposed to go here but got + # redirected or cancelled on the way and not from the start on. + # If the departure itself was cancelled, the user route is + # cancelled_from action -> 'cancelled journey' panel on main page + # -> cancelled_to action -> force checkout (causing the + # previous branch to be taken due to $force) + $journey->{cancelled} = 1; + $self->journeys->add_from_in_transit( + db => $db, + journey => $journey + ); + $self->in_transit->set_cancelled_destination( + uid => $uid, + db => $db, + cancelled_destination => $train->station, + ); + } + + if ( not $opt{in_transaction} ) { + $tx->commit; + } + }; + + if ($@) { + $self->app->log->error("Checkout($uid): $@"); + $promise->resolve( 1, 'Checkout error: ' . $@ ); + return; } - } - if ( not $force ) { - # mustn't be called during a transaction + if ( $has_arrived or $force ) { + if ( not $opt{in_transaction} ) { + $self->run_hook( $uid, 'checkout' ); + } + $promise->resolve( 0, undef ); + return; + } if ( not $opt{in_transaction} ) { $self->run_hook( $uid, 'update' ); + $self->add_route_timestamps( $uid, $train, 0, 1 ); + $self->add_wagonorder( + uid => $uid, + train_id => $train->train_id, + is_arrival => 1, + eva => $new_checkout_station_id, + datetime => $train->sched_departure, + train_type => $train->type, + train_no => $train->train_no + ); + $self->add_stationinfo( $uid, 0, $train->train_id, + $dep_eva, $new_checkout_station_id ); } - return ( 1, undef ); + $promise->resolve( 1, undef ); + return; + } - } + )->catch( + sub { + my ($err) = @_; + $promise->resolve( 1, $err ); + return; + } + )->wait; - my $has_arrived = 0; + return $promise; + } + ); - eval { + $self->helper( + '_checkout_journey_p' => sub { + my ( $self, %opt ) = @_; - my $tx; - if ( not $opt{in_transaction} ) { - $tx = $db->begin; - } + my $station = $opt{station}; + my $force = $opt{force}; + my $uid = $opt{uid} // $self->current_user->{id}; + my $db = $opt{db} // $self->pg->db; - if ( defined $train and not $train->arrival and not $force ) { - my $train_no = $train->train_no; - die("Train ${train_no} has no arrival timestamp\n"); - } - elsif ( defined $train and $train->arrival ) { - $self->in_transit->set_arrival( - uid => $uid, - db => $db, - train => $train, - route => [ $self->iris->route_diff($train) ] - ); + my $promise = Mojo::Promise->new; - $has_arrived = $train->arrival->epoch < $now->epoch ? 1 : 0; - if ($has_arrived) { - my @unknown_stations - = $self->grep_unknown_stations( $train->route ); - if (@unknown_stations) { - $self->app->log->warn( - sprintf( -'Route of %s %s (%s -> %s) contains unknown stations: %s', - $train->type, - $train->train_no, - $train->origin, - $train->destination, - join( ', ', @unknown_stations ) - ) - ); - } + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + my $journey = $self->in_transit->get( + uid => $uid, + db => $db, + with_data => 1, + with_timestamps => 1, + with_visibility => 1, + postprocess => 1, + ); + + # with_visibility needed due to postprocess + + my $found; + my $has_arrived; + for my $stop ( @{ $journey->{route_after} } ) { + if ( $station eq $stop->[0] or $station eq $stop->[1] ) { + $found = $stop; + $self->in_transit->set_arrival_eva( + uid => $uid, + db => $db, + arrival_eva => $stop->[1], + ); + if ( defined $journey->{checkout_station_id} + and $journey->{checkout_station_id} != $stop->{eva} ) + { + $self->in_transit->unset_arrival_data( + uid => $uid, + db => $db + ); + } + $self->in_transit->set_arrival_times( + uid => $uid, + db => $db, + sched_arrival => $stop->[2]{sched_arr}, + rt_arrival => + ( $stop->[2]{rt_arr} || $stop->[2]{sched_arr} ) + ); + if ($stop->[2]{platform}) { + $self->in_transit->set_arrival_platform( + uid => $uid, + db => $db, + arrival_platform => $stop->[2]{platform} + ); + } + if ( + $now > ( $stop->[2]{rt_arr} || $stop->[2]{sched_arr} ) ) + { + $has_arrived = 1; } + last; } + } + if ( not $found and not $force ) { + return $promise->resolve( 1, 'station not found in route' ); + } - $journey = $self->in_transit->get( - uid => $uid, - db => $db - ); + eval { + my $tx; + if ( not $opt{in_transaction} ) { + $tx = $db->begin; + } if ( $has_arrived or $force ) { + $journey = $self->in_transit->get( + uid => $uid, + db => $db + ); $self->journeys->add_from_in_transit( db => $db, journey => $journey @@ -785,15 +1669,11 @@ sub startup { uid => $uid ); } - elsif ( defined $train and $train->arrival_is_cancelled ) { - - # This branch is only taken if the deparure was not cancelled, - # i.e., if the train was supposed to go here but got - # redirected or cancelled on the way and not from the start on. - # If the departure itself was cancelled, the user route is - # cancelled_from action -> 'cancelled journey' panel on main page - # -> cancelled_to action -> force checkout (causing the - # previous branch to be taken due to $force) + elsif ( $found and $found->[2]{isCancelled} ) { + $journey = $self->in_transit->get( + uid => $uid, + db => $db + ); $journey->{cancelled} = 1; $self->journeys->add_from_in_transit( db => $db, @@ -802,31 +1682,30 @@ sub startup { $self->in_transit->set_cancelled_destination( uid => $uid, db => $db, - cancelled_destination => $train->station, + cancelled_destination => $found->[0], ); } - if ( not $opt{in_transaction} ) { + if ($tx) { $tx->commit; } }; if ($@) { $self->app->log->error("Checkout($uid): $@"); - return ( 1, 'Checkout error: ' . $@ ); + return $promise->resolve( 1, 'Checkout error: ' . $@ ); } if ( $has_arrived or $force ) { if ( not $opt{in_transaction} ) { $self->run_hook( $uid, 'checkout' ); } - return ( 0, undef ); + return $promise->resolve( 0, undef ); } if ( not $opt{in_transaction} ) { $self->run_hook( $uid, 'update' ); - $self->add_route_timestamps( $uid, $train, 0 ); } - return ( 1, undef ); + return $promise->resolve( 1, undef ); } ); @@ -839,92 +1718,7 @@ sub startup { $uid //= $self->current_user->{id}; - return $self->users->get_data( uid => $uid ); - } - ); - - $self->helper( - 'get_api_token' => sub { - my ( $self, $uid ) = @_; - $uid //= $self->current_user->{id}; - - my $token = {}; - my $res = $self->pg->db->select( - 'tokens', - [ 'type', 'token' ], - { user_id => $uid } - ); - - for my $entry ( $res->hashes->each ) { - $token->{ $self->app->token_types->[ $entry->{type} - 1 ] } - = $entry->{token}; - } - - return $token; - } - ); - - $self->helper( - 'get_webhook' => sub { - my ( $self, $uid ) = @_; - $uid //= $self->current_user->{id}; - - my $res_h - = $self->pg->db->select( 'webhooks_str', '*', - { user_id => $uid } )->hash; - - $res_h->{latest_run} = epoch_to_dt( $res_h->{latest_run_ts} ); - - return $res_h; - } - ); - - $self->helper( - 'set_webhook' => sub { - my ( $self, %opt ) = @_; - - $opt{uid} //= $self->current_user->{id}; - - if ( $opt{token} ) { - $opt{token} =~ tr{\r\n}{}d; - } - - my $res = $self->pg->db->insert( - 'webhooks', - { - user_id => $opt{uid}, - enabled => $opt{enabled}, - url => $opt{url}, - token => $opt{token} - }, - { - on_conflict => \ -'(user_id) do update set enabled = EXCLUDED.enabled, url = EXCLUDED.url, token = EXCLUDED.token, errored = null, latest_run = null, output = null' - } - ); - } - ); - - $self->helper( - 'mark_hook_status' => sub { - my ( $self, $uid, $url, $success, $text ) = @_; - - if ( length($text) > 1000 ) { - $text = substr( $text, 0, 1000 ) . '…'; - } - - $self->pg->db->update( - 'webhooks', - { - errored => $success ? 0 : 1, - latest_run => DateTime->now( time_zone => 'Europe/Berlin' ), - output => $text, - }, - { - user_id => $uid, - url => $url - } - ); + return $self->users->get( uid => $uid ); } ); @@ -932,7 +1726,7 @@ sub startup { 'run_hook' => sub { my ( $self, $uid, $reason, $callback ) = @_; - my $hook = $self->get_webhook($uid); + my $hook = $self->users->get_webhook( uid => $uid ); if ( not $hook->{enabled} or not $hook->{url} =~ m{^ https?:// }x ) { @@ -942,7 +1736,7 @@ sub startup { return; } - my $status = $self->get_user_status_json_v1($uid); + my $status = $self->get_user_status_json_v1( uid => $uid ); my $header = {}; my $hook_body = { reason => $reason, @@ -967,12 +1761,20 @@ sub startup { sub { my ($tx) = @_; if ( my $err = $tx->error ) { - $self->mark_hook_status( $uid, $hook->{url}, 0, - "HTTP $err->{code} $err->{message}" ); + $self->users->update_webhook_status( + uid => $uid, + url => $hook->{url}, + success => 0, + text => "HTTP $err->{code} $err->{message}" + ); } else { - $self->mark_hook_status( $uid, $hook->{url}, 1, - $tx->result->body ); + $self->users->update_webhook_status( + uid => $uid, + url => $hook->{url}, + success => 1, + text => $tx->result->body + ); } if ($callback) { &$callback(); @@ -982,7 +1784,12 @@ sub startup { )->catch( sub { my ($err) = @_; - $self->mark_hook_status( $uid, $hook->{url}, 0, $err ); + $self->users->update_webhook_status( + uid => $uid, + url => $hook->{url}, + success => 0, + text => $err + ); if ($callback) { &$callback(); } @@ -993,235 +1800,258 @@ sub startup { ); $self->helper( - 'add_route_timestamps' => sub { - my ( $self, $uid, $train, $is_departure ) = @_; + 'add_wagonorder' => sub { + my ( $self, %opt ) = @_; + + my $uid = $opt{uid}; + my $train_id = $opt{train_id}; + my $train_type = $opt{train_type}; + my $train_no = $opt{train_no}; + my $eva = $opt{eva}; + my $datetime = $opt{datetime}; $uid //= $self->current_user->{id}; my $db = $self->pg->db; -# TODO "with_timestamps" is misleading, there are more differences between in_transit and in_transit_str -# Here it's only needed because of dep_eva / arr_eva names - my $journey = $self->in_transit->get( - db => $db, - uid => $uid, - with_data => 1, - with_timestamps => 1 - ); - - if ( not $journey ) { - return; - } - - if ( $journey->{data}{trip_id} - and not $journey->{polyline} ) - { - my ( $origin_eva, $destination_eva, $polyline_str ); - $self->hafas->get_polyline_p( $train, - $journey->{data}{trip_id} )->then( + if ( $datetime and $train_no ) { + $self->dbdb->has_wagonorder_p(%opt)->then( sub { - my ($ret) = @_; - my $polyline = $ret->{polyline}; - $origin_eva = 0 + $ret->{raw}{origin}{id}; - $destination_eva = 0 + $ret->{raw}{destination}{id}; - - # work around Cache::File turning floats into strings - for my $coord ( @{$polyline} ) { - @{$coord} = map { 0 + $_ } @{$coord}; - } + return $self->dbdb->get_wagonorder_p(%opt); + } + )->then( + sub { + my ($wagonorder) = @_; - $polyline_str = JSON->new->encode($polyline); + my $data = {}; + my $user_data = {}; - my $pl_res = $db->select( - 'polylines', - ['id'], - { - origin_eva => $origin_eva, - destination_eva => $destination_eva, - polyline => $polyline_str - }, - { limit => 1 } - ); + my $wr; + eval { + $wr + = Travel::Status::DE::DBRIS::Formation->new( + json => $wagonorder ); + }; - my $polyline_id; - if ( my $h = $pl_res->hash ) { - $polyline_id = $h->{id}; - } - else { - eval { - $polyline_id = $db->insert( - 'polylines', - { - origin_eva => $origin_eva, - destination_eva => $destination_eva, - polyline => $polyline_str - }, - { returning => 'id' } - )->hash->{id}; + if ( $opt{is_departure} + and $wr + and not exists $wagonorder->{error} ) + { + my $dt + = $opt{datetime}->clone->set_time_zone('UTC'); + $data->{wagonorder_dep} = $wagonorder; + $data->{wagonorder_param} = { + time => $dt->rfc3339 =~ s{(?=Z)}{.000}r, + number => $opt{train_no}, + evaNumber => $opt{eva}, + administrationId => 80, + date => $dt->strftime('%Y-%m-%d'), + category => $opt{train_type}, }; - if ($@) { - $self->app->log->warn( - "add_route_timestamps: insert polyline: $@" + $user_data->{wagongroups} = []; + for my $group ( $wr->groups ) { + my @wagons; + for my $wagon ( $group->carriages ) { + push( + @wagons, + { + id => $wagon->uic_id, + number => $wagon->number, + type => $wagon->type, + } + ); + } + push( + @{ $user_data->{wagongroups} }, + { + name => $group->name, + desc => $group->desc_short, + description => $group->description, + designation => $group->designation, + to => $group->destination, + type => $group->train_type, + no => $group->train_no, + wagons => [@wagons], + } ); + if ( $group->{name} + and $group->{name} eq 'ICE0304' ) + { + $data->{wagonorder_pride} = 1; + } } + $self->in_transit->update_data( + uid => $uid, + db => $db, + data => $data, + train_id => $train_id, + ); + $self->in_transit->update_user_data( + uid => $uid, + db => $db, + user_data => $user_data, + train_id => $train_id, + ); } - if ($polyline_id) { - $self->in_transit->set_polyline_id( - uid => $uid, - db => $db, - polyline_id => $polyline_id + elsif ( $opt{is_arrival} + and not exists $wagonorder->{error} ) + { + $data->{wagonorder_arr} = $wagonorder; + $self->in_transit->update_data( + uid => $uid, + db => $db, + data => $data, + train_id => $train_id, ); } return; } )->catch( sub { - my ($err) = @_; - if ( $err =~ m{extra content at the end}i ) { - $self->app->log->debug( - "add_route_timestamps: $err"); - } - else { - $self->app->log->warn("add_route_timestamps: $err"); - } + # no wagonorder? no problem. return; } )->wait; } + } + ); - my ($platform) = ( ( $train->platform // 0 ) =~ m{(\d+)} ); - - my $route = $journey->{route}; - - my $base - = 'https://reiseauskunft.bahn.de/bin/trainsearch.exe/dn?L=vs_json.vs_hap&start=yes&rt=1'; - my $date_yy = $train->start->strftime('%d.%m.%y'); - my $date_yyyy = $train->start->strftime('%d.%m.%Y'); - my $train_no = $train->type . ' ' . $train->train_no; - - my ( $trainlink, $route_data ); + # This helper is only ever called from an IRIS context. + # HAFAS already has all relevant information. + $self->helper( + 'add_route_timestamps' => sub { + my ( $self, $uid, $train, $is_departure, $update_polyline ) = @_; - $self->hafas->get_json_p( - "${base}&date=${date_yy}&trainname=${train_no}")->then( - sub { - my ($trainsearch) = @_; + $uid //= $self->current_user->{id}; - # Fallback: Take first result - my $result = $trainsearch->{suggestions}[0]; - $trainlink = $result->{trainLink}; + my $db = $self->pg->db; - # Try finding a result for the current date - for - my $suggestion ( @{ $trainsearch->{suggestions} // [] } ) - { + # TODO "with_timestamps" is misleading, there are more differences between in_transit and in_transit_str + # Here it's only needed because of dep_eva / arr_eva names + my $in_transit = $self->in_transit->get( + db => $db, + uid => $uid, + with_data => 1, + with_timestamps => 1 + ); - # Drunken API, sail with care. Both date formats are used interchangeably - if ( - $suggestion->{depDate} - and ( $suggestion->{depDate} eq $date_yy - or $suggestion->{depDate} eq $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 ( $suggestion->{dep} eq $train->origin ) { - $result = $suggestion; - $trainlink = $suggestion->{trainLink}; - last; - } - } - } + if ( not $in_transit ) { + return; + } - if ( not $trainlink ) { - $self->app->log->debug("trainlink not found"); - return Mojo::Promise->reject("trainlink not found"); - } + my $route = $in_transit->{route}; + my $train_id = $train->train_id; - # Calculate and store trip_id. - # 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 = $date_yyyy; - $date_map =~ tr{.}{}d; - my $trip_id = sprintf( '1|%d|%d|%d|%s', - $result->{id}, $result->{cycle}, - $result->{pool}, $date_map ); + my $tripid_promise; - $self->in_transit->update_data( - uid => $uid, - db => $db, - data => { trip_id => $trip_id } - ); + if ( $in_transit->{data}{trip_id} ) { + $tripid_promise + = Mojo::Promise->resolve( $in_transit->{data}{trip_id} ); + } + else { + $tripid_promise = $self->hafas->get_tripid_p( train => $train ); + } - 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( + $tripid_promise->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 ($trip_id) = @_; - 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, - }; + if ( not $in_transit->{extra_data}{trip_id} ) { + $self->in_transit->update_data( + uid => $uid, + db => $db, + data => { trip_id => $trip_id }, + train_id => $train_id, + ); } - 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_p( + train => $train, + trip_id => $trip_id, + with_polyline => ( + $update_polyline + or not $in_transit->{polyline} + ) ? 1 : 0, ); } )->then( sub { - my ($traininfo2) = @_; + my ( $new_route, $journey, $polyline ) = @_; + my $db_route; - for my $station ( keys %{$route_data} ) { - for my $key ( - keys %{ $traininfo2->{station}{$station} // {} } ) - { - $route_data->{$station}{$key} - = $traininfo2->{station}{$station}{$key}; + for my $stop ( $journey->route ) { + $self->stations->add_or_update( + stop => $stop, + db => $db, + iris => 1, + ); + } + + for my $i ( 0 .. $#{$new_route} ) { + my $old_name = $route->[$i][0]; + my $old_eva = $route->[$i][1]; + my $old_entry = $route->[$i][2]; + my $new_name = $new_route->[$i]->{name}; + my $new_eva = $new_route->[$i]->{eva}; + my $new_entry = $new_route->[$i]; + + if ( defined $old_name and $old_name eq $new_name ) { + if ( $old_entry->{rt_arr} + and not $new_entry->{rt_arr} ) + { + $new_entry->{rt_arr} = $old_entry->{rt_arr}; + $new_entry->{arr_delay} + = $old_entry->{arr_delay}; + } + if ( $old_entry->{rt_dep} + and not $new_entry->{rt_dep} ) + { + $new_entry->{rt_dep} = $old_entry->{rt_dep}; + $new_entry->{dep_delay} + = $old_entry->{dep_delay}; + } } + + push( + @{$db_route}, + [ + $new_name, + $new_eva, + { + sched_arr => $new_entry->{sched_arr}, + rt_arr => $new_entry->{rt_arr}, + arr_delay => $new_entry->{arr_delay}, + sched_dep => $new_entry->{sched_dep}, + rt_dep => $new_entry->{rt_dep}, + dep_delay => $new_entry->{dep_delay}, + tz_offset => $new_entry->{tz_offset}, + isAdditional => $new_entry->{isAdditional}, + isCancelled => $new_entry->{isCancelled}, + load => $new_entry->{load}, + lat => $new_entry->{lat}, + lon => $new_entry->{lon}, + } + ] + ); } - for my $station ( @{$route} ) { - $station->[1] - = $route_data->{ $station->[0] }; + my @messages; + for my $m ( $journey->messages ) { + if ( not $m->code ) { + push( + @messages, + { + header => $m->short, + lead => $m->text, + } + ); + } } $self->in_transit->set_route_data( uid => $uid, db => $db, - route => $route, + route => $db_route, delay_messages => [ map { [ $_->[0]->epoch, $_->[1] ] } $train->delay_messages @@ -1230,119 +2060,51 @@ sub startup { map { [ $_->[0]->epoch, $_->[1] ] } $train->qos_messages ], - him_messages => $traininfo2->{messages}, + him_messages => \@messages, + train_id => $train_id, ); + + if ($polyline) { + $self->in_transit->set_polyline( + uid => $uid, + db => $db, + polyline => $polyline, + old_id => $in_transit->{polyline_id}, + train_id => $train_id, + ); + } + return; } )->catch( sub { my ($err) = @_; - if ( $err - =~ m{trainlink not found|extra content at the end}i ) - { - $self->app->log->debug("add_route_timestamps: $err"); - } - else { - $self->app->log->warn("add_route_timestamps: $err"); - } + $self->app->log->debug("add_route_timestamps: $err"); return; } )->wait; + } + ); - if ( $train->sched_departure ) { - $self->dbdb->has_wagonorder_p( $train->sched_departure, - $train->train_no )->then( - sub { - my ($api) = @_; - return $self->dbdb->get_wagonorder_p( $api, - $train->sched_departure, $train->train_no ); - } - )->then( - sub { - my ($wagonorder) = @_; - - my $data = {}; - my $user_data = {}; + $self->helper( + 'add_stationinfo' => sub { + my ( $self, $uid, $is_departure, $train_id, $dep_eva, $arr_eva ) + = @_; - if ( $is_departure and not exists $wagonorder->{error} ) - { - $data->{wagonorder_dep} = $wagonorder; - $user_data->{wagongroups} = []; - for my $group ( - @{ - $wagonorder->{data}{istformation} - {allFahrzeuggruppe} // [] - } - ) - { - my @wagons; - for - my $wagon ( @{ $group->{allFahrzeug} // [] } ) - { - push( - @wagons, - { - id => $wagon->{fahrzeugnummer}, - number => - $wagon->{wagenordnungsnummer}, - type => $wagon->{fahrzeugtyp}, - } - ); - } - push( - @{ $user_data->{wagongroups} }, - { - name => - $group->{fahrzeuggruppebezeichnung}, - from => - $group->{startbetriebsstellename}, - to => $group->{zielbetriebsstellename}, - no => $group->{verkehrlichezugnummer}, - wagons => [@wagons], - } - ); - } - $self->in_transit->update_data( - uid => $uid, - db => $db, - data => $data - ); - $self->in_transit->update_user_data( - uid => $uid, - db => $db, - user_data => $user_data - ); - } - elsif ( not $is_departure - and not exists $wagonorder->{error} ) - { - $data->{wagonorder_arr} = $wagonorder; - $self->in_transit->update_data( - uid => $uid, - db => $db, - data => $data - ); - } - return; - } - )->catch( - sub { - # no wagonorder? no problem. - return; - } - )->wait; - } + $uid //= $self->current_user->{id}; + my $db = $self->pg->db; if ($is_departure) { - $self->dbdb->get_stationinfo_p( $journey->{dep_eva} )->then( + $self->dbdb->get_stationinfo_p($dep_eva)->then( sub { my ($station_info) = @_; my $data = { stationinfo_dep => $station_info }; $self->in_transit->update_data( - uid => $uid, - db => $db, - data => $data + uid => $uid, + db => $db, + data => $data, + train_id => $train_id, ); return; } @@ -1354,16 +2116,17 @@ sub startup { )->wait; } - if ( $journey->{arr_eva} and not $is_departure ) { - $self->dbdb->get_stationinfo_p( $journey->{arr_eva} )->then( + if ( $arr_eva and not $is_departure ) { + $self->dbdb->get_stationinfo_p($arr_eva)->then( sub { my ($station_info) = @_; my $data = { stationinfo_arr => $station_info }; $self->in_transit->update_data( - uid => $uid, - db => $db, - data => $data + uid => $uid, + db => $db, + data => $data, + train_id => $train_id, ); return; } @@ -1378,249 +2141,27 @@ sub startup { ); $self->helper( - 'get_latest_dest_id' => sub { - my ( $self, %opt ) = @_; - - my $uid = $opt{uid} // $self->current_user->{id}; - my $db = $opt{db} // $self->pg->db; - - if ( - my $id = $self->in_transit->get_checkout_station_id( - uid => $uid, - db => $db - ) - ) - { - return $id; - } - - return $self->journeys->get_latest_checkout_station_id( - uid => $uid, - db => $db - ); - } - ); - - $self->helper( - 'get_connection_targets' => sub { - my ( $self, %opt ) = @_; - - my $uid = $opt{uid} //= $self->current_user->{id}; - my $threshold = $opt{threshold} - // DateTime->now( time_zone => 'Europe/Berlin' ) - ->subtract( months => 4 ); - my $db = $opt{db} //= $self->pg->db; - my $min_count = $opt{min_count} // 3; - - if ( $opt{destination_name} ) { - return ( $opt{destination_name} ); - } - - my $dest_id = $opt{eva} // $self->get_latest_dest_id(%opt); - - if ( not $dest_id ) { - return; - } - - my $res = $db->query( - qq{ - select - count(checkout_station_id) as count, - checkout_station_id as dest - from journeys - where user_id = ? - and checkin_station_id = ? - and real_departure > ? - group by checkout_station_id - order by count desc; - }, - $uid, - $dest_id, - $threshold - ); - my @destinations - = $res->hashes->grep( sub { shift->{count} >= $min_count } ) - ->map( sub { shift->{dest} } )->each; - @destinations - = grep { $self->app->station_by_eva->{$_} } @destinations; - @destinations - = map { $self->app->station_by_eva->{$_}->[1] } @destinations; - return @destinations; - } - ); - - $self->helper( - 'get_connecting_trains' => sub { - my ( $self, %opt ) = @_; - - my $uid = $opt{uid} //= $self->current_user->{id}; - my $use_history = $self->users->use_history( uid => $uid ); - - my ( $eva, $exclude_via, $exclude_train_id, $exclude_before ); - my $now = $self->now->epoch; - my ( $stationinfo, $arr_epoch, $arr_platform ); - - if ( $opt{eva} ) { - if ( $use_history & 0x01 ) { - $eva = $opt{eva}; - } - elsif ( $opt{destination_name} ) { - $eva = $opt{eva}; - } + 'resolve_sb_template' => sub { + my ( $self, $template, %opt ) = @_; + my $ret = $template; + my $name = $opt{name} =~ s{/}{%2F}gr; + $ret =~ s{[{]eva[}]}{$opt{eva}}g; + $ret =~ s{[{]name[}]}{$name}g; + $ret =~ s{[{]tt[}]}{$opt{tt}}g; + $ret =~ s{[{]tn[}]}{$opt{tn}}g; + $ret =~ s{[{]id[}]}{$opt{id}}g; + $ret =~ s{[{]dbris[}]}{$opt{dbris}}g; + $ret =~ s{[{]efa[}]}{$opt{efa}}g; + $ret =~ s{[{]hafas[}]}{$opt{hafas}}g; + $ret =~ s{[{]motis[}]}{$opt{motis}}g; + + if ( $opt{id} and not $opt{is_iris} ) { + $ret =~ s{[{]id_or_tttn[}]}{$opt{id}}g; } else { - if ( $use_history & 0x02 ) { - my $status = $self->get_user_status; - $eva = $status->{arr_eva}; - $exclude_via = $status->{dep_name}; - $exclude_train_id = $status->{train_id}; - $arr_platform = $status->{arr_platform}; - $stationinfo = $status->{extra_data}{stationinfo_arr}; - if ( $status->{real_arrival} ) { - $exclude_before = $arr_epoch - = $status->{real_arrival}->epoch; - } - } - } - - $exclude_before //= $now - 300; - - if ( not $eva ) { - return; - } - - my @destinations = $self->get_connection_targets(%opt); - - if ($exclude_via) { - @destinations = grep { $_ ne $exclude_via } @destinations; + $ret =~ s{[{]id_or_tttn[}]}{$opt{tt}$opt{tn}}g; } - - if ( not @destinations ) { - return; - } - - my $stationboard = $self->iris->get_departures( - station => $eva, - lookbehind => 10, - lookahead => 40, - with_related => 1 - ); - if ( $stationboard->{errstr} ) { - return; - } - @{ $stationboard->{results} } = map { $_->[0] } - sort { $a->[1] <=> $b->[1] } - map { [ $_, $_->departure ? $_->departure->epoch : 0 ] } - @{ $stationboard->{results} }; - my @results; - my @cancellations; - my %via_count = map { $_ => 0 } @destinations; - for my $train ( @{ $stationboard->{results} } ) { - if ( not $train->departure ) { - next; - } - if ( $exclude_before - and $train->departure - and $train->departure->epoch < $exclude_before ) - { - next; - } - if ( $exclude_train_id - and $train->train_id eq $exclude_train_id ) - { - next; - } - - # In general, this function is meant to return feasible - # connections. However, cancelled connections may also be of - # interest and are also useful for logging cancellations. - # To satisfy both demands with (hopefully) little confusion and - # UI clutter, this function returns two concatenated arrays: - # actual connections (ordered by actual departure time) followed - # by cancelled connections (ordered by scheduled departure time). - # This is easiest to achieve in two separate loops. - # - # Note that a cancelled train may still have a matching destination - # in its route_post, e.g. if it leaves out $eva due to - # unscheduled route changes but continues on schedule afterwards - # -- so it is only cancelled at $eva, not on the remainder of - # the route. Also note that this specific case is not yet handled - # properly by the cancellation logic etc. - - if ( $train->departure_is_cancelled ) { - my @via - = ( $train->sched_route_post, $train->sched_route_end ); - for my $dest (@destinations) { - if ( List::Util::any { $_ eq $dest } @via ) { - push( @cancellations, [ $train, $dest ] ); - next; - } - } - } - else { - my @via = ( $train->route_post, $train->route_end ); - for my $dest (@destinations) { - if ( $via_count{$dest} < 2 - and List::Util::any { $_ eq $dest } @via ) - { - push( @results, [ $train, $dest ] ); - - # Show all past and up to two future departures per destination - if ( not $train->departure - or $train->departure->epoch >= $now ) - { - $via_count{$dest}++; - } - next; - } - } - } - } - - @results = map { $_->[0] } - sort { $a->[1] <=> $b->[1] } - map { - [ - $_, - $_->[0]->departure->epoch // $_->[0]->sched_departure->epoch - ] - } @results; - @cancellations = map { $_->[0] } - sort { $a->[1] <=> $b->[1] } - map { [ $_, $_->[0]->sched_departure->epoch ] } @cancellations; - - for my $result (@results) { - my $train = $result->[0]; - my @message_ids - = List::Util::uniq map { $_->[1] } $train->raw_messages; - $train->{message_id} = { map { $_ => 1 } @message_ids }; - my $interchange_duration; - if ( exists $stationinfo->{i} ) { - $interchange_duration - = $stationinfo->{i}{$arr_platform}{ $train->platform }; - $interchange_duration //= $stationinfo->{i}{"*"}; - } - if ( defined $interchange_duration ) { - my $interchange_time - = ( $train->departure->epoch - $arr_epoch ) / 60; - if ( $interchange_time < $interchange_duration ) { - $train->{interchange_text} = 'Anschluss knapp'; - $train->{interchange_icon} = 'warning'; - } - elsif ( $interchange_time == $interchange_duration ) { - $train->{interchange_text} - = 'Anschluss könnte knapp werden'; - $train->{interchange_icon} = 'directions_run'; - } - - #else { - # $train->{interchange_text} = 'Anschluss wird voraussichtlich erreicht'; - # $train->{interchange_icon} = 'check'; - #} - } - } - - return ( @results, @cancellations ); + return $ret; } ); @@ -1650,14 +2191,14 @@ sub startup { my $wr; eval { $wr - = Travel::Status::DE::DBWagenreihung->new( - from_json => $wagonorder ); + = Travel::Status::DE::DBRIS::Formation->new( + json => $wagonorder ); }; if ( $wr - and $wr->sections + and $wr->sectors and defined $wr->direction ) { - my $section_0 = ( $wr->sections )[0]; + my $section_0 = ( $wr->sectors )[0]; my $direction = $wr->direction; if ( $section_0->name eq 'A' and $direction == 0 ) @@ -1688,21 +2229,17 @@ sub startup { for my $station ( @{ $journey->{route_after} } ) { my $station_desc = $station->[0]; - if ( $station->[1]{rt_arr} ) { - $station_desc .= $station->[1]{sched_arr}->strftime(';%s'); - $station_desc .= $station->[1]{rt_arr}->strftime(';%s'); - if ( $station->[1]{rt_dep} ) { - $station_desc - .= $station->[1]{sched_dep}->strftime(';%s'); - $station_desc .= $station->[1]{rt_dep}->strftime(';%s'); - } - else { - $station_desc .= ';0;0'; - } - } - else { - $station_desc .= ';0;0;0;0'; - } + + my $sa = $station->[2]{sched_arr}; + my $ra = $station->[2]{rt_arr} || $station->[2]{sched_arr}; + my $sd = $station->[2]{sched_dep}; + my $rd = $station->[2]{rt_dep} || $station->[2]{sched_dep}; + + $station_desc .= $sa ? $sa->strftime(';%s') : ';0'; + $station_desc .= $ra ? $ra->strftime(';%s') : ';0'; + $station_desc .= $sd ? $sd->strftime(';%s') : ';0'; + $station_desc .= $rd ? $rd->strftime(';%s') : ';0'; + push( @route, $station_desc ); } @@ -1724,157 +2261,76 @@ sub startup { uid => $uid, db => $db, with_data => 1, - with_timestamps => 1 + with_polyline => 1, + with_timestamps => 1, + with_visibility => 1, + postprocess => 1, ); if ($in_transit) { + my $ret = $in_transit; - if ( my $station - = $self->app->station_by_eva->{ $in_transit->{dep_eva} } ) - { - $in_transit->{dep_ds100} = $station->[0]; - $in_transit->{dep_name} = $station->[1]; - } - if ( $in_transit->{arr_eva} - and my $station - = $self->app->station_by_eva->{ $in_transit->{arr_eva} } ) + my $traewelling = $self->traewelling->get( + uid => $uid, + db => $db + ); + if ( $traewelling->{latest_run} + >= epoch_to_dt( $in_transit->{checkin_ts} ) ) { - $in_transit->{arr_ds100} = $station->[0]; - $in_transit->{arr_name} = $station->[1]; - } - - my @route = @{ $in_transit->{route} // [] }; - my @route_after; - my $dep_info; - my $stop_before_dest; - my $is_after = 0; - for my $station (@route) { - - if ( $in_transit->{arr_name} - and @route_after - and $station->[0] eq $in_transit->{arr_name} ) + $ret->{traewelling} = $traewelling; + if ( @{ $traewelling->{data}{log} // [] } + and ( my $log_entry = $traewelling->{data}{log}[0] ) ) { - $stop_before_dest = $route_after[-1][0]; - } - if ($is_after) { - push( @route_after, $station ); - } - if ( $in_transit->{dep_name} - and $station->[0] eq $in_transit->{dep_name} ) - { - $is_after = 1; - if ( @{$station} > 1 and not $dep_info ) { - $dep_info = $station->[1]; + if ( $log_entry->[2] ) { + $ret->{traewelling_status} = $log_entry->[2]; + $ret->{traewelling_url} + = 'https://traewelling.de/status/' + . $log_entry->[2]; } + $ret->{traewelling_log_latest} = $log_entry->[1]; } } - my $stop_after_dep = @route_after ? $route_after[0][0] : undef; - my $ts = $in_transit->{checkout_ts} - // $in_transit->{checkin_ts}; - my $action_time = epoch_to_dt($ts); - - my $ret = { - checked_in => !$in_transit->{cancelled}, - cancelled => $in_transit->{cancelled}, - timestamp => $action_time, - timestamp_delta => $now->epoch - $action_time->epoch, - train_type => $in_transit->{train_type}, - train_line => $in_transit->{train_line}, - train_no => $in_transit->{train_no}, - train_id => $in_transit->{train_id}, - boarding_countdown => -1, - sched_departure => - epoch_to_dt( $in_transit->{sched_dep_ts} ), - real_departure => epoch_to_dt( $in_transit->{real_dep_ts} ), - dep_ds100 => $in_transit->{dep_ds100}, - dep_eva => $in_transit->{dep_eva}, - dep_name => $in_transit->{dep_name}, - dep_platform => $in_transit->{dep_platform}, - sched_arrival => epoch_to_dt( $in_transit->{sched_arr_ts} ), - real_arrival => epoch_to_dt( $in_transit->{real_arr_ts} ), - arr_ds100 => $in_transit->{arr_ds100}, - arr_eva => $in_transit->{arr_eva}, - arr_name => $in_transit->{arr_name}, - arr_platform => $in_transit->{arr_platform}, - route_after => \@route_after, - messages => $in_transit->{messages}, - extra_data => $in_transit->{data}, - comment => $in_transit->{user_data}{comment}, - }; - - my @parsed_messages; - for my $message ( @{ $ret->{messages} // [] } ) { - my ( $ts, $msg ) = @{$message}; - push( @parsed_messages, [ epoch_to_dt($ts), $msg ] ); - } - $ret->{messages} = [ reverse @parsed_messages ]; - - @parsed_messages = (); - for my $message ( @{ $ret->{extra_data}{qos_msg} // [] } ) { - my ( $ts, $msg ) = @{$message}; - push( @parsed_messages, [ epoch_to_dt($ts), $msg ] ); - } - $ret->{extra_data}{qos_msg} = [@parsed_messages]; - - 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+$} ) + my $stop_after_dep + = scalar @{ $ret->{route_after} } + ? $ret->{route_after}[0][0] + : undef; + my $stop_before_dest; + for my $i ( 1 .. $#{ $ret->{route_after} } ) { + if ( $ret->{arr_name} + and $ret->{route_after}[$i][0] eq $ret->{arr_name} ) { - $dep_info->{rt_arr} - ->add( minutes => $dep_info->{adelay} ); + $stop_before_dest = $ret->{route_after}[ $i - 1 ][0]; + last; } - $dep_info->{rt_arr_countdown} = $ret->{boarding_countdown} - = $dep_info->{rt_arr}->epoch - $epoch; } - for my $station (@route_after) { - if ( @{$station} > 1 ) { - - # Note: $station->[1]{sched_arr} may already have been - # converted to a DateTime object in $station->[1] is - # $dep_info. This can happen when a station is present - # several times in a train's route, e.g. for Frankfurt - # Flughafen in some nightly connections. - my $times = $station->[1]; - if ( $times->{sched_arr} - and ref( $times->{sched_arr} ) ne 'DateTime' ) - { - $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_countdown} - = $times->{rt_arr}->epoch - $epoch; - } - if ( $times->{sched_dep} - and ref( $times->{sched_dep} ) ne 'DateTime' ) - { - $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_countdown} - = $times->{rt_dep}->epoch - $epoch; - } - } + my ($dep_platform_number) + = ( ( $ret->{dep_platform} // 0 ) =~ m{(\d+)} ); + if ( $dep_platform_number + and + exists $ret->{data}{stationinfo_dep}{$dep_platform_number} ) + { + $ret->{dep_direction} = $self->stationinfo_to_direction( + $ret->{data}{stationinfo_dep}{$dep_platform_number}, + $ret->{data}{wagonorder_dep}, + undef, $stop_after_dep + ); } - $ret->{departure_countdown} - = $ret->{real_departure}->epoch - $now->epoch; + my ($arr_platform_number) + = ( ( $ret->{arr_platform} // 0 ) =~ m{(\d+)} ); + if ( $arr_platform_number + and + exists $ret->{data}{stationinfo_arr}{$arr_platform_number} ) + { + $ret->{arr_direction} = $self->stationinfo_to_direction( + $ret->{data}{stationinfo_arr}{$arr_platform_number}, + $ret->{data}{wagonorder_arr}, + $stop_before_dest, + undef + ); + } if ( $ret->{departure_countdown} > 0 and $in_transit->{data}{wagonorder_dep} ) @@ -1882,96 +2338,45 @@ sub startup { my $wr; eval { $wr - = Travel::Status::DE::DBWagenreihung->new( - from_json => $in_transit->{data}{wagonorder_dep} ); + = Travel::Status::DE::DBRIS::Formation->new( + json => $in_transit->{data}{wagonorder_dep} ); }; if ( $wr - and $wr->wagons + and $wr->carriages and defined $wr->direction ) { $ret->{wagonorder} = $wr; } } - if ( $in_transit->{real_arr_ts} ) { - $ret->{arrival_countdown} - = $ret->{real_arrival}->epoch - $now->epoch; - $ret->{journey_duration} - = $ret->{real_arrival}->epoch - - $ret->{real_departure}->epoch; - $ret->{journey_completion} - = $ret->{journey_duration} - ? 1 - - ( $ret->{arrival_countdown} / $ret->{journey_duration} ) - : 1; - if ( $ret->{journey_completion} > 1 ) { - $ret->{journey_completion} = 1; - } - elsif ( $ret->{journey_completion} < 0 ) { - $ret->{journey_completion} = 0; - } - - my ($dep_platform_number) - = ( ( $ret->{dep_platform} // 0 ) =~ m{(\d+)} ); - if ( $dep_platform_number - and exists $in_transit->{data}{stationinfo_dep} - {$dep_platform_number} ) - { - $ret->{dep_direction} - = $self->stationinfo_to_direction( - $in_transit->{data}{stationinfo_dep} - {$dep_platform_number}, - $in_transit->{data}{wagonorder_dep}, - undef, - $stop_after_dep - ); - } - - my ($arr_platform_number) - = ( ( $ret->{arr_platform} // 0 ) =~ m{(\d+)} ); - if ( $arr_platform_number - and exists $in_transit->{data}{stationinfo_arr} - {$arr_platform_number} ) - { - $ret->{arr_direction} - = $self->stationinfo_to_direction( - $in_transit->{data}{stationinfo_arr} - {$arr_platform_number}, - $in_transit->{data}{wagonorder_arr}, - $stop_before_dest, - undef - ); - } - - } - else { - $ret->{arrival_countdown} = undef; - $ret->{journey_duration} = undef; - $ret->{journey_completion} = undef; - } - return $ret; } my ( $latest, $latest_cancellation ) = $self->journeys->get_latest( uid => $uid, - db => $db + db => $db, ); if ( $latest_cancellation and $latest_cancellation->{cancelled} ) { - if ( my $station - = $self->app->station_by_eva - ->{ $latest_cancellation->{dep_eva} } ) + if ( + my $station = $self->stations->get_by_eva( + $latest_cancellation->{dep_eva}, + backend_id => $latest_cancellation->{backend_id}, + ) + ) { - $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 - ->{ $latest_cancellation->{arr_eva} } ) + if ( + my $station = $self->stations->get_by_eva( + $latest_cancellation->{arr_eva}, + backend_id => $latest_cancellation->{backend_id}, + ) + ) { - $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 { @@ -1981,22 +2386,34 @@ sub startup { if ($latest) { my $ts = $latest->{checkout_ts}; my $action_time = epoch_to_dt($ts); - if ( my $station - = $self->app->station_by_eva->{ $latest->{dep_eva} } ) + if ( + my $station = $self->stations->get_by_eva( + $latest->{dep_eva}, backend_id => $latest->{backend_id} + ) + ) { - $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} } ) + if ( + my $station = $self->stations->get_by_eva( + $latest->{arr_eva}, backend_id => $latest->{backend_id} + ) + ) { - $latest->{arr_ds100} = $station->[0]; - $latest->{arr_name} = $station->[1]; + $latest->{arr_ds100} = $station->{ds100}; + $latest->{arr_name} = $station->{name}; } return { checked_in => 0, cancelled => 0, cancellation => $latest_cancellation, + backend_id => $latest->{backend_id}, + backend_name => $latest->{backend_name}, + is_dbris => $latest->{is_dbris}, + is_iris => $latest->{is_iris}, + is_hafas => $latest->{is_hafas}, + is_motis => $latest->{is_motis}, journey_id => $latest->{journey_id}, timestamp => $action_time, timestamp_delta => $now->epoch - $action_time->epoch, @@ -2008,15 +2425,26 @@ sub startup { real_departure => epoch_to_dt( $latest->{real_dep_ts} ), dep_ds100 => $latest->{dep_ds100}, dep_eva => $latest->{dep_eva}, + dep_external_id => $latest->{dep_external_id}, dep_name => $latest->{dep_name}, + dep_lat => $latest->{dep_lat}, + dep_lon => $latest->{dep_lon}, dep_platform => $latest->{dep_platform}, sched_arrival => epoch_to_dt( $latest->{sched_arr_ts} ), real_arrival => epoch_to_dt( $latest->{real_arr_ts} ), arr_ds100 => $latest->{arr_ds100}, arr_eva => $latest->{arr_eva}, + arr_external_id => $latest->{arr_external_id}, arr_name => $latest->{arr_name}, + arr_lat => $latest->{arr_lat}, + arr_lon => $latest->{arr_lon}, arr_platform => $latest->{arr_platform}, comment => $latest->{user_data}{comment}, + visibility => $latest->{visibility}, + visibility_str => $latest->{visibility_str}, + effective_visibility => $latest->{effective_visibility}, + effective_visibility_str => + $latest->{effective_visibility_str}, }; } @@ -2033,10 +2461,11 @@ sub startup { $self->helper( 'get_user_status_json_v1' => sub { - my ( $self, $uid ) = @_; - my $status = $self->get_user_status($uid); - - # TODO simplify lon/lat (can be returned from get_user_status) + my ( $self, %opt ) = @_; + my $uid = $opt{uid}; + my $privacy = $opt{privacy} + // $self->users->get_privacy_by( uid => $uid ); + my $status = $opt{status} // $self->get_user_status($uid); my $ret = { deprecated => \0, @@ -2044,12 +2473,22 @@ sub startup { $status->{checked_in} or $status->{cancelled} ) ? \1 : \0, + comment => $status->{comment}, + backend => { + id => $status->{backend_id}, + type => $status->{is_dbris} ? 'DBRIS' + : $status->{is_hafas} ? 'HAFAS' + : $status->{is_motis} ? 'MOTIS' + : 'IRIS-TTS', + name => $status->{backend_name}, + }, fromStation => { ds100 => $status->{dep_ds100}, name => $status->{dep_name}, uic => $status->{dep_eva}, - longitude => undef, - latitude => undef, + longitude => $status->{dep_lon}, + latitude => $status->{dep_lat}, + platform => $status->{dep_platform}, scheduledTime => $status->{sched_departure} ? $status->{sched_departure}->epoch : undef, @@ -2061,8 +2500,9 @@ sub startup { ds100 => $status->{arr_ds100}, name => $status->{arr_name}, uic => $status->{arr_eva}, - longitude => undef, - latitude => undef, + longitude => $status->{arr_lon}, + latitude => $status->{arr_lat}, + platform => $status->{arr_platform}, scheduledTime => $status->{sched_arrival} ? $status->{sched_arrival}->epoch : undef, @@ -2071,17 +2511,31 @@ sub startup { : undef, }, train => { - type => $status->{train_type}, - line => $status->{train_line}, - no => $status->{train_no}, - id => $status->{train_id}, + type => $status->{train_type}, + line => $status->{train_line}, + no => $status->{train_no}, + id => $status->{train_id}, + hafasId => $status->{extra_data}{trip_id}, }, - actionTime => $status->{timestamp} - ? $status->{timestamp}->epoch - : undef, intermediateStops => [], + visibility => { + level => $status->{effective_visibility}, + desc => $status->{effective_visibility_str}, + } }; + if ( $opt{public} ) { + if ( not $privacy->{comments_visible} ) { + delete $ret->{comment}; + } + } + else { + $ret->{actionTime} + = $status->{timestamp} + ? $status->{timestamp}->epoch + : undef; + } + for my $stop ( @{ $status->{route_after} // [] } ) { if ( $status->{arr_name} and $stop->[0] eq $status->{arr_name} ) { @@ -2091,64 +2545,40 @@ sub startup { @{ $ret->{intermediateStops} }, { name => $stop->[0], - scheduledArrival => $stop->[1]{sched_arr} - ? $stop->[1]{sched_arr}->epoch + scheduledArrival => $stop->[2]{sched_arr} + ? $stop->[2]{sched_arr}->epoch : undef, - realArrival => $stop->[1]{rt_arr} - ? $stop->[1]{rt_arr}->epoch + realArrival => $stop->[2]{rt_arr} + ? $stop->[2]{rt_arr}->epoch : undef, - scheduledDeparture => $stop->[1]{sched_dep} - ? $stop->[1]{sched_dep}->epoch + scheduledDeparture => $stop->[2]{sched_dep} + ? $stop->[2]{sched_dep}->epoch : undef, - realDeparture => $stop->[1]{rt_dep} - ? $stop->[1]{rt_dep}->epoch + realDeparture => $stop->[2]{rt_dep} + ? $stop->[2]{rt_dep}->epoch : undef, } ); } - 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 ( $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] }; - } - } - return $ret; } ); $self->helper( - 'traewelling_to_travelynx' => sub { + 'traewelling_to_travelynx_p' => sub { my ( $self, %opt ) = @_; my $traewelling = $opt{traewelling}; my $user_data = $opt{user_data}; my $uid = $user_data->{user_id}; + my $promise = Mojo::Promise->new; + if ( not $traewelling->{checkin} or $self->now->epoch - $traewelling->{checkin}->epoch > 900 ) { $self->log->debug("... not checked in"); - return; + return $promise->resolve; } if ( $traewelling->{status_id} and $user_data->{data}{latest_pull_status_id} @@ -2156,139 +2586,88 @@ sub startup { == $user_data->{data}{latest_pull_status_id} ) { $self->log->debug("... already handled"); - return; + return $promise->resolve; } - $self->log->debug("... checked in"); + $self->log->debug( +"... checked in : $traewelling->{dep_name} $traewelling->{dep_eva} -> $traewelling->{arr_name} $traewelling->{arr_eva}" + ); + $self->users->mark_seen( uid => $uid ); my $user_status = $self->get_user_status($uid); if ( $user_status->{checked_in} ) { $self->log->debug( "... also checked in via travelynx. aborting."); - return; - } - - if ( $traewelling->{category} - !~ m{^ (?: national .* | regional .* | suburban ) $ }x ) - { - $self->log->debug( - "... status is not a train, but $traewelling->{category}"); - $self->traewelling->log( - uid => $uid, - message => -"$traewelling->{line} nach $traewelling->{arr_name} ist keine Zugfahrt (HAFAS-Kategorie '$traewelling->{category}')", - status_id => $traewelling->{status_id}, - ); - $self->traewelling->set_latest_pull_status_id( - uid => $uid, - status_id => $traewelling->{status_id} - ); - return; - } - - my $dep = $self->iris->get_departures( - station => $traewelling->{dep_eva}, - lookbehind => 60, - lookahead => 40 - ); - if ( $dep->{errstr} ) { - $self->traewelling->log( - uid => $uid, - message => -"Fehler bei $traewelling->{line} nach $traewelling->{arr_name}: $dep->{errstr}", - status_id => $traewelling->{status_id}, - is_error => 1, - ); - return; + return $promise->resolve; } - my ( $train_ref, $train_id ); - for my $train ( @{ $dep->{results} } ) { - if ( $train->line ne $traewelling->{line} ) { - next; - } - if ( not $train->sched_departure - or $train->sched_departure->epoch - != $traewelling->{dep_dt}->epoch ) - { - next; - } - if ( - not List::Util::first { $_ eq $traewelling->{arr_name} } - $train->route_post - ) - { - next; - } - $train_id = $train->train_id; - $train_ref = $train; - last; - } - if ($train_id) { - $self->log->debug("... found train: $train_id"); - - my $db = $self->pg->db; - my $tx = $db->begin; - - my ( undef, $err ) = $self->checkin( - station => $traewelling->{dep_eva}, - train_id => $train_id, - uid => $uid, - in_transaction => 1, - db => $db - ); - if ( not $err ) { - ( undef, $err ) = $self->checkout( + my $db = $self->pg->db; + my $tx = $db->begin; + + $self->_checkin_dbris_p( + station => $traewelling->{dep_eva}, + train_id => $traewelling->{trip_id}, + uid => $uid, + in_transaction => 1, + db => $db + )->then( + sub { + $self->log->debug("... handled origin"); + return $self->_checkout_journey_p( station => $traewelling->{arr_eva}, - train_id => 0, + train_id => $traewelling->{trip_id}, uid => $uid, in_transaction => 1, db => $db ); - if ( not $err ) { - $self->log->debug("... success!"); - if ( $traewelling->{message} ) { - $self->in_transit->update_user_data( - uid => $uid, - db => $db, - user_data => - { comment => $traewelling->{message} } - ); - } - $self->traewelling->log( - uid => $uid, - db => $db, - message => -"Eingecheckt in $traewelling->{line} nach $traewelling->{arr_name}", - status_id => $traewelling->{status_id}, - ); - $self->traewelling->set_latest_pull_status_id( + } + )->then( + sub { + my ( undef, $err ) = @_; + if ($err) { + $self->log->debug("... error: $err"); + return Mojo::Promise->reject($err); + } + $self->log->debug("... handled destination"); + if ( $traewelling->{message} ) { + $self->in_transit->update_user_data( uid => $uid, - status_id => $traewelling->{status_id}, - db => $db + db => $db, + user_data => { comment => $traewelling->{message} } ); - - $tx->commit; } + $self->traewelling->log( + uid => $uid, + db => $db, + message => +"Eingecheckt in $traewelling->{line} nach $traewelling->{arr_name}", + status_id => $traewelling->{status_id}, + ); + + $self->traewelling->set_latest_pull_status_id( + uid => $uid, + status_id => $traewelling->{status_id}, + db => $db + ); + + $tx->commit; + $promise->resolve; + return; } - if ($err) { + )->catch( + sub { + my ($err) = @_; $self->log->debug("... error: $err"); $self->traewelling->log( - uid => $uid, + uid => $uid, message => -"Fehler bei $traewelling->{line} nach $traewelling->{arr_name}: $err", +"Konnte $traewelling->{line} nach $traewelling->{arr_name} nicht übernehmen: $err", status_id => $traewelling->{status_id}, is_error => 1 ); + $promise->resolve; + return; } - } - else { - $self->traewelling->log( - uid => $uid, - message => -"$traewelling->{line} nach $traewelling->{arr_name} nicht gefunden", - status_id => $traewelling->{status_id}, - is_error => 1 - ); - } + )->wait; + return $promise; } ); @@ -2300,8 +2679,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 ) { @@ -2317,12 +2694,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} // $_->{arr_name}, + latlon => $_->{to_latlon} // $_->{arr_latlon}, + }, + { + name => $_->{from_name} // $_->{dep_name}, + latlon => $_->{from_latlon} // $_->{dep_latlon} + } + } @journeys; + + my @station_coordinates + = map { [ $_->{latlon}, $_->{name} ] } @stations; my @station_pairs; my @polylines; @@ -2342,19 +2726,44 @@ sub startup { for my $journey (@polyline_journeys) { my @polyline = @{ $journey->{polyline} }; - my $from_eva = $journey->{from_eva}; - my $to_eva = $journey->{to_eva}; + my $from_eva = $journey->{from_eva} // $journey->{dep_eva}; + my $to_eva = $journey->{to_eva} // $journey->{arr_eva}; my $from_index = first_index { $_->[2] and $_->[2] == $from_eva } @polyline; my $to_index = first_index { $_->[2] and $_->[2] == $to_eva } @polyline; + # Work around inconsistencies caused by a multiple EVA IDs mapping to the same station name + if ( $from_index == -1 ) { + for my $entry ( @{ $journey->{route} // [] } ) { + if ( $entry->[0] eq $journey->{from_name} ) { + $from_eva = $entry->[1]; + $from_index + = first_index { $_->[2] and $_->[2] == $from_eva } + @polyline; + last; + } + } + } + + if ( $to_index == -1 ) { + for my $entry ( @{ $journey->{route} // [] } ) { + if ( $entry->[0] eq $journey->{to_name} ) { + $to_eva = $entry->[1]; + $to_index + = first_index { $_->[2] and $_->[2] == $to_eva } + @polyline; + last; + } + } + } + if ( $from_index == -1 or $to_index == -1 ) { # Fall back to route - delete $journey->{polyline}; + push( @beeline_journeys, $journey ); next; } @@ -2366,7 +2775,6 @@ sub startup { if ( $seen{$key} ) { next; } - $seen{$key} = 1; # direction does not matter at the moment @@ -2376,6 +2784,9 @@ sub startup { . ( $to_index - $from_index ); $seen{$key} = 1; + if ( $from_index > $to_index ) { + ( $to_index, $from_index ) = ( $from_index, $to_index ); + } @polyline = @polyline[ $from_index .. $to_index ]; my @polyline_coords; for my $coord (@polyline) { @@ -2386,23 +2797,38 @@ 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; + my $from_index = first_index { + ( $_->[1] + and $_->[1] + == ( $journey->{from_eva} // $journey->{dep_eva} ) ) + or $_->[0] eq + ( $journey->{from_name} // $journey->{dep_name} ) + } + @route; + my $to_index = first_index { + ( $_->[1] + and $_->[1] + == ( $journey->{to_eva} // $journey->{arr_eva} ) ) + or $_->[0] eq + ( $journey->{to_name} // $journey->{arr_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} // $journey->{dep_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} // $journey->{arr_name} ) } @route; } @@ -2415,17 +2841,18 @@ sub startup { next; } - # Manual journey entries are only included if one of the following - # conditions is satisfied: - # * their route has more than two elements (-> probably more than just - # start and stop station), or - # * $include_manual is true (-> user wants to see incomplete routes) - # This avoids messing up the map in case an A -> B connection has been - # tracked both with a regular checkin (-> detailed route shown on map) - # and entered manually (-> beeline also shown on map, typically - # significantly differs from detailed route) -- unless the user - # sets include_manual, of course. - if ( $journey->{edited} & 0x0010 + # Manual journey entries are only included if one of the following + # conditions is satisfied: + # * their route has more than two elements (-> probably more than just + # start and stop station), or + # * $include_manual is true (-> user wants to see incomplete routes) + # This avoids messing up the map in case an A -> B connection has been + # tracked both with a regular checkin (-> detailed route shown on map) + # and entered manually (-> beeline also shown on map, typically + # significantly differs from detailed route) -- unless the user + # sets include_manual, of course. + if ( $journey->{edited} + and $journey->{edited} & 0x0010 and @route <= 2 and not $include_manual ) { @@ -2436,7 +2863,7 @@ sub startup { @route = @route[ $from_index .. $to_index ]; - my $key = join( '|', @route ); + my $key = join( '|', map { $_->[0] } @route ); if ( $seen{$key} ) { next; @@ -2445,7 +2872,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) { @@ -2454,14 +2881,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, @@ -2470,7 +2900,11 @@ sub startup { { polylines => $json->encode( \@station_pairs ), color => '#673ab7', - opacity => $with_polyline ? 0.4 : 0.6, + opacity => @polylines + ? $with_polyline + ? 0.4 + : 0.6 + : 0.8, }, { polylines => $json->encode( \@polylines ), @@ -2481,8 +2915,8 @@ sub startup { }; if (@station_coordinates) { - my @lats = map { $_->[0][0] } @station_coordinates; - my @lons = map { $_->[0][1] } @station_coordinates; + my @lats = map { $_->[0][0] } @station_coordinates; + my @lons = map { $_->[0][1] } @station_coordinates; my $min_lat = List::Util::min @lats; my $max_lat = List::Util::max @lats; my $min_lon = List::Util::min @lons; @@ -2514,26 +2948,39 @@ sub startup { $r->get('/changelog')->to('static#changelog'); $r->get('/impressum')->to('static#imprint'); $r->get('/imprint')->to('static#imprint'); - $r->get('/offline')->to('static#offline'); + $r->get('/tos')->to('static#tos'); + $r->get('/legend')->to('static#legend'); + $r->get('/offline.html')->to('static#offline'); $r->get('/api/v1/:user_action/:token')->to('api#get_v1'); $r->get('/login')->to('account#login_form'); $r->get('/recover')->to('account#request_password_reset'); $r->get('/recover/:id/:token')->to('account#recover_password'); $r->get('/reg/:id/:token')->to('account#verify'); - $r->get('/status/:name')->to('traveling#user_status'); - $r->get('/status/:name/:ts')->to('traveling#user_status'); - $r->get('/ajax/status/:name')->to('traveling#public_status_card'); - $r->get('/ajax/status/:name/:ts')->to('traveling#public_status_card'); - $r->get('/p/:name')->to('traveling#public_profile'); - $r->get('/p/:name/j/:id')->to('traveling#public_journey_details'); + $r->get( '/status/:name' => [ format => [ 'html', 'json' ] ] ) + ->to( 'profile#user_status', format => undef ); + $r->get( '/status/:name/:ts' => [ format => [ 'html', 'json' ] ] ) + ->to( 'profile#user_status', format => undef ); + $r->get('/ajax/status/#name')->to('profile#status_card'); + $r->get('/ajax/status/:name/:ts')->to('profile#status_card'); + $r->get( '/p/:name' => [ format => [ 'html', 'json' ] ] ) + ->to( 'profile#profile', format => undef ); + $r->get( '/p/:name/j/:id' => 'public_journey' ) + ->to('profile#journey_details'); + $r->get('/.well-known/webfinger')->to('account#webfinger'); + $r->get('/dyn/:av/autocomplete.js')->to('api#autocomplete'); $r->post('/api/v1/import')->to('api#import_v1'); $r->post('/api/v1/travel')->to('api#travel_v1'); - $r->post('/action')->to('traveling#log_action'); + $r->post('/action')->to('traveling#travel_action'); $r->post('/geolocation')->to('traveling#geolocation'); $r->post('/list_departures')->to('traveling#redirect_to_station'); $r->post('/login')->to('account#do_login'); $r->post('/recover')->to('account#request_password_reset'); + if ( $self->config->{traewelling}{oauth} ) { + $r->get('/oauth/traewelling')->to('traewelling#oauth'); + $r->post('/oauth/traewelling')->to('traewelling#oauth'); + } + if ( not $self->config->{registration}{disabled} ) { $r->get('/register')->to('account#registration_form'); $r->post('/register')->to('account#register'); @@ -2545,22 +2992,32 @@ sub startup { if ( $self->is_user_authenticated ) { return 1; } - $self->render( 'login', redirect_to => $self->req->url ); + $self->render( + 'login', + redirect_to => $self->req->url, + from => 'auth_required' + ); return undef; } ); $authed_r->get('/account')->to('account#account'); $authed_r->get('/account/privacy')->to('account#privacy'); + $authed_r->get('/account/social')->to('account#social'); + $authed_r->get('/account/social/:kind')->to('account#social_list'); + $authed_r->get('/account/profile')->to('account#profile'); $authed_r->get('/account/hooks')->to('account#webhook'); $authed_r->get('/account/traewelling')->to('traewelling#settings'); $authed_r->get('/account/insight')->to('account#insight'); $authed_r->get('/ajax/status_card.html')->to('traveling#status_card'); - $authed_r->get('/cancelled')->to('traveling#cancelled'); + $authed_r->get( '/cancelled' => [ format => [ 'html', 'json' ] ] ) + ->to( 'traveling#cancelled', format => undef ); + $authed_r->get('/checkin/add')->to('traveling#add_intransit_form'); $authed_r->get('/fgr')->to('passengerrights#list_candidates'); $authed_r->get('/account/password')->to('account#password_form'); $authed_r->get('/account/mail')->to('account#change_mail'); $authed_r->get('/account/name')->to('account#change_name'); + $authed_r->get('/account/select_backend')->to('account#backend_form'); $authed_r->get('/export.json')->to('account#json_export'); $authed_r->get('/history.json')->to('traveling#json_history'); $authed_r->get('/history.csv')->to('traveling#csv_history'); @@ -2568,27 +3025,36 @@ sub startup { $authed_r->get('/history/commute')->to('traveling#commute'); $authed_r->get('/history/map')->to('traveling#map_history'); $authed_r->get('/history/:year')->to('traveling#yearly_history'); + $authed_r->get('/history/:year/review')->to('traveling#year_in_review'); $authed_r->get('/history/:year/:month')->to('traveling#monthly_history'); $authed_r->get('/journey/add')->to('traveling#add_journey_form'); $authed_r->get('/journey/comment')->to('traveling#comment_form'); + $authed_r->get('/journey/visibility')->to('traveling#visibility_form'); $authed_r->get('/journey/:id')->to('traveling#journey_details'); $authed_r->get('/s/*station')->to('traveling#station'); $authed_r->get('/confirm_mail/:token')->to('account#confirm_mail'); $authed_r->post('/account/privacy')->to('account#privacy'); + $authed_r->post('/account/social')->to('account#social'); + $authed_r->post('/account/profile')->to('account#profile'); $authed_r->post('/account/hooks')->to('account#webhook'); $authed_r->post('/account/traewelling')->to('traewelling#settings'); $authed_r->post('/account/insight')->to('account#insight'); + $authed_r->post('/account/select_backend')->to('account#change_backend'); + $authed_r->post('/checkin/add')->to('traveling#add_intransit_form'); $authed_r->post('/journey/add')->to('traveling#add_journey_form'); $authed_r->post('/journey/comment')->to('traveling#comment_form'); + $authed_r->post('/journey/visibility')->to('traveling#visibility_form'); $authed_r->post('/journey/edit')->to('traveling#edit_journey'); $authed_r->post('/journey/passenger_rights/*filename') ->to('passengerrights#generate'); $authed_r->post('/account/password')->to('account#change_password'); $authed_r->post('/account/mail')->to('account#change_mail'); $authed_r->post('/account/name')->to('account#change_name'); + $authed_r->post('/social-action')->to('account#social_action'); $authed_r->post('/delete')->to('account#delete'); $authed_r->post('/logout')->to('account#do_logout'); $authed_r->post('/set_token')->to('api#set_token'); + $authed_r->get('/timeline/in-transit')->to('profile#checked_in'); } |