summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Friesel <derf@finalrewind.org>2019-03-24 10:13:30 +0100
committerDaniel Friesel <derf@finalrewind.org>2019-03-24 10:13:30 +0100
commit9792369c2b79e68cc7384bbd9b55eef30fe8c004 (patch)
treeced72989066592a9344109974480ed67e413f9ee
parent542a1db1106aaafe16203ffdb3bbac792d17a96c (diff)
Transition from Mojolicious::Lite to full Mojolicious app
-rw-r--r--index.pl1089
-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
-rw-r--r--t/01-basic.t2
-rw-r--r--t/22-json.t50
7 files changed, 1197 insertions, 1112 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');
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;
diff --git a/t/01-basic.t b/t/01-basic.t
index da7b654..4f471b0 100644
--- a/t/01-basic.t
+++ b/t/01-basic.t
@@ -4,7 +4,7 @@ use Test::Mojo;
use FindBin;
require "$FindBin::Bin/../index.pl";
-my $t = Test::Mojo->new;
+my $t = Test::Mojo->new('DBInfoscreen');
$t->get_ok('/')->status_is(200)->content_like(qr/db-infoscreen/);
done_testing();
diff --git a/t/22-json.t b/t/22-json.t
index 9db67b8..471467f 100644
--- a/t/22-json.t
+++ b/t/22-json.t
@@ -8,39 +8,35 @@ use Test::Mojo;
use FindBin;
require "$FindBin::Bin/../index.pl";
-my $t = Test::Mojo->new;
+my $t = Test::Mojo->new('DBInfoscreen');
# Note: These tests depends on IRIS live data. If it fails, it -might- also
# be because of IRIS problems or unanticipated schedule changes.
# TODO: Support mock XML from hard disk.
-$t->get_ok('/EDUV?mode=json&version=1')
- ->status_is(200)
- ->json_has('/departures', 'has departures')
- ->json_has('/departures/0', 'has a departure')
- ->json_has('/departures/0/route', '.route')
- ->json_has('/departures/0/delay', '.delay')
- ->json_like('/departures/0/destination',
- qr{ ^ (Dortmund|Bochum|Essen|D.sseldorf|Solingen) \s Hbf $}x,
- '.destination')
- ->json_like('/departures/0/isCancelled', qr{ ^ 0 | 1 $ }x, '.is_cancelled')
- ->json_has('/departures/0/messages', '.messages')
- ->json_has('/departures/0/messages/delay', '.messages.delay')
- ->json_has('/departures/0/messages/qos', '.messages.qos')
- ->json_like('/departures/0/time', qr{ ^ \d \d? : \d\d $ }x, '.time')
- ->json_is('/departures/0/train', 'S 1', '.train')
- ->json_like('/departures/0/platform', qr{ ^ 1 | 2 $}x, '.platform')
- ->json_like('/departures/0/route/0/name',
- qr{ ^ (Dortmund|Bochum|Essen|D.sseldorf|Solingen) \s Hbf $}x,
- '.route[0]')
- ->json_like('/departures/0/via/0',
- qr{ ^ Dortmund-Dorstfeld \s S.d | Dortmund-Oespel $}x,
- '.via[0]')
- ;
+$t->get_ok('/EDUV?mode=json&version=1')->status_is(200)
+ ->json_has( '/departures', 'has departures' )
+ ->json_has( '/departures/0', 'has a departure' )
+ ->json_has( '/departures/0/route', '.route' )
+ ->json_has( '/departures/0/delay', '.delay' )
+ ->json_like( '/departures/0/destination',
+ qr{ ^ (Dortmund|Bochum|Essen|D.sseldorf|Solingen) \s Hbf $}x,
+ '.destination' )
+ ->json_like( '/departures/0/isCancelled', qr{ ^ 0 | 1 $ }x, '.is_cancelled' )
+ ->json_has( '/departures/0/messages', '.messages' )
+ ->json_has( '/departures/0/messages/delay', '.messages.delay' )
+ ->json_has( '/departures/0/messages/qos', '.messages.qos' )
+ ->json_like( '/departures/0/time', qr{ ^ \d \d? : \d\d $ }x, '.time' )
+ ->json_is( '/departures/0/train', 'S 1', '.train' )
+ ->json_like( '/departures/0/platform', qr{ ^ 1 | 2 $}x, '.platform' )
+ ->json_like( '/departures/0/route/0/name',
+ qr{ ^ (Dortmund|Bochum|Essen|D.sseldorf|Solingen) \s Hbf $}x, '.route[0]' )
+ ->json_like( '/departures/0/via/0',
+ qr{ ^ Dortmund-Dorstfeld \s S.d | Dortmund-Oespel $}x, '.via[0]' );
+
+$t->get_ok('/EDUV?mode=json&version=1&callback=my_callback')->status_is(200)
+ ->content_like( qr{ ^ my_callback \( }x, 'json callback works' );
-$t->get_ok('/EDUV?mode=json&version=1&callback=my_callback')
- ->status_is(200)
- ->content_like(qr{ ^ my_callback \( }x, 'json callback works');
# ) <- just here to fix bracket grouping in vim
done_testing();