diff options
Diffstat (limited to 'lib/DBInfoscreen/Controller/Stationboard.pm')
| -rw-r--r-- | lib/DBInfoscreen/Controller/Stationboard.pm | 3646 |
1 files changed, 2682 insertions, 964 deletions
diff --git a/lib/DBInfoscreen/Controller/Stationboard.pm b/lib/DBInfoscreen/Controller/Stationboard.pm index 59ee48d..3e07f90 100644 --- a/lib/DBInfoscreen/Controller/Stationboard.pm +++ b/lib/DBInfoscreen/Controller/Stationboard.pm @@ -1,16 +1,24 @@ package DBInfoscreen::Controller::Stationboard; -use Mojo::Base 'Mojolicious::Controller'; -# Copyright (C) 2011-2019 Daniel Friesel <derf+dbf@finalrewind.org> -# License: 2-Clause BSD +# Copyright (C) 2011-2020 Birte Kristina Friesel +# +# SPDX-License-Identifier: AGPL-3.0-or-later + +use Mojo::Base 'Mojolicious::Controller'; use DateTime; use DateTime::Format::Strptime; -use Encode qw(decode encode); -use File::Slurp qw(read_file write_file); -use List::Util qw(max); +use Encode qw(decode encode); +use File::Slurp qw(read_file write_file); +use List::Util qw(max uniq); +use List::UtilsBy qw(uniq_by); use List::MoreUtils qw(); -use Mojo::JSON qw(decode_json); +use Mojo::JSON qw(decode_json encode_json); +use Mojo::Promise; +use Mojo::UserAgent; +use Travel::Status::DE::DBRIS; +use Travel::Status::DE::DBRIS::Formation; +use Travel::Status::DE::EFA; use Travel::Status::DE::HAFAS; use Travel::Status::DE::IRIS; use Travel::Status::DE::IRIS::Stations; @@ -18,36 +26,197 @@ use XML::LibXML; use utf8; -no if $] >= 5.018, warnings => 'experimental::smartmatch'; +my %default = ( + mode => 'app', + admode => 'deparr', +); -my $dbf_version = qx{git describe --dirty} || 'experimental'; +sub class_to_product { + my ( $self, $hafas ) = @_; -chomp $dbf_version; + my $bits = $hafas->get_active_service->{productbits}; + my $ret; -my %default = ( - backend => 'iris', - mode => 'app', - admode => 'deparr', -); + for my $i ( 0 .. $#{$bits} ) { + $ret->{ 2**$i } + = ref( $bits->[$i] ) eq 'ARRAY' ? $bits->[$i][0] : $bits->[$i]; + } -sub result_is_train { - my ( $result, $train ) = @_; + return $ret; +} + +sub handle_no_results { + my ( $self, $station, $data, $hafas, $efa ) = @_; - if ( $result->can('train_id') ) { + my $errstr = $data->{errstr}; - # IRIS - if ( $train eq $result->type . ' ' . $result->train_no ) { - return 1; + if ($efa) { + if ( $errstr =~ m{ambiguous} and $efa->name_candidates ) { + $self->render( + 'landingpage', + stationlist => [ $efa->name_candidates ], + hide_opts => 0, + status => $data->{status} // 300, + ); } - return 0; + else { + $self->render( + 'landingpage', + error => ( $errstr // "Keine Abfahrten an '$station'" ), + hide_opts => 0, + status => $data->{status} // 404, + ); + } + return; + } + elsif ($hafas) { + $self->render_later; + my $service = 'ÖBB'; + if ( $hafas ne '1' and Travel::Status::DE::HAFAS::get_service($hafas) ) + { + $service = $hafas; + } + Travel::Status::DE::HAFAS->new_p( + locationSearch => $station, + service => $service, + promise => 'Mojo::Promise', + user_agent => $service eq 'PKP' ? Mojo::UserAgent->new : $self->ua, + )->then( + sub { + my ($status) = @_; + my @candidates = $status->results; + @candidates = map { [ $_->name, $_->eva ] } @candidates; + if ( @candidates == 1 and $candidates[0][0] ne $station ) { + my $s = $candidates[0][0]; + my $params = $self->req->params->to_string; + $self->redirect_to("/${s}?${params}"); + return; + } + for my $candidate (@candidates) { + $candidate->[0] =~ s{[&]#x0028;}{(}g; + $candidate->[0] =~ s{[&]#x0029;}{)}g; + } + my $err; + if ( not $errstr =~ m{LOCATION} ) { + $err = $errstr; + } + $self->render( + 'landingpage', + error => $err, + stationlist => \@candidates, + hide_opts => 0, + status => $data->{status} // 300, + ); + return; + } + )->catch( + sub { + my ($err) = @_; + $self->render( + 'landingpage', + error => ( $err // "Keine Abfahrten an '$station'" ), + hide_opts => 0, + status => $data->{status} // 500, + ); + return; + } + )->wait; + return; + } + + my @candidates = map { [ $_->[1], $_->[0] ] } + Travel::Status::DE::IRIS::Stations::get_station($station); + if ( + @candidates > 1 + or ( @candidates == 1 + and $candidates[0][0] ne $station + and $candidates[0][1] ne $station ) + ) + { + $self->render( + 'landingpage', + stationlist => \@candidates, + hide_opts => 0, + status => $data->{status} // 300, + ); + return; + } + if ( $data->{station_ds100} and $data->{station_ds100} =~ m{ ^ [OPQXYZ] }x ) + { + $self->render( + 'landingpage', + error => ( $errstr // "Keine Abfahrten an '$station'" ) + . '. Das von DBF genutzte IRIS-Backend unterstützt im Regelfall nur innerdeutsche Zugfahrten.', + hide_opts => 0, + status => $data->{status} // 200, + ); + return; + } + $self->render( + 'landingpage', + error => ( $errstr // "Keine Abfahrten an '$station'" ), + hide_opts => 0, + status => $data->{status} // 404, + ); + return; +} + +sub handle_no_results_json { + my ( $self, $station, $data, $api_version ) = @_; + + my $errstr = $data->{errstr}; + my $callback = $self->param('callback'); + + $self->res->headers->access_control_allow_origin(q{*}); + my $json; + if ($errstr) { + $json = { + api_version => $api_version, + error => $errstr, + }; } else { - # HAFAS - if ( $train eq $result->type . ' ' . $result->train ) { - return 1; + my @candidates = map { { code => $_->[0], name => $_->[1] } } + Travel::Status::DE::IRIS::Stations::get_station($station); + if ( @candidates > 1 + or ( @candidates == 1 and $candidates[0]{code} ne $station ) ) + { + $json = { + api_version => $api_version, + error => 'ambiguous station code/name', + candidates => \@candidates, + }; + } + else { + $json = { + api_version => $api_version, + error => ( $errstr // "Got no results for '$station'" ) + }; } - return 0; } + if ($callback) { + $json = $self->render_to_string( json => $json ); + $self->render( + data => "$callback($json);", + format => 'json', + ); + } + else { + $self->render( + json => $json, + status => $data->{status} // 300, + ); + } + return; +} + +sub result_is_train { + my ( $result, $train ) = @_; + + if ( $train eq $result->type . ' ' . $result->train_no ) { + return 1; + } + return 0; } sub result_has_line { @@ -83,557 +252,2016 @@ sub result_has_train_type { sub result_has_via { my ( $result, $via ) = @_; - if ( not $result->can('route_post') ) { + my @route; + + if ( $result->isa('Travel::Status::DE::IRIS::Result') ) { + @route = ( $result->route_post, $result->sched_route_post ); + } + elsif ( $result->isa('Travel::Status::DE::HAFAS::Journey') ) { + @route = map { $_->loc->name } $result->route; + } + elsif ( $result->isa('Travel::Status::DE::EFA::Departure') ) { + @route = map { $_->full_name } $result->route_post; + } + my $eq_result = List::MoreUtils::any { lc eq lc($via) } @route; + + if ($eq_result) { return 1; } - my @route = $result->route_post; + my ( $re1_result, $re2_result ); - if ( List::MoreUtils::any { m{$via}i } @route ) { - return 1; + eval { + $re2_result = List::MoreUtils::any { m{\Q$via\E}i } @route; + }; + eval { + $re1_result = List::MoreUtils::any { m{$via}i } @route; + }; + + if ($@) { + return $re2_result || $eq_result; } - return 0; + + return $re1_result || $re2_result || $eq_result; } sub log_api_access { + my ($suffix) = @_; + $suffix //= q{}; + + my $file = "$ENV{DBFAKEDISPLAY_STATS}${suffix}"; my $counter = 1; - if ( -r $ENV{DBFAKEDISPLAY_STATS} ) { - $counter = read_file( $ENV{DBFAKEDISPLAY_STATS} ) + 1; + if ( -r $file ) { + $counter = read_file($file) + 1; } - write_file( $ENV{DBFAKEDISPLAY_STATS}, $counter ); + write_file( $file, $counter ); return; } -sub check_wagonorder_with_wings { - my ( $ua, $cache, $train, $wr_link ) = @_; +sub json_route_diff { + my ( $self, $route, $sched_route ) = @_; + my @json_route; + my @route = @{$route}; + my @sched_route = @{$sched_route}; - if ( check_wagonorder( $ua, $cache, $train->train_no, $wr_link ) ) { - return 1; + my $route_idx = 0; + my $sched_idx = 0; + + while ( $route_idx <= $#route and $sched_idx <= $#sched_route ) { + if ( $route[$route_idx] eq $sched_route[$sched_idx] ) { + push( @json_route, { name => $route[$route_idx] } ); + $route_idx++; + $sched_idx++; + } + + # this branch is inefficient, but won't be taken frequently + elsif ( + not( + List::MoreUtils::any { $route[$route_idx] eq $_ } + @sched_route + ) + ) + { + push( + @json_route, + { + name => $route[$route_idx], + isAdditional => 1 + } + ); + $route_idx++; + } + else { + push( + @json_route, + { + name => $sched_route[$sched_idx], + isCancelled => 1 + } + ); + $sched_idx++; + } + } + while ( $route_idx <= $#route ) { + push( + @json_route, + { + name => $route[$route_idx], + isAdditional => 1, + isCancelled => 0 + } + ); + $route_idx++; + } + while ( $sched_idx <= $#sched_route ) { + push( + @json_route, + { + name => $sched_route[$sched_idx], + isAdditional => 0, + isCancelled => 1 + } + ); + $sched_idx++; + } + return @json_route; +} + +sub get_results_p { + my ( $self, $station, %opt ) = @_; + my $data; + + if ( $opt{dbris} ) { + if ( $station =~ m{ [@] L = (?<eva> \d+ ) [@] }x ) { + return Travel::Status::DE::DBRIS->new_p( + station => { + eva => $+{eva}, + id => $station, + }, + cache => $opt{cache_iris_rt}, + lwp_options => { + timeout => 10, + agent => 'dbf.finalrewind.org/2' + }, + promise => 'Mojo::Promise', + user_agent => Mojo::UserAgent->new, + ); + } + my $promise = Mojo::Promise->new; + Travel::Status::DE::DBRIS->new_p( + locationSearch => $station, + cache => $opt{cache_iris_main}, + lwp_options => { + timeout => 10, + agent => 'dbf.finalrewind.org/2' + }, + promise => 'Mojo::Promise', + user_agent => Mojo::UserAgent->new, + )->then( + sub { + my ($dbris) = @_; + $promise->reject( 'station disambiguation', $dbris ); + return; + } + )->catch( + sub { + my ($err) = @_; + $promise->reject("'$err' while trying to look up '$station'"); + return; + } + )->wait; + return $promise; } - elsif ( $train->is_wing ) { - my $wing = $train->wing_of; - if ( check_wagonorder( $ua, $cache, $wing->train_no, $wr_link ) ) { - return 1; + if ( $opt{efa} ) { + my $service = 'VRR'; + if ( $opt{efa} ne '1' + and Travel::Status::DE::EFA::get_service( $opt{efa} ) ) + { + $service = $opt{efa}; } + return Travel::Status::DE::EFA->new_p( + service => $service, + name => $station, + full_routes => 1, + cache => $opt{cache_iris_rt}, + lwp_options => { + timeout => 10, + agent => 'dbf.finalrewind.org/2' + }, + promise => 'Mojo::Promise', + user_agent => Mojo::UserAgent->new, + ); + } + if ( $opt{hafas} ) { + my $service = 'ÖBB'; + if ( $opt{hafas} ne '1' + and Travel::Status::DE::HAFAS::get_service( $opt{hafas} ) ) + { + $service = $opt{hafas}; + } + return Travel::Status::DE::HAFAS->new_p( + service => $service, + station => $station, + arrivals => $opt{arrivals}, + cache => $opt{cache_iris_rt}, + lwp_options => { + timeout => 10, + agent => 'dbf.finalrewind.org/2' + }, + promise => 'Mojo::Promise', + user_agent => $service eq 'PKP' ? Mojo::UserAgent->new : $self->ua, + ); + } + + if ( $ENV{DBFAKEDISPLAY_STATS} ) { + log_api_access(); + } + + # requests with DS100 codes should be preferred (they avoid + # encoding problems on the IRIS server). However, only use them + # if we have an exact match. Ask the backend otherwise. + my @station_matches + = Travel::Status::DE::IRIS::Stations::get_station($station); + + # Requests with EVA codes can be handled even if we do not know about them. + if ( @station_matches != 1 and $station =~ m{^\d+$} ) { + @station_matches = ( [ undef, undef, $station ] ); + } + + if ( @station_matches == 1 ) { + $station = $station_matches[0][2]; + return Travel::Status::DE::IRIS->new_p( + iris_base => $ENV{DBFAKEDISPLAY_IRIS_BASE}, + station => $station, + main_cache => $opt{cache_iris_main}, + realtime_cache => $opt{cache_iris_rt}, + log_dir => $ENV{DBFAKEDISPLAY_XMLDUMP_DIR}, + lookbehind => 20, + lwp_options => { + timeout => 10, + agent => 'dbf.finalrewind.org/2' + }, + promise => 'Mojo::Promise', + user_agent => Mojo::UserAgent->new, + get_station => \&Travel::Status::DE::IRIS::Stations::get_station, + meta => Travel::Status::DE::IRIS::Stations::get_meta(), + %opt + ); + } + elsif ( @station_matches > 1 ) { + return Mojo::Promise->reject('Ambiguous station name'); + } + else { + return Mojo::Promise->reject('Unknown station name'); } - return; } -sub get_hafas_trip_id { - my ( $ua, $cache, $train ) = @_; +sub handle_board_request { + my ($self) = @_; + my $station = $self->stash('station'); - my $eva = $train->station_uic; - my $dep_ts = DateTime->now( time_zone => 'Europe/Berlin' ); - my $url - = "https://2.db.transport.rest/stations/${eva}/departures?duration=5&when=$dep_ts"; - if ( $train->sched_departure ) { - $dep_ts = $train->sched_departure->epoch; - $url - = "https://2.db.transport.rest/stations/${eva}/departures?duration=5&when=$dep_ts"; + my $template = $self->param('mode') // 'app'; + my $dbris = $self->param('dbris'); + my $efa = $self->param('efa'); + my $hafas = $self->param('hafas'); + my $with_related = !$self->param('no_related'); + my %opt = ( + cache_iris_main => $self->app->cache_iris_main, + cache_iris_rt => $self->app->cache_iris_rt, + lookahead => $self->config->{lookahead}, + dbris => $dbris, + efa => $efa, + hafas => $hafas, + ); + + if ( $self->param('past') ) { + $opt{datetime} = DateTime->now( time_zone => 'Europe/Berlin' ) + ->subtract( minutes => 60 ); + $opt{lookahead} += 60; } - elsif ( $train->sched_arrival ) { - $dep_ts = $train->sched_arrival->epoch; - $url - = "https://2.db.transport.rest/stations/${eva}/arrivals?duration=5&when=$dep_ts"; + + if ( $self->param('admode') and $self->param('admode') eq 'arr' ) { + $opt{arrivals} = 1; } - if ( my $content = $cache->get($url) ) { - return $content; + my $api_version = $Travel::Status::DE::IRIS::VERSION; + + $self->stash( departures => [] ); + $self->stash( title => 'DBF' ); + + if ( + not( + List::MoreUtils::any { $template eq $_ } + (qw(app infoscreen json multi single text)) + ) + ) + { + $template = 'app'; } - $ua->request_timeout(2); - my $res = eval { - $ua->get( - $url => { 'User-Agent' => "dbf.finalrewind.org/${dbf_version}" } ) - ->result; - }; - if ($@) { - return; + if ( defined $station and $station =~ s{ [.] txt $ }{}x ) { + $template = 'text'; + $self->param( station => $station ); + $self->stash( layout => 'text' ); + } + elsif ( defined $station and $station =~ s{ [.] json $ }{}x ) { + $template = 'json'; + } + elsif ( $template ne 'app' ) { + $self->stash( layout => 'legacy' ); } - if ( $res->is_error ) { + + # Historically, there were two JSON APIs: 'json' (undocumented, raw + # passthrough of serialized Travel::Status::DE::IRIS::Result / + # Travel::Status::DE::DE::HAFAS::Result objects) and 'marudor' + # (documented, IRIS only, stable versioned API). The latter was initially + # created for marudor.de, but quickly used by other clients as well. + # + # marudor.de switched to a nodejs IRIS parser in December 2018. As the + # 'json' API was not used and the 'marudor' variant is no longer related to + # (or used by) marudor.de, it was renamed to 'json'. Many clients won't + # notice this for year to come, so we make sure mode=marudor still works as + # intended. + if ( + $template eq 'marudor' + or ( $self->req->headers->accept + and $self->req->headers->accept eq 'application/json' ) + ) + { + $template = 'json'; + } + + $self->param( mode => $template ); + + if ( not $station ) { + $self->param( rt => 1 ); + $self->render( 'landingpage', show_intro => 1 ); return; } - my $json = decode_json( $res->body ); + # pre-fill station / train input form + $self->stash( input => $station ); + $self->param( input => $station ); + + if ($with_related) { + $opt{with_related} = 1; + } + + if ( $self->param('train') and not $opt{datetime} ) { - #say "looking for " . $train->train_no; - for my $result ( @{$json} ) { - my $trip_id = $result->{tripId}; - my $fahrt = $result->{line}{fahrtNr}; + # request results from twenty minutes ago to avoid train details suddenly + # becoming unavailable when its scheduled departure is reached. + $opt{datetime} = DateTime->now( time_zone => 'Europe/Berlin' ) + ->subtract( minutes => 20 ); + $opt{lookahead} = $self->config->{lookahead} + 20; + } - #say "checking $fahrt"; - if ( $result->{line} and $result->{line}{fahrtNr} == $train->train_no ) - { - #say "Trip ID is $trip_id"; - $cache->set( $url, $trip_id ); - return $trip_id; + $self->render_later; + + $self->get_results_p( $station, %opt )->then( + sub { + my ($status) = @_; + if ($dbris) { + $self->render_board_dbris( $station, $status ); + return; + } + if ($efa) { + $self->render_board_efa( $station, $status ); + return; + } + my $data = { + results => [ $status->results ], + hafas => $hafas ? $status : undef, + station_ds100 => + ( $status->station ? $status->station->{ds100} : undef ), + station_eva => ( + $status->station + ? ( $status->station->{uic} // $status->station->{eva} ) + : undef + ), + station_evas => + ( $status->station ? $status->station->{evas} : [] ), + station_name => + ( $status->station ? $status->station->{name} : $station ), + }; + + if ( not @{ $data->{results} } and $template eq 'json' ) { + $self->handle_no_results_json( $station, $data, $api_version ); + return; + } + if ( not @{ $data->{results} } ) { + $self->handle_no_results( $station, $data, $hafas ); + return; + } + $self->render_board_hafas($data); } - else { - #say "unmatched Trip ID $trip_id"; + )->catch( + sub { + my ( $err, $status ) = @_; + if ( $dbris and $err eq 'station disambiguation' ) { + for my $result ( $status->results ) { + if ( defined $result->eva ) { + $self->redirect_to( + '/' . $result->id . '?dbris=bahn.de' ); + return; + } + } + } + if ( $template eq 'json' ) { + $self->handle_no_results_json( + $station, + { + errstr => $err, + status => + ( $err =~ m{[Aa]mbiguous|LOCATION} ? 300 : 500 ), + }, + $api_version + ); + return; + } + $self->handle_no_results( + $station, + { + errstr => $err, + status => ( $err =~ m{[Aa]mbiguous|LOCATION} ? 300 : 500 ), + }, + $hafas, + $efa ? $status : undef + ); + return; } - } - return; + )->wait; } -sub check_wagonorder { - my ( $ua, $cache, $train_no, $wr_link ) = @_; +sub filter_results { + my ( $self, @results ) = @_; - my $url - = "https://lib.finalrewind.org/dbdb/has_wagonorder/${train_no}/${wr_link}"; + if ( my $train = $self->param('train') ) { + @results = grep { result_is_train( $_, $train ) } @results; + } - if ( my $content = $cache->get($url) ) { - return $content eq 'y' ? 1 : undef; + if ( my @lines = split( /,/, $self->param('lines') // q{} ) ) { + @results = grep { result_has_line( $_, @lines ) } @results; } - $ua->request_timeout(2); - my $res = eval { $ua->head($url)->result }; + if ( my @platforms = split( /,/, $self->param('platforms') // q{} ) ) { + @results = grep { result_has_platform( $_, @platforms ) } @results; + } - if ($@) { - return; + if ( my $via = $self->param('via') ) { + $via =~ s{ , \s* }{|}gx; + @results = grep { result_has_via( $_, $via ) } @results; } - if ( $res->is_error ) { - $cache->set( $url, 'n' ); - return; + + if ( my @train_types = split( /,/, $self->param('train_types') // q{} ) ) { + @results = grep { result_has_train_type( $_, @train_types ) } @results; } - else { - $cache->set( $url, 'y' ); - return 1; + + if ( my $limit = $self->param('limit') ) { + if ( $limit =~ m{ ^ \d+ $ }x ) { + splice( @results, $limit ); + } } + + return @results; } -sub hafas_json_req { - my ( $ua, $cache, $url ) = @_; +sub format_iris_result_info { + my ( $self, $template, $result ) = @_; + my ( $info, $moreinfo ); + + my $delaymsg + = join( ', ', map { $_->[1] } $result->delay_messages ); + my $qosmsg = join( ' +++ ', map { $_->[1] } $result->qos_messages ); + if ( $result->is_cancelled ) { + $info = "Fahrt fällt aus"; + if ($delaymsg) { + $info .= ": ${delaymsg}"; + } + } + elsif ( $result->departure_is_cancelled ) { + $info = "Zug endet hier"; + if ($delaymsg) { + $info .= ": ${delaymsg}"; + } + } + elsif ( $result->delay and $result->delay >= 20 ) { + if ( $template eq 'app' or $template eq 'infoscreen' ) { + $info = $delaymsg; + } + else { + $info = sprintf( 'ca. +%d%s%s', + $result->delay, $delaymsg ? q{: } : q{}, $delaymsg ); + } + } + if ( $result->replacement_for + and $template ne 'app' + and $template ne 'infoscreen' ) + { + for my $rep ( $result->replacement_for ) { + $info = sprintf( + 'Ersatzzug für %s %s %s%s', + $rep->type, $rep->train_no, + $info ? '+++ ' : q{}, $info // q{} + ); + } + } + if ( $info and $qosmsg ) { + $info .= ' +++ '; + } + $info .= $qosmsg; + + if ( $result->additional_stops and not $result->is_cancelled ) { + my $additional_line = join( q{, }, $result->additional_stops ); + $info + = 'Zusätzliche Halte: ' + . $additional_line + . ( $info ? ' +++ ' : q{} ) + . $info; + if ( $template ne 'json' ) { + push( + @{$moreinfo}, + [ 'Außerplanmäßiger Halt in', { text => $additional_line } ] + ); + } + } - if ( my $content = $cache->thaw($url) ) { - return $content; + if ( $result->canceled_stops and not $result->is_cancelled ) { + my $cancel_line = join( q{, }, $result->canceled_stops ); + $info + = 'Ohne Halt in: ' . $cancel_line . ( $info ? ' +++ ' : q{} ) . $info; + if ( $template ne 'json' ) { + push( @{$moreinfo}, [ 'Ohne Halt in', { text => $cancel_line } ] ); + } } - my $res = eval { $ua->get($url)->result }; + push( @{$moreinfo}, $result->messages ); - if ($@) { - return; + return ( $info, $moreinfo ); +} + +sub render_train { + my ( $self, $result, $departure, $station_name, $template ) = @_; + + $departure->{links} = []; + if ( $result->can('route_pre') ) { + $departure->{route_pre_diff} = [ + $self->json_route_diff( + [ $result->route_pre ], + [ $result->sched_route_pre ] + ) + ]; + $departure->{route_post_diff} = [ + $self->json_route_diff( + [ $result->route_post ], + [ $result->sched_route_post ] + ) + ]; + } + + if ( not $result->has_realtime ) { + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + if ( $result->start < $now ) { + $departure->{missing_realtime} = 1; + } + else { + $departure->{no_realtime_yet} = 1; + } } - if ( $res->is_error ) { - return; + + my $linetype = 'bahn'; + + if ( $result->can('classes') ) { + my @classes = $result->classes; + if ( @classes == 0 ) { + $linetype = 'ext'; + } + elsif ( grep { $_ eq 'S' } @classes ) { + $linetype = 'sbahn'; + } + elsif ( grep { $_ eq 'F' } @classes ) { + $linetype = 'fern'; + } + } + elsif ( $result->can('class') ) { + if ( $result->class <= 2 ) { + $linetype = 'fern'; + } + elsif ( $result->class == 16 ) { + $linetype = 'sbahn'; + } + elsif ( $result->class == 32 ) { + $linetype = 'bus'; + } + elsif ( $result->class == 128 ) { + $linetype = 'ubahn'; + } + elsif ( $result->class == 256 ) { + $linetype = 'tram'; + } } - my $body = encode( 'utf-8', decode( 'ISO-8859-15', $res->body ) ); + $self->render_later; + + my $wagonorder_req = Mojo::Promise->new; + my $occupancy_req = Mojo::Promise->new; + my $stationinfo_req = Mojo::Promise->new; + my $route_req = Mojo::Promise->new; + + my @requests + = ( $wagonorder_req, $occupancy_req, $stationinfo_req, $route_req ); + + if ( $departure->{wr_dt} ) { + $self->wagonorder->get_p( + train_type => $result->type, + train_number => $result->train_no, + datetime => $departure->{wr_dt}, + eva => $departure->{eva} + )->then( + sub { + my ( $wr_json, $wr_param ) = @_; + eval { + my $wr + = Travel::Status::DE::DBRIS::Formation->new( + json => $wr_json ); + $departure->{wr} = $wr; + $departure->{wr_link} = join( '&', + map { $_ . '=' . $wr_param->{$_} } keys %{$wr_param} ); + $departure->{wr_text} = join( q{ • }, + map { $_->desc_short } + grep { $_->desc_short } $wr->groups ); + my $first = 0; + for my $group ( $wr->groups ) { + my $had_entry = 0; + for my $wagon ( $group->carriages ) { + if ( + not( $wagon->is_locomotive + or $wagon->is_powercar ) + ) + { + my $class; + if ($first) { + push( + @{ $departure->{wr_preview} }, + [ '•', 'meta' ] + ); + $first = 0; + } + my $entry; + if ( $wagon->is_closed ) { + $entry = 'X'; + $class = 'closed'; + } + elsif ( $wagon->number ) { + $entry = $wagon->number; + } + else { + if ( $wagon->has_first_class ) { + if ( $wagon->has_second_class ) { + $entry = '½'; + } + else { + $entry = '1.'; + } + } + elsif ( $wagon->has_second_class ) { + $entry = '2.'; + } + else { + $entry = $wagon->type; + } + } + if ( + $group->train_no ne $departure->{train_no} ) + { + $class = 'otherno'; + } + push( + @{ $departure->{wr_preview} }, + [ $entry, $class ] + ); + $had_entry = 1; + } + } + if ($had_entry) { + $first = 1; + } + } + }; + $departure->{wr_text} ||= 'Wagen'; + return; + }, + sub { + $departure->{wr_dt} = undef; + return; + } + )->finally( + sub { + $wagonorder_req->resolve; + return; + } + )->wait; + } + else { + $wagonorder_req->resolve; + } + + $self->efa->get_efa_occupancy( + eva => $result->station_uic, + train_no => $result->train_no + )->then( + sub { + my ($occupancy) = @_; + $departure->{occupancy} = $occupancy; + return; + }, + sub { + $departure->{occupancy} = undef; + return; + } + )->finally( + sub { + $occupancy_req->resolve; + return; + } + )->wait; + + $self->wagonorder->get_stationinfo_p( $result->station_uic )->then( + sub { + my ($station_info) = @_; + my ($platform_number) = ( $result->platform =~ m{(\d+)} ); + if ( not defined $platform_number ) { + return; + } + my $platform_info = $station_info->{$platform_number}; + if ( not $platform_info ) { + return; + } + my $prev_stop = ( $result->route_pre )[-1]; + my $next_stop = ( $result->route_post )[0]; + my $direction; - $body =~ s{^TSLs[.]sls = }{}; - $body =~ s{;$}{}; - $body =~ s{(}{(}g; - $body =~ s{)}{)}g; + if ( $platform_info->{kopfgleis} and $next_stop ) { + $direction = $platform_info->{direction} eq 'r' ? 'l' : 'r'; + } + elsif ( $platform_info->{kopfgleis} ) { + $direction = $platform_info->{direction}; + } + elsif ( $prev_stop + and exists $platform_info->{direction_from}{$prev_stop} ) + { + $direction = $platform_info->{direction_from}{$prev_stop}; + } + elsif ( $next_stop + and exists $platform_info->{direction_from}{$next_stop} ) + { + $direction + = $platform_info->{direction_from}{$next_stop} eq 'r' + ? 'l' + : 'r'; + } + + if ($direction) { + $departure->{wr_direction} = $direction; + $departure->{wr_direction_num} = $direction eq 'l' ? 0 : 100; + } + elsif ( $platform_info->{direction} ) { + $departure->{wr_direction} = 'a' . $platform_info->{direction}; + $departure->{wr_direction_num} + = $platform_info->{direction} eq 'l' ? 0 : 100; + } + + return; + }, + sub { + # errors don't matter here + return; + } + )->finally( + sub { + $stationinfo_req->resolve; + return; + } + )->wait; + + my %opt = ( train => $result ); + + #if ( $self->languages =~ m{^en} ) { + # $opt{language} = 'en'; + #} + + $self->hafas->get_route_p(%opt)->then( + sub { + my ( $route, $journey ) = @_; + + $departure->{trip_id} = $journey->id; + $departure->{operators} = [ $journey->operators ]; + $departure->{date} = $route->[0]{sched_dep} // $route->[0]{dep}; + + # Use HAFAS route as source of truth; ignore IRIS data + $departure->{route_pre_diff} = []; + $departure->{route_post_diff} = $route; + my $split; + for my $i ( 0 .. $#{ $departure->{route_post_diff} } ) { + if ( $departure->{route_post_diff}[$i]{name} eq $station_name ) + { + $split = $i; + if ( my $load = $route->[$i]{load} ) { + if ( %{$load} ) { + $departure->{utilization} + = [ $load->{FIRST}, $load->{SECOND} ]; + } + } + $departure->{tz_offset} = $route->[$i]{tz_offset}; + $departure->{local_dt_da} = $route->[$i]{local_dt_da}; + $departure->{local_sched_arr} + = $route->[$i]{local_sched_arr}; + $departure->{local_sched_dep} + = $route->[$i]{local_sched_dep}; + $departure->{is_annotated} = $route->[$i]{is_annotated}; + $departure->{prod_name} = $route->[$i]{prod_name}; + $departure->{direction} = $route->[$i]{direction}; + $departure->{operator} = $route->[$i]{operator}; + last; + } + } - my $json = decode_json($body); + if ( defined $split ) { + for my $i ( 0 .. $split - 1 ) { + push( + @{ $departure->{route_pre_diff} }, + shift( @{ $departure->{route_post_diff} } ) + ); + } - $cache->freeze( $url, $json ); + # remove entry for $station_name + shift( @{ $departure->{route_post_diff} } ); + } - return $json; + my @him_messages; + my @him_details; + for my $message ( $journey->messages ) { + if ( $message->code ) { + push( @him_details, + [ $message->short // q{}, { text => $message->text } ] + ); + } + else { + push( @him_messages, + [ $message->short // q{}, { text => $message->text } ] + ); + } + } + for my $m (@him_messages) { + if ( $m->[0] =~ s{: Information.}{:} ) { + $m->[1]{icon} = 'info_outline'; + } + elsif ( $m->[0] =~ s{: Störung.}{: } ) { + $m->[1]{icon} = 'warning'; + } + elsif ( $m->[0] =~ s{: Bauarbeiten.}{: } ) { + $m->[1]{icon} = 'build'; + } + $m->[0] =~ s{(?!<)->}{ → }; + } + unshift( @{ $departure->{moreinfo} }, @him_messages ); + unshift( @{ $departure->{details} }, @him_details ); + } + )->catch( + sub { + # nop + } + )->finally( + sub { + $route_req->resolve; + return; + } + )->wait; + + # Defer rendering until all requests have completed + Mojo::Promise->all(@requests)->then( + sub { + $self->respond_to( + json => { + json => { + departure => $departure, + station_name => $station_name, + }, + }, + any => { + template => $template // '_train_details', + description => sprintf( + '%s %s%s%s nach %s', + $departure->{train_type}, + $departure->{train_line} // $departure->{train_no}, + $departure->{origin} ? ' von ' : q{}, + $departure->{origin} // q{}, + $departure->{destination} // 'unbekannt' + ), + departure => $departure, + linetype => $linetype, + dt_now => DateTime->now( time_zone => 'Europe/Berlin' ), + station_name => $station_name, + nav_link => + $self->url_for( 'station', station => $station_name ) + ->query( + { + detailed => $self->param('detailed'), + hafas => $self->param('hafas') + } + ), + }, + ); + } + )->wait; } -sub hafas_xml_req { - my ( $ua, $cache, $url ) = @_; +# /z/:train/*station +sub station_train_details { + my ($self) = @_; + my $train_no = $self->stash('train'); + my $station = $self->stash('station'); - if ( my $content = $cache->thaw($url) ) { - return $content; + if ( $self->param('ajax') ) { + delete $self->stash->{layout}; } - my $res = eval { $ua->get($url)->result }; + if ( $station =~ s{ [.] json $ }{}x ) { + $self->stash( format => 'json' ); + } - if ($@) { - return; + my %opt = ( + cache_iris_main => $self->app->cache_iris_main, + cache_iris_rt => $self->app->cache_iris_rt, + ); + + my $api_version = $Travel::Status::DE::IRIS::VERSION; + + $self->stash( departures => [] ); + $self->stash( title => 'DBF' ); + $self->stash( version => $self->config->{version} ); + + if ( $self->param('past') ) { + $opt{datetime} = DateTime->now( time_zone => 'Europe/Berlin' ) + ->subtract( minutes => 80 ); + $opt{lookahead} = $self->config->{lookahead} + 80; } - if ( $res->is_error ) { - $cache->freeze( $url, {} ); - return; + else { + $opt{datetime} = DateTime->now( time_zone => 'Europe/Berlin' ) + ->subtract( minutes => 20 ); + $opt{lookahead} = $self->config->{lookahead} + 20; + } + + # Berlin Hbf exists twice: + # - BLS / 8011160 + # - BL / 8098160 (formerly "Berlin Hbf (tief)") + # Right now DBF assumes that station name -> EVA / DS100 is a unique map. + # This is not the case. Work around it here until dbf has been adjusted + # properly. + if ( $station eq 'Berlin Hbf' ) { + $opt{with_related} = 1; } - my $body = decode( 'ISO-8859-15', $res->body ); + $self->render_later; - # <SDay text="... > ..."> is invalid HTML, but present - # regardless. As it is the last tag, we just throw it away. - $body =~ s{<SDay [^>]*/>}{}s; + # Always performs an IRIS request + $self->get_results_p( $station, %opt )->then( + sub { + my ($status) = @_; + my ($result) + = grep { result_is_train( $_, $train_no ) } $status->results; - my $tree; + if ( not $result ) { + die("Train not found\n"); + } - eval { $tree = XML::LibXML->load_xml( string => $body ) }; + my ( $info, $moreinfo ) + = $self->format_iris_result_info( 'app', $result ); + + my $result_info = { + sched_arrival => $result->sched_arrival + ? $result->sched_arrival->strftime('%H:%M') + : undef, + sched_departure => $result->sched_departure + ? $result->sched_departure->strftime('%H:%M') + : undef, + arrival => $result->arrival + ? $result->arrival->strftime('%H:%M') + : undef, + departure => $result->departure + ? $result->departure->strftime('%H:%M') + : undef, + arrival_hidden => $result->arrival_hidden, + departure_hidden => $result->departure_hidden, + train_type => $result->type // '', + train_line => $result->line_no, + train_no => $result->train_no, + destination => $result->destination, + origin => $result->origin, + platform => $result->platform, + scheduled_platform => $result->sched_platform, + is_cancelled => $result->is_cancelled, + departure_is_cancelled => $result->departure_is_cancelled, + arrival_is_cancelled => $result->arrival_is_cancelled, + moreinfo => $moreinfo, + delay => $result->delay, + arrival_delay => $result->arrival_delay, + departure_delay => $result->departure_delay, + route_pre => [ $result->route_pre ], + route_post => [ $result->route_post ], + replaced_by => [ + map { $_->type . q{ } . $_->train_no } $result->replaced_by + ], + replacement_for => [ + map { $_->type . q{ } . $_->train_no } + $result->replacement_for + ], + wr_dt => $result->sched_departure, + eva => $result->station_uic, + start => $result->start, + }; - if ($@) { - $cache->freeze( $url, {} ); - return; - } + $self->stash( title => $status->station->{name} + // $self->stash('station') ); + $self->stash( hide_opts => 1 ); - my $ret = { - station => {}, - stations => [], - messages => [], - }; + $self->render_train( + $result, + $result_info, + $status->station->{name} // $self->stash('station'), + $self->param('ajax') ? '_train_details' : 'train_details' + ); + } + )->catch( + sub { + my ($errstr) = @_; + $self->respond_to( + json => { + json => { + error => +"Keine Abfahrt von $train_no in $station gefunden: $errstr", + }, + status => 404, + }, + any => { + template => 'landingpage', + error => +"Keine Abfahrt von $train_no in $station gefunden: $errstr", + status => 404, + }, + ); + return; + } + )->wait; +} + +sub train_details_dbris { + my ($self) = @_; + my $trip_id = $self->stash('train'); + + $self->render_later; + + $self->dbris->get_journey_p( id => $trip_id )->then( + sub { + my ($dbris) = @_; + my $trip = $dbris->result; + + my ( @him_messages, @him_details ); + for my $message ( $trip->messages ) { + if ( not $message->{ueberschrift} ) { + push( + @him_messages, + [ + q{}, + { + icon => $message->{prioritaet} eq 'HOCH' + ? 'warning' + : 'info', + text => $message->{text} + } + ] + ); + } + } + + for my $attribute ( $trip->attributes ) { + push( + @him_details, + [ + q{}, + { + text => $attribute->{value} + . ( + $attribute->{teilstreckenHinweis} + ? q { } . $attribute->{teilstreckenHinweis} + : q{} + ) + } + ] + ); + } + + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + my $res = { + trip_id => $trip_id, + train_line => $trip->train, + train_no => $trip->number, + origin => ( $trip->route )[0]->name, + destination => ( $trip->route )[-1]->name, + operators => [], + linetype => 'bahn', + route_pre_diff => [], + route_post_diff => [], + moreinfo => [@him_messages], + details => [@him_details], + replaced_by => [], + replacement_for => [], + }; - for my $station ( $tree->findnodes('/Journey/St') ) { - my $name = $station->getAttribute('name'); - my $adelay = $station->getAttribute('adelay'); - my $ddelay = $station->getAttribute('ddelay'); - push( @{ $ret->{stations} }, $name ); - $ret->{station}{$name} = { - adelay => $adelay, - ddelay => $ddelay, + my $line = $trip->train; + if ( $line =~ m{ STR }x ) { + $res->{linetype} = 'tram'; + } + elsif ( $line =~ m{ ^ S }x ) { + $res->{linetype} = 'sbahn'; + } + elsif ( $line =~ m{ U }x ) { + $res->{linetype} = 'ubahn'; + } + elsif ( $line =~ m{ Bus }x ) { + $res->{linetype} = 'bus'; + } + elsif ( $line =~ m{ ^ [EI]CE? }x ) { + $res->{linetype} = 'fern'; + } + elsif ( $line =~ m{ EST | FLX }x ) { + $res->{linetype} = 'ext'; + } + + my $station_is_past = 1; + for my $stop ( $trip->route ) { + + push( + @{ $res->{route_post_diff} }, + { + name => $stop->name, + eva => $stop->eva, + id => $stop->id, + sched_arr => $stop->sched_arr, + sched_dep => $stop->sched_dep, + rt_arr => $stop->rt_arr, + rt_dep => $stop->rt_dep, + arr_delay => $stop->arr_delay, + dep_delay => $stop->dep_delay, + platform => $stop->platform, + } + ); + if ( + $station_is_past + and $now->epoch < ( + $res->{route_post_diff}[-1]{rt_arr} + // $res->{route_post_diff}[-1]{rt_dep} + // $res->{route_post_diff}[-1]{sched_arr} + // $res->{route_post_diff}[-1]{sched_dep} // $now + )->epoch + ) + { + $station_is_past = 0; + } + $res->{route_post_diff}[-1]{isPast} = $station_is_past; + } + + if ( my $req_id = $self->param('highlight') ) { + my $split; + for my $i ( 0 .. $#{ $res->{route_post_diff} } ) { + if ( $res->{route_post_diff}[$i]{eva} eq $req_id ) { + $split = $i; + last; + } + } + if ( defined $split ) { + $self->stash( + station_name => $res->{route_post_diff}[$split]{name} ); + for my $i ( 0 .. $split - 1 ) { + push( + @{ $res->{route_pre_diff} }, + shift( @{ $res->{route_post_diff} } ) + ); + } + my $station_info = shift( @{ $res->{route_post_diff} } ); + $res->{eva} = $station_info->{eva}; + if ( $station_info->{sched_arr} ) { + $res->{sched_arrival} + = $station_info->{sched_arr}->strftime('%H:%M'); + } + if ( $station_info->{rt_arr} ) { + $res->{arrival} + = $station_info->{rt_arr}->strftime('%H:%M'); + } + if ( $station_info->{sched_dep} ) { + $res->{sched_departure} + = $station_info->{sched_dep}->strftime('%H:%M'); + } + if ( $station_info->{rt_dep} ) { + $res->{departure} + = $station_info->{rt_dep}->strftime('%H:%M'); + } + $res->{arrival_is_cancelled} + = $station_info->{arr_cancelled}; + $res->{departure_is_cancelled} + = $station_info->{dep_cancelled}; + $res->{is_cancelled} = $res->{arrival_is_cancelled} + || $res->{arrival_is_cancelled}; + $res->{tz_offset} = $station_info->{tz_offset}; + $res->{local_dt_da} = $station_info->{local_dt_da}; + $res->{local_sched_arr} = $station_info->{local_sched_arr}; + $res->{local_sched_dep} = $station_info->{local_sched_dep}; + $res->{is_annotated} = $station_info->{is_annotated}; + $res->{prod_name} = $station_info->{prod_name}; + $res->{direction} = $station_info->{direction}; + $res->{operator} = $station_info->{operator}; + $res->{platform} = $station_info->{platform}; + $res->{scheduled_platform} + = $station_info->{sched_platform}; + } + } + + $self->respond_to( + json => { + json => { + journey => $trip, + }, + }, + any => { + template => $self->param('ajax') + ? '_train_details' + : 'train_details', + description => sprintf( + '%s %s%s%s nach %s', + $res->{train_type}, + $res->{train_line} // $res->{train_no}, + $res->{origin} ? ' von ' : q{}, + $res->{origin} // q{}, + $res->{destination} // 'unbekannt' + ), + departure => $res, + linetype => $res->{linetype}, + dt_now => DateTime->now( time_zone => 'Europe/Berlin' ), + }, + ); + } + )->catch( + sub { + my ($e) = @_; + $self->respond_to( + json => { + json => { + error => $e, + }, + status => 500, + }, + any => { + template => 'exception', + message => $e, + exception => undef, + snapshot => {}, + status => 500, + }, + ); + } + )->wait; +} + +sub train_details_efa { + my ($self) = @_; + my $trip_id = $self->stash('train'); + + my $stopseq; + if ( $trip_id + =~ m{ ^ ([^@]*) @ ([^@]*) [(] ([^T]*) T ([^)]*) [)] (.*) $ }x ) + { + $stopseq = { + stateless => $1, + stop_id => $2, + date => $3, + time => $4, + key => $5 }; } + else { + $self->render( 'not_found', status => 404 ); + return; + } - for my $message ( $tree->findnodes('/Journey/HIMMessage') ) { - my $header = $message->getAttribute('header'); - my $lead = $message->getAttribute('lead'); - my $display = $message->getAttribute('display'); - push( - @{ $ret->{messages} }, - { - header => $header, - lead => $lead, - display => $display + $self->render_later; + + Travel::Status::DE::EFA->new_p( + service => $self->param('efa'), + stopseq => $stopseq, + cache => $self->app->cache_iris_rt, + lwp_options => { + timeout => 10, + agent => 'dbf.finalrewind.org/2' + }, + promise => 'Mojo::Promise', + user_agent => Mojo::UserAgent->new, + )->then( + sub { + my ($efa) = @_; + my $trip = $efa->result; + + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + my $res = { + trip_id => $trip_id, + train_type => $trip->type, + train_line => $trip->line, + train_no => $trip->number, + origin => ( $trip->route )[0]->full_name, + destination => ( $trip->route )[-1]->full_name, + operators => [ $trip->operator ], + linetype => lc( $trip->product ) =~ tr{a-z}{}cdr, + route_pre_diff => [], + route_post_diff => [], + moreinfo => [], + replaced_by => [], + replacement_for => [], + }; + + if ( $res->{linetype} =~ m{strab|stra.?enbahn} ) { + $res->{linetype} = 'tram'; + } + elsif ( $res->{linetype} =~ m{bus} ) { + $res->{linetype} = 'bus'; } - ); - } - $cache->freeze( $url, $ret ); + my $station_is_past = 1; + for my $stop ( $trip->route ) { - return $ret; + push( + @{ $res->{route_post_diff} }, + { + name => $stop->full_name, + id => $stop->id_code, + sched_arr => $stop->sched_arr, + sched_dep => $stop->sched_dep, + rt_arr => $stop->rt_arr, + rt_dep => $stop->rt_dep, + arr_delay => $stop->arr_delay, + dep_delay => $stop->dep_delay, + platform => $stop->platform, + } + ); + if ( + $station_is_past + and $now->epoch < ( + $res->{route_post_diff}[-1]{rt_arr} + // $res->{route_post_diff}[-1]{rt_dep} + // $res->{route_post_diff}[-1]{sched_arr} + // $res->{route_post_diff}[-1]{sched_dep} // $now + )->epoch + ) + { + $station_is_past = 0; + } + $res->{route_post_diff}[-1]{isPast} = $station_is_past; + } + + if ( my $req_id = $self->param('highlight') ) { + my $split; + for my $i ( 0 .. $#{ $res->{route_post_diff} } ) { + if ( $res->{route_post_diff}[$i]{id} eq $req_id ) { + $split = $i; + last; + } + } + if ( defined $split ) { + $self->stash( + station_name => $res->{route_post_diff}[$split]{name} ); + for my $i ( 0 .. $split - 1 ) { + push( + @{ $res->{route_pre_diff} }, + shift( @{ $res->{route_post_diff} } ) + ); + } + my $station_info = shift( @{ $res->{route_post_diff} } ); + $res->{eva} = $station_info->{eva}; + if ( $station_info->{sched_arr} ) { + $res->{sched_arrival} + = $station_info->{sched_arr}->strftime('%H:%M'); + } + if ( $station_info->{rt_arr} ) { + $res->{arrival} + = $station_info->{rt_arr}->strftime('%H:%M'); + } + if ( $station_info->{sched_dep} ) { + $res->{sched_departure} + = $station_info->{sched_dep}->strftime('%H:%M'); + } + if ( $station_info->{rt_dep} ) { + $res->{departure} + = $station_info->{rt_dep}->strftime('%H:%M'); + } + $res->{arrival_is_cancelled} + = $station_info->{arr_cancelled}; + $res->{departure_is_cancelled} + = $station_info->{dep_cancelled}; + $res->{is_cancelled} = $res->{arrival_is_cancelled} + || $res->{arrival_is_cancelled}; + $res->{tz_offset} = $station_info->{tz_offset}; + $res->{local_dt_da} = $station_info->{local_dt_da}; + $res->{local_sched_arr} = $station_info->{local_sched_arr}; + $res->{local_sched_dep} = $station_info->{local_sched_dep}; + $res->{is_annotated} = $station_info->{is_annotated}; + $res->{prod_name} = $station_info->{prod_name}; + $res->{direction} = $station_info->{direction}; + $res->{operator} = $station_info->{operator}; + $res->{platform} = $station_info->{platform}; + $res->{scheduled_platform} + = $station_info->{sched_platform}; + } + } + + $self->respond_to( + json => { + json => { + journey => $trip, + }, + }, + any => { + template => $self->param('ajax') + ? '_train_details' + : 'train_details', + description => sprintf( + '%s %s%s%s nach %s', + $res->{train_type}, + $res->{train_line} // $res->{train_no}, + $res->{origin} ? ' von ' : q{}, + $res->{origin} // q{}, + $res->{destination} // 'unbekannt' + ), + departure => $res, + linetype => $res->{linetype}, + dt_now => DateTime->now( time_zone => 'Europe/Berlin' ), + }, + ); + } + )->catch( + sub { + my ($e) = @_; + $self->respond_to( + json => { + json => { + error => $e, + }, + status => 500, + }, + any => { + template => 'exception', + message => $e, + exception => undef, + snapshot => {}, + status => 500, + }, + ); + } + )->wait; } -# quick&dirty, will be cleaned up later -sub get_route_timestamps { - my ( $ua, $cache_main, $cache_rt, $opt ) = @_; +# /z/:train +sub train_details { + my ($self) = @_; + my $train = $self->stash('train'); + my $dbris = $self->param('dbris'); + my $efa = $self->param('efa'); + my $hafas = $self->param('hafas'); + + # TODO error handling - $ua->request_timeout(3); + if ( $self->param('ajax') ) { + delete $self->stash->{layout}; + } - my $base - = 'https://reiseauskunft.bahn.de/bin/trainsearch.exe/dn?L=vs_json&start=yes&rt=1'; - my ( $date_yy, $date_yyyy, $train_no, $train_origin ); + $self->stash( departures => [] ); + $self->stash( title => 'DBF' ); - if ( $opt->{train} ) { - $date_yy = $opt->{train}->start->strftime('%d.%m.%y'); - $date_yyyy = $opt->{train}->start->strftime('%d.%m.%Y'); - $train_no = $opt->{train}->type . ' ' . $opt->{train}->train_no; - $train_origin = $opt->{train}->origin; + if ($dbris) { + return $self->train_details_dbris; } - else { - my $now = DateTime->now( time_zone => 'Europe/Berlin' ); - $date_yy = $now->strftime('%d.%m.%y'); - $date_yyyy = $now->strftime('%d.%m.%Y'); - $train_no = $opt->{train_no}; + if ($efa) { + return $self->train_details_efa; } - my $trainsearch = hafas_json_req( $ua, $cache_main, - "${base}&date=${date_yy}&trainname=${train_no}" ); + my $res = { + train_type => undef, + train_line => undef, + train_no => undef, + route_pre_diff => [], + route_post_diff => [], + moreinfo => [], + replaced_by => [], + replacement_for => [], + }; + + my %opt; - if ( not $trainsearch ) { - return; + if ( $train =~ m{[|]} ) { + $opt{trip_id} = $train; + } + else { + my ( $train_type, $train_no ) = ( $train =~ m{ ^ (\S+) \s+ (.*) $ }x ); + $res->{train_type} = $train_type; + $res->{train_no} = $train_no; + $self->stash( title => "${train_type} ${train_no}" ); + $opt{train_type} = $train_type; + $opt{train_no} = $train_no; } - # Fallback: Take first result - my $trainlink = $trainsearch->{suggestions}[0]{trainLink}; + my $service = 'DB'; + if ( $hafas + and $hafas ne '1' + and Travel::Status::DE::HAFAS::get_service($hafas) ) + { + $opt{service} = $hafas; + } - # Try finding a result for the current date - for my $suggestion ( @{ $trainsearch->{suggestions} // [] } ) { + #if ( $self->languages =~ m{^en} ) { + # $opt{language} = 'en'; + #} - # Drunken API, sail with care. Both date formats are used interchangeably - if ( - exists $suggestion->{depDate} - and ( $suggestion->{depDate} eq $date_yy - or $suggestion->{depDate} eq $date_yyyy ) + if ( my $date = $self->param('date') ) { + if ( $date + =~ m{ ^ (?<day> \d{1,2} ) [.] (?<month> \d{1,2} ) [.] (?<year> \d{4})? $ }x ) { - # 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 ( $train_origin and $suggestion->{dep} eq $train_origin ) { - $trainlink = $suggestion->{trainLink}; - last; + $opt{datetime} = DateTime->now( time_zone => 'Europe/Berlin' ); + $opt{datetime}->set( + day => $+{day}, + month => $+{month} + ); + if ( $+{year} ) { + $opt{datetime}->set( year => $+{year} ); } } } - if ( not $trainlink ) { - return; - } + $self->stash( hide_opts => 1 ); + $self->render_later; - $base = 'https://reiseauskunft.bahn.de/bin/traininfo.exe/dn'; + my $linetype = 'bahn'; - my $traininfo = hafas_json_req( $ua, $cache_rt, - "${base}/${trainlink}?rt=1&date=${date_yy}&L=vs_json" ); + $self->hafas->get_route_p(%opt)->then( + sub { + my ( $route, $journey, $hafas_obj ) = @_; - if ( not $traininfo or $traininfo->{error} ) { - return; - } + $res->{trip_id} = $journey->id; + $res->{date} = $route->[0]{sched_dep} // $route->[0]{dep}; - my $traindelay = hafas_xml_req( $ua, $cache_rt, - "${base}/${trainlink}?rt=1&date=${date_yy}&L=vs_java3" ); + my $product = $journey->product; - my $ret = {}; + if ( my $req_name = $self->param('highlight') ) { + if ( my $p = $journey->product_at($req_name) ) { + $product = $p; + } + } - my $strp = DateTime::Format::Strptime->new( - pattern => '%d.%m.%y %H:%M', - time_zone => 'Europe/Berlin', - ); + my $train_type = $res->{train_type} = $product->type // q{}; + my $train_no = $res->{train_no} = $product->number // q{}; + $res->{train_line} = $product->line_no // q{}; + $self->stash( title => $train_type . ' ' + . ( $train_no || $res->{train_line} ) ); - for my $station ( @{ $traininfo->{suggestions}[0]{locations} // [] } ) { - my $name = $station->{name}; - my $arr = $station->{arrDate} . ' ' . $station->{arrTime}; - my $dep = $station->{depDate} . ' ' . $station->{depTime}; - $ret->{$name} = { - sched_arr => scalar $strp->parse_datetime($arr), - sched_dep => scalar $strp->parse_datetime($dep), - }; - if ( exists $traindelay->{station}{$name} ) { - my $delay = $traindelay->{station}{$name}; - if ( $ret->{$name}{sched_arr} - and $delay->{adelay} - and $delay->{adelay} =~ m{^\d+$} ) - { - $ret->{$name}{rt_arr} = $ret->{$name}{sched_arr} - ->clone->add( minutes => $delay->{adelay} ); + if ( not defined $product->class ) { + $linetype = 'ext'; } - if ( $ret->{$name}{sched_dep} - and $delay->{ddelay} - and $delay->{ddelay} =~ m{^\d+$} ) - { - $ret->{$name}{rt_dep} = $ret->{$name}{sched_dep} - ->clone->add( minutes => $delay->{ddelay} ); + else { + my $prod + = $self->class_to_product($hafas_obj)->{ $product->class } + // q{}; + if ( $prod =~ m{ ^ ice? | inter-?cit }ix ) { + $linetype = 'fern'; + } + elsif ( $prod =~ m{ s-bahn | urban | rapid }ix ) { + $linetype = 'sbahn'; + } + elsif ( $prod =~ m{ bus }ix ) { + $linetype = 'bus'; + } + elsif ( $prod =~ m{ metro | u-bahn | subway }ix ) { + $linetype = 'ubahn'; + } + elsif ( $prod =~ m{ tram }ix ) { + $linetype = 'tram'; + } } - } - } - return ( $ret, $traindelay // {} ); -} + $res->{origin} = $journey->route_start; + $res->{destination} = $journey->route_end; + $res->{operators} = [ $journey->operators ]; -sub get_results_for { - my ( $backend, $station, %opt ) = @_; - my $data; + $res->{route_post_diff} = $route; - # Cache::File has UTF-8 problems, so strip it (and any other potentially - # problematic chars). - my $cache_str = $station; - $cache_str =~ tr{[0-9a-zA-Z -]}{}cd; - - if ( $backend eq 'iris' ) { - - if ( $ENV{DBFAKEDISPLAY_STATS} ) { - log_api_access(); - } - - # requests with DS100 codes should be preferred (they avoid - # encoding problems on the IRIS server). However, only use them - # if we have an exact match. Ask the backend otherwise. - my @station_matches - = Travel::Status::DE::IRIS::Stations::get_station($station); - if ( @station_matches == 1 ) { - $station = $station_matches[0][0]; - my $status = Travel::Status::DE::IRIS->new( - station => $station, - main_cache => $opt{cache_iris_main}, - realtime_cache => $opt{cache_iris_rt}, - log_dir => $ENV{DBFAKEDISPLAY_XMLDUMP_DIR}, - lookbehind => 20, - lwp_options => { - timeout => 10, - agent => 'dbf.finalrewind.org/2' + if ( my $req_name = $self->param('highlight') ) { + my $split; + for my $i ( 0 .. $#{ $res->{route_post_diff} } ) { + if ( $res->{route_post_diff}[$i]{name} eq $req_name ) { + $split = $i; + last; + } + } + if ( defined $split ) { + $self->stash( station_name => $req_name ); + for my $i ( 0 .. $split - 1 ) { + push( + @{ $res->{route_pre_diff} }, + shift( @{ $res->{route_post_diff} } ) + ); + } + my $station_info = shift( @{ $res->{route_post_diff} } ); + $res->{eva} = $station_info->{eva}; + if ( $station_info->{sched_arr} ) { + $res->{sched_arrival} + = $station_info->{sched_arr}->strftime('%H:%M'); + } + if ( $station_info->{rt_arr} ) { + $res->{arrival} + = $station_info->{rt_arr}->strftime('%H:%M'); + } + if ( $station_info->{sched_dep} ) { + $res->{sched_departure} + = $station_info->{sched_dep}->strftime('%H:%M'); + } + if ( $station_info->{rt_dep} ) { + $res->{departure} + = $station_info->{rt_dep}->strftime('%H:%M'); + } + $res->{arrival_is_cancelled} + = $station_info->{arr_cancelled}; + $res->{departure_is_cancelled} + = $station_info->{dep_cancelled}; + $res->{is_cancelled} = $res->{arrival_is_cancelled} + || $res->{arrival_is_cancelled}; + $res->{tz_offset} = $station_info->{tz_offset}; + $res->{local_dt_da} = $station_info->{local_dt_da}; + $res->{local_sched_arr} = $station_info->{local_sched_arr}; + $res->{local_sched_dep} = $station_info->{local_sched_dep}; + $res->{is_annotated} = $station_info->{is_annotated}; + $res->{prod_name} = $station_info->{prod_name}; + $res->{direction} = $station_info->{direction}; + $res->{operator} = $station_info->{operator}; + $res->{platform} = $station_info->{platform}; + $res->{scheduled_platform} + = $station_info->{sched_platform}; + } + } + + my @him_messages; + my @him_details; + for my $message ( $journey->messages ) { + if ( $message->code ) { + push( @him_details, + [ $message->short // q{}, { text => $message->text } ] + ); + } + else { + push( @him_messages, + [ $message->short // q{}, { text => $message->text } ] + ); + } + } + for my $m (@him_messages) { + if ( $m->[0] =~ s{: Information.}{:} ) { + $m->[1]{icon} = 'info_outline'; + } + elsif ( $m->[0] =~ s{: Störung.}{: } ) { + $m->[1]{icon} = 'warning'; + } + elsif ( $m->[0] =~ s{: Bauarbeiten.}{: } ) { + $m->[1]{icon} = 'build'; + } + } + if (@him_messages) { + $res->{moreinfo} = [@him_messages]; + } + if (@him_details) { + $res->{details} = [@him_details]; + } + + $self->respond_to( + json => { + json => { + journey => $journey, + }, + }, + any => { + template => $self->param('ajax') + ? '_train_details' + : 'train_details', + description => sprintf( + '%s %s%s%s nach %s', + $res->{train_type}, + $res->{train_line} // $res->{train_no}, + $res->{origin} ? ' von ' : q{}, + $res->{origin} // q{}, + $res->{destination} // 'unbekannt' + ), + departure => $res, + linetype => $linetype, + dt_now => DateTime->now( time_zone => 'Europe/Berlin' ), }, - %opt ); - $data = { - results => [ $status->results ], - errstr => $status->errstr, - station_name => - ( $status->station ? $status->station->{name} : $station ), - }; - } - elsif ( @station_matches > 1 ) { - $data = { - results => [], - errstr => 'Ambiguous station name', - }; } - else { - $data = { - results => [], - errstr => 'Unknown station name', - }; - } - } - elsif ( $backend eq 'ris' ) { - $data = $opt{cache_hafas}->thaw($cache_str); - if ( not $data ) { - if ( $ENV{DBFAKEDISPLAY_STATS} ) { - log_api_access(); + )->catch( + sub { + my ($e) = @_; + if ($e) { + $self->respond_to( + json => { + json => { + error => $e, + }, + status => 500, + }, + any => { + template => 'exception', + message => $e, + exception => undef, + snapshot => {}, + status => 500, + }, + ); + } + else { + $self->render( 'not_found', status => 404 ); } - my $status = Travel::Status::DE::HAFAS->new( - station => $station, - excluded_mots => [qw[bus ferry ondemand tram u]], - lwp_options => { - timeout => 10, - agent => 'dbf.finalrewind.org/2' - }, - %opt - ); - $data = { - results => [ $status->results ], - errstr => $status->errstr, - }; - $opt{cache_hafas}->freeze( $cache_str, $data ); } + )->wait; +} + +sub render_board_dbris { + my ( $self, $station_id, $dbris ) = @_; + my $template = $self->param('mode') // 'app'; + my $hide_low_delay = $self->param('hidelowdelay') // 0; + my $hide_opts = $self->param('hide_opts') // 0; + my $show_realtime = $self->param('rt') // $self->param('show_realtime') + // 1; + + my $station_name; + if ( $station_id =~ m{ [@] O = (?<name> [^@]+) [@] }x ) { + $station_name = $+{name}; } - else { - $data = { - results => [], - errstr => "Backend '$backend' not supported", - }; + + my @departures; + + if ( $self->param('ajax') ) { + delete $self->stash->{layout}; } - return $data; -} + my @results = $self->filter_results( $dbris->results ); -sub handle_request { - my ($self) = @_; - my $station = $self->stash('station'); - my $via = $self->param('via'); - - my @platforms = split( /,/, $self->param('platforms') // q{} ); - my @lines = split( /,/, $self->param('lines') // q{} ); - my $template = $self->param('mode') // 'app'; - my $hide_low_delay = $self->param('hidelowdelay') // 0; - my $hide_opts = $self->param('hide_opts') // 0; - my $show_realtime = $self->param('show_realtime') // 0; - my $show_details = $self->param('detailed') // 0; - my $backend = $self->param('backend') // 'iris'; - my $admode = $self->param('admode') // 'deparr'; - my $dark_layout = $self->param('dark') // 0; - my $apiver = $self->param('version') // 0; - my $callback = $self->param('callback'); - my $with_related = !$self->param('no_related'); - my $save_defaults = $self->param('save_defaults') // 0; - my $limit = $self->param('limit') // 0; - my @train_types = split( /,/, $self->param('train_types') // q{} ); - my %opt = ( - cache_hafas => $self->app->cache_hafas, - cache_iris_main => $self->app->cache_iris_main, - cache_iris_rt => $self->app->cache_iris_rt, - ); + @results = map { $_->[1] } sort { $a->[0] <=> $b->[0] } + map { [ $_->dep, $_ ] } @results; - my $api_version - = $backend eq 'iris' - ? $Travel::Status::DE::IRIS::VERSION - : $Travel::Status::DE::HAFAS::VERSION; + for my $result (@results) { + my $time; - if ($save_defaults) { - $self->session( has_data => 1 ); - $self->session( mode => $template ); - $self->session( hidelowdelay => $hide_low_delay ); - $self->session( hide_opts => $hide_opts ); - $self->session( show_realtime => $show_realtime ); - $self->session( admode => $admode ); - $self->session( dark => $dark_layout ); - $self->session( detailed => $show_details ); - $self->session( no_related => !$with_related ); - } + if ( $template eq 'json' ) { + push( @departures, $result ); + next; + } - $self->stash( departures => [] ); - $self->stash( title => 'DBF' ); - $self->stash( version => $dbf_version ); + if ( $show_realtime and $result->rt_dep ) { + $time = $result->rt_dep->strftime('%H:%M'); + } + else { + $time = $result->sched_dep->strftime('%H:%M'); + } - if ( defined $station and $station =~ s{ [.] txt $ }{}x ) { - $template = 'text'; - $self->param( station => $station ); - $self->stash( layout => 'text' ); + my $linetype = $result->line; + if ( $linetype =~ m{ STR }x ) { + $linetype = 'tram'; + } + elsif ( $linetype =~ m{ ^ S }x ) { + $linetype = 'sbahn'; + } + elsif ( $linetype =~ m{ U }x ) { + $linetype = 'ubahn'; + } + elsif ( $linetype =~ m{ Bus }x ) { + $linetype = 'bus'; + } + elsif ( $linetype =~ m{ ^ [EI]CE? }x ) { + $linetype = 'fern'; + } + elsif ( $linetype =~ m{ EST | FLX }x ) { + $linetype = 'ext'; + } + else { + $linetype = 'bahn'; + } + + my $delay = $result->delay; + + push( + @departures, + { + time => $time, + sched_departure => $result->sched_dep->strftime('%H:%M'), + departure => $result->rt_dep + ? $result->rt_dep->strftime('%H:%M') + : undef, + train => $result->train_mid, + train_type => q{}, + train_line => $result->line, + train_no => $result->maybe_train_no, + journey_id => $result->id, + via => [ $result->via ], + origin => q{}, + destination => $result->destination, + platform => $result->rt_platform // $result->platform, + scheduled_platform => $result->platform, + is_cancelled => $result->is_cancelled, + linetype => $linetype, + delay => $delay, + is_bit_delayed => + ( $delay and $delay > 0 and $delay < 5 ? 1 : 0 ), + is_delayed => ( $delay and $delay >= 5 ? 1 : 0 ), + has_realtime => defined $delay ? 1 : 0, + station => $result->stop_eva, + replaced_by => [], + replacement_for => [], + route_pre => [], + route_post => [ $result->via ], + wr_dt => undef, + } + ); } - elsif ( defined $station and $station =~ s{ [.] json $ }{}x ) { - $template = 'json'; + + if ( $template eq 'json' ) { + $self->res->headers->access_control_allow_origin(q{*}); + my $json = { + departures => \@departures, + }; + $self->render( + json => $json, + ); } - elsif ( $template ne 'app' ) { - $self->stash( layout => 'legacy' ); + else { + $self->render( + $template, + description => "Abfahrtstafel $station_name", + departures => \@departures, + station => $station_name, + version => $self->config->{version}, + title => $station_name, + refresh_interval => $template eq 'app' ? 0 : 120, + hide_opts => $hide_opts, + hide_footer => $hide_opts, + hide_low_delay => $hide_low_delay, + show_realtime => $show_realtime, + load_marquee => ( + $template eq 'single' + or $template eq 'multi' + ), + force_mobile => ( $template eq 'app' ), + ); } +} - # Historically, there were two JSON APIs: 'json' (undocumented, raw - # passthrough of serialized Travel::Status::DE::IRIS::Result / - # Travel::Status::DE::DE::HAFAS::Result objects) and 'marudor' - # (documented, IRIS only, stable versioned API). The latter was initially - # created for marudor.de, but quickly used by other clients as well. - # - # marudor.de switched to a nodejs IRIS parser in December 2018. As the - # 'json' API was not used and the 'marudor' variant is no longer related to - # (or used by) marudor.de, it was renamed to 'json'. Many clients won't - # notice this for year to come, so we make sure mode=marudor still works as - # intended. - if ( $template eq 'marudor' ) { - $template = 'json'; - } +sub render_board_efa { + my ( $self, $station_name, $efa ) = @_; + my $template = $self->param('mode') // 'app'; + my $hide_low_delay = $self->param('hidelowdelay') // 0; + my $hide_opts = $self->param('hide_opts') // 0; + my $show_realtime = $self->param('rt') // $self->param('show_realtime') + // 1; - if ( not( $template ~~ [qw[app infoscreen json multi single text]] ) ) { - $template = 'app'; + my @departures; + + if ( $self->param('ajax') ) { + delete $self->stash->{layout}; } - if ( not $station ) { - if ( $self->session('has_data') ) { - for my $param ( - qw(mode hidelowdelay hide_opts show_realtime admode no_related dark detailed) - ) + my @results = $self->filter_results( $efa->results ); + + for my $result (@results) { + my $time; + + if ( $template eq 'json' ) { + push( @departures, $result ); + next; + } + + if ( $show_realtime and $result->rt_datetime ) { + $time = $result->rt_datetime->strftime('%H:%M'); + } + else { + $time = $result->sched_datetime->strftime('%H:%M'); + } + + my $linetype = $result->mot_name // 'bahn'; + if ( $linetype =~ m{ s-bahn | urban | rapid }ix ) { + $linetype = 'sbahn'; + } + elsif ( $linetype =~ m{ metro | u-bahn | subway }ix ) { + $linetype = 'ubahn'; + } + elsif ( $linetype =~ m{ bus }ix ) { + $linetype = 'bus'; + } + elsif ( $linetype =~ m{ tram }ix ) { + $linetype = 'tram'; + } + elsif ( $linetype =~ m{ ^ ice? | inter-?cit }ix ) { + $linetype = 'fern'; + } + elsif ( $linetype eq 'sonstige' ) { + $linetype = 'ext'; + } + + my $delay = $result->delay; + + push( + @departures, { - $self->param( $param => $self->session($param) ); + time => $time, + sched_departure => $result->sched_datetime->strftime('%H:%M'), + departure => $result->rt_datetime + ? $result->rt_datetime->strftime('%H:%M') + : undef, + train => $result->line, + train_type => q{}, + train_line => $result->line, + train_no => $result->train_no, + journey_id => $result->id, + via => [ map { $_->name } $result->route_interesting ], + origin => $result->origin, + destination => $result->destination, + platform => $result->platform, + is_cancelled => $result->is_cancelled, + linetype => $linetype, + delay => $delay, + is_bit_delayed => + ( $delay and $delay > 0 and $delay < 5 ? 1 : 0 ), + is_delayed => ( $delay and $delay >= 5 ? 1 : 0 ), + has_realtime => defined $delay ? 1 : 0, + occupancy => $result->occupancy, + station => $efa->stop->id_code, + replaced_by => [], + replacement_for => [], + route_pre => [ map { $_->full_name } $result->route_pre ], + route_post => [ map { $_->full_name } $result->route_post ], + wr_dt => undef, } - } - $self->render( 'landingpage', show_intro => 1 ); - return; + ); } if ( $template eq 'json' ) { - $backend = 'iris'; - $opt{lookahead} = 120; + $self->res->headers->access_control_allow_origin(q{*}); + my $json = { + departures => \@departures, + }; + $self->render( + json => $json, + ); } - - if ($with_related) { - $opt{with_related} = 1; + else { + $self->render( + $template, + description => "Abfahrtstafel $station_name", + departures => \@departures, + station => $efa->stop->name, + version => $self->config->{version}, + title => $efa->stop->name // $station_name, + refresh_interval => $template eq 'app' ? 0 : 120, + hide_opts => $hide_opts, + hide_footer => $hide_opts, + hide_low_delay => $hide_low_delay, + show_realtime => $show_realtime, + load_marquee => ( + $template eq 'single' + or $template eq 'multi' + ), + force_mobile => ( $template eq 'app' ), + ); } +} + +# For HAFAS and IRIS departure elements +sub render_board_hafas { + my ( $self, $data ) = @_; + my @results = @{ $data->{results} }; my @departures; - my $data = get_results_for( $backend, $station, %opt ); - my $results_ref = $data->{results}; - my $errstr = $data->{errstr}; - my @results = @{$results_ref}; - - if ( not @results and $template eq 'json' ) { - $self->handle_no_results_json( $backend, $station, $errstr, - $api_version, $callback ); - return; - } - # foo/bar used to mean "departures for foo via bar". This is now - # deprecated, but most of these cases are handled here. - if ( not @results and $station =~ m{/} ) { - ( $station, $via ) = split( qr{/}, $station ); - $self->param( station => $station ); - $self->param( via => $via ); - $data = get_results_for( $backend, $station, %opt ); - $results_ref = $data->{results}; - $errstr = $data->{errstr}; - @results = @{$results_ref}; - } + my @platforms = split( /,/, $self->param('platforms') // q{} ); + my $template = $self->param('mode') // 'app'; + my $hide_low_delay = $self->param('hidelowdelay') // 0; + my $hide_opts = $self->param('hide_opts') // 0; + my $show_realtime = $self->param('rt') // $self->param('show_realtime') + // 1; + my $show_details = $self->param('detailed') // 0; + my $admode = $self->param('admode') // 'deparr'; + my $apiver = $self->param('version') // 0; + my $callback = $self->param('callback'); + my $via = $self->param('via'); + my $hafas = $self->param('hafas'); + my $hafas_obj = $data->{hafas}; + + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); - if ( not @results ) { - $self->handle_no_results( $backend, $station, $errstr ); - return; + if ( $self->param('ajax') ) { + delete $self->stash->{layout}; } if ( $template eq 'single' ) { if ( not @platforms ) { for my $result (@results) { + my $num_part + = $self->numeric_platform_part( $result->platform ); if ( - not( $self->numeric_platform_part( $result->platform ) ~~ - \@platforms ) - ) + not( List::MoreUtils::any { $num_part eq $_ } @platforms ) ) { - push( @platforms, - $self->numeric_platform_part( $result->platform ) ); + push( @platforms, $num_part ); } } @platforms = sort { $a <=> $b } @platforms; @@ -647,160 +2275,117 @@ sub handle_request { map { [ $self->numeric_platform_part( $_->platform ), $_ ] } @results; } - if ( $backend eq 'iris' and $show_realtime ) { - if ( $admode eq 'arr' ) { - @results = sort { - ( $a->arrival // $a->departure ) - <=> ( $b->arrival // $b->departure ) - } @results; + if ($show_realtime) { + if ($hafas) { + @results = sort { $a->datetime <=> $b->datetime } @results; + } + elsif ( $admode eq 'arr' ) { + @results = map { $_->[1] } + sort { $a->[0] <=> $b->[0] } + map { + [ + ( + $_->sched_arrival ? $_->arrival_is_cancelled + : $_->is_cancelled + ) ? ( $_->sched_arrival // $_->sched_departure ) + : ( $_->arrival // $_->departure ), + $_ + ] + } @results; } else { - @results = sort { - ( $a->departure // $a->arrival ) - <=> ( $b->departure // $b->arrival ) - } @results; + @results = map { $_->[1] } + sort { $a->[0] <=> $b->[0] } + map { + [ + ( + $_->sched_departure ? $_->departure_is_cancelled + : $_->is_cancelled + ) ? ( $_->sched_departure // $_->sched_arrival ) + : ( $_->departure // $_->arrival ), + $_ + ] + } @results; } } - if ( my $train = $self->param('train') ) { - @results = grep { result_is_train( $_, $train ) } @results; - } - - if (@lines) { - @results = grep { result_has_line( $_, @lines ) } @results; - } - - if (@platforms) { - @results = grep { result_has_platform( $_, @platforms ) } @results; - } - - if ($via) { - $via =~ s{ , \s* }{|}gx; - @results = grep { result_has_via( $_, $via ) } @results; - } - - if (@train_types) { - @results = grep { result_has_train_type( $_, @train_types ) } @results; - } + my $class_to_product + = $hafas_obj ? $self->class_to_product($hafas_obj) : {}; - if ( $limit and $limit =~ m{ ^ \d+ $ }x ) { - splice( @results, $limit ); - } + @results = $self->filter_results(@results); for my $result (@results) { my $platform = ( split( qr{ }, $result->platform // '' ) )[0]; my $delay = $result->delay; - if ( $backend eq 'iris' and $admode eq 'arr' and not $result->arrival ) - { + if ( $admode eq 'arr' and not $hafas and not $result->arrival ) { next; } - if ( $backend eq 'iris' - and $admode eq 'dep' + if ( $admode eq 'dep' + and not $hafas and not $result->departure ) { next; } my ( $info, $moreinfo ); - if ( $backend eq 'iris' ) { - my $delaymsg - = join( ', ', map { $_->[1] } $result->delay_messages ); - my $qosmsg = join( ' +++ ', map { $_->[1] } $result->qos_messages ); - if ( $result->is_cancelled ) { - $info = "Fahrt fällt aus: ${delaymsg}"; - } - elsif ( $result->departure_is_cancelled ) { - $info = "Zug endet hier: ${delaymsg}"; - } - elsif ( $result->delay and $result->delay > 0 ) { - if ( $template eq 'app' or $template eq 'infoscreen' ) { - $info = $delaymsg; - } - else { - $info = sprintf( 'ca. +%d%s%s', - $result->delay, $delaymsg ? q{: } : q{}, $delaymsg ); - } + if ( $result->can('replacement_for') ) { + ( $info, $moreinfo ) + = $self->format_iris_result_info( $template, $result ); + } + + my $time + = $result->can('time') + ? $result->time + : $result->sched_datetime->strftime('%H:%M'); + my $linetype = 'bahn'; + + if ( $result->can('classes') ) { + my @classes = $result->classes; + if ( @classes == 0 ) { + $linetype = 'ext'; } - if ( $result->replacement_for - and $template ne 'app' - and $template ne 'infoscreen' ) - { - for my $rep ( $result->replacement_for ) { - $info = sprintf( - 'Ersatzzug für %s %s %s%s', - $rep->type, $rep->train_no, - $info ? '+++ ' : q{}, $info // q{} - ); - } + elsif ( grep { $_ eq 'S' } @classes ) { + $linetype = 'sbahn'; } - if ( $info and $qosmsg ) { - $info .= ' +++ '; + elsif ( grep { $_ eq 'F' } @classes ) { + $linetype = 'fern'; } - $info .= $qosmsg; - - if ( $result->additional_stops and not $result->is_cancelled ) { - my $additional_line = join( q{, }, $result->additional_stops ); - $info - = 'Zusätzliche Halte: ' - . $additional_line - . ( $info ? ' +++ ' : q{} ) - . $info; - if ( $template ne 'json' ) { - push( - @{$moreinfo}, - [ 'Zusätzliche Halte', $additional_line ] - ); - } + } + elsif ( $result->can('class') ) { + my $prod = $class_to_product->{ $result->class } // q{}; + if ( $prod =~ m{ ^ ice? | inter-?cit }ix ) { + $linetype = 'fern'; } - - if ( $result->canceled_stops and not $result->is_cancelled ) { - my $cancel_line = join( q{, }, $result->canceled_stops ); - $info - = 'Ohne Halt in: ' - . $cancel_line - . ( $info ? ' +++ ' : q{} ) - . $info; - if ( $template ne 'json' ) { - push( @{$moreinfo}, [ 'Ohne Halt in', $cancel_line ] ); - } + elsif ( $prod =~ m{ s-bahn | urban | rapid }ix ) { + $linetype = 'sbahn'; } - - push( @{$moreinfo}, $result->messages ); - } - else { - $info = $result->info; - if ($info) { - $moreinfo = [ [ 'HAFAS', $info ] ]; + elsif ( $prod =~ m{ bus }ix ) { + $linetype = 'bus'; } - if ( $result->delay and $result->delay > 0 ) { - if ($info) { - $info = 'ca. +' . $result->delay . ': ' . $info; - } - else { - $info = 'ca. +' . $result->delay; - } + elsif ( $prod =~ m{ metro | u-bahn | subway }ix ) { + $linetype = 'ubahn'; + } + elsif ( $prod =~ m{ tram }ix ) { + $linetype = 'tram'; } - push( @{$moreinfo}, map { [ 'HAFAS', $_ ] } $result->messages ); } - my $time = $result->time; - - if ( $backend eq 'iris' ) { + # ->time defaults to dep, so we only need to overwrite $time + # if we want arrival times + if ( $admode eq 'arr' and not $hafas ) { + $time = $result->sched_arrival->strftime('%H:%M'); + } - # ->time defaults to dep, so we only need to overwrite $time - # if we want arrival times - if ( $admode eq 'arr' ) { - $time = $result->sched_arrival->strftime('%H:%M'); + if ($show_realtime) { + if ($hafas) { + $time = $result->datetime->strftime('%H:%M'); } - - if ($show_realtime) { - if ( ( $admode eq 'arr' and $result->arrival ) - or not $result->departure ) - { - $time = $result->arrival->strftime('%H:%M'); - } - else { - $time = $result->departure->strftime('%H:%M'); - } + elsif ( ( $admode eq 'arr' and $result->arrival ) + or not $result->departure ) + { + $time = $result->arrival->strftime('%H:%M'); + } + else { + $time = $result->departure->strftime('%H:%M'); } } @@ -808,80 +2393,168 @@ sub handle_request { if ($info) { $info =~ s{ (?: ca [.] \s* )? [+] [ 1 2 3 4 ] $ }{}x; } - if ( $delay and $delay < 5 ) { - $delay = undef; - } } if ($info) { $info =~ s{ (?: ca [.] \s* )? [+] (\d+) }{Verspätung ca $1 Min.}x; } if ( $template eq 'json' ) { - my @json_route = $self->json_route_diff( [ $result->route ], - [ $result->sched_route ] ); + my @json_route; + if ( $result->can('sched_route') ) { + @json_route = $self->json_route_diff( [ $result->route ], + [ $result->sched_route ] ); + } + else { + @json_route = map { $_->TO_JSON } $result->route; + } - if ( $apiver == 1 ) { - push( - @departures, + if ( $apiver eq '1' or $apiver eq '2' ) { + + # no longer supported + $self->handle_no_results_json( + undef, { - delay => $delay, - destination => $result->destination, - isCancelled => $result->can('is_cancelled') - ? $result->is_cancelled - : undef, - messages => { - delay => [ - map { - { - timestamp => $_->[0], - text => $_->[1] - } - } $result->delay_messages - ], - qos => [ - map { - { - timestamp => $_->[0], - text => $_->[1] - } - } $result->qos_messages - ], - }, - platform => $result->platform, - route => \@json_route, - scheduledPlatform => $result->sched_platform, - time => $time, - train => $result->train, - via => [ $result->route_interesting(3) ], - } + errstr => + "JSON API version=${apiver} is no longer supported" + }, + $Travel::Status::DE::IRIS::VERSION ); + return; } - elsif ( $apiver == 2 ) { - my ( $delay_arr, $delay_dep, $sched_arr, $sched_dep ); - if ( $result->arrival ) { - $delay_arr = $result->arrival->subtract_datetime( - $result->sched_arrival )->in_units('minutes'); - } - if ( $result->departure ) { - $delay_dep = $result->departure->subtract_datetime( - $result->sched_departure )->in_units('minutes'); - } - if ( $result->sched_arrival ) { - $sched_arr = $result->sched_arrival->strftime('%H:%M'); + elsif ( $apiver eq 'raw' ) { + push( @departures, $result ); + } + else { # apiver == 3 + if ( $result->isa('Travel::Status::DE::IRIS::Result') ) { + my ( $delay_arr, $delay_dep, $sched_arr, $sched_dep ); + if ( $result->arrival ) { + $delay_arr = $result->arrival->subtract_datetime( + $result->sched_arrival )->in_units('minutes'); + } + if ( $result->departure ) { + $delay_dep = $result->departure->subtract_datetime( + $result->sched_departure )->in_units('minutes'); + } + if ( $result->sched_arrival ) { + $sched_arr = $result->sched_arrival->strftime('%H:%M'); + } + if ( $result->sched_departure ) { + $sched_dep + = $result->sched_departure->strftime('%H:%M'); + } + push( + @departures, + { + delayArrival => $delay_arr, + delayDeparture => $delay_dep, + destination => $result->destination, + isCancelled => $result->is_cancelled, + messages => { + delay => [ + map { + { + timestamp => $_->[0], + text => $_->[1] + } + } $result->delay_messages + ], + qos => [ + map { + { + timestamp => $_->[0], + text => $_->[1] + } + } $result->qos_messages + ], + }, + missingRealtime => ( + ( + not $result->has_realtime + and $result->start < $now + ) ? \1 : \0 + ), + platform => $result->platform, + route => \@json_route, + scheduledPlatform => $result->sched_platform, + scheduledArrival => $sched_arr, + scheduledDeparture => $sched_dep, + train => $result->train, + trainClasses => [ $result->classes ], + trainNumber => $result->train_no, + via => [ $result->route_interesting(3) ], + } + ); } - if ( $result->sched_departure ) { - $sched_dep = $result->sched_departure->strftime('%H:%M'); + else { + push( + @departures, + { + delay => $result->delay, + direction => $result->direction, + destination => $result->destination, + isCancelled => $result->is_cancelled, + messages => [ $result->messages ], + platform => $result->platform, + route => \@json_route, + scheduledPlatform => $result->sched_platform, + scheduledTime => $result->sched_datetime->epoch, + time => $result->datetime->epoch, + train => $result->line, + trainNumber => $result->number, + via => [ $result->route_interesting(3) ], + } + ); } + } + } + elsif ( $template eq 'text' ) { + push( + @departures, + [ + sprintf( '%5s %s%s', + $result->is_cancelled ? '--:--' : $time, + ( $delay and $delay > 0 ) ? q{+} : q{}, + $delay || q{} ), + $result->train, + $result->destination, + $platform // q{ } + ] + ); + } + else { + if ( $result->can('replacement_for') ) { push( @departures, { - delayArrival => $delay_arr, - delayDeparture => $delay_dep, - destination => $result->destination, - isCancelled => $result->can('is_cancelled') - ? $result->is_cancelled + time => $time, + sched_arrival => $result->sched_arrival + ? $result->sched_arrival->strftime('%H:%M') : undef, - messages => { + sched_departure => $result->sched_departure + ? $result->sched_departure->strftime('%H:%M') + : undef, + arrival => $result->arrival + ? $result->arrival->strftime('%H:%M') + : undef, + departure => $result->departure + ? $result->departure->strftime('%H:%M') + : undef, + train => $result->train, + train_type => $result->type // '', + train_line => $result->line_no, + train_no => $result->train_no, + via => [ $result->route_interesting(3) ], + destination => $result->destination, + origin => $result->origin, + platform => $result->platform, + scheduled_platform => $result->sched_platform, + info => $info, + is_cancelled => $result->is_cancelled, + departure_is_cancelled => + $result->departure_is_cancelled, + arrival_is_cancelled => $result->arrival_is_cancelled, + linetype => $linetype, + messages => { delay => [ map { { @@ -899,314 +2572,104 @@ sub handle_request { } $result->qos_messages ], }, - platform => $result->platform, - route => \@json_route, - scheduledPlatform => $result->sched_platform, - scheduledArrival => $sched_arr, - scheduledDeparture => $sched_dep, - train => $result->train, - via => [ $result->route_interesting(3) ], + station => $result->station, + moreinfo => $moreinfo, + delay => $delay, + is_bit_delayed => + ( $delay and $delay > 0 and $delay < 5 ? 1 : 0 ), + is_delayed => ( $delay and $delay >= 5 ? 1 : 0 ), + arrival_delay => $result->arrival_delay, + departure_delay => $result->departure_delay, + has_realtime => $result->has_realtime, + missing_realtime => ( + not $result->has_realtime + and $result->start < $now ? 1 : 0 + ), + route_pre => [ $result->route_pre ], + route_post => [ $result->route_post ], + additional_stops => [ $result->additional_stops ], + canceled_stops => [ $result->canceled_stops ], + replaced_by => [ + map { $_->type . q{ } . $_->train_no } + $result->replaced_by + ], + replacement_for => [ + map { $_->type . q{ } . $_->train_no } + $result->replacement_for + ], + wr_dt => $result->sched_departure, + eva => $result->station_uic, } ); } - else { # apiver == 3 - my ( $delay_arr, $delay_dep, $sched_arr, $sched_dep ); - if ( $result->arrival ) { - $delay_arr = $result->arrival->subtract_datetime( - $result->sched_arrival )->in_units('minutes'); - } - if ( $result->departure ) { - $delay_dep = $result->departure->subtract_datetime( - $result->sched_departure )->in_units('minutes'); - } - if ( $result->sched_arrival ) { - $sched_arr = $result->sched_arrival->strftime('%H:%M'); - } - if ( $result->sched_departure ) { - $sched_dep = $result->sched_departure->strftime('%H:%M'); + else { + my $city = q{}; + if ( $result->station =~ m{ , ([^,]+) $ }x ) { + $city = $1; } push( @departures, { - delayArrival => $delay_arr, - delayDeparture => $delay_dep, - destination => $result->destination, - isCancelled => $result->can('is_cancelled') - ? $result->is_cancelled + time => $time, + sched_departure => + ( $result->sched_datetime and $admode ne 'arr' ) + ? $result->sched_datetime->strftime('%H:%M') : undef, - messages => { - delay => [ - map { - { - timestamp => $_->[0], - text => $_->[1] - } - } $result->delay_messages - ], - qos => [ - map { - { - timestamp => $_->[0], - text => $_->[1] - } - } $result->qos_messages - ], - }, + departure => + ( $result->rt_datetime and $admode ne 'arr' ) + ? $result->rt_datetime->strftime('%H:%M') + : undef, + train => $result->name, + train_type => q{}, + train_line => $result->line, + train_no => $result->number, + journey_id => $result->id, + via => [ + map { $_->loc->name =~ s{,\Q$city\E}{}r } + $result->route_interesting(3) + ], + destination => $result->route_end =~ s{,\Q$city\E}{}r, + origin => $result->route_end =~ s{,\Q$city\E}{}r, platform => $result->platform, - route => \@json_route, - scheduledPlatform => $result->sched_platform, - scheduledArrival => $sched_arr, - scheduledDeparture => $sched_dep, - train => $result->train, - trainClasses => [ $result->classes ], - trainNumber => $result->train_no, - via => [ $result->route_interesting(3) ], + scheduled_platform => $result->sched_platform, + load => $result->load // {}, + info => $info, + is_cancelled => $result->is_cancelled, + linetype => $linetype, + station => $result->station, + moreinfo => $moreinfo, + delay => $delay, + is_bit_delayed => + ( $delay and $delay > 0 and $delay < 5 ? 1 : 0 ), + is_delayed => ( $delay and $delay >= 5 ? 1 : 0 ), + has_realtime => defined $delay ? 1 : 0, + replaced_by => [], + replacement_for => [], + route_pre => $admode eq 'arr' + ? [ map { $_->loc->name } $result->route ] + : [], + route_post => $admode eq 'arr' ? [] + : [ map { $_->loc->name } $result->route ], + wr_dt => $result->sched_datetime, + eva => $result->station_uic, } ); } - } - elsif ( $template eq 'text' ) { - push( - @departures, - [ - sprintf( '%5s %s%s', - $result->is_cancelled ? '--:--' : $time, - ( $delay and $delay > 0 ) ? q{+} : q{}, - $delay || q{} ), - $result->train, - $result->destination, - $platform // q{ } - ] - ); - } - elsif ( $backend eq 'iris' ) { - push( - @departures, - { - time => $time, - sched_arrival => $result->sched_arrival - ? $result->sched_arrival->strftime('%H:%M') - : undef, - sched_departure => $result->sched_departure - ? $result->sched_departure->strftime('%H:%M') - : undef, - arrival => $result->arrival - ? $result->arrival->strftime('%H:%M') - : undef, - departure => $result->departure - ? $result->departure->strftime('%H:%M') - : undef, - train => $result->train, - train_type => $result->type // '', - train_line => $result->line_no, - train_no => $result->train_no, - via => [ $result->route_interesting(3) ], - destination => $result->destination, - origin => $result->origin, - platform => $result->platform, - scheduled_platform => $result->sched_platform, - info => $info, - is_cancelled => $result->is_cancelled, - departure_is_cancelled => $result->departure_is_cancelled, - arrival_is_cancelled => $result->arrival_is_cancelled, - messages => { - delay => [ - map { { timestamp => $_->[0], text => $_->[1] } } - $result->delay_messages - ], - qos => [ - map { { timestamp => $_->[0], text => $_->[1] } } - $result->qos_messages - ], - }, - moreinfo => $moreinfo, - delay => $delay, - route_pre => [ $result->route_pre ], - route_post => [ $result->route_post ], - additional_stops => [ $result->additional_stops ], - canceled_stops => [ $result->canceled_stops ], - replaced_by => [ - map { $_->type . q{ } . $_->train_no } - $result->replaced_by - ], - replacement_for => [ - map { $_->type . q{ } . $_->train_no } - $result->replacement_for - ], - wr_link => $result->sched_departure - ? $result->sched_departure->strftime('%Y%m%d%H%M') - : undef, - } - ); if ( $self->param('train') ) { - $departures[-1]{route_pre_diff} = [ - $self->json_route_diff( - [ $result->route_pre ], - [ $result->sched_route_pre ] - ) - ]; - $departures[-1]{route_post_diff} = [ - $self->json_route_diff( - [ $result->route_post ], - [ $result->sched_route_post ] - ) - ]; - - $departures[-1]{trip_id} - = get_hafas_trip_id( $self->ua, $self->app->cache_iris_main, - $result ); - - if ( - $departures[-1]{wr_link} - and not check_wagonorder_with_wings( - $self->ua, $self->app->cache_iris_main, - $result, $departures[-1]{wr_link} - ) - ) - { - $departures[-1]{wr_link} = undef; - } - - my ( $route_ts, $route_info ) = get_route_timestamps( - $self->ua, - $self->app->cache_iris_main, - $self->app->cache_iris_rt, - { train => $result } - ); - - # If a train number changes on the way, IRIS routes are incomplete, - # whereas HAFAS data has all stops -> merge HAFAS stops into IRIS - # stops. This is a rare case, one point where it can be observed is - # the TGV service at Frankfurt/Karlsruhe/Mannheim. - if ( $route_info - and my @hafas_stations - = @{ $route_info->{stations} // [] } ) - { - if ( my @iris_stations - = @{ $departures[-1]{route_pre_diff} } ) - { - my @missing_pre; - for my $station (@hafas_stations) { - if ( - List::MoreUtils::any { $_->{name} eq $station } - @iris_stations - ) - { - unshift( - @{ $departures[-1]{route_pre_diff} }, - @missing_pre - ); - last; - } - push( - @missing_pre, - { - name => $station, - hafas => 1 - } - ); - } - } - if ( my @iris_stations - = @{ $departures[-1]{route_post_diff} } ) - { - my @missing_post; - for my $station ( reverse @hafas_stations ) { - if ( - List::MoreUtils::any { $_->{name} eq $station } - @iris_stations - ) - { - push( - @{ $departures[-1]{route_post_diff} }, - @missing_post - ); - last; - } - unshift( - @missing_post, - { - name => $station, - hafas => 1 - } - ); - } - } - } - if ($route_ts) { - for my $elem ( - @{ $departures[-1]{route_pre_diff} }, - @{ $departures[-1]{route_post_diff} } - ) - { - for my $key ( - keys %{ $route_ts->{ $elem->{name} } // {} } ) - { - $elem->{$key} = $route_ts->{ $elem->{name} }{$key}; - } - } - } - if ( $route_info and @{ $route_info->{messages} // [] } ) { - my $him = $route_info->{messages}; - my @him_messages; - $departures[-1]{messages}{him} = $him; - for my $message ( @{$him} ) { - if ( $message->{display} ) { - push( @him_messages, - [ $message->{header}, $message->{lead} ] ); - } - } - for my $message ( @{ $departures[-1]{moreinfo} // [] } ) { - my $m = $message->[1]; - @him_messages - = grep { $_->[0] !~ m{Information\. $m\.$} } - @him_messages; - } - unshift( @{ $departures[-1]{moreinfo} }, @him_messages ); - } + $self->render_train( $result, $departures[-1], + $data->{station_name} // $self->stash('station') ); + return; } } - else { - push( - @departures, - { - time => $time, - train => $result->train, - train_type => $result->type, - destination => $result->destination, - platform => $platform, - changed_platform => $result->is_changed_platform, - info => $info, - is_cancelled => $result->can('is_cancelled') - ? $result->is_cancelled - : undef, - messages => { - delay => [], - qos => [], - }, - moreinfo => $moreinfo, - delay => $delay, - additional_stops => [], - canceled_stops => [], - replaced_by => [], - replacement_for => [], - } - ); - } - } - - if ( $self->param('ajax') ) { - delete $self->stash->{layout}; } if ( $template eq 'json' ) { $self->res->headers->access_control_allow_origin(q{*}); - my $json = $self->render_to_string( - json => { - departures => \@departures, - } - ); + my $json = { + departures => \@departures, + }; if ($callback) { + $json = $self->render_to_string( json => $json ); $self->render( data => "$callback($json);", format => 'json' @@ -1214,8 +2677,7 @@ sub handle_request { } else { $self->render( - data => $json, - format => 'json' + json => $json, ); } } @@ -1236,60 +2698,42 @@ sub handle_request { format => 'text', ); } - elsif ( my $train = $self->param('train') ) { - - my ($departure) = @departures; - - if ($departure) { - - my $linetype = 'bahn'; - if ( $departure->{train_type} eq 'S' ) { - $linetype = 'sbahn'; - } - elsif ($departure->{train_type} eq 'IC' - or $departure->{train_type} eq 'ICE' - or $departure->{train_type} eq 'EC' - or $departure->{train_type} eq 'ECE' - or $departure->{train_type} eq 'EN' ) + else { + my $station_name = $data->{station_name} // $self->stash('station'); + my ( $api_link, $api_text, $api_icon ); + my $params = $self->req->params->clone; + if ( not $hafas ) { + if ( $data->{station_eva} >= 8100000 + and $data->{station_eva} < 8200000 ) { - $linetype = 'fern'; + $params->param( hafas => 'ÖBB' ); } - elsif ($departure->{train_type} eq 'THA' - or $departure->{train_type} eq 'TGV' - or $departure->{train_type} eq 'FLX' - or $departure->{train_type} eq 'NJ' ) + elsif ( $data->{station_eva} >= 8500000 + and $data->{station_eva} < 8600000 ) { - $linetype = 'ext'; + $params->param( hafas => 'BLS' ); } - elsif ( $departure->{train_line} - and $departure->{train_line} =~ m{^S\d} ) - { - $linetype = 'sbahn'; + if ( $params->param('hafas') ) { + $api_link + = '/' . $data->{station_eva} . '?' . $params->to_string; + $api_text = 'Auf Nahverkehr wechseln'; + $api_icon = 'train'; } - - $self->render( - '_train_details', - departure => $departure, - linetype => $linetype, - icetype => $self->app->ice_type_map->{ $departure->{train_no} }, - dt_now => DateTime->now( time_zone => 'Europe/Berlin' ), - station_name => $data->{station_name} // $station, - ); } - else { - $self->render('not_found'); - } - } - else { - my $station_name = $data->{station_name} // $station; $self->render( $template, + description => 'Abfahrtstafel ' + . ( $via ? "$station_name via $via" : $station_name ), + api_link => $api_link, + api_text => $api_text, + api_icon => $api_icon, departures => \@departures, - ice_type => $self->app->ice_type_map, - version => $dbf_version, + station => $station_name, + version => $self->config->{version}, title => $via ? "$station_name → $via" : $station_name, - refresh_interval => $template eq 'app' ? 0 : 120, + refresh_interval => $template eq 'app' ? 0 : 120, hide_opts => $hide_opts, + hide_footer => $hide_opts, hide_low_delay => $hide_low_delay, show_realtime => $show_realtime, load_marquee => ( @@ -1297,6 +2741,13 @@ sub handle_request { or $template eq 'multi' ), force_mobile => ( $template eq 'app' ), + nav_link => + $self->url_for( 'station', station => $station_name )->query( + { + detailed => $self->param('detailed'), + hafas => $self->param('hafas') + } + ), ); } return; @@ -1305,30 +2756,297 @@ sub handle_request { sub stations_by_coordinates { my $self = shift; - my $lon = $self->param('lon'); - my $lat = $self->param('lat'); + my $lon = $self->param('lon'); + my $lat = $self->param('lat'); + my $efa_service = $self->param('efa'); + my $hafas = $self->param('hafas'); if ( not $lon or not $lat ) { $self->render( json => { error => 'Invalid lon/lat received' } ); + return; } - else { - my @candidates = map { + + my $service = 'ÖBB'; + if ( $hafas + and $hafas ne '1' + and Travel::Status::DE::HAFAS::get_service($hafas) ) + { + $service = $hafas; + } + + $self->render_later; + + if ($efa_service) { + Travel::Status::DE::EFA->new_p( + promise => 'Mojo::Promise', + user_agent => $self->ua, + service => $efa_service, + coord => { + lat => $lat, + lon => $lon + } + )->then( + sub { + my ($efa) = @_; + my @efa = map { + { + name => $_->full_name, + eva => $_->id =~ s{:}{%3A}gr, + distance => $_->distance_m / 1000, + efa => $efa_service, + } + } $efa->results; + $self->render( + json => { + candidates => [@efa], + } + ); + } + )->catch( + sub { + my ($err) = @_; + $self->render( + json => { + candidates => [], + warning => $err, + } + ); + } + )->wait; + return; + } + + my @iris = map { + { + ds100 => $_->[0][0], + name => $_->[0][1], + eva => $_->[0][2], + lon => $_->[0][3], + lat => $_->[0][4], + distance => $_->[1], + hafas => 0, + } + } Travel::Status::DE::IRIS::Stations::get_station_by_location( $lon, + $lat, 10 ); + + @iris = uniq_by { $_->{name} } @iris; + + Travel::Status::DE::HAFAS->new_p( + promise => 'Mojo::Promise', + user_agent => $service eq 'PKP' ? Mojo::UserAgent->new : $self->ua, + service => $service, + geoSearch => { + lat => $lat, + lon => $lon + } + )->then( + sub { + my ($hafas) = @_; + my @hafas = map { + { + name => $_->name, + eva => $_->eva, + distance => $_->distance_m / 1000, + hafas => $service, + } + } $hafas->results; + if ( @hafas > 10 ) { + @hafas = @hafas[ 0 .. 9 ]; + } + my @results = map { $_->[0] } + sort { $a->[1] <=> $b->[1] } + map { [ $_, $_->{distance} ] } ( @iris, @hafas ); + $self->render( + json => { + candidates => [@results], + } + ); + } + )->catch( + sub { + my ($err) = @_; + $self->render( + json => { + candidates => [@iris], + warning => $err, + } + ); + } + )->wait; +} + +sub backend_list { + my ($self) = @_; + + my %place_map = ( + AT => 'Österreich', + CH => 'Schweiz', + 'CH-BE' => 'Kanton Bern', + 'CH-GE' => 'Kanton Genf', + 'CH-LU' => 'Kanton Luzern', + 'CH-ZH' => 'Kanton Zürich', + DE => 'Deutschland', + 'DE-BB' => 'Brandenburg', + 'DE-BW' => 'Baden-Württemberg', + 'DE-BE' => 'Berlin', + 'DE-BY' => 'Bayern', + 'DE-HB' => 'Bremen', + 'DE-HE' => 'Hessen', + 'DE-MV' => 'Mecklenburg-Vorpommern', + 'DE-NI' => 'Niedersachsen', + 'DE-NW' => 'Nordrhein-Westfalen', + 'DE-RP' => 'Rheinland-Pfalz', + 'DE-SH' => 'Schleswig-Holstein', + 'DE-ST' => 'Sachsen-Anhalt', + 'DE-TH' => 'Thüringen', + DK => 'Dänemark', + 'GB-NIR' => 'Nordirland', + LI => 'Liechtenstein', + LU => 'Luxembourg', + IE => 'Irland', + 'US-CA' => 'California', + 'US-TX' => 'Texas', + ); + + my @backends = ( + { + name => 'Deutsche Bahn', + type => 'IRIS-TTS', + } + ); + + for my $backend ( Travel::Status::DE::EFA::get_services() ) { + push( + @backends, { - ds100 => $_->[0][0], - name => $_->[0][1], - eva => $_->[0][2], - lon => $_->[0][3], - lat => $_->[0][4], - distance => $_->[1], - } - } Travel::Status::DE::IRIS::Stations::get_station_by_location( $lon, - $lat, 10 ); - $self->render( - json => { - candidates => [@candidates], + name => $backend->{name}, + shortname => $backend->{shortname}, + homepage => $backend->{homepage}, + regions => [ + map { $place_map{$_} // $_ } + @{ $backend->{coverage}{regions} } + ], + has_area => $backend->{coverage}{area} ? 1 : 0, + type => 'EFA', + efa => 1, + } + ); + } + + for my $backend ( Travel::Status::DE::HAFAS::get_services() ) { + if ( $backend->{shortname} eq 'DB' ) { + + # HTTP 503 Service Temporarily Unavailable as of 2025-01-08 ~10:30 UTC + # (I bet it's actually Permanently Unavailable) + next; + } + if ( $backend->{shortname} eq 'VRN' ) { + + # HTTP 403 Forbidden as of 2025-03-03 + next; + } + push( + @backends, + { + name => $backend->{name}, + shortname => $backend->{shortname}, + homepage => $backend->{homepage}, + regions => [ + map { $place_map{$_} // $_ } + @{ $backend->{coverage}{regions} } + ], + has_area => $backend->{coverage}{area} ? 1 : 0, + type => 'HAFAS', + hafas => 1, } ); } + + $self->render( + 'select_backend', + backends => \@backends, + hide_opts => 1, + hide_footer => 1 + ); +} + +sub autocomplete { + my ($self) = @_; + + $self->res->headers->cache_control('max-age=31536000, immutable'); + + my $output = '$(function(){const stations='; + $output + .= encode_json( + [ map { $_->[1] } Travel::Status::DE::IRIS::Stations::get_stations() ] + ); + $output .= ";\n"; + $output + .= "\$('input.station').autocomplete({delay:0,minLength:3,source:stations});});\n"; + + $self->render( + format => 'js', + data => $output + ); +} + +sub redirect_to_station { + my ($self) = @_; + my $input = $self->param('input'); + my $params = $self->req->params; + + $params->remove('input'); + + for my $param (qw(platforms mode admode via)) { + if ( + not $params->param($param) + or ( exists $default{$param} + and $params->param($param) eq $default{$param} ) + ) + { + $params->remove($param); + } + } + + if ( $input =~ m{ ^ [a-zA-Z]{1,5} \s+ \d+ }x ) { + if ( $input =~ s{ \s* @ \s* (?<date> [0-9.]+) $ }{}x ) { + $params->param( date => $+{date} ); + } + elsif ( $input =~ s{ \s* [(] \s* (?<date> [0-9.]+) \s* [)] $ }{}x ) { + $params->param( date => $+{date} ); + } + $params = $params->to_string; + $self->redirect_to("/z/${input}?${params}"); + } + elsif ( $params->param('efa') ) { + $params->remove('hafas'); + $params = $params->to_string; + $self->redirect_to("/${input}?${params}"); + } + elsif ( $params->param('hafas') and $params->param('hafas') ne '1' ) { + $params->remove('efa'); + $params = $params->to_string; + $self->redirect_to("/${input}?${params}"); + } + else { + $params->remove('efa'); + my @candidates + = Travel::Status::DE::IRIS::Stations::get_station($input); + if ( + @candidates == 1 + and ( $input eq $candidates[0][0] + or lc($input) eq lc( $candidates[0][1] ) + or $input eq $candidates[0][2] ) + ) + { + $params->remove('hafas'); + } + else { + $params->param( hafas => 1 ); + } + $params = $params->to_string; + $self->redirect_to("/${input}?${params}"); + } } 1; |