summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/DBInfoscreen.pm249
-rw-r--r--lib/DBInfoscreen/Controller/Static.pm58
-rw-r--r--lib/DBInfoscreen/Controller/Stationboard.pm835
-rw-r--r--lib/DBInfoscreen/Controller/Wagenreihung.pm26
4 files changed, 1168 insertions, 0 deletions
diff --git a/lib/DBInfoscreen.pm b/lib/DBInfoscreen.pm
new file mode 100644
index 0000000..af952c2
--- /dev/null
+++ b/lib/DBInfoscreen.pm
@@ -0,0 +1,249 @@
+package DBInfoscreen;
+use Mojo::Base 'Mojolicious';
+
+# Copyright (C) 2011-2019 Daniel Friesel <derf+dbf@finalrewind.org>
+# License: 2-Clause BSD
+
+use Travel::Status::DE::HAFAS;
+use Travel::Status::DE::HAFAS::StopFinder;
+use Travel::Status::DE::IRIS::Stations;
+
+use utf8;
+
+no if $] >= 5.018, warnings => 'experimental::smartmatch';
+
+our $VERSION = qx{git describe --dirty} || '0.05';
+
+my %default = (
+ backend => 'iris',
+ mode => 'app',
+ admode => 'deparr',
+);
+
+sub startup {
+ my ($self) = @_;
+
+ $self->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;
+ }
+ );
+
+ $self->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;
+ }
+ );
+
+ $self->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;
+ }
+ );
+
+ $self->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;
+ }
+ );
+
+ my $r = $self->routes;
+
+ $r->get('/_redirect')->to('static#redirect');
+
+ $r->get('/_auto')->to('static#geolocation');
+
+ $r->get('/_datenschutz')->to('static#privacy');
+
+ $r->post('/_geolocation')->to('stationboard#stations_by_coordinates');
+
+ $r->get('/_impressum')->to('static#imprint');
+
+ $r->get('/_wr/:train/:departure')->to('wagenreihung#wagenreihung');
+
+ $self->defaults( layout => 'default' );
+ $self->sessions->default_expiration( 3600 * 24 * 28 );
+
+ $r->get('/')->to('stationboard#handle_request');
+ $r->get('/multi/*station')->to('stationboard#handle_request');
+ $r->get('/*station')->to('stationboard#handle_request');
+
+ $self->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,
+ },
+ );
+
+ $self->types->type( json => 'application/json; charset=utf-8' );
+ $self->plugin('browser_detect');
+
+}
+
+1;
diff --git a/lib/DBInfoscreen/Controller/Static.pm b/lib/DBInfoscreen/Controller/Static.pm
new file mode 100644
index 0000000..434facd
--- /dev/null
+++ b/lib/DBInfoscreen/Controller/Static.pm
@@ -0,0 +1,58 @@
+package DBInfoscreen::Controller::Static;
+use Mojo::Base 'Mojolicious::Controller';
+
+# Copyright (C) 2011-2019 Daniel Friesel <derf+dbf@finalrewind.org>
+# License: 2-Clause BSD
+
+my %default = (
+ backend => 'iris',
+ mode => 'app',
+ admode => 'deparr',
+);
+
+sub redirect {
+ my ($self) = @_;
+ 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}");
+}
+
+sub geolocation {
+ my ($self) = @_;
+
+ $self->render(
+ 'geolocation',
+ with_geolocation => 1,
+ hide_opts => 1
+ );
+}
+
+sub privacy {
+ my ($self) = @_;
+
+ $self->render( 'privacy', hide_opts => 1 );
+}
+
+sub imprint {
+ my ($self) = @_;
+
+ $self->render( 'imprint', hide_opts => 1 );
+}
+
+1;
diff --git a/lib/DBInfoscreen/Controller/Stationboard.pm b/lib/DBInfoscreen/Controller/Stationboard.pm
new file mode 100644
index 0000000..08ef638
--- /dev/null
+++ b/lib/DBInfoscreen/Controller/Stationboard.pm
@@ -0,0 +1,835 @@
+package DBInfoscreen::Controller::Stationboard;
+use Mojo::Base 'Mojolicious::Controller';
+
+# Copyright (C) 2011-2019 Daniel Friesel <derf+dbf@finalrewind.org>
+# License: 2-Clause BSD
+
+use Cache::File;
+use File::Slurp qw(read_file write_file);
+use List::Util qw(max);
+use List::MoreUtils qw();
+use Travel::Status::DE::HAFAS;
+use Travel::Status::DE::IRIS;
+use Travel::Status::DE::IRIS::Stations;
+
+use utf8;
+
+no if $] >= 5.018, warnings => 'experimental::smartmatch';
+
+my $dbf_version = qx{git describe --dirty} || 'experimental';
+
+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;
+}
+
+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;
+
+ 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 => $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';
+ }
+
+ # 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 => $dbf_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;
+}
+
+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;
diff --git a/lib/DBInfoscreen/Controller/Wagenreihung.pm b/lib/DBInfoscreen/Controller/Wagenreihung.pm
new file mode 100644
index 0000000..2279da3
--- /dev/null
+++ b/lib/DBInfoscreen/Controller/Wagenreihung.pm
@@ -0,0 +1,26 @@
+package DBInfoscreen::Controller::Wagenreihung;
+use Mojo::Base 'Mojolicious::Controller';
+
+# Copyright (C) 2011-2019 Daniel Friesel <derf+dbf@finalrewind.org>
+# License: 2-Clause BSD
+
+use Travel::Status::DE::DBWagenreihung;
+
+sub wagenreihung {
+ my ($self) = @_;
+ 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,
+ );
+}
+
+1;