summaryrefslogtreecommitdiff
path: root/index.pl
diff options
context:
space:
mode:
Diffstat (limited to 'index.pl')
-rw-r--r--index.pl1089
1 files changed, 5 insertions, 1084 deletions
diff --git a/index.pl b/index.pl
index 7f27c97..004f751 100644
--- a/index.pl
+++ b/index.pl
@@ -1,1090 +1,11 @@
#!/usr/bin/env perl
# Copyright (C) 2011-2018 Daniel Friesel <derf+dbf@finalrewind.org>
# License: 2-Clause BSD
-use Mojolicious::Lite;
-use Cache::File;
-use File::Slurp qw(read_file write_file);
-use List::Util qw(max);
-use List::MoreUtils qw();
-use Travel::Status::DE::DBWagenreihung;
-use Travel::Status::DE::HAFAS;
-use Travel::Status::DE::HAFAS::StopFinder;
-use Travel::Status::DE::IRIS;
-use Travel::Status::DE::IRIS::Stations;
-use 5.014;
-use utf8;
-no if $] >= 5.018, warnings => 'experimental::smartmatch';
+use strict;
+use warnings;
-our $VERSION = qx{git describe --dirty} || '0.05';
+use lib 'lib';
+use Mojolicious::Commands;
-my %default = (
- backend => 'iris',
- mode => 'app',
- admode => 'deparr',
-);
-
-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 get_results_for {
- my ( $backend, $station, %opt ) = @_;
- my $data;
-
- my $cache_hafas = Cache::File->new(
- cache_root => $ENV{DBFAKEDISPLAY_HAFAS_CACHE} // '/tmp/dbf-hafas',
- default_expires => '180 seconds',
- lock_level => Cache::File::LOCK_LOCAL(),
- );
-
- my $cache_iris_main = Cache::File->new(
- cache_root => $ENV{DBFAKEDISPLAY_IRIS_CACHE} // '/tmp/dbf-iris-main',
- default_expires => '6 hours',
- lock_level => Cache::File::LOCK_LOCAL(),
- );
-
- my $cache_iris_rt = Cache::File->new(
- cache_root => $ENV{DBFAKEDISPLAY_IRISRT_CACHE}
- // '/tmp/dbf-iris-realtime',
- default_expires => '70 seconds',
- lock_level => Cache::File::LOCK_LOCAL(),
- );
-
- # 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 => $cache_iris_main,
- realtime_cache => $cache_iris_rt,
- log_dir => $ENV{DBFAKEDISPLAY_XMLDUMP_DIR},
- lookbehind => 20,
- %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 = $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]],
- %opt
- );
- $data = {
- results => [ $status->results ],
- errstr => $status->errstr,
- };
- $cache_hafas->freeze( $cache_str, $data );
- }
- }
- else {
- $data = {
- results => [],
- errstr => "Backend '$backend' not supported",
- };
- }
-
- return $data;
-}
-
-helper 'handle_no_results' => sub {
- my ( $self, $backend, $station, $errstr ) = @_;
-
- if ( $backend eq 'ris' ) {
- my $db_service = Travel::Status::DE::HAFAS::get_service('DB');
- my $sf = Travel::Status::DE::HAFAS::StopFinder->new(
- url => $db_service->{stopfinder},
- input => $station,
- );
- my @candidates
- = map { [ $_->{name}, $_->{id} ] } $sf->results;
- if ( @candidates > 1
- or ( @candidates == 1 and $candidates[0][1] ne $station ) )
- {
- $self->render(
- 'landingpage',
- stationlist => \@candidates,
- hide_opts => 0
- );
- return;
- }
- }
- if ( $backend eq 'iris' ) {
- my @candidates = map { [ $_->[1], $_->[0] ] }
- Travel::Status::DE::IRIS::Stations::get_station($station);
- if ( @candidates > 1
- or ( @candidates == 1 and $candidates[0][1] ne $station ) )
- {
- $self->render(
- 'landingpage',
- stationlist => \@candidates,
- hide_opts => 0
- );
- return;
- }
- }
- $self->render(
- 'landingpage',
- error => ( $errstr // "Got no results for '$station'" ),
- hide_opts => 0
- );
- return;
-};
-
-helper 'handle_no_results_json' => sub {
- my ( $self, $backend, $station, $errstr, $api_version, $callback ) = @_;
-
- $self->res->headers->access_control_allow_origin(q{*});
- my $json;
- if ($errstr) {
- $json = $self->render_to_string(
- json => {
- api_version => $api_version,
- version => $VERSION,
- error => $errstr,
- }
- );
- }
- else {
- 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 = $self->render_to_string(
- json => {
- api_version => $api_version,
- version => $VERSION,
- error => 'ambiguous station code/name',
- candidates => \@candidates,
- }
- );
- }
- else {
- $json = $self->render_to_string(
- json => {
- api_version => $api_version,
- version => $VERSION,
- error => ( $errstr // "Got no results for '$station'" )
- }
- );
- }
- }
- if ($callback) {
- $self->render(
- data => "$callback($json);",
- format => 'json'
- );
- }
- else {
- $self->render(
- data => $json,
- format => 'json'
- );
- }
- return;
-};
-
-helper 'is_important' => sub {
- my ( $self, $stop ) = @_;
-
- # Centraal: dutch main station (Hbf in .nl)
- # HB: swiss main station (Hbf in .ch)
- # hl.n.: czech main station (Hbf in .cz)
- if ( $stop =~ m{ HB $ | hl\.n\. $ | Hbf | Centraal | Flughafen }x ) {
- return 1;
- }
- return;
-};
-
-helper 'json_route_diff' => sub {
- my ( $self, $route, $sched_route ) = @_;
- my @json_route;
- my @route = @{$route};
- my @sched_route = @{$sched_route};
-
- 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( $route[$route_idx] ~~ \@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 handle_request {
- my $self = shift;
- 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;
-
- 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 => 'db-infoscreen' );
- $self->stash( version => $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';
- }
-
- # 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',
- hide_opts => 0,
- 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( $result->platform ~~ \@platforms ) ) {
- push( @platforms, $result->platform );
- }
- }
- @platforms = sort { $a <=> $b } @platforms;
- }
- my %pcnt;
- @results = grep { $pcnt{ $_->platform }++ < 1 } @results;
- @results = sort { $a->platform <=> $b->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 (@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) ],
- scheduled_route => [ $result->sched_route ],
- route_pre => [ $result->route_pre ],
- route_pre_diff => [
- $self->json_route_diff(
- [ $result->route_pre ],
- [ $result->sched_route_pre ]
- )
- ],
- route_post => [ $result->route_post ],
- route_post_diff => [
- $self->json_route_diff(
- [ $result->route_post ],
- [ $result->sched_route_post ]
- )
- ],
- 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,
- 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,
- }
- );
- }
- 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 ( $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',
- );
- }
- else {
- my $station_name = $data->{station_name} // $station;
- $self->render(
- $template,
- departures => \@departures,
- version => $VERSION,
- title => "Abfahrtsmonitor $station_name",
- refresh_interval => 120,
- hide_opts => $hide_opts,
- hide_low_delay => $hide_low_delay,
- show_realtime => $show_realtime,
- load_marquee => (
- $template eq 'single'
- or $template eq 'multi'
- ),
- );
- }
- return;
-}
-
-get '/_redirect' => sub {
- my $self = shift;
- my $station = $self->param('station');
- my $params = $self->req->params;
-
- $params->remove('station');
-
- for my $param (qw(platforms backend mode admode via)) {
- if (
- not $params->param($param)
- or ( exists $default{$param}
- and $params->param($param) eq $default{$param} )
- )
- {
- $params->remove($param);
- }
- }
-
- $params = $params->to_string;
-
- $self->redirect_to("/${station}?${params}");
-};
-
-get '/_auto' => sub {
- my $self = shift;
-
- $self->render(
- 'geolocation',
- with_geolocation => 1,
- hide_opts => 1
- );
-};
-
-get '/_datenschutz' => sub {
- my $self = shift;
-
- $self->render( 'privacy', hide_opts => 1 );
-};
-
-post '/_geolocation' => sub {
- 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],
- }
- );
- }
-};
-
-get '/_impressum' => sub {
- my $self = shift;
-
- $self->render( 'imprint', hide_opts => 1 );
-};
-
-get '/_wr/:train/:departure' => sub {
- my $self = shift;
- my $train = $self->stash('train');
- my $departure = $self->stash('departure');
-
- my $wr = Travel::Status::DE::DBWagenreihung->new(
- departure => $departure,
- train_number => $train,
- );
-
- $self->render(
- 'wagenreihung',
- wr => $wr,
- hide_opts => 1,
- );
-};
-
-app->defaults( layout => 'default' );
-app->sessions->default_expiration( 3600 * 24 * 28 );
-
-get '/' => \&handle_request;
-get '/multi/*station' => \&handle_request;
-get '/*station' => \&handle_request;
-
-app->config(
- hypnotoad => {
- accepts => $ENV{DBFAKEDISPLAY_ACCEPTS} // 100,
- clients => $ENV{DBFAKEDISPLAY_CLIENTS} // 10,
- listen => [ $ENV{DBFAKEDISPLAY_LISTEN} // 'http://*:8092' ],
- pid_file => $ENV{DBFAKEDISPLAY_PID_FILE} // '/tmp/db-fakedisplay.pid',
- spare => $ENV{DBFAKEDISPLAY_SPARE} // 2,
- workers => $ENV{DBFAKEDISPLAY_WORKERS} // 2,
- },
-);
-
-app->types->type( json => 'application/json; charset=utf-8' );
-app->plugin('browser_detect');
-app->start();
+Mojolicious::Commands->start_app('DBInfoscreen');