package DBInfoscreen::Controller::Stationboard; use Mojo::Base 'Mojolicious::Controller'; # Copyright (C) 2011-2019 Daniel Friesel # License: 2-Clause BSD 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 List::MoreUtils qw(); use Mojo::JSON qw(decode_json); use Travel::Status::DE::HAFAS; use Travel::Status::DE::IRIS; use Travel::Status::DE::IRIS::Stations; use XML::LibXML; use utf8; no if $] >= 5.018, warnings => 'experimental::smartmatch'; my $dbf_version = qx{git describe --dirty} || 'experimental'; chomp $dbf_version; my %default = ( backend => 'iris', mode => 'app', admode => 'deparr', ); sub result_is_train { my ( $result, $train ) = @_; if ( $result->can('train_id') ) { # IRIS if ( $train eq $result->type . ' ' . $result->train_no ) { return 1; } return 0; } else { # HAFAS if ( $train eq $result->type . ' ' . $result->train ) { return 1; } return 0; } } sub result_has_line { my ( $result, @lines ) = @_; my $line = $result->line; if ( List::MoreUtils::any { $line =~ m{^$_} } @lines ) { return 1; } return 0; } sub result_has_platform { my ( $result, @platforms ) = @_; my $platform = ( split( qr{ }, $result->platform // '' ) )[0] // ''; if ( List::MoreUtils::any { $_ eq $platform } @platforms ) { return 1; } return 0; } sub result_has_train_type { my ( $result, @train_types ) = @_; my $train_type = $result->type; if ( List::MoreUtils::any { $train_type =~ m{^$_} } @train_types ) { return 1; } return 0; } sub result_has_via { my ( $result, $via ) = @_; if ( not $result->can('route_post') ) { return 1; } my @route = $result->route_post; if ( List::MoreUtils::any { m{$via}i } @route ) { return 1; } return 0; } sub log_api_access { my $counter = 1; if ( -r $ENV{DBFAKEDISPLAY_STATS} ) { $counter = read_file( $ENV{DBFAKEDISPLAY_STATS} ) + 1; } write_file( $ENV{DBFAKEDISPLAY_STATS}, $counter ); return; } sub check_wagonorder_with_wings { my ( $ua, $cache, $train, $wr_link ) = @_; if ( check_wagonorder( $ua, $cache, $train->train_no, $wr_link ) ) { return 1; } elsif ( $train->is_wing ) { my $wing = $train->wing_of; if ( check_wagonorder( $ua, $cache, $wing->train_no, $wr_link ) ) { return 1; } } return; } sub get_hafas_trip_id { my ( $ua, $cache, $train ) = @_; 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"; } 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 ( my $content = $cache->get($url) ) { return $content; } $ua->request_timeout(2); my $res = $ua->get( $url => { 'User-Agent' => "dbf.finalrewind.org/${dbf_version}" } ) ->result; if ( $res->is_error ) { return; } my $json = decode_json( $res->body ); #say "looking for " . $train->train_no; for my $result ( @{$json} ) { my $trip_id = $result->{tripId}; my $fahrt = $result->{line}{fahrtNr}; #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; } else { #say "unmatched Trip ID $trip_id"; } } return; } sub check_wagonorder { my ( $ua, $cache, $train_no, $wr_link ) = @_; my $url = "https://lib.finalrewind.org/dbdb/has_wagonorder/${train_no}/${wr_link}"; if ( my $content = $cache->get($url) ) { return $content eq 'y' ? 1 : undef; } $ua->request_timeout(2); my $res = $ua->head($url)->result; if ( $res->is_error ) { $cache->set( $url, 'n' ); return; } else { $cache->set( $url, 'y' ); return 1; } } sub hafas_json_req { my ( $ua, $cache, $url ) = @_; if ( my $content = $cache->thaw($url) ) { return $content; } my $res = $ua->get($url)->result; if ( $res->is_error ) { return; } my $body = encode( 'utf-8', decode( 'ISO-8859-15', $res->body ) ); $body =~ s{^TSLs[.]sls = }{}; $body =~ s{;$}{}; $body =~ s{(}{(}g; $body =~ s{)}{)}g; my $json = decode_json($body); $cache->freeze( $url, $json ); return $json; } sub hafas_xml_req { my ( $ua, $cache, $url ) = @_; if ( my $content = $cache->thaw($url) ) { return $content; } my $res = $ua->get($url)->result; if ( $res->is_error ) { $cache->freeze( $url, {} ); return; } my $body = decode( 'ISO-8859-15', $res->body ); # is invalid HTML, but present # regardless. As it is the last tag, we just throw it away. $body =~ s{]*/>}{}s; my $tree; eval { $tree = XML::LibXML->load_xml( string => $body ) }; if ($@) { $cache->freeze( $url, {} ); return; } my $ret = { station => {}, stations => [], messages => [], }; 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, }; } 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 } ); } $cache->freeze( $url, $ret ); return $ret; } # quick&dirty, will be cleaned up later sub get_route_timestamps { my ( $ua, $cache_main, $cache_rt, $opt ) = @_; $ua->request_timeout(3); 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 ); 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; } 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}; } my $trainsearch = hafas_json_req( $ua, $cache_main, "${base}&date=${date_yy}&trainname=${train_no}" ); if ( not $trainsearch ) { return; } # Fallback: Take first result my $trainlink = $trainsearch->{suggestions}[0]{trainLink}; # Try finding a result for the current date for my $suggestion ( @{ $trainsearch->{suggestions} // [] } ) { # 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 ) ) { # 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; } } } if ( not $trainlink ) { return; } $base = 'https://reiseauskunft.bahn.de/bin/traininfo.exe/dn'; my $traininfo = hafas_json_req( $ua, $cache_rt, "${base}/${trainlink}?rt=1&date=${date_yy}&L=vs_json" ); if ( not $traininfo or $traininfo->{error} ) { return; } my $traindelay = hafas_xml_req( $ua, $cache_rt, "${base}/${trainlink}?rt=1&date=${date_yy}&L=vs_java3" ); my $ret = {}; my $strp = DateTime::Format::Strptime->new( pattern => '%d.%m.%y %H:%M', time_zone => 'Europe/Berlin', ); 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 ( $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} ); } } } return ( $ret, $traindelay // {} ); } sub get_results_for { my ( $backend, $station, %opt ) = @_; my $data; # 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' }, %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(); } 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 ); } } else { $data = { results => [], errstr => "Backend '$backend' not supported", }; } return $data; } 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, ); my $api_version = $backend eq 'iris' ? $Travel::Status::DE::IRIS::VERSION : $Travel::Status::DE::HAFAS::VERSION; 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 ); } $self->stash( departures => [] ); $self->stash( title => 'DBF' ); $self->stash( version => $dbf_version ); 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' ); } # 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'; } if ( not( $template ~~ [qw[app infoscreen json multi single text]] ) ) { $template = 'app'; } if ( not $station ) { if ( $self->session('has_data') ) { for my $param ( qw(mode hidelowdelay hide_opts show_realtime admode no_related dark detailed) ) { $self->param( $param => $self->session($param) ); } } $self->render( 'landingpage', show_intro => 1 ); return; } if ( $template eq 'json' ) { $backend = 'iris'; $opt{lookahead} = 120; } if ($with_related) { $opt{with_related} = 1; } 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}; } if ( not @results ) { $self->handle_no_results( $backend, $station, $errstr ); return; } if ( $template eq 'single' ) { if ( not @platforms ) { for my $result (@results) { if ( not( $self->numeric_platform_part( $result->platform ) ~~ \@platforms ) ) { push( @platforms, $self->numeric_platform_part( $result->platform ) ); } } @platforms = sort { $a <=> $b } @platforms; } my %pcnt; @results = grep { $pcnt{ $self->numeric_platform_part( $_->platform ) }++ < 1 } @results; @results = map { $_->[1] } sort { $a->[0] <=> $b->[0] } 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; } else { @results = sort { ( $a->departure // $a->arrival ) <=> ( $b->departure // $b->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; } if ( $limit and $limit =~ m{ ^ \d+ $ }x ) { splice( @results, $limit ); } 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 ) { next; } if ( $backend eq 'iris' and $admode eq 'dep' 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->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}, [ 'Zusätzliche Halte', $additional_line ] ); } } 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 ] ); } } push( @{$moreinfo}, $result->messages ); } else { $info = $result->info; if ($info) { $moreinfo = [ [ 'HAFAS', $info ] ]; } if ( $result->delay and $result->delay > 0 ) { if ($info) { $info = 'ca. +' . $result->delay . ': ' . $info; } else { $info = 'ca. +' . $result->delay; } } 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' ) { $time = $result->sched_arrival->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'); } } } if ($hide_low_delay) { 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 ] ); if ( $apiver == 1 ) { push( @departures, { 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) ], } ); } 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'); } 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->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, scheduledArrival => $sched_arr, scheduledDeparture => $sched_dep, train => $result->train, via => [ $result->route_interesting(3) ], } ); } 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'); } push( @departures, { delayArrival => $delay_arr, delayDeparture => $delay_dep, 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, scheduledArrival => $sched_arr, scheduledDeparture => $sched_dep, train => $result->train, trainClasses => [ $result->classes ], trainNumber => $result->train_no, 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{ } ] ); } 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 ); } } } 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, } ); if ($callback) { $self->render( data => "$callback($json);", format => 'json' ); } else { $self->render( data => $json, format => 'json' ); } } elsif ( $template eq 'text' ) { my @line_length; for my $i ( 0 .. $#{ $departures[0] } ) { $line_length[$i] = max map { length( $_->[$i] ) } @departures; } my $output = q{}; for my $departure (@departures) { $output .= sprintf( join( q{ }, ( map { "%-${_}s" } @line_length ) ) . "\n", @{$departure}[ 0 .. $#{$departure} ] ); } $self->render( text => $output, 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' ) { $linetype = 'fern'; } elsif ($departure->{train_type} eq 'THA' or $departure->{train_type} eq 'TGV' or $departure->{train_type} eq 'FLX' or $departure->{train_type} eq 'NJ' ) { $linetype = 'ext'; } elsif ( $departure->{train_line} and $departure->{train_line} =~ m{^S\d} ) { $linetype = 'sbahn'; } $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' ), ); } else { $self->render('not_found'); } } else { my $station_name = $data->{station_name} // $station; $self->render( $template, departures => \@departures, ice_type => $self->app->ice_type_map, version => $dbf_version, title => $via ? "$station_name → $via" : $station_name, refresh_interval => $template eq 'app' ? 0 : 120, hide_opts => $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' ), ); } return; } sub stations_by_coordinates { my $self = shift; my $lon = $self->param('lon'); my $lat = $self->param('lat'); if ( not $lon or not $lat ) { $self->render( json => { error => 'Invalid lon/lat received' } ); } else { my @candidates = map { { 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], } ); } } 1;