diff options
Diffstat (limited to 'lib/DBInfoscreen')
| -rw-r--r-- | lib/DBInfoscreen/Controller/Map.pm | 969 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Controller/Static.pm | 8 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Controller/Stationboard.pm | 1322 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Controller/Wagenreihung.pm | 88 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Helper/DBRIS.pm | 93 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Helper/EFA.pm | 47 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Helper/HAFAS.pm | 43 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Helper/MOTIS.pm | 82 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Helper/Wagonorder.pm | 54 |
9 files changed, 2449 insertions, 257 deletions
diff --git a/lib/DBInfoscreen/Controller/Map.pm b/lib/DBInfoscreen/Controller/Map.pm index bced612..0a597e1 100644 --- a/lib/DBInfoscreen/Controller/Map.pm +++ b/lib/DBInfoscreen/Controller/Map.pm @@ -1,11 +1,12 @@ package DBInfoscreen::Controller::Map; # Copyright (C) 2011-2020 Birte Kristina Friesel +# Copyright (C) 2025 networkException <git@nwex.de> # # SPDX-License-Identifier: AGPL-3.0-or-later use Mojo::Base 'Mojolicious::Controller'; -use Mojo::JSON qw(decode_json); +use Mojo::JSON qw(decode_json encode_json); use Mojo::Promise; use DateTime; @@ -19,26 +20,28 @@ my $strp = DateTime::Format::Strptime->new( ); # Input: -# - polyline: Travel::Status::DE::HAFAS::Journey->polyline +# - polyline: [{lat, lon, name?}, ...] # - from_name: station name # - to_name: station name # Ouptut: -# - from_index: polyline index that corresponds to from_name -# - to_index: polyline index that corresponds to to_name +# - from_index: polyline index where name eq from_name +# - to_index: polyline index where name eq to_name sub get_route_indexes { my ( $polyline, $from_name, $to_name ) = @_; my ( $from_index, $to_index ); for my $i ( 0 .. $#{$polyline} ) { my $this_point = $polyline->[$i]; + my $name = $this_point->{name} // $this_point->{stop}->{name}; + if ( not defined $from_index - and $this_point->{name} - and $this_point->{name} eq $from_name ) + and $name + and $name eq $from_name ) { $from_index = $i; } - elsif ( $this_point->{name} - and $this_point->{name} eq $to_name ) + elsif ( $name + and $name eq $to_name ) { $to_index = $i; last; @@ -50,9 +53,9 @@ sub get_route_indexes { # Input: # now: DateTime # from: current/previous stop -# {dep => DateTime, name => str, lat => float, lon => float} +# {arr => DateTime, dep => DateTime, name => str, lat => float, lon => float} # to: next stop -# {arr => DateTime, name => str, lat => float, lon => float} +# {arr => DateTime, dep => DateTime, name => str, lat => float, lon => float} # route: Travel::Status::DE::HAFAS::Journey->route # polyline: Travel::Status::DE::HAFAS::Journey->polyline (list of lon/lat hashes) # Output: list of estimated train positions in [lat, lon] format. @@ -65,10 +68,10 @@ sub estimate_train_positions { my $now = $opt{now}; - my $from_dt = $opt{from}->dep // $opt{from}->arr; - my $to_dt = $opt{to}->arr // $opt{to}->dep; - my $from_name = $opt{from}->loc->name; - my $to_name = $opt{to}->loc->name; + my $from_dt = $opt{from}{dep} // $opt{from}{arr}; + my $to_dt = $opt{to}{arr} // $opt{to}{dep}; + my $from_name = $opt{from}{name}; + my $to_name = $opt{to}{name}; my $route = $opt{route}; my $polyline = $opt{polyline}; @@ -142,16 +145,14 @@ sub estimate_train_positions { ); for my $ratio (@completion_ratios) { my $lat - = $opt{from}->loc->lat - + ( $opt{to}->loc->lat - $opt{from}->loc->lat ) * $ratio; + = $opt{from}{lat} + ( $opt{to}{lat} - $opt{from}{lat} ) * $ratio; my $lon - = $opt{from}->loc->lon - + ( $opt{to}->loc->lon - $opt{from}->loc->lon ) * $ratio; + = $opt{from}{lon} + ( $opt{to}{lon} - $opt{from}{lon} ) * $ratio; push( @train_positions, [ $lat, $lon ] ); } return @train_positions; } - return [ $opt{to}->loc->lat, $opt{to}->loc->lon ]; + return [ $opt{to}{lat}, $opt{to}{lon} ]; } # Input: @@ -162,6 +163,8 @@ sub estimate_train_positions { # name: str # arr: DateTime # dep: DateTime +# arr_delay: int +# dep_delay: int # polyline: ref to Travel::Status::DE::HAFAS::Journey polyline list # Output: # next_stop: {type, station} @@ -179,10 +182,10 @@ sub estimate_train_positions2 { for my $i ( 1 .. $#route ) { if ( not $next_stop - and ( $route[$i]->arr // $route[$i]->dep ) - and ( $route[ $i - 1 ]->dep // $route[ $i - 1 ]->arr ) - and $now > ( $route[ $i - 1 ]->dep // $route[ $i - 1 ]->arr ) - and $now < ( $route[$i]->arr // $route[$i]->dep ) ) + and ( $route[$i]{arr} // $route[$i]{dep} ) + and ( $route[ $i - 1 ]{dep} // $route[ $i - 1 ]{arr} ) + and $now > ( $route[ $i - 1 ]{dep} // $route[ $i - 1 ]{arr} ) + and $now < ( $route[$i]{arr} // $route[$i]{dep} ) ) { # HAFAS does not provide delays for past stops @@ -207,15 +210,15 @@ sub estimate_train_positions2 { and $now <= ( $route[ $i - 1 ]{dep} // $route[ $i - 1 ]{arr} ) ) { @train_positions - = ( [ $route[ $i - 1 ]->loc->lat, $route[ $i - 1 ]->loc->lon ] ); + = ( [ $route[ $i - 1 ]{lat}, $route[ $i - 1 ]{lon} ] ); $next_stop = { type => 'present', station => $route[ $i - 1 ], }; } $stop_distance_sum += $distance->distance_metal( - $route[ $i - 1 ]->loc->lat, $route[ $i - 1 ]->loc->lon, - $route[$i]->loc->lat, $route[$i]->loc->lon + $route[ $i - 1 ]{lat}, $route[ $i - 1 ]{lon}, + $route[$i]{lat}, $route[$i]{lon} ) / 1000; } @@ -224,7 +227,7 @@ sub estimate_train_positions2 { } if ( @route and not $next_stop ) { - @train_positions = ( [ $route[-1]->loc->lat, $route[-1]->loc->lon ] ); + @train_positions = ( [ $route[-1]{lat}, $route[-1]{lon} ] ); $next_stop = { type => 'present', station => $route[-1] @@ -241,18 +244,23 @@ sub estimate_train_positions2 { }; } +# input: [{ +# name, platform, +# arr, arr_cancelled, arr_delay, +# dep, dep_cancelled, dep_delay +# }] sub route_to_ajax { my (@stopovers) = @_; my @route_entries; for my $stop (@stopovers) { - my @stop_entries = ( $stop->loc->name ); + my @stop_entries = ( $stop->{name} ); my $platform; - if ( my $arr = $stop->arr and not $stop->arr_cancelled ) { - my $delay = $stop->arr_delay // 0; - $platform = $stop->platform; + if ( my $arr = $stop->{arr} and not $stop->{arr_cancelled} ) { + my $delay = $stop->{arr_delay} // 0; + $platform = $stop->{platform}; push( @stop_entries, $arr->epoch, $delay ); } @@ -260,9 +268,9 @@ sub route_to_ajax { push( @stop_entries, q{}, q{} ); } - if ( my $dep = $stop->dep and not $stop->dep_cancelled ) { - my $delay = $stop->dep_delay // 0; - $platform //= $stop->platform // q{}; + if ( my $dep = $stop->{dep} and not $stop->{dep_cancelled} ) { + my $delay = $stop->{dep_delay} // 0; + $platform //= $stop->{platform} // q{}; push( @stop_entries, $dep->epoch, $delay, $platform ); } @@ -310,6 +318,494 @@ sub backpropagate_delay { } } +sub route_efa { + my ($self) = @_; + my $trip_id = $self->stash('tripid'); + my $backend = $self->param('efa'); + + my $stopseq; + if ( $trip_id + =~ m{ ^ ([^@]*) @ ([^@]*) [(] ([^T]*) T ([^)]*) [)] (.*) $ }x ) + { + $stopseq = { + stateless => $1, + stop_id => $2, + date => $3, + time => $4, + key => $5 + }; + } + else { + $self->render( + 'route_map', + title => "DBF", + hide_opts => 1, + with_map => 1, + error => "cannot parse trip ID: $trip_id", + ); + return; + } + + $self->efa->get_polyline_p( + stopseq => $stopseq, + service => $backend, + )->then( + sub { + my ($trip) = @_; + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + my @markers; + my @polyline = $trip->polyline( fallback => 1 ); + my @line_pairs = polyline_to_line_pairs(@polyline); + my @route = $trip->route; + + my $ref_route = [ + map { + { + name => $_->full_name, + platform => $_->platform, + arr => $_->arr, + dep => $_->dep, + arr_delay => $_->arr_delay, + dep_delay => $_->dep_delay, + lat => $_->latlon->[0], + lon => $_->latlon->[1] + } + } @route + ]; + + for my $pl (@polyline) { + if ( $pl->{stop} ) { + $pl->{name} = $pl->{stop}->full_name; + } + } + + my $train_pos = $self->estimate_train_positions2( + now => $now, + route => $ref_route, + polyline => \@polyline, + ); + + my @station_coordinates; + for my $stop (@route) { + my @stop_lines = ( $stop->full_name ); + if ( $stop->platform ) { + push( @stop_lines, 'Gleis ' . $stop->platform ); + } + if ( $stop->arr ) { + my $arr_line = $stop->arr->strftime('Ankunft: %H:%M'); + if ( $stop->arr_delay ) { + $arr_line .= sprintf( ' (%+d)', $stop->arr_delay ); + } + push( @stop_lines, $arr_line ); + } + if ( $stop->dep ) { + my $dep_line = $stop->dep->strftime('Abfahrt: %H:%M'); + if ( $stop->dep_delay ) { + $dep_line .= sprintf( ' (%+d)', $stop->dep_delay ); + } + push( @stop_lines, $dep_line ); + } + + push( @station_coordinates, [ $stop->latlon, [@stop_lines], ] ); + } + + push( + @markers, + { + lat => $train_pos->{position_now}[0], + lon => $train_pos->{position_now}[1], + title => $trip->name, + } + ); + + $self->render( + 'route_map', + description => "Karte für " . $trip->name, + title => $trip->name, + hide_opts => 1, + with_map => 1, + ajax_req => "${trip_id}/0", + ajax_route => route_to_ajax( @{$ref_route} ), + ajax_polyline => join( '|', + map { join( ';', @{$_} ) } @{ $train_pos->{positions} } ), + origin => { + name => ( $trip->route )[0]->full_name, + ts => ( $trip->route )[0]->dep, + }, + destination => { + name => ( $trip->route )[-1]->full_name, + ts => ( $trip->route )[-1]->arr, + }, + train_no => $trip->number + ? ( $trip->type // q{} . ' ' . $trip->number ) + : undef, + operator => $trip->operator, + next_stop => $train_pos->{next_stop}, + polyline_groups => [ + { + polylines => \@line_pairs, + color => '#00838f', + opacity => 0.6, + fit_bounds => 1, + } + ], + station_coordinates => \@station_coordinates, + station_radius => 100, + markers => \@markers, + ); + } + )->catch( + sub { + my ($err) = @_; + $self->render( + 'route_map', + title => "DBF", + hide_opts => 1, + with_map => 1, + error => $err, + ); + } + )->wait; +} + +sub route_dbris { + my ($self) = @_; + my $trip_id = $self->stash('tripid'); + + my $from_name = $self->param('from'); + my $to_name = $self->param('to'); + + $self->dbris->get_polyline_p( id => $trip_id )->then( + sub { + my ($journey) = @_; + + my @polyline = $journey->polyline; + my @station_coordinates; + + my @markers; + + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + + # used to draw the train's journey on the map + my @line_pairs = polyline_to_line_pairs(@polyline); + + my @route = $journey->route; + + my $train_pos = $self->estimate_train_positions2( + now => $now, + route => [ + map { + { + name => $_->name, + arr => $_->arr, + dep => $_->dep, + arr_delay => $_->arr_delay, + dep_delay => $_->dep_delay, + lat => $_->lat, + lon => $_->lon + } + } @route + ], + polyline => \@polyline, + ); + + # Prepare from/to markers and name/time/delay overlays for stations + for my $stop (@route) { + my @stop_lines = ( $stop->name ); + + if ( $from_name and $stop->name eq $from_name ) { + push( + @markers, + { + lon => $stop->lon, + lat => $stop->lat, + title => $stop->name, + icon => 'goldIcon', + } + ); + } + if ( $to_name and $stop->name eq $to_name ) { + push( + @markers, + { + lon => $stop->lon, + lat => $stop->lat, + title => $stop->name, + icon => 'greenIcon', + } + ); + } + + if ( $stop->platform ) { + push( @stop_lines, 'Gleis ' . $stop->platform ); + } + if ( $stop->arr ) { + my $arr_line = $stop->arr->strftime('Ankunft: %H:%M'); + if ( $stop->arr_delay ) { + $arr_line .= sprintf( ' (%+d)', $stop->arr_delay ); + } + push( @stop_lines, $arr_line ); + } + if ( $stop->dep ) { + my $dep_line = $stop->dep->strftime('Abfahrt: %H:%M'); + if ( $stop->dep_delay ) { + $dep_line .= sprintf( ' (%+d)', $stop->dep_delay ); + } + push( @stop_lines, $dep_line ); + } + + push( @station_coordinates, + [ [ $stop->lat, $stop->lon ], [@stop_lines], ] ); + } + + push( + @markers, + { + lat => $train_pos->{position_now}[0], + lon => $train_pos->{position_now}[1], + title => $journey->train, + } + ); + + $self->render( + 'route_map', + description => "Karte für " . $journey->train, + title => $journey->train, + hide_opts => 1, + with_map => 1, + ajax_req => "${trip_id}/0", + ajax_route => route_to_ajax( + map { + { + name => $_->name, + platform => $_->platform, + arr => $_->arr, + arr_cancelled => $_->is_cancelled, + arr_delay => $_->arr_delay, + dep => $_->dep, + dep_cancelled => $_->is_cancelled, + dep_delay => $_->dep_delay, + } + } $journey->route + ), + ajax_polyline => join( + '|', + map { join( ';', @{$_} ) } @{ $train_pos->{positions} } + ), + origin => { + name => ( $journey->route )[0]->name, + ts => ( $journey->route )[0]->dep, + }, + destination => { + name => ( $journey->route )[-1]->name, + ts => ( $journey->route )[-1]->arr, + }, + train_no => $journey->number + ? ( $journey->type // q{} . ' ' . $journey->number ) + : undef, + next_stop => $train_pos->{next_stop}, + polyline_groups => [ + { + polylines => [@line_pairs], + color => '#00838f', + opacity => 0.6, + fit_bounds => 1, + } + ], + station_coordinates => [@station_coordinates], + station_radius => + ( $train_pos->{avg_inter_stop_beeline} > 500 ? 250 : 100 ), + markers => [@markers], + ); + } + )->catch( + sub { + my ($err) = @_; + $self->render( + 'route_map', + title => "DBF", + hide_opts => 1, + with_map => 1, + error => $err, + ); + + } + )->wait; +} + +sub route_motis { + my ($self) = @_; + + my $service = $self->param('motis') // 'transitous'; + my $trip_id = $self->stash('tripid'); + + my $from_name = $self->param('from'); + my $to_name = $self->param('to'); + + $self->motis->get_polyline_p( + service => $service, + id => $trip_id, + )->then( + sub { + my ($trip) = @_; + + my @polyline = $trip->polyline; + my @station_coordinates; + + my @markers; + + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + + # used to draw the train's journey on the map + my @line_pairs = polyline_to_line_pairs(@polyline); + + my @stopovers = $trip->stopovers; + + my $train_pos = $self->estimate_train_positions2( + now => $now, + route => [ + map { + { + name => $_->stop->name, + arr => $_->arrival, + dep => $_->departure, + arr_delay => $_->arrival_delay, + dep_delay => $_->departure_delay, + lat => $_->stop->lat, + lon => $_->stop->lon, + } + } @stopovers + ], + polyline => \@polyline, + ); + + # Prepare from/to markers and name/time/delay overlays for stations + for my $stopover (@stopovers) { + my $stop = $stopover->stop; + my @stop_lines = ( $stop->name ); + + if ( $from_name and $stop->name eq $from_name ) { + push( + @markers, + { + lon => $stop->lon, + lat => $stop->lat, + title => $stop->name, + icon => 'goldIcon', + } + ); + } + if ( $to_name and $stop->name eq $to_name ) { + push( + @markers, + { + lon => $stop->lon, + lat => $stop->lat, + title => $stop->name, + icon => 'greenIcon', + } + ); + } + + if ( $stopover->track ) { + push( @stop_lines, 'Gleis ' . $stop->track ); + } + if ( $stopover->arrival ) { + my $arr_line + = $stopover->arrival->strftime('Ankunft: %H:%M'); + if ( $stopover->arrival_delay ) { + $arr_line + .= sprintf( ' (%+d)', $stopover->arrival_delay ); + } + push( @stop_lines, $arr_line ); + } + if ( $stopover->departure ) { + my $dep_line + = $stopover->departure->strftime('Abfahrt: %H:%M'); + if ( $stopover->departure_delay ) { + $dep_line + .= sprintf( ' (%+d)', $stopover->departure_delay ); + } + push( @stop_lines, $dep_line ); + } + + push( @station_coordinates, + [ [ $stop->lat, $stop->lon ], [@stop_lines], ] ); + } + + push( + @markers, + { + lat => $train_pos->{position_now}[0], + lon => $train_pos->{position_now}[1], + title => $trip->route_name, + } + ); + + $self->render( + 'route_map', + description => "Karte für " . $trip->route_name, + title => $trip->route_name, + hide_opts => 1, + with_map => 1, + ajax_req => "${trip_id}/0", + ajax_route => route_to_ajax( + map { + { + name => $_->stop->name, + platform => $_->track, + arr => $_->arrival, + arr_cancelled => $_->is_cancelled, + arr_delay => $_->arrival_delay, + dep => $_->departure, + dep_cancelled => $_->is_cancelled, + dep_delay => $_->departure_delay, + } + } $trip->stopovers + ), + ajax_polyline => join( + '|', + map { join( ';', @{$_} ) } @{ $train_pos->{positions} } + ), + origin => { + name => ( $trip->stopovers )[0]->stop->name, + ts => ( $trip->stopovers )[0]->departure, + }, + destination => { + name => ( $trip->stopovers )[-1]->stop->name, + ts => ( $trip->stopovers )[-1]->arrival, + }, + train_no => undef, # FIXME: Better value? + next_stop => $train_pos->{next_stop}, + polyline_groups => [ + { + polylines => [@line_pairs], + color => '#00838f', + opacity => 0.6, + fit_bounds => 1, + } + ], + station_coordinates => [@station_coordinates], + station_radius => + ( $train_pos->{avg_inter_stop_beeline} > 500 ? 250 : 100 ), + markers => [@markers], + ); + } + )->catch( + sub { + my ($err) = @_; + $self->render( + 'route_map', + title => "DBF", + hide_opts => 1, + with_map => 1, + error => $err, + ); + + } + )->wait; +} + sub route { my ($self) = @_; my $trip_id = $self->stash('tripid'); @@ -321,7 +817,17 @@ sub route { $self->render_later; - my $service = 'DB'; + if ( $self->param('dbris') ) { + return $self->route_dbris; + } + if ( $self->param('motis') ) { + return $self->route_motis; + } + if ( $self->param('efa') ) { + return $self->route_efa; + } + + my $service = 'ÖBB'; if ( $hafas and $hafas ne '1' and Travel::Status::DE::HAFAS::get_service($hafas) ) @@ -341,7 +847,6 @@ sub route { my @station_coordinates; my @markers; - my $next_stop; my $now = DateTime->now( time_zone => 'Europe/Berlin' ); @@ -351,8 +856,20 @@ sub route { my @route = $journey->route; my $train_pos = $self->estimate_train_positions2( - now => $now, - route => \@route, + now => $now, + route => [ + map { + { + name => $_->loc->name, + arr => $_->arr, + dep => $_->dep, + arr_delay => $_->arr_delay, + dep_delay => $_->dep_delay, + lat => $_->loc->lat, + lon => $_->loc->lon + } + } @route + ], polyline => \@polyline, ); @@ -413,18 +930,32 @@ sub route { title => $journey->name } ); - $next_stop = $train_pos->{next_stop}; $self->render( 'route_map', - description => "Karte für " . $journey->name, - title => $journey->name, - hide_opts => 1, - with_map => 1, - ajax_req => "${trip_id}/${line_no}", - ajax_route => route_to_ajax( $journey->route ), - ajax_polyline => join( '|', - map { join( ';', @{$_} ) } @{ $train_pos->{positions} } ), + description => "Karte für " . $journey->name, + title => $journey->name, + hide_opts => 1, + with_map => 1, + ajax_req => "${trip_id}/${line_no}", + ajax_route => route_to_ajax( + map { + { + name => $_->loc->name, + platform => $_->platform, + arr => $_->arr, + arr_cancelled => $_->arr_cancelled, + arr_delay => $_->arr_delay, + dep => $_->dep, + dep_cancelled => $_->dep_cancelled, + dep_delay => $_->dep_delay, + } + } $journey->route + ), + ajax_polyline => join( + '|', + map { join( ';', @{$_} ) } @{ $train_pos->{positions} } + ), origin => { name => ( $journey->route )[0]->loc->name, ts => ( $journey->route )[0]->dep, @@ -434,10 +965,10 @@ sub route { ts => ( $journey->route )[-1]->arr, }, train_no => $journey->number - ? ( $journey->type . ' ' . $journey->number ) + ? ( $journey->type // q{} . ' ' . $journey->number ) : undef, operator => $journey->operator, - next_stop => $next_stop, + next_stop => $train_pos->{next_stop}, polyline_groups => [ { polylines => [@line_pairs], @@ -467,17 +998,284 @@ sub route { )->wait; } -sub ajax_route { +sub ajax_route_efa { my ($self) = @_; + my $backend = $self->param('efa'); + my $trip_id = $self->stash('tripid'); + + my $stopseq; + if ( $trip_id + =~ m{ ^ ([^@]*) @ ([^@]*) [(] ([^T]*) T ([^)]*) [)] (.*) $ }x ) + { + $stopseq = { + stateless => $1, + stop_id => $2, + date => $3, + time => $4, + key => $5 + }; + } + else { + $self->render( + '_error', + error => "cannot parse trip ID: $trip_id", + ); + return; + } + + $self->efa->get_polyline_p( + stopseq => $stopseq, + service => $backend + )->then( + sub { + my ($trip) = @_; + + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + + my @polyline = $trip->polyline( fallback => 1 ); + my @route = $trip->route; + + my $ref_route = [ + map { + { + name => $_->full_name, + platform => $_->platform, + arr => $_->arr, + dep => $_->dep, + arr_delay => $_->arr_delay, + dep_delay => $_->dep_delay, + lat => $_->latlon->[0], + lon => $_->latlon->[1] + } + } @route + ]; + + for my $pl (@polyline) { + if ( $pl->{stop} ) { + $pl->{name} = $pl->{stop}->full_name; + } + } + + my $train_pos = $self->estimate_train_positions2( + now => $now, + route => $ref_route, + polyline => \@polyline, + ); + + $self->render( + '_map_infobox', + ajax_req => "${trip_id}/0", + ajax_route => route_to_ajax( @{$ref_route} ), + ajax_polyline => join( '|', + map { join( ';', @{$_} ) } @{ $train_pos->{positions} } ), + origin => { + name => ( $trip->route )[0]->full_name, + ts => ( $trip->route )[0]->dep, + }, + destination => { + name => ( $trip->route )[-1]->full_name, + ts => ( $trip->route )[-1]->arr, + }, + train_no => $trip->number + ? ( $trip->type // q{} . ' ' . $trip->number ) + : undef, + next_stop => $train_pos->{next_stop}, + ); + } + )->catch( + sub { + sub { + my ($err) = @_; + $self->render( + '_error', + error => $err, + ); + } + } + )->wait; +} + +sub ajax_route_dbris { + my ($self) = @_; + my $trip_id = $self->stash('tripid'); + + $self->dbris->get_polyline_p( id => $trip_id )->then( + sub { + my ($journey) = @_; + + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + + my @route = $journey->route; + my @polyline = $journey->polyline; + + my $train_pos = $self->estimate_train_positions2( + now => $now, + route => [ + map { + { + name => $_->name, + arr => $_->arr, + dep => $_->dep, + arr_delay => $_->arr_delay, + dep_delay => $_->dep_delay, + lat => $_->lat, + lon => $_->lon + } + } @route + ], + polyline => \@polyline, + ); + + $self->render( + '_map_infobox', + ajax_req => "${trip_id}/0", + ajax_route => route_to_ajax( + map { + { + name => $_->name, + platform => $_->platform, + arr => $_->arr, + arr_cancelled => $_->is_cancelled, + arr_delay => $_->arr_delay, + dep => $_->dep, + dep_cancelled => $_->is_cancelled, + dep_delay => $_->dep_delay, + } + } @route + ), + ajax_polyline => join( + '|', + map { join( ';', @{$_} ) } @{ $train_pos->{positions} } + ), + origin => { + name => ( $journey->route )[0]->name, + ts => ( $journey->route )[0]->dep, + }, + destination => { + name => ( $journey->route )[-1]->name, + ts => ( $journey->route )[-1]->arr, + }, + train_no => $journey->number + ? ( $journey->type . ' ' . $journey->number ) + : undef, + next_stop => $train_pos->{next_stop}, + platform_type => q{}, + ); + } + )->catch( + sub { + my ($err) = @_; + $self->render( + '_error', + error => $err, + ); + } + )->wait; +} + +sub ajax_route_motis { + my ($self) = @_; + + my $service = $self->param('motis') // 'transitous'; my $trip_id = $self->stash('tripid'); - my $line_no = $self->stash('lineno'); - my $hafas = $self->param('hafas'); + + $self->motis->get_polyline_p( + service => $service, + id => $trip_id, + )->then( + sub { + my ($trip) = @_; + + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + + my @stopovers = $trip->stopovers; + my @polyline = $trip->polyline; + + my $train_pos = $self->estimate_train_positions2( + now => $now, + route => [ + map { + { + name => $_->stop->name, + arr => $_->arrival, + dep => $_->departure, + arr_delay => $_->arrival_delay, + dep_delay => $_->departure_delay, + lat => $_->stop->lat, + lon => $_->stop->lon, + } + } @stopovers + ], + polyline => \@polyline, + ); + + $self->render( + '_map_infobox', + ajax_req => "${trip_id}/0", + ajax_route => route_to_ajax( + map { + { + name => $_->stop->name, + platform => $_->track, + arr => $_->arrival, + arr_cancelled => $_->is_cancelled, + arr_delay => $_->arrival_delay, + dep => $_->departure, + dep_cancelled => $_->is_cancelled, + dep_delay => $_->departure_delay, + } + } @stopovers + ), + ajax_polyline => join( + '|', + map { join( ';', @{$_} ) } @{ $train_pos->{positions} } + ), + origin => { + name => ( $trip->stopovers )[0]->stop->name, + ts => ( $trip->stopovers )[0]->departure, + }, + destination => { + name => ( $trip->stopovers )[-1]->stop->name, + ts => ( $trip->stopovers )[-1]->arrival, + }, + train_no => undef, # FIXME + next_stop => $train_pos->{next_stop}, + platform_type => q{}, + ); + } + )->catch( + sub { + my ($err) = @_; + $self->render( + '_error', + error => $err, + ); + } + )->wait; +} + +sub ajax_route { + my ($self) = @_; delete $self->stash->{layout}; $self->render_later; - my $service = 'DB'; + if ( $self->param('dbris') ) { + return $self->ajax_route_dbris; + } + if ( $self->param('motis') ) { + return $self->ajax_route_motis; + } + if ( $self->param('efa') ) { + return $self->ajax_route_efa; + } + + my $trip_id = $self->stash('tripid'); + my $line_no = $self->stash('lineno'); + my $hafas = $self->param('hafas'); + + my $service = 'ÖBB'; if ( $hafas and $hafas ne '1' and Travel::Status::DE::HAFAS::get_service($hafas) ) @@ -499,17 +1297,44 @@ sub ajax_route { my @polyline = $journey->polyline; my $train_pos = $self->estimate_train_positions2( - now => $now, - route => \@route, + now => $now, + route => [ + map { + { + name => $_->loc->name, + arr => $_->arr, + dep => $_->dep, + arr_delay => $_->arr_delay, + dep_delay => $_->dep_delay, + lat => $_->loc->lat, + lon => $_->loc->lon + } + } @route + ], polyline => \@polyline, ); $self->render( '_map_infobox', - ajax_req => "${trip_id}/${line_no}", - ajax_route => route_to_ajax(@route), - ajax_polyline => join( '|', - map { join( ';', @{$_} ) } @{ $train_pos->{positions} } ), + ajax_req => "${trip_id}/${line_no}", + ajax_route => route_to_ajax( + map { + { + name => $_->loc->name, + platform => $_->platform, + arr => $_->arr, + arr_cancelled => $_->arr_cancelled, + arr_delay => $_->arr_delay, + dep => $_->dep, + dep_cancelled => $_->dep_cancelled, + dep_delay => $_->dep_delay, + } + } @route + ), + ajax_polyline => join( + '|', + map { join( ';', @{$_} ) } @{ $train_pos->{positions} } + ), origin => { name => ( $journey->route )[0]->loc->name, ts => ( $journey->route )[0]->dep, @@ -535,4 +1360,30 @@ sub ajax_route { )->wait; } +sub coverage { + my ($self) = @_; + my $backend = lc( $self->stash('backend') ); + my $service = $self->stash('service'); + + my $coverage = {}; + + if ( $backend eq 'efa' ) { + $coverage = $self->efa->get_coverage($service); + } + elsif ( $backend eq 'hafas' ) { + $coverage = $self->hafas->get_coverage($service); + } + elsif ( $backend eq 'motis' ) { + $coverage = $self->motis->get_coverage($service); + } + + $self->render( + 'coverage_map', + title => "Abdeckung $service", + hide_opts => 1, + with_map => 1, + coverage => encode_json($coverage), + ); +} + 1; diff --git a/lib/DBInfoscreen/Controller/Static.pm b/lib/DBInfoscreen/Controller/Static.pm index 927bf6e..9a57f05 100644 --- a/lib/DBInfoscreen/Controller/Static.pm +++ b/lib/DBInfoscreen/Controller/Static.pm @@ -17,7 +17,8 @@ sub geostop { $self->render( 'geostop', with_geostop => 1, - hide_opts => 1 + hide_opts => 1, + hide_footer => 1, ); } @@ -27,19 +28,20 @@ sub about { $self->render( 'about', hide_opts => 1, + hide_footer => 1, ); } sub privacy { my ($self) = @_; - $self->render( 'privacy', hide_opts => 1 ); + $self->render( 'privacy', hide_opts => 1, hide_footer => 1 ); } sub imprint { my ($self) = @_; - $self->render( 'imprint', hide_opts => 1 ); + $self->render( 'imprint', hide_opts => 1, hide_footer => 1 ); } 1; diff --git a/lib/DBInfoscreen/Controller/Stationboard.pm b/lib/DBInfoscreen/Controller/Stationboard.pm index 9657bc0..3e07f90 100644 --- a/lib/DBInfoscreen/Controller/Stationboard.pm +++ b/lib/DBInfoscreen/Controller/Stationboard.pm @@ -16,7 +16,9 @@ use List::MoreUtils qw(); use Mojo::JSON qw(decode_json encode_json); use Mojo::Promise; use Mojo::UserAgent; -use Travel::Status::DE::DBWagenreihung; +use Travel::Status::DE::DBRIS; +use Travel::Status::DE::DBRIS::Formation; +use Travel::Status::DE::EFA; use Travel::Status::DE::HAFAS; use Travel::Status::DE::IRIS; use Travel::Status::DE::IRIS::Stations; @@ -44,13 +46,32 @@ sub class_to_product { } sub handle_no_results { - my ( $self, $station, $data, $hafas ) = @_; + my ( $self, $station, $data, $hafas, $efa ) = @_; my $errstr = $data->{errstr}; - if ($hafas) { + if ($efa) { + if ( $errstr =~ m{ambiguous} and $efa->name_candidates ) { + $self->render( + 'landingpage', + stationlist => [ $efa->name_candidates ], + hide_opts => 0, + status => $data->{status} // 300, + ); + } + else { + $self->render( + 'landingpage', + error => ( $errstr // "Keine Abfahrten an '$station'" ), + hide_opts => 0, + status => $data->{status} // 404, + ); + } + return; + } + elsif ($hafas) { $self->render_later; - my $service = 'DB'; + my $service = 'ÖBB'; if ( $hafas ne '1' and Travel::Status::DE::HAFAS::get_service($hafas) ) { $service = $hafas; @@ -59,7 +80,7 @@ sub handle_no_results { locationSearch => $station, service => $service, promise => 'Mojo::Promise', - user_agent => $self->ua, + user_agent => $service eq 'PKP' ? Mojo::UserAgent->new : $self->ua, )->then( sub { my ($status) = @_; @@ -231,10 +252,17 @@ sub result_has_train_type { sub result_has_via { my ( $result, $via ) = @_; - my @route - = $result->can('route_post') ? $result->route_post : map { $_->loc->name } - $result->route; + my @route; + if ( $result->isa('Travel::Status::DE::IRIS::Result') ) { + @route = ( $result->route_post, $result->sched_route_post ); + } + elsif ( $result->isa('Travel::Status::DE::HAFAS::Journey') ) { + @route = map { $_->loc->name } $result->route; + } + elsif ( $result->isa('Travel::Status::DE::EFA::Departure') ) { + @route = map { $_->full_name } $result->route_post; + } my $eq_result = List::MoreUtils::any { lc eq lc($via) } @route; if ($eq_result) { @@ -343,8 +371,69 @@ sub get_results_p { my ( $self, $station, %opt ) = @_; my $data; + if ( $opt{dbris} ) { + if ( $station =~ m{ [@] L = (?<eva> \d+ ) [@] }x ) { + return Travel::Status::DE::DBRIS->new_p( + station => { + eva => $+{eva}, + id => $station, + }, + cache => $opt{cache_iris_rt}, + lwp_options => { + timeout => 10, + agent => 'dbf.finalrewind.org/2' + }, + promise => 'Mojo::Promise', + user_agent => Mojo::UserAgent->new, + ); + } + my $promise = Mojo::Promise->new; + Travel::Status::DE::DBRIS->new_p( + locationSearch => $station, + cache => $opt{cache_iris_main}, + lwp_options => { + timeout => 10, + agent => 'dbf.finalrewind.org/2' + }, + promise => 'Mojo::Promise', + user_agent => Mojo::UserAgent->new, + )->then( + sub { + my ($dbris) = @_; + $promise->reject( 'station disambiguation', $dbris ); + return; + } + )->catch( + sub { + my ($err) = @_; + $promise->reject("'$err' while trying to look up '$station'"); + return; + } + )->wait; + return $promise; + } + if ( $opt{efa} ) { + my $service = 'VRR'; + if ( $opt{efa} ne '1' + and Travel::Status::DE::EFA::get_service( $opt{efa} ) ) + { + $service = $opt{efa}; + } + return Travel::Status::DE::EFA->new_p( + service => $service, + name => $station, + full_routes => 1, + cache => $opt{cache_iris_rt}, + lwp_options => { + timeout => 10, + agent => 'dbf.finalrewind.org/2' + }, + promise => 'Mojo::Promise', + user_agent => Mojo::UserAgent->new, + ); + } if ( $opt{hafas} ) { - my $service = 'DB'; + my $service = 'ÖBB'; if ( $opt{hafas} ne '1' and Travel::Status::DE::HAFAS::get_service( $opt{hafas} ) ) { @@ -360,7 +449,7 @@ sub get_results_p { agent => 'dbf.finalrewind.org/2' }, promise => 'Mojo::Promise', - user_agent => $self->ua, + user_agent => $service eq 'PKP' ? Mojo::UserAgent->new : $self->ua, ); } @@ -407,17 +496,21 @@ sub get_results_p { } } -sub handle_request { +sub handle_board_request { my ($self) = @_; my $station = $self->stash('station'); my $template = $self->param('mode') // 'app'; + my $dbris = $self->param('dbris'); + my $efa = $self->param('efa'); my $hafas = $self->param('hafas'); my $with_related = !$self->param('no_related'); my %opt = ( cache_iris_main => $self->app->cache_iris_main, cache_iris_rt => $self->app->cache_iris_rt, lookahead => $self->config->{lookahead}, + dbris => $dbris, + efa => $efa, hafas => $hafas, ); @@ -469,13 +562,19 @@ sub handle_request { # (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' ) { + if ( + $template eq 'marudor' + or ( $self->req->headers->accept + and $self->req->headers->accept eq 'application/json' ) + ) + { $template = 'json'; } $self->param( mode => $template ); if ( not $station ) { + $self->param( rt => 1 ); $self->render( 'landingpage', show_intro => 1 ); return; } @@ -502,6 +601,14 @@ sub handle_request { $self->get_results_p( $station, %opt )->then( sub { my ($status) = @_; + if ($dbris) { + $self->render_board_dbris( $station, $status ); + return; + } + if ($efa) { + $self->render_board_efa( $station, $status ); + return; + } my $data = { results => [ $status->results ], hafas => $hafas ? $status : undef, @@ -526,17 +633,27 @@ sub handle_request { $self->handle_no_results( $station, $data, $hafas ); return; } - $self->handle_result($data); + $self->render_board_hafas($data); } )->catch( sub { - my ($err) = @_; + my ( $err, $status ) = @_; + if ( $dbris and $err eq 'station disambiguation' ) { + for my $result ( $status->results ) { + if ( defined $result->eva ) { + $self->redirect_to( + '/' . $result->id . '?dbris=bahn.de' ); + return; + } + } + } if ( $template eq 'json' ) { $self->handle_no_results_json( $station, { errstr => $err, - status => ( $err =~ m{Ambiguous|LOCATION} ? 300 : 500 ), + status => + ( $err =~ m{[Aa]mbiguous|LOCATION} ? 300 : 500 ), }, $api_version ); @@ -546,9 +663,10 @@ sub handle_request { $station, { errstr => $err, - status => ( $err =~ m{Ambiguous|LOCATION} ? 300 : 500 ), + status => ( $err =~ m{[Aa]mbiguous|LOCATION} ? 300 : 500 ), }, - $hafas + $hafas, + $efa ? $status : undef ); return; } @@ -607,7 +725,7 @@ sub format_iris_result_info { $info .= ": ${delaymsg}"; } } - elsif ( $result->delay and $result->delay > 0 ) { + elsif ( $result->delay and $result->delay >= 20 ) { if ( $template eq 'app' or $template eq 'infoscreen' ) { $info = $delaymsg; } @@ -733,25 +851,88 @@ sub render_train { my @requests = ( $wagonorder_req, $occupancy_req, $stationinfo_req, $route_req ); - if ( $departure->{wr_link} ) { - $self->wagonorder->get_p( $result->train_no, $departure->{wr_link} ) - ->then( + if ( $departure->{wr_dt} ) { + $self->wagonorder->get_p( + train_type => $result->type, + train_number => $result->train_no, + datetime => $departure->{wr_dt}, + eva => $departure->{eva} + )->then( sub { - my ($wr_json) = @_; + my ( $wr_json, $wr_param ) = @_; eval { my $wr - = Travel::Status::DE::DBWagenreihung->new( - from_json => $wr_json ); + = Travel::Status::DE::DBRIS::Formation->new( + json => $wr_json ); $departure->{wr} = $wr; + $departure->{wr_link} = join( '&', + map { $_ . '=' . $wr_param->{$_} } keys %{$wr_param} ); $departure->{wr_text} = join( q{ • }, - map { $_->{short} } - grep { $_->{short} } $wr->train_descriptions ); + map { $_->desc_short } + grep { $_->desc_short } $wr->groups ); + my $first = 0; + for my $group ( $wr->groups ) { + my $had_entry = 0; + for my $wagon ( $group->carriages ) { + if ( + not( $wagon->is_locomotive + or $wagon->is_powercar ) + ) + { + my $class; + if ($first) { + push( + @{ $departure->{wr_preview} }, + [ '•', 'meta' ] + ); + $first = 0; + } + my $entry; + if ( $wagon->is_closed ) { + $entry = 'X'; + $class = 'closed'; + } + elsif ( $wagon->number ) { + $entry = $wagon->number; + } + else { + if ( $wagon->has_first_class ) { + if ( $wagon->has_second_class ) { + $entry = '½'; + } + else { + $entry = '1.'; + } + } + elsif ( $wagon->has_second_class ) { + $entry = '2.'; + } + else { + $entry = $wagon->type; + } + } + if ( + $group->train_no ne $departure->{train_no} ) + { + $class = 'otherno'; + } + push( + @{ $departure->{wr_preview} }, + [ $entry, $class ] + ); + $had_entry = 1; + } + } + if ($had_entry) { + $first = 1; + } + } }; $departure->{wr_text} ||= 'Wagen'; return; }, sub { - $departure->{wr_link} = undef; + $departure->{wr_dt} = undef; return; } )->finally( @@ -821,10 +1002,13 @@ sub render_train { } if ($direction) { - $departure->{direction} = $direction; + $departure->{wr_direction} = $direction; + $departure->{wr_direction_num} = $direction eq 'l' ? 0 : 100; } elsif ( $platform_info->{direction} ) { - $departure->{direction} = 'a' . $platform_info->{direction}; + $departure->{wr_direction} = 'a' . $platform_info->{direction}; + $departure->{wr_direction_num} + = $platform_info->{direction} eq 'l' ? 0 : 100; } return; @@ -937,27 +1121,36 @@ sub render_train { # Defer rendering until all requests have completed Mojo::Promise->all(@requests)->then( sub { - $self->render( - $template // '_train_details', - description => sprintf( - '%s %s%s%s nach %s', - $departure->{train_type}, - $departure->{train_line} // $departure->{train_no}, - $departure->{origin} ? ' von ' : q{}, - $departure->{origin} // q{}, - $departure->{destination} // 'unbekannt' - ), - departure => $departure, - linetype => $linetype, - dt_now => DateTime->now( time_zone => 'Europe/Berlin' ), - station_name => $station_name, - nav_link => - $self->url_for( 'station', station => $station_name )->query( - { - detailed => $self->param('detailed'), - hafas => $self->param('hafas') - } - ), + $self->respond_to( + json => { + json => { + departure => $departure, + station_name => $station_name, + }, + }, + any => { + template => $template // '_train_details', + description => sprintf( + '%s %s%s%s nach %s', + $departure->{train_type}, + $departure->{train_line} // $departure->{train_no}, + $departure->{origin} ? ' von ' : q{}, + $departure->{origin} // q{}, + $departure->{destination} // 'unbekannt' + ), + departure => $departure, + linetype => $linetype, + dt_now => DateTime->now( time_zone => 'Europe/Berlin' ), + station_name => $station_name, + nav_link => + $self->url_for( 'station', station => $station_name ) + ->query( + { + detailed => $self->param('detailed'), + hafas => $self->param('hafas') + } + ), + }, ); } )->wait; @@ -973,6 +1166,10 @@ sub station_train_details { delete $self->stash->{layout}; } + if ( $station =~ s{ [.] json $ }{}x ) { + $self->stash( format => 'json' ); + } + my %opt = ( cache_iris_main => $self->app->cache_iris_main, cache_iris_rt => $self->app->cache_iris_rt, @@ -1059,9 +1256,7 @@ sub station_train_details { map { $_->type . q{ } . $_->train_no } $result->replacement_for ], - wr_link => $result->sched_departure - ? $result->sched_departure->strftime('%Y%m%d%H%M') - : undef, + wr_dt => $result->sched_departure, eva => $result->station_uic, start => $result->start, }; @@ -1080,21 +1275,444 @@ sub station_train_details { )->catch( sub { my ($errstr) = @_; - $self->render( - 'landingpage', - error => - "Keine Abfahrt von $train_no in $station gefunden: $errstr", - status => 404, + $self->respond_to( + json => { + json => { + error => +"Keine Abfahrt von $train_no in $station gefunden: $errstr", + }, + status => 404, + }, + any => { + template => 'landingpage', + error => +"Keine Abfahrt von $train_no in $station gefunden: $errstr", + status => 404, + }, ); return; } )->wait; } +sub train_details_dbris { + my ($self) = @_; + my $trip_id = $self->stash('train'); + + $self->render_later; + + $self->dbris->get_journey_p( id => $trip_id )->then( + sub { + my ($dbris) = @_; + my $trip = $dbris->result; + + my ( @him_messages, @him_details ); + for my $message ( $trip->messages ) { + if ( not $message->{ueberschrift} ) { + push( + @him_messages, + [ + q{}, + { + icon => $message->{prioritaet} eq 'HOCH' + ? 'warning' + : 'info', + text => $message->{text} + } + ] + ); + } + } + + for my $attribute ( $trip->attributes ) { + push( + @him_details, + [ + q{}, + { + text => $attribute->{value} + . ( + $attribute->{teilstreckenHinweis} + ? q { } . $attribute->{teilstreckenHinweis} + : q{} + ) + } + ] + ); + } + + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + my $res = { + trip_id => $trip_id, + train_line => $trip->train, + train_no => $trip->number, + origin => ( $trip->route )[0]->name, + destination => ( $trip->route )[-1]->name, + operators => [], + linetype => 'bahn', + route_pre_diff => [], + route_post_diff => [], + moreinfo => [@him_messages], + details => [@him_details], + replaced_by => [], + replacement_for => [], + }; + + my $line = $trip->train; + if ( $line =~ m{ STR }x ) { + $res->{linetype} = 'tram'; + } + elsif ( $line =~ m{ ^ S }x ) { + $res->{linetype} = 'sbahn'; + } + elsif ( $line =~ m{ U }x ) { + $res->{linetype} = 'ubahn'; + } + elsif ( $line =~ m{ Bus }x ) { + $res->{linetype} = 'bus'; + } + elsif ( $line =~ m{ ^ [EI]CE? }x ) { + $res->{linetype} = 'fern'; + } + elsif ( $line =~ m{ EST | FLX }x ) { + $res->{linetype} = 'ext'; + } + + my $station_is_past = 1; + for my $stop ( $trip->route ) { + + push( + @{ $res->{route_post_diff} }, + { + name => $stop->name, + eva => $stop->eva, + id => $stop->id, + sched_arr => $stop->sched_arr, + sched_dep => $stop->sched_dep, + rt_arr => $stop->rt_arr, + rt_dep => $stop->rt_dep, + arr_delay => $stop->arr_delay, + dep_delay => $stop->dep_delay, + platform => $stop->platform, + } + ); + if ( + $station_is_past + and $now->epoch < ( + $res->{route_post_diff}[-1]{rt_arr} + // $res->{route_post_diff}[-1]{rt_dep} + // $res->{route_post_diff}[-1]{sched_arr} + // $res->{route_post_diff}[-1]{sched_dep} // $now + )->epoch + ) + { + $station_is_past = 0; + } + $res->{route_post_diff}[-1]{isPast} = $station_is_past; + } + + if ( my $req_id = $self->param('highlight') ) { + my $split; + for my $i ( 0 .. $#{ $res->{route_post_diff} } ) { + if ( $res->{route_post_diff}[$i]{eva} eq $req_id ) { + $split = $i; + last; + } + } + if ( defined $split ) { + $self->stash( + station_name => $res->{route_post_diff}[$split]{name} ); + for my $i ( 0 .. $split - 1 ) { + push( + @{ $res->{route_pre_diff} }, + shift( @{ $res->{route_post_diff} } ) + ); + } + my $station_info = shift( @{ $res->{route_post_diff} } ); + $res->{eva} = $station_info->{eva}; + if ( $station_info->{sched_arr} ) { + $res->{sched_arrival} + = $station_info->{sched_arr}->strftime('%H:%M'); + } + if ( $station_info->{rt_arr} ) { + $res->{arrival} + = $station_info->{rt_arr}->strftime('%H:%M'); + } + if ( $station_info->{sched_dep} ) { + $res->{sched_departure} + = $station_info->{sched_dep}->strftime('%H:%M'); + } + if ( $station_info->{rt_dep} ) { + $res->{departure} + = $station_info->{rt_dep}->strftime('%H:%M'); + } + $res->{arrival_is_cancelled} + = $station_info->{arr_cancelled}; + $res->{departure_is_cancelled} + = $station_info->{dep_cancelled}; + $res->{is_cancelled} = $res->{arrival_is_cancelled} + || $res->{arrival_is_cancelled}; + $res->{tz_offset} = $station_info->{tz_offset}; + $res->{local_dt_da} = $station_info->{local_dt_da}; + $res->{local_sched_arr} = $station_info->{local_sched_arr}; + $res->{local_sched_dep} = $station_info->{local_sched_dep}; + $res->{is_annotated} = $station_info->{is_annotated}; + $res->{prod_name} = $station_info->{prod_name}; + $res->{direction} = $station_info->{direction}; + $res->{operator} = $station_info->{operator}; + $res->{platform} = $station_info->{platform}; + $res->{scheduled_platform} + = $station_info->{sched_platform}; + } + } + + $self->respond_to( + json => { + json => { + journey => $trip, + }, + }, + any => { + template => $self->param('ajax') + ? '_train_details' + : 'train_details', + description => sprintf( + '%s %s%s%s nach %s', + $res->{train_type}, + $res->{train_line} // $res->{train_no}, + $res->{origin} ? ' von ' : q{}, + $res->{origin} // q{}, + $res->{destination} // 'unbekannt' + ), + departure => $res, + linetype => $res->{linetype}, + dt_now => DateTime->now( time_zone => 'Europe/Berlin' ), + }, + ); + } + )->catch( + sub { + my ($e) = @_; + $self->respond_to( + json => { + json => { + error => $e, + }, + status => 500, + }, + any => { + template => 'exception', + message => $e, + exception => undef, + snapshot => {}, + status => 500, + }, + ); + } + )->wait; +} + +sub train_details_efa { + my ($self) = @_; + my $trip_id = $self->stash('train'); + + my $stopseq; + if ( $trip_id + =~ m{ ^ ([^@]*) @ ([^@]*) [(] ([^T]*) T ([^)]*) [)] (.*) $ }x ) + { + $stopseq = { + stateless => $1, + stop_id => $2, + date => $3, + time => $4, + key => $5 + }; + } + else { + $self->render( 'not_found', status => 404 ); + return; + } + + $self->render_later; + + Travel::Status::DE::EFA->new_p( + service => $self->param('efa'), + stopseq => $stopseq, + cache => $self->app->cache_iris_rt, + lwp_options => { + timeout => 10, + agent => 'dbf.finalrewind.org/2' + }, + promise => 'Mojo::Promise', + user_agent => Mojo::UserAgent->new, + )->then( + sub { + my ($efa) = @_; + my $trip = $efa->result; + + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + my $res = { + trip_id => $trip_id, + train_type => $trip->type, + train_line => $trip->line, + train_no => $trip->number, + origin => ( $trip->route )[0]->full_name, + destination => ( $trip->route )[-1]->full_name, + operators => [ $trip->operator ], + linetype => lc( $trip->product ) =~ tr{a-z}{}cdr, + route_pre_diff => [], + route_post_diff => [], + moreinfo => [], + replaced_by => [], + replacement_for => [], + }; + + if ( $res->{linetype} =~ m{strab|stra.?enbahn} ) { + $res->{linetype} = 'tram'; + } + elsif ( $res->{linetype} =~ m{bus} ) { + $res->{linetype} = 'bus'; + } + + my $station_is_past = 1; + for my $stop ( $trip->route ) { + + push( + @{ $res->{route_post_diff} }, + { + name => $stop->full_name, + id => $stop->id_code, + sched_arr => $stop->sched_arr, + sched_dep => $stop->sched_dep, + rt_arr => $stop->rt_arr, + rt_dep => $stop->rt_dep, + arr_delay => $stop->arr_delay, + dep_delay => $stop->dep_delay, + platform => $stop->platform, + } + ); + if ( + $station_is_past + and $now->epoch < ( + $res->{route_post_diff}[-1]{rt_arr} + // $res->{route_post_diff}[-1]{rt_dep} + // $res->{route_post_diff}[-1]{sched_arr} + // $res->{route_post_diff}[-1]{sched_dep} // $now + )->epoch + ) + { + $station_is_past = 0; + } + $res->{route_post_diff}[-1]{isPast} = $station_is_past; + } + + if ( my $req_id = $self->param('highlight') ) { + my $split; + for my $i ( 0 .. $#{ $res->{route_post_diff} } ) { + if ( $res->{route_post_diff}[$i]{id} eq $req_id ) { + $split = $i; + last; + } + } + if ( defined $split ) { + $self->stash( + station_name => $res->{route_post_diff}[$split]{name} ); + for my $i ( 0 .. $split - 1 ) { + push( + @{ $res->{route_pre_diff} }, + shift( @{ $res->{route_post_diff} } ) + ); + } + my $station_info = shift( @{ $res->{route_post_diff} } ); + $res->{eva} = $station_info->{eva}; + if ( $station_info->{sched_arr} ) { + $res->{sched_arrival} + = $station_info->{sched_arr}->strftime('%H:%M'); + } + if ( $station_info->{rt_arr} ) { + $res->{arrival} + = $station_info->{rt_arr}->strftime('%H:%M'); + } + if ( $station_info->{sched_dep} ) { + $res->{sched_departure} + = $station_info->{sched_dep}->strftime('%H:%M'); + } + if ( $station_info->{rt_dep} ) { + $res->{departure} + = $station_info->{rt_dep}->strftime('%H:%M'); + } + $res->{arrival_is_cancelled} + = $station_info->{arr_cancelled}; + $res->{departure_is_cancelled} + = $station_info->{dep_cancelled}; + $res->{is_cancelled} = $res->{arrival_is_cancelled} + || $res->{arrival_is_cancelled}; + $res->{tz_offset} = $station_info->{tz_offset}; + $res->{local_dt_da} = $station_info->{local_dt_da}; + $res->{local_sched_arr} = $station_info->{local_sched_arr}; + $res->{local_sched_dep} = $station_info->{local_sched_dep}; + $res->{is_annotated} = $station_info->{is_annotated}; + $res->{prod_name} = $station_info->{prod_name}; + $res->{direction} = $station_info->{direction}; + $res->{operator} = $station_info->{operator}; + $res->{platform} = $station_info->{platform}; + $res->{scheduled_platform} + = $station_info->{sched_platform}; + } + } + + $self->respond_to( + json => { + json => { + journey => $trip, + }, + }, + any => { + template => $self->param('ajax') + ? '_train_details' + : 'train_details', + description => sprintf( + '%s %s%s%s nach %s', + $res->{train_type}, + $res->{train_line} // $res->{train_no}, + $res->{origin} ? ' von ' : q{}, + $res->{origin} // q{}, + $res->{destination} // 'unbekannt' + ), + departure => $res, + linetype => $res->{linetype}, + dt_now => DateTime->now( time_zone => 'Europe/Berlin' ), + }, + ); + } + )->catch( + sub { + my ($e) = @_; + $self->respond_to( + json => { + json => { + error => $e, + }, + status => 500, + }, + any => { + template => 'exception', + message => $e, + exception => undef, + snapshot => {}, + status => 500, + }, + ); + } + )->wait; +} + # /z/:train sub train_details { my ($self) = @_; my $train = $self->stash('train'); + my $dbris = $self->param('dbris'); + my $efa = $self->param('efa'); my $hafas = $self->param('hafas'); # TODO error handling @@ -1103,11 +1721,16 @@ sub train_details { delete $self->stash->{layout}; } - my $api_version = $Travel::Status::DE::IRIS::VERSION; - $self->stash( departures => [] ); $self->stash( title => 'DBF' ); + if ($dbris) { + return $self->train_details_dbris; + } + if ($efa) { + return $self->train_details_efa; + } + my $res = { train_type => undef, train_line => undef, @@ -1134,7 +1757,10 @@ sub train_details { } my $service = 'DB'; - if ( $hafas ne '1' and Travel::Status::DE::HAFAS::get_service($hafas) ) { + if ( $hafas + and $hafas ne '1' + and Travel::Status::DE::HAFAS::get_service($hafas) ) + { $opt{service} = $hafas; } @@ -1191,19 +1817,19 @@ sub train_details { my $prod = $self->class_to_product($hafas_obj)->{ $product->class } // q{}; - if ( $prod eq 'ice' or $prod eq 'ic_ec' ) { + if ( $prod =~ m{ ^ ice? | inter-?cit }ix ) { $linetype = 'fern'; } - elsif ( $prod eq 's' ) { + elsif ( $prod =~ m{ s-bahn | urban | rapid }ix ) { $linetype = 'sbahn'; } - elsif ( $prod eq 'bus' ) { + elsif ( $prod =~ m{ bus }ix ) { $linetype = 'bus'; } - elsif ( $prod eq 'u' ) { + elsif ( $prod =~ m{ metro | u-bahn | subway }ix ) { $linetype = 'ubahn'; } - elsif ( $prod eq 'tram' ) { + elsif ( $prod =~ m{ tram }ix ) { $linetype = 'tram'; } } @@ -1300,40 +1926,308 @@ sub train_details { $res->{details} = [@him_details]; } - $self->render( - $self->param('ajax') ? '_train_details' : 'train_details', - description => sprintf( - '%s %s%s%s nach %s', - $res->{train_type}, - $res->{train_line} // $res->{train_no}, - $res->{origin} ? ' von ' : q{}, - $res->{origin} // q{}, - $res->{destination} // 'unbekannt' - ), - departure => $res, - linetype => $linetype, - dt_now => DateTime->now( time_zone => 'Europe/Berlin' ), + $self->respond_to( + json => { + json => { + journey => $journey, + }, + }, + any => { + template => $self->param('ajax') + ? '_train_details' + : 'train_details', + description => sprintf( + '%s %s%s%s nach %s', + $res->{train_type}, + $res->{train_line} // $res->{train_no}, + $res->{origin} ? ' von ' : q{}, + $res->{origin} // q{}, + $res->{destination} // 'unbekannt' + ), + departure => $res, + linetype => $linetype, + dt_now => DateTime->now( time_zone => 'Europe/Berlin' ), + }, ); } )->catch( sub { my ($e) = @_; if ($e) { - $self->render( - 'exception', - message => $e, - exception => undef, - snapshot => {} + $self->respond_to( + json => { + json => { + error => $e, + }, + status => 500, + }, + any => { + template => 'exception', + message => $e, + exception => undef, + snapshot => {}, + status => 500, + }, ); } else { - $self->render('not_found'); + $self->render( 'not_found', status => 404 ); } } )->wait; } -sub handle_result { +sub render_board_dbris { + my ( $self, $station_id, $dbris ) = @_; + 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('rt') // $self->param('show_realtime') + // 1; + + my $station_name; + if ( $station_id =~ m{ [@] O = (?<name> [^@]+) [@] }x ) { + $station_name = $+{name}; + } + + my @departures; + + if ( $self->param('ajax') ) { + delete $self->stash->{layout}; + } + + my @results = $self->filter_results( $dbris->results ); + + @results = map { $_->[1] } sort { $a->[0] <=> $b->[0] } + map { [ $_->dep, $_ ] } @results; + + for my $result (@results) { + my $time; + + if ( $template eq 'json' ) { + push( @departures, $result ); + next; + } + + if ( $show_realtime and $result->rt_dep ) { + $time = $result->rt_dep->strftime('%H:%M'); + } + else { + $time = $result->sched_dep->strftime('%H:%M'); + } + + my $linetype = $result->line; + if ( $linetype =~ m{ STR }x ) { + $linetype = 'tram'; + } + elsif ( $linetype =~ m{ ^ S }x ) { + $linetype = 'sbahn'; + } + elsif ( $linetype =~ m{ U }x ) { + $linetype = 'ubahn'; + } + elsif ( $linetype =~ m{ Bus }x ) { + $linetype = 'bus'; + } + elsif ( $linetype =~ m{ ^ [EI]CE? }x ) { + $linetype = 'fern'; + } + elsif ( $linetype =~ m{ EST | FLX }x ) { + $linetype = 'ext'; + } + else { + $linetype = 'bahn'; + } + + my $delay = $result->delay; + + push( + @departures, + { + time => $time, + sched_departure => $result->sched_dep->strftime('%H:%M'), + departure => $result->rt_dep + ? $result->rt_dep->strftime('%H:%M') + : undef, + train => $result->train_mid, + train_type => q{}, + train_line => $result->line, + train_no => $result->maybe_train_no, + journey_id => $result->id, + via => [ $result->via ], + origin => q{}, + destination => $result->destination, + platform => $result->rt_platform // $result->platform, + scheduled_platform => $result->platform, + is_cancelled => $result->is_cancelled, + linetype => $linetype, + delay => $delay, + is_bit_delayed => + ( $delay and $delay > 0 and $delay < 5 ? 1 : 0 ), + is_delayed => ( $delay and $delay >= 5 ? 1 : 0 ), + has_realtime => defined $delay ? 1 : 0, + station => $result->stop_eva, + replaced_by => [], + replacement_for => [], + route_pre => [], + route_post => [ $result->via ], + wr_dt => undef, + } + ); + } + + if ( $template eq 'json' ) { + $self->res->headers->access_control_allow_origin(q{*}); + my $json = { + departures => \@departures, + }; + $self->render( + json => $json, + ); + } + else { + $self->render( + $template, + description => "Abfahrtstafel $station_name", + departures => \@departures, + station => $station_name, + version => $self->config->{version}, + title => $station_name, + refresh_interval => $template eq 'app' ? 0 : 120, + hide_opts => $hide_opts, + hide_footer => $hide_opts, + hide_low_delay => $hide_low_delay, + show_realtime => $show_realtime, + load_marquee => ( + $template eq 'single' + or $template eq 'multi' + ), + force_mobile => ( $template eq 'app' ), + ); + } +} + +sub render_board_efa { + my ( $self, $station_name, $efa ) = @_; + 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('rt') // $self->param('show_realtime') + // 1; + + my @departures; + + if ( $self->param('ajax') ) { + delete $self->stash->{layout}; + } + + my @results = $self->filter_results( $efa->results ); + + for my $result (@results) { + my $time; + + if ( $template eq 'json' ) { + push( @departures, $result ); + next; + } + + if ( $show_realtime and $result->rt_datetime ) { + $time = $result->rt_datetime->strftime('%H:%M'); + } + else { + $time = $result->sched_datetime->strftime('%H:%M'); + } + + my $linetype = $result->mot_name // 'bahn'; + if ( $linetype =~ m{ s-bahn | urban | rapid }ix ) { + $linetype = 'sbahn'; + } + elsif ( $linetype =~ m{ metro | u-bahn | subway }ix ) { + $linetype = 'ubahn'; + } + elsif ( $linetype =~ m{ bus }ix ) { + $linetype = 'bus'; + } + elsif ( $linetype =~ m{ tram }ix ) { + $linetype = 'tram'; + } + elsif ( $linetype =~ m{ ^ ice? | inter-?cit }ix ) { + $linetype = 'fern'; + } + elsif ( $linetype eq 'sonstige' ) { + $linetype = 'ext'; + } + + my $delay = $result->delay; + + push( + @departures, + { + time => $time, + sched_departure => $result->sched_datetime->strftime('%H:%M'), + departure => $result->rt_datetime + ? $result->rt_datetime->strftime('%H:%M') + : undef, + train => $result->line, + train_type => q{}, + train_line => $result->line, + train_no => $result->train_no, + journey_id => $result->id, + via => [ map { $_->name } $result->route_interesting ], + origin => $result->origin, + destination => $result->destination, + platform => $result->platform, + is_cancelled => $result->is_cancelled, + linetype => $linetype, + delay => $delay, + is_bit_delayed => + ( $delay and $delay > 0 and $delay < 5 ? 1 : 0 ), + is_delayed => ( $delay and $delay >= 5 ? 1 : 0 ), + has_realtime => defined $delay ? 1 : 0, + occupancy => $result->occupancy, + station => $efa->stop->id_code, + replaced_by => [], + replacement_for => [], + route_pre => [ map { $_->full_name } $result->route_pre ], + route_post => [ map { $_->full_name } $result->route_post ], + wr_dt => undef, + } + ); + } + + if ( $template eq 'json' ) { + $self->res->headers->access_control_allow_origin(q{*}); + my $json = { + departures => \@departures, + }; + $self->render( + json => $json, + ); + } + else { + $self->render( + $template, + description => "Abfahrtstafel $station_name", + departures => \@departures, + station => $efa->stop->name, + version => $self->config->{version}, + title => $efa->stop->name // $station_name, + refresh_interval => $template eq 'app' ? 0 : 120, + hide_opts => $hide_opts, + hide_footer => $hide_opts, + hide_low_delay => $hide_low_delay, + show_realtime => $show_realtime, + load_marquee => ( + $template eq 'single' + or $template eq 'multi' + ), + force_mobile => ( $template eq 'app' ), + ); + } +} + +# For HAFAS and IRIS departure elements +sub render_board_hafas { my ( $self, $data ) = @_; my @results = @{ $data->{results} }; @@ -1344,7 +2238,7 @@ sub handle_result { my $hide_low_delay = $self->param('hidelowdelay') // 0; my $hide_opts = $self->param('hide_opts') // 0; my $show_realtime = $self->param('rt') // $self->param('show_realtime') - // 0; + // 1; my $show_details = $self->param('detailed') // 0; my $admode = $self->param('admode') // 'deparr'; my $apiver = $self->param('version') // 0; @@ -1386,16 +2280,32 @@ sub handle_result { @results = sort { $a->datetime <=> $b->datetime } @results; } elsif ( $admode eq 'arr' ) { - @results = sort { - ( $a->arrival // $a->departure ) - <=> ( $b->arrival // $b->departure ) - } @results; + @results = map { $_->[1] } + sort { $a->[0] <=> $b->[0] } + map { + [ + ( + $_->sched_arrival ? $_->arrival_is_cancelled + : $_->is_cancelled + ) ? ( $_->sched_arrival // $_->sched_departure ) + : ( $_->arrival // $_->departure ), + $_ + ] + } @results; } else { - @results = sort { - ( $a->departure // $a->arrival ) - <=> ( $b->departure // $b->arrival ) - } @results; + @results = map { $_->[1] } + sort { $a->[0] <=> $b->[0] } + map { + [ + ( + $_->sched_departure ? $_->departure_is_cancelled + : $_->is_cancelled + ) ? ( $_->sched_departure // $_->sched_arrival ) + : ( $_->departure // $_->arrival ), + $_ + ] + } @results; } } @@ -1442,19 +2352,19 @@ sub handle_result { } elsif ( $result->can('class') ) { my $prod = $class_to_product->{ $result->class } // q{}; - if ( $prod eq 'ice' or $prod eq 'ic_ec' ) { + if ( $prod =~ m{ ^ ice? | inter-?cit }ix ) { $linetype = 'fern'; } - elsif ( $prod eq 's' ) { + elsif ( $prod =~ m{ s-bahn | urban | rapid }ix ) { $linetype = 'sbahn'; } - elsif ( $prod eq 'bus' ) { + elsif ( $prod =~ m{ bus }ix ) { $linetype = 'bus'; } - elsif ( $prod eq 'u' ) { + elsif ( $prod =~ m{ metro | u-bahn | subway }ix ) { $linetype = 'ubahn'; } - elsif ( $prod eq 'tram' ) { + elsif ( $prod =~ m{ tram }ix ) { $linetype = 'tram'; } } @@ -1511,6 +2421,9 @@ sub handle_result { ); return; } + elsif ( $apiver eq 'raw' ) { + push( @departures, $result ); + } else { # apiver == 3 if ( $result->isa('Travel::Status::DE::IRIS::Result') ) { my ( $delay_arr, $delay_dep, $sched_arr, $sched_dep ); @@ -1659,11 +2572,15 @@ sub handle_result { } $result->qos_messages ], }, - station => $result->station, - moreinfo => $moreinfo, - delay => $delay, + station => $result->station, + moreinfo => $moreinfo, + delay => $delay, + is_bit_delayed => + ( $delay and $delay > 0 and $delay < 5 ? 1 : 0 ), + is_delayed => ( $delay and $delay >= 5 ? 1 : 0 ), arrival_delay => $result->arrival_delay, departure_delay => $result->departure_delay, + has_realtime => $result->has_realtime, missing_realtime => ( not $result->has_realtime and $result->start < $now ? 1 : 0 @@ -1680,9 +2597,8 @@ sub handle_result { map { $_->type . q{ } . $_->train_no } $result->replacement_for ], - wr_link => $result->sched_departure - ? $result->sched_departure->strftime('%Y%m%d%H%M') - : undef, + wr_dt => $result->sched_departure, + eva => $result->station_uic, } ); } @@ -1716,22 +2632,26 @@ sub handle_result { origin => $result->route_end =~ s{,\Q$city\E}{}r, platform => $result->platform, scheduled_platform => $result->sched_platform, + load => $result->load // {}, info => $info, is_cancelled => $result->is_cancelled, linetype => $linetype, station => $result->station, moreinfo => $moreinfo, delay => $delay, - replaced_by => [], - replacement_for => [], - route_pre => $admode eq 'arr' + is_bit_delayed => + ( $delay and $delay > 0 and $delay < 5 ? 1 : 0 ), + is_delayed => ( $delay and $delay >= 5 ? 1 : 0 ), + has_realtime => defined $delay ? 1 : 0, + replaced_by => [], + replacement_for => [], + route_pre => $admode eq 'arr' ? [ map { $_->loc->name } $result->route ] : [], route_post => $admode eq 'arr' ? [] : [ map { $_->loc->name } $result->route ], - wr_link => $result->sched_datetime - ? $result->sched_datetime->strftime('%Y%m%d%H%M') - : undef, + wr_dt => $result->sched_datetime, + eva => $result->station_uic, } ); } @@ -1782,24 +2702,22 @@ sub handle_result { my $station_name = $data->{station_name} // $self->stash('station'); my ( $api_link, $api_text, $api_icon ); my $params = $self->req->params->clone; - $params->param( hafas => not $params->param('hafas') ); - if ( $params->param('hafas') ) { + if ( not $hafas ) { if ( $data->{station_eva} >= 8100000 and $data->{station_eva} < 8200000 ) { $params->param( hafas => 'ÖBB' ); } - $api_link = '/' . $data->{station_eva} . '?' . $params->to_string; - $api_text = 'Auf Nahverkehr wechseln'; - $api_icon = 'train'; - } - else { - my $iris_eva = List::Util::min grep { $_ >= 1000000 } - @{ $data->{station_evas} // [] }; - if ($iris_eva) { - $api_link = '/' . $iris_eva . '?' . $params->to_string; - $api_text = 'Auf Bahnverkehr wechseln'; - $api_icon = 'directions'; + elsif ( $data->{station_eva} >= 8500000 + and $data->{station_eva} < 8600000 ) + { + $params->param( hafas => 'BLS' ); + } + if ( $params->param('hafas') ) { + $api_link + = '/' . $data->{station_eva} . '?' . $params->to_string; + $api_text = 'Auf Nahverkehr wechseln'; + $api_icon = 'train'; } } $self->render( @@ -1815,6 +2733,7 @@ sub handle_result { title => $via ? "$station_name → $via" : $station_name, refresh_interval => $template eq 'app' ? 0 : 120, hide_opts => $hide_opts, + hide_footer => $hide_opts, hide_low_delay => $hide_low_delay, show_realtime => $show_realtime, load_marquee => ( @@ -1837,16 +2756,17 @@ sub handle_result { sub stations_by_coordinates { my $self = shift; - my $lon = $self->param('lon'); - my $lat = $self->param('lat'); - my $hafas = $self->param('hafas'); + my $lon = $self->param('lon'); + my $lat = $self->param('lat'); + my $efa_service = $self->param('efa'); + my $hafas = $self->param('hafas'); if ( not $lon or not $lat ) { $self->render( json => { error => 'Invalid lon/lat received' } ); return; } - my $service = 'DB'; + my $service = 'ÖBB'; if ( $hafas and $hafas ne '1' and Travel::Status::DE::HAFAS::get_service($hafas) ) @@ -1856,6 +2776,46 @@ sub stations_by_coordinates { $self->render_later; + if ($efa_service) { + Travel::Status::DE::EFA->new_p( + promise => 'Mojo::Promise', + user_agent => $self->ua, + service => $efa_service, + coord => { + lat => $lat, + lon => $lon + } + )->then( + sub { + my ($efa) = @_; + my @efa = map { + { + name => $_->full_name, + eva => $_->id =~ s{:}{%3A}gr, + distance => $_->distance_m / 1000, + efa => $efa_service, + } + } $efa->results; + $self->render( + json => { + candidates => [@efa], + } + ); + } + )->catch( + sub { + my ($err) = @_; + $self->render( + json => { + candidates => [], + warning => $err, + } + ); + } + )->wait; + return; + } + my @iris = map { { ds100 => $_->[0][0], @@ -1873,7 +2833,7 @@ sub stations_by_coordinates { Travel::Status::DE::HAFAS->new_p( promise => 'Mojo::Promise', - user_agent => $self->ua, + user_agent => $service eq 'PKP' ? Mojo::UserAgent->new : $self->ua, service => $service, geoSearch => { lat => $lat, @@ -1915,6 +2875,101 @@ sub stations_by_coordinates { )->wait; } +sub backend_list { + my ($self) = @_; + + my %place_map = ( + AT => 'Österreich', + CH => 'Schweiz', + 'CH-BE' => 'Kanton Bern', + 'CH-GE' => 'Kanton Genf', + 'CH-LU' => 'Kanton Luzern', + 'CH-ZH' => 'Kanton Zürich', + DE => 'Deutschland', + 'DE-BB' => 'Brandenburg', + 'DE-BW' => 'Baden-Württemberg', + 'DE-BE' => 'Berlin', + 'DE-BY' => 'Bayern', + 'DE-HB' => 'Bremen', + 'DE-HE' => 'Hessen', + 'DE-MV' => 'Mecklenburg-Vorpommern', + 'DE-NI' => 'Niedersachsen', + 'DE-NW' => 'Nordrhein-Westfalen', + 'DE-RP' => 'Rheinland-Pfalz', + 'DE-SH' => 'Schleswig-Holstein', + 'DE-ST' => 'Sachsen-Anhalt', + 'DE-TH' => 'Thüringen', + DK => 'Dänemark', + 'GB-NIR' => 'Nordirland', + LI => 'Liechtenstein', + LU => 'Luxembourg', + IE => 'Irland', + 'US-CA' => 'California', + 'US-TX' => 'Texas', + ); + + my @backends = ( + { + name => 'Deutsche Bahn', + type => 'IRIS-TTS', + } + ); + + for my $backend ( Travel::Status::DE::EFA::get_services() ) { + push( + @backends, + { + name => $backend->{name}, + shortname => $backend->{shortname}, + homepage => $backend->{homepage}, + regions => [ + map { $place_map{$_} // $_ } + @{ $backend->{coverage}{regions} } + ], + has_area => $backend->{coverage}{area} ? 1 : 0, + type => 'EFA', + efa => 1, + } + ); + } + + for my $backend ( Travel::Status::DE::HAFAS::get_services() ) { + if ( $backend->{shortname} eq 'DB' ) { + + # HTTP 503 Service Temporarily Unavailable as of 2025-01-08 ~10:30 UTC + # (I bet it's actually Permanently Unavailable) + next; + } + if ( $backend->{shortname} eq 'VRN' ) { + + # HTTP 403 Forbidden as of 2025-03-03 + next; + } + push( + @backends, + { + name => $backend->{name}, + shortname => $backend->{shortname}, + homepage => $backend->{homepage}, + regions => [ + map { $place_map{$_} // $_ } + @{ $backend->{coverage}{regions} } + ], + has_area => $backend->{coverage}{area} ? 1 : 0, + type => 'HAFAS', + hafas => 1, + } + ); + } + + $self->render( + 'select_backend', + backends => \@backends, + hide_opts => 1, + hide_footer => 1 + ); +} + sub autocomplete { my ($self) = @_; @@ -1963,11 +3018,18 @@ sub redirect_to_station { $params = $params->to_string; $self->redirect_to("/z/${input}?${params}"); } + elsif ( $params->param('efa') ) { + $params->remove('hafas'); + $params = $params->to_string; + $self->redirect_to("/${input}?${params}"); + } elsif ( $params->param('hafas') and $params->param('hafas') ne '1' ) { + $params->remove('efa'); $params = $params->to_string; $self->redirect_to("/${input}?${params}"); } else { + $params->remove('efa'); my @candidates = Travel::Status::DE::IRIS::Stations::get_station($input); if ( diff --git a/lib/DBInfoscreen/Controller/Wagenreihung.pm b/lib/DBInfoscreen/Controller/Wagenreihung.pm index 1708285..b9f0ee3 100644 --- a/lib/DBInfoscreen/Controller/Wagenreihung.pm +++ b/lib/DBInfoscreen/Controller/Wagenreihung.pm @@ -10,39 +10,40 @@ use Mojo::Util qw(b64_encode b64_decode); use utf8; -use Travel::Status::DE::DBWagenreihung; -use Travel::Status::DE::DBWagenreihung::Wagon; +use Travel::Status::DE::DBRIS::Formation; sub handle_wagenreihung_error { - my ( $self, $train_no, $err ) = @_; + my ( $self, $train, $err ) = @_; $self->render( 'wagenreihung', - title => "Zug $train_no", + title => $train, wr_error => $err, - train_no => $train_no, wr => undef, wref => undef, hide_opts => 1, + status => 500, ); } sub wagenreihung { - my ($self) = @_; - my $train = $self->stash('train'); - my $departure = $self->stash('departure'); + my ($self) = @_; my $exit_side = $self->param('e'); + my $train_type = $self->param('category'); + my $train_no = $self->param('number'); + my $train = "${train_type} ${train_no}"; + $self->render_later; - $self->wagonorder->get_p( $train, $departure )->then( + $self->wagonorder->get_p( param => $self->req->query_params->to_hash ) + ->then( sub { my ($json) = @_; my $wr; eval { $wr - = Travel::Status::DE::DBWagenreihung->new( - from_json => $json ); + = Travel::Status::DE::DBRIS::Formation->new( json => $json ); }; if ($@) { $self->handle_wagenreihung_error( $train, scalar $@ ); @@ -50,8 +51,8 @@ sub wagenreihung { } if ( $exit_side and $exit_side =~ m{^a} ) { - if ( $wr->sections and defined $wr->direction ) { - my $section_0 = ( $wr->sections )[0]; + if ( $wr->sectors and defined $wr->direction ) { + my $section_0 = ( $wr->sectors )[0]; my $direction = $wr->direction; if ( $section_0->name eq 'A' and $direction == 0 ) { $exit_side =~ s{^a}{}; @@ -71,22 +72,21 @@ sub wagenreihung { my $wref = { e => $exit_side ? substr( $exit_side, 0, 1 ) : '', tt => $wr->train_type, - tn => $train, - s => $wr->station_name, + tn => $train_no, p => $wr->platform }; - if ( $wr->has_bad_wagons ) { + #if ( $wr->has_bad_wagons ) { - # create fake positions as the correct ones are not available - my $pos = 0; - for my $wagon ( $wr->wagons ) { - $wagon->{position}{start_percent} = $pos; - $wagon->{position}{end_percent} = $pos + 4; - $pos += 4; - } - } - elsif ( defined $wr->direction and scalar $wr->wagons > 2 ) { + # # create fake positions as the correct ones are not available + # my $pos = 0; + # for my $wagon ( $wr->wagons ) { + # $wagon->{position}{start_percent} = $pos; + # $wagon->{position}{end_percent} = $pos + 4; + # $pos += 4; + # } + #} + if ( defined $wr->direction and scalar $wr->carriages > 2 ) { # wagenlexikon images only know one orientation. They assume # that the second class (i.e., the wagon with the lowest @@ -100,17 +100,17 @@ sub wagenreihung { # order differs, we do not show a direction, as we do not # handle that case yet. - my @wagons = $wr->wagons; + my @wagons = $wr->carriages; # skip first/last wagon as it may be a locomotive my $wna1 = $wagons[1]->number; my $wna2 = $wagons[2]->number; my $wnb1 = $wagons[-3]->number; my $wnb2 = $wagons[-2]->number; - my $wpa1 = $wagons[1]{position}{start_percent}; - my $wpa2 = $wagons[2]{position}{start_percent}; - my $wpb1 = $wagons[-3]{position}{start_percent}; - my $wpb2 = $wagons[-2]{position}{start_percent}; + my $wpa1 = $wagons[1]->start_percent; + my $wpa2 = $wagons[2]->start_percent; + my $wpb1 = $wagons[-3]->start_percent; + my $wpb2 = $wagons[-2]->start_percent; if ( $wna1 =~ m{^\d+$} and $wna2 =~ m{^\d+$} @@ -161,33 +161,29 @@ sub wagenreihung { $wref = b64_encode( encode_json($wref) ); - my $title = join( ' / ', - map { $wr->train_type . ' ' . $_ } $wr->train_numbers ); + my $title = join( ' / ', map { $_->{name} } $wr->trains ); $self->render( 'wagenreihung', - description => sprintf( - 'Ist-Wagenreihung %s in %s', - $title, $wr->station_name - ), - wr_error => undef, - title => $title, - train_no => $train, - wr => $wr, - wref => $wref, - exit_dir => $exit_dir, - hide_opts => 1, + description => sprintf( 'Ist-Wagenreihung %s', $title ), + wr_error => undef, + title => $title, + wr => $wr, + wref => $wref, + exit_dir => $exit_dir, + hide_opts => 1, + ts => $json->{ts}, ); } - )->catch( + )->catch( sub { my ($err) = @_; $self->handle_wagenreihung_error( $train, - $err->{error}->{msg} // "Unbekannter Fehler" ); + $err // "Unbekannter Fehler" ); return; } - )->wait; + )->wait; } diff --git a/lib/DBInfoscreen/Helper/DBRIS.pm b/lib/DBInfoscreen/Helper/DBRIS.pm new file mode 100644 index 0000000..e780213 --- /dev/null +++ b/lib/DBInfoscreen/Helper/DBRIS.pm @@ -0,0 +1,93 @@ +package DBInfoscreen::Helper::DBRIS; + +# Copyright (C) 2025 Birte Kristina Friesel +# +# SPDX-License-Identifier: AGPL-3.0-or-later + +use strict; +use warnings; +use 5.020; + +use DateTime; +use Encode qw(decode encode); +use Travel::Status::DE::DBRIS; +use Mojo::JSON qw(decode_json); +use Mojo::Promise; +use Mojo::UserAgent; + +sub new { + my ( $class, %opt ) = @_; + + my $version = $opt{version}; + + $opt{header} + = { 'User-Agent' => +"dbf/${version} on $opt{root_url} +https://finalrewind.org/projects/db-fakedisplay" + }; + + return bless( \%opt, $class ); + +} + +sub get_journey_p { + my ( $self, %opt ) = @_; + + my $agent = $self->{user_agent}; + + if ( my $proxy = $ENV{DBFAKEDISPLAY_DBRIS_PROXY} ) { + $agent = Mojo::UserAgent->new; + $agent->proxy->http($proxy); + $agent->proxy->https($proxy); + } + + return Travel::Status::DE::DBRIS->new_p( + journey => $opt{id}, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $agent->request_timeout(10) + ); +} + +# Input: TripID +# Output: Promise returning a Travel::Status::DE::DBRIS::Journey instance on success +sub get_polyline_p { + my ( $self, %opt ) = @_; + + my $trip_id = $opt{id}; + my $promise = Mojo::Promise->new; + + my $agent = $self->{user_agent}; + + if ( my $proxy = $ENV{DBFAKEDISPLAY_DBRIS_PROXY} ) { + $agent = Mojo::UserAgent->new; + $agent->proxy->http($proxy); + $agent->proxy->https($proxy); + } + + Travel::Status::DE::DBRIS->new_p( + journey => $trip_id, + with_polyline => 1, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $agent->request_timeout(10) + )->then( + sub { + my ($dbris) = @_; + my $journey = $dbris->result; + + $promise->resolve($journey); + return; + } + )->catch( + sub { + my ($err) = @_; + $self->{log}->debug("DBRIS->new_p($trip_id) error: $err"); + $promise->reject($err); + return; + } + )->wait; + + return $promise; +} + +1; diff --git a/lib/DBInfoscreen/Helper/EFA.pm b/lib/DBInfoscreen/Helper/EFA.pm index 2a7416e..0e7f7d7 100644 --- a/lib/DBInfoscreen/Helper/EFA.pm +++ b/lib/DBInfoscreen/Helper/EFA.pm @@ -13,7 +13,7 @@ use Encode qw(decode encode); use Mojo::JSON qw(decode_json); use Mojo::Promise; use Mojo::Util qw(url_escape); -use XML::LibXML; +use Travel::Status::DE::EFA; sub new { my ( $class, %opt ) = @_; @@ -29,6 +29,51 @@ sub new { } +sub get_polyline_p { + my ( $self, %opt ) = @_; + + my $stopseq = $opt{stopseq}; + my $service = $opt{service}; + my $promise = Mojo::Promise->new; + + Travel::Status::DE::EFA->new_p( + service => $service, + stopseq => $stopseq, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $self->{user_agent}->request_timeout(10) + )->then( + sub { + my ($efa) = @_; + my $journey = $efa->result; + + $promise->resolve($journey); + return; + } + )->catch( + sub { + my ($err) = @_; + $self->{log}->debug("EFA->new_p($stopseq) error: $err"); + $promise->reject($err); + return; + } + )->wait; + + return $promise; +} + +sub get_coverage { + my ( $self, $service ) = @_; + + my $service_definition = Travel::Status::DE::EFA::get_service($service); + + if ( not $service_definition ) { + return {}; + } + + return $service_definition->{coverage}{area} // {}; +} + sub get_json_p { my ( $self, $cache, $url ) = @_; diff --git a/lib/DBInfoscreen/Helper/HAFAS.pm b/lib/DBInfoscreen/Helper/HAFAS.pm index cdb84f0..e16bad8 100644 --- a/lib/DBInfoscreen/Helper/HAFAS.pm +++ b/lib/DBInfoscreen/Helper/HAFAS.pm @@ -7,13 +7,14 @@ package DBInfoscreen::Helper::HAFAS; use strict; use warnings; use 5.020; +use utf8; use DateTime; use Encode qw(decode encode); use Travel::Status::DE::HAFAS; use Mojo::JSON qw(decode_json); use Mojo::Promise; -use XML::LibXML; +use Mojo::UserAgent; sub new { my ( $class, %opt ) = @_; @@ -29,6 +30,18 @@ sub new { } +sub get_coverage { + my ( $self, $service ) = @_; + + my $service_definition = Travel::Status::DE::HAFAS::get_service($service); + + if ( not $service_definition ) { + return {}; + } + + return $service_definition->{coverage}{area} // {}; +} + sub get_route_p { my ( $self, %opt ) = @_; @@ -37,16 +50,23 @@ sub get_route_p { my $hafas_promise; + my $agent = $self->{user_agent}; + if ( $opt{service} and $opt{service} eq 'PKP' ) { + + # PKP needs proxying + $agent = Mojo::UserAgent->new; + } + if ( $opt{trip_id} ) { $hafas_promise = Travel::Status::DE::HAFAS->new_p( - service => $opt{service}, + service => $opt{service} // 'ÖBB', journey => { id => $opt{trip_id}, }, language => $opt{language}, cache => $self->{realtime_cache}, promise => 'Mojo::Promise', - user_agent => $self->{user_agent}->request_timeout(10) + user_agent => $agent->request_timeout(10) ); } elsif ( $opt{train} ) { @@ -58,12 +78,13 @@ sub get_route_p { } $hafas_promise //= Travel::Status::DE::HAFAS->new_p( + service => $opt{service} // 'ÖBB', journeyMatch => $opt{train_req} =~ s{^- }{}r, datetime => ( $opt{train} ? $opt{train}->start : $opt{datetime} ), language => $opt{language}, cache => $self->{realtime_cache}, promise => 'Mojo::Promise', - user_agent => $self->{user_agent}->request_timeout(10) + user_agent => $agent->request_timeout(10) )->then( sub { my ($hafas) = @_; @@ -88,13 +109,14 @@ sub get_route_p { } return Travel::Status::DE::HAFAS->new_p( + service => $opt{service} // 'ÖBB', journey => { id => $result->id, }, language => $opt{language}, cache => $self->{realtime_cache}, promise => 'Mojo::Promise', - user_agent => $self->{user_agent}->request_timeout(10) + user_agent => $agent->request_timeout(10) ); } ); @@ -253,9 +275,16 @@ sub get_polyline_p { my $trip_id = $opt{id}; my $line = $opt{line}; - my $service = $opt{service}; + my $service = $opt{service} // 'ÖBB'; my $promise = Mojo::Promise->new; + my $agent = $self->{user_agent}; + if ( $opt{service} and $opt{service} eq 'PKP' ) { + + # PKP needs proxying + $agent = Mojo::UserAgent->new; + } + Travel::Status::DE::HAFAS->new_p( service => $service, journey => { @@ -265,7 +294,7 @@ sub get_polyline_p { with_polyline => 1, cache => $self->{realtime_cache}, promise => 'Mojo::Promise', - user_agent => $self->{user_agent}->request_timeout(10) + user_agent => $agent->request_timeout(10) )->then( sub { my ($hafas) = @_; diff --git a/lib/DBInfoscreen/Helper/MOTIS.pm b/lib/DBInfoscreen/Helper/MOTIS.pm new file mode 100644 index 0000000..002a601 --- /dev/null +++ b/lib/DBInfoscreen/Helper/MOTIS.pm @@ -0,0 +1,82 @@ +package DBInfoscreen::Helper::MOTIS; + +# Copyright (C) 2025 networkException <git@nwex.de> +# +# SPDX-License-Identifier: AGPL-3.0-or-later + +use strict; +use warnings; +use 5.020; + +use DateTime; +use Encode qw(decode encode); +use Travel::Status::MOTIS; +use Mojo::JSON qw(decode_json); +use Mojo::Promise; + +sub new { + my ( $class, %opt ) = @_; + + my $version = $opt{version}; + + $opt{header} + = { 'User-Agent' => +"dbf/${version} on $opt{root_url} +https://finalrewind.org/projects/db-fakedisplay" + }; + + return bless( \%opt, $class ); + +} + +sub get_coverage { + my ( $self, $service ) = @_; + + my $service_definition = Travel::Status::MOTIS::get_service($service); + + if ( not $service_definition ) { + return {}; + } + + return $service_definition->{coverage}{area} // {}; +} + +# Input: TripID +# Output: Promise returning a Travel::Status::MOTIS::Trip instance on success +sub get_polyline_p { + my ( $self, %opt ) = @_; + + my $trip_id = $opt{id}; + my $service = $opt{service} // 'transitous'; + + my $promise = Mojo::Promise->new; + + my $agent = $self->{user_agent}; + + Travel::Status::MOTIS->new_p( + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $agent->request_timeout(10), + + service => $service, + trip_id => $trip_id, + )->then( + sub { + my ($motis) = @_; + my $trip = $motis->result; + + $promise->resolve($trip); + return; + } + )->catch( + sub { + my ($err) = @_; + $self->{log}->debug("MOTIS->new_p($trip_id) error: $err"); + $promise->reject($err); + return; + } + )->wait; + + return $promise; +} + +1; diff --git a/lib/DBInfoscreen/Helper/Wagonorder.pm b/lib/DBInfoscreen/Helper/Wagonorder.pm index 5cdee40..9981244 100644 --- a/lib/DBInfoscreen/Helper/Wagonorder.pm +++ b/lib/DBInfoscreen/Helper/Wagonorder.pm @@ -8,6 +8,7 @@ use strict; use warnings; use 5.020; +use DateTime; use Mojo::Promise; sub new { @@ -25,21 +26,50 @@ sub new { } sub get_p { - my ( $self, $train_no, $api_ts ) = @_; + my ( $self, %opt ) = @_; - my $url - = "https://ist-wr.noncd.db.de/wagenreihung/1.0/${train_no}/${api_ts}"; + my %param; - my $cache = $self->{realtime_cache}; + if ( $opt{param} ) { + %param = %{ $opt{param} }; + delete $param{e}; + } + else { + my $datetime = $opt{datetime}->clone->set_time_zone('UTC'); + %param = ( + administrationId => 80, + category => $opt{train_type}, + date => $datetime->strftime('%Y-%m-%d'), + evaNumber => $opt{eva}, + number => $opt{train_number}, + time => $datetime->rfc3339 =~ s{(?=Z)}{.000}r + ); + } + + my $url = sprintf( '%s?%s', +'https://www.bahn.de/web/api/reisebegleitung/wagenreihung/vehicle-sequence', + join( '&', map { $_ . '=' . $param{$_} } sort keys %param ) ); my $promise = Mojo::Promise->new; - if ( my $content = $cache->thaw($url) ) { + if ( my $content = $self->{main_cache}->thaw($url) ) { $self->{log}->debug("wagonorder->get_p($url): cached"); if ( $content->{error} ) { - return $promise->reject($content); + return $promise->reject( +"GET $url: HTTP $content->{error}{code} $content->{error}{message} (cachd)" + ); } - return $promise->resolve($content); + return $promise->resolve( $content, \%param ); + } + + if ( my $content = $self->{realtime_cache}->thaw($url) ) { + $self->{log}->debug("wagonorder->get_p($url): cached"); + if ( $content->{error} ) { + return $promise->reject( +"GET $url: HTTP $content->{error}{code} $content->{error}{message} (cachd)" + ); + } + return $promise->resolve( $content, \%param ); } $self->{user_agent}->request_timeout(10)->get_p( $url => $self->{header} ) @@ -57,16 +87,18 @@ sub get_p { $self->{log}->debug( "wagonorder->get_p($url): HTTP $err->{code} $err->{message}" ); - $cache->freeze( $url, $json ); - $promise->reject($json); + $self->{realtime_cache}->freeze( $url, $json ); + $promise->reject("GET $url: HTTP $err->{code} $err->{message}"); return; } $self->{log}->debug("wagonorder->get_p($url): OK"); my $json = $tx->res->json; + $json->{ts} = DateTime->now( time_zone => 'Europe/Berlin' ) + ->strftime('%d.%m.%Y %H:%M'); - $cache->freeze( $url, $json ); - $promise->resolve($json); + $self->{main_cache}->freeze( $url, $json ); + $promise->resolve( $json, \%param ); return; } )->catch( |