diff options
| -rw-r--r-- | index.pl | 1089 | ||||
| -rw-r--r-- | lib/DBInfoscreen.pm | 249 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Controller/Static.pm | 58 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Controller/Stationboard.pm | 835 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Controller/Wagenreihung.pm | 26 | ||||
| -rw-r--r-- | t/01-basic.t | 2 | ||||
| -rw-r--r-- | t/22-json.t | 50 |
7 files changed, 1197 insertions, 1112 deletions
@@ -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(); |