diff options
Diffstat (limited to 'lib/DBInfoscreen')
| -rw-r--r-- | lib/DBInfoscreen/Controller/Map.pm | 730 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Controller/Static.pm | 31 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Controller/Stationboard.pm | 1517 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Controller/Wagenreihung.pm | 149 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Helper/EFA.pm (renamed from lib/DBInfoscreen/Helper/Marudor.pm) | 70 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Helper/HAFAS.pm | 606 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Helper/Wagonorder.pm | 163 | ||||
| -rw-r--r-- | lib/DBInfoscreen/I18N/en.pm | 84 |
8 files changed, 1529 insertions, 1821 deletions
diff --git a/lib/DBInfoscreen/Controller/Map.pm b/lib/DBInfoscreen/Controller/Map.pm index 4748e11..bced612 100644 --- a/lib/DBInfoscreen/Controller/Map.pm +++ b/lib/DBInfoscreen/Controller/Map.pm @@ -1,6 +1,6 @@ package DBInfoscreen::Controller::Map; -# Copyright (C) 2011-2020 Daniel Friesel +# Copyright (C) 2011-2020 Birte Kristina Friesel # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -18,22 +18,27 @@ my $strp = DateTime::Format::Strptime->new( time_zone => 'Europe/Berlin', ); +# Input: +# - polyline: Travel::Status::DE::HAFAS::Journey->polyline +# - 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 sub get_route_indexes { - my ( $features, $from_name, $to_name ) = @_; + my ( $polyline, $from_name, $to_name ) = @_; my ( $from_index, $to_index ); - for my $i ( 0 .. $#{$features} ) { - my $this_point = $features->[$i]; + for my $i ( 0 .. $#{$polyline} ) { + my $this_point = $polyline->[$i]; if ( not defined $from_index - and $this_point->{properties}{type} - and $this_point->{properties}{type} eq 'stop' - and $this_point->{properties}{name} eq $from_name ) + and $this_point->{name} + and $this_point->{name} eq $from_name ) { $from_index = $i; } - elsif ( $this_point->{properties}{type} - and $this_point->{properties}{type} eq 'stop' - and $this_point->{properties}{name} eq $to_name ) + elsif ( $this_point->{name} + and $this_point->{name} eq $to_name ) { $to_index = $i; last; @@ -42,107 +47,30 @@ sub get_route_indexes { return ( $from_index, $to_index ); } -# Returns timestamped train positions between stop1 and stop2 (must not have -# intermittent stops) in 10-second steps. -sub estimate_timestamped_positions { - my (%opt) = @_; - - my $from_dt = $opt{from}{dep}; - my $to_dt = $opt{to}{arr}; - my $from_name = $opt{from}{name}; - my $to_name = $opt{to}{name}; - my $features = $opt{features}; - - my $duration = $to_dt->epoch - $from_dt->epoch; - - my @train_positions; - - my @completion_ratios - = map { ( $_ * 10 / $duration ) } ( 0 .. $duration / 10 ); - - my ( $from_index, $to_index ) - = get_route_indexes( $features, $from_name, $to_name ); - - my $location_epoch = $from_dt->epoch; - my $distance = GIS::Distance->new; - - if ( defined $from_index and defined $to_index ) { - my $total_distance = 0; - for my $j ( $from_index + 1 .. $to_index ) { - my $prev = $features->[ $j - 1 ]{geometry}{coordinates}; - my $this = $features->[$j]{geometry}{coordinates}; - if ( $prev and $this ) { - $total_distance - += $distance->distance_metal( $prev->[1], $prev->[0], - $this->[1], $this->[0] ); - } - } - my @marker_distances = map { $total_distance * $_ } @completion_ratios; - $total_distance = 0; - for my $j ( $from_index + 1 .. $to_index ) { - my $prev = $features->[ $j - 1 ]{geometry}{coordinates}; - my $this = $features->[$j]{geometry}{coordinates}; - if ( $prev and $this ) { - my $prev_distance = $total_distance; - $total_distance - += $distance->distance_metal( $prev->[1], $prev->[0], - $this->[1], $this->[0] ); - for my $i ( @train_positions .. $#marker_distances ) { - my $marker_distance = $marker_distances[$i]; - if ( $total_distance > $marker_distance ) { - - # completion ratio for the line between (prev, this) - my $sub_ratio = 1; - if ( $total_distance != $prev_distance ) { - $sub_ratio = ( $marker_distance - $prev_distance ) - / ( $total_distance - $prev_distance ); - } - - my $lat = $prev->[1] - + ( $this->[1] - $prev->[1] ) * $sub_ratio; - my $lon = $prev->[0] - + ( $this->[0] - $prev->[0] ) * $sub_ratio; - - push( @train_positions, - [ $location_epoch, $lat, $lon ] ); - $location_epoch += 10; - } - } - if ( @train_positions == @completion_ratios ) { - return @train_positions; - } - } - } - if (@train_positions) { - return @train_positions; - } - } - return; -} - # Input: # now: DateTime # from: current/previous stop # {dep => DateTime, name => str, lat => float, lon => float} # to: next stop # {arr => DateTime, name => str, lat => float, lon => float} -# features: https://github.com/public-transport/hafas-client/blob/5/docs/trip.md features array -# (with [lon, lat] coordinates in the geometry dict) +# 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. # - current position # - position 2 seconds from now # - position 4 seconds from now # - ... sub estimate_train_positions { - my (%opt) = @_; + my ( $self, %opt ) = @_; 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}{name}; - my $to_name = $opt{to}{name}; - my $features = $opt{features}; + 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 $route = $opt{route}; + my $polyline = $opt{polyline}; my @train_positions; @@ -155,29 +83,29 @@ sub estimate_train_positions { my $distance = GIS::Distance->new; my ( $from_index, $to_index ) - = get_route_indexes( $features, $from_name, $to_name ); + = get_route_indexes( $polyline, $from_name, $to_name ); if ( defined $from_index and defined $to_index ) { my $total_distance = 0; for my $j ( $from_index + 1 .. $to_index ) { - my $prev = $features->[ $j - 1 ]{geometry}{coordinates}; - my $this = $features->[$j]{geometry}{coordinates}; + my $prev = $polyline->[ $j - 1 ]; + my $this = $polyline->[$j]; if ( $prev and $this ) { $total_distance - += $distance->distance_metal( $prev->[1], $prev->[0], - $this->[1], $this->[0] ); + += $distance->distance_metal( $prev->{lat}, $prev->{lon}, + $this->{lat}, $this->{lon} ); } } my @marker_distances = map { $total_distance * $_ } @completion_ratios; $total_distance = 0; for my $j ( $from_index + 1 .. $to_index ) { - my $prev = $features->[ $j - 1 ]{geometry}{coordinates}; - my $this = $features->[$j]{geometry}{coordinates}; + my $prev = $polyline->[ $j - 1 ]; + my $this = $polyline->[$j]; if ( $prev and $this ) { my $prev_distance = $total_distance; $total_distance - += $distance->distance_metal( $prev->[1], $prev->[0], - $this->[1], $this->[0] ); + += $distance->distance_metal( $prev->{lat}, $prev->{lon}, + $this->{lat}, $this->{lon} ); for my $i ( @train_positions .. $#marker_distances ) { my $marker_distance = $marker_distances[$i]; if ( $total_distance > $marker_distance ) { @@ -189,10 +117,10 @@ sub estimate_train_positions { / ( $total_distance - $prev_distance ); } - my $lat = $prev->[1] - + ( $this->[1] - $prev->[1] ) * $sub_ratio; - my $lon = $prev->[0] - + ( $this->[0] - $prev->[0] ) * $sub_ratio; + my $lat = $prev->{lat} + + ( $this->{lat} - $prev->{lat} ) * $sub_ratio; + my $lon = $prev->{lon} + + ( $this->{lon} - $prev->{lon} ) * $sub_ratio; push( @train_positions, [ $lat, $lon ] ); } @@ -207,16 +135,23 @@ sub estimate_train_positions { } } else { + $self->log->debug( + "Did not find route indexes for $from_name → $to_name"); + $self->log->debug( +"Falling back to $opt{from}{lat} $opt{from}{lon} → $opt{to}{lat} $opt{to}{lon}" + ); for my $ratio (@completion_ratios) { my $lat - = $opt{from}{lat} + ( $opt{to}{lat} - $opt{from}{lat} ) * $ratio; + = $opt{from}->loc->lat + + ( $opt{to}->loc->lat - $opt{from}->loc->lat ) * $ratio; my $lon - = $opt{from}{lon} + ( $opt{to}{lon} - $opt{from}{lon} ) * $ratio; + = $opt{from}->loc->lon + + ( $opt{to}->loc->lon - $opt{from}->loc->lon ) * $ratio; push( @train_positions, [ $lat, $lon ] ); } return @train_positions; } - return [ $opt{to}{lat}, $opt{to}{lon} ]; + return [ $opt{to}->loc->lat, $opt{to}->loc->lon ]; } # Input: @@ -227,7 +162,7 @@ sub estimate_train_positions { # name: str # arr: DateTime # dep: DateTime -# features: ref to transport.rest features list +# polyline: ref to Travel::Status::DE::HAFAS::Journey polyline list # Output: # next_stop: {type, station} # positions: [current position [lat, lon], 2s from now, 4s from now, ...] @@ -244,21 +179,22 @@ 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 $self->backpropagate_delay( $route[ $i - 1 ], $route[$i] ); # (current position, future positons...) in 2 second steps - @train_positions = estimate_train_positions( + @train_positions = $self->estimate_train_positions( from => $route[ $i - 1 ], to => $route[$i], now => $now, - features => $opt{features}, + route => $opt{route}, + polyline => $opt{polyline}, ); $next_stop = { @@ -271,15 +207,15 @@ sub estimate_train_positions2 { and $now <= ( $route[ $i - 1 ]{dep} // $route[ $i - 1 ]{arr} ) ) { @train_positions - = ( [ $route[ $i - 1 ]{lat}, $route[ $i - 1 ]{lon} ] ); + = ( [ $route[ $i - 1 ]->loc->lat, $route[ $i - 1 ]->loc->lon ] ); $next_stop = { type => 'present', station => $route[ $i - 1 ], }; } $stop_distance_sum += $distance->distance_metal( - $route[ $i - 1 ]{lat}, $route[ $i - 1 ]{lon}, - $route[$i]{lat}, $route[$i]{lon} + $route[ $i - 1 ]->loc->lat, $route[ $i - 1 ]->loc->lon, + $route[$i]->loc->lat, $route[$i]->loc->lon ) / 1000; } @@ -288,7 +224,7 @@ sub estimate_train_positions2 { } if ( @route and not $next_stop ) { - @train_positions = ( [ $route[-1]{lat}, $route[-1]{lon} ] ); + @train_positions = ( [ $route[-1]->loc->lat, $route[-1]->loc->lon ] ); $next_stop = { type => 'present', station => $route[-1] @@ -305,160 +241,18 @@ sub estimate_train_positions2 { }; } -sub estimate_train_intersection { - my (%opt) = @_; - my @route1 = @{ $opt{routes}[0] // [] }; - my @route2 = @{ $opt{routes}[1] // [] }; - - my $ret; - - my $i1 = 0; - my $i2 = 0; - - my @pairs; - my @meeting_points; - my $distance = GIS::Distance->new; - - # skip last route element as we compare route[i] with route[i+1] - while ( $i1 < $#route1 and $i2 < $#route2 ) { - my $dep1 = $route1[$i1]{dep}; - my $arr1 = $route1[ $i1 + 1 ]{arr}; - my $dep2 = $route2[$i2]{dep}; - my $arr2 = $route2[ $i2 + 1 ]{arr}; - - if ( not( $dep1 and $arr1 ) ) { - - #say "skip 1 $route1[$i1]{name}"; - $i1++; - next; - } - - if ( not( $dep2 and $arr2 ) ) { - - #say "skip 2 $route2[$i2]{name}"; - $i2++; - next; - } - - if ( $arr1 <= $dep2 ) { - $i1++; - } - elsif ( $arr2 <= $dep1 ) { - $i2++; - } - elsif ( $arr2 <= $arr1 ) { - push( @pairs, [ $i1, $i2 ] ); - if ( $route1[$i1]{name} eq $route2[ $i2 + 1 ]{name} - and $route2[$i2]{name} eq $route1[ $i1 + 1 ]{name} ) - { - # both i1 name == i2+1 name and i1 name == i2 name are valid cases - # (trains don't just intersect when they travel in opposing - # directions -- they may also travel in the same direction - # with different speed and overtake each other). - # We need both stop pairs later on, so we save both. - $ret->{stop_pair} = [ - [ $route1[$i1]{name}, $route1[ $i1 + 1 ]{name} ], - [ $route2[$i2]{name}, $route2[ $i2 + 1 ]{name} ] - ]; - } - $i2++; - } - elsif ( $arr1 <= $arr2 ) { - push( @pairs, [ $i1, $i2 ] ); - if ( $route1[$i1]{name} eq $route2[ $i2 + 1 ]{name} - and $route2[$i2]{name} eq $route1[ $i1 + 1 ]{name} ) - { - $ret->{stop_pair} = [ - [ $route1[$i1]{name}, $route1[ $i1 + 1 ]{name} ], - [ $route2[$i2]{name}, $route2[ $i2 + 1 ]{name} ] - ]; - } - $i1++; - } - else { - $i1++; - } - } - - for my $pair (@pairs) { - my ( $i1, $i2 ) = @{$pair}; - my @train1_positions = estimate_timestamped_positions( - from => $route1[$i1], - to => $route1[ $i1 + 1 ], - features => $opt{features}[0], - ); - my @train2_positions = estimate_timestamped_positions( - from => $route2[$i2], - to => $route2[ $i2 + 1 ], - features => $opt{features}[1], - ); - $i1 = 0; - $i2 = 0; - while ( $i1 <= $#train1_positions and $i2 <= $#train2_positions ) { - if ( $train1_positions[$i1][0] < $train2_positions[$i2][0] ) { - $i1++; - } - elsif ( $train1_positions[$i2][0] < $train2_positions[$i2][0] ) { - $i2++; - } - else { - if ( - ( - my $distance_km = $distance->distance_metal( - $train1_positions[$i1][1], - $train1_positions[$i1][2], - $train2_positions[$i2][1], - $train2_positions[$i2][2] - ) - ) < 1 - ) - { - my $ts = DateTime->from_epoch( - epoch => $train1_positions[$i1][0], - time_zone => 'Europe/Berlin' - ); - $ret->{first_meeting_time} //= $ts; - push( - @meeting_points, - { - timestamp => $ts, - lat => ( - $train1_positions[$i1][1] - + $train2_positions[$i2][1] - ) / 2, - lon => ( - $train1_positions[$i1][2] - + $train2_positions[$i2][2] - ) / 2, - distance => $distance_km, - } - ); - } - $i1++; - $i2++; - } - } - } - - $ret->{meeting_points} = \@meeting_points; - - return $ret; -} - sub route_to_ajax { my (@stopovers) = @_; my @route_entries; for my $stop (@stopovers) { - my @stop_entries = ( $stop->{stop}{name} ); + my @stop_entries = ( $stop->loc->name ); my $platform; - if ( $stop->{arrival} - and my $arr = $strp->parse_datetime( $stop->{arrival} ) ) - { - my $delay = ( $stop->{arrivalDelay} // 0 ) / 60; - $platform = $stop->{arrivalPlatform}; + 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 ); } @@ -466,11 +260,9 @@ sub route_to_ajax { push( @stop_entries, q{}, q{} ); } - if ( $stop->{departure} - and my $dep = $strp->parse_datetime( $stop->{departure} ) ) - { - my $delay = ( $stop->{departureDelay} // 0 ) / 60; - $platform //= $stop->{departurePlatform} // 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 ); } @@ -484,56 +276,6 @@ sub route_to_ajax { return join( '|', @route_entries ); } -# Input: List of transport.rest stopovers -# Output: List of preprocessed stops. Each is a hash with the following keys: -# lat: float -# lon: float -# name: str -# arr: DateTime -# dep: DateTime -# arr_delay: int -# dep_delay: int -# platform: str -sub stopovers_to_route { - my (@stopovers) = @_; - my @route; - - for my $stop (@stopovers) { - my @stop_lines = ( $stop->{stop}{name} ); - my ( $platform, $arr, $dep, $arr_delay, $dep_delay ); - - if ( $stop->{arrival} - and $arr = $strp->parse_datetime( $stop->{arrival} ) ) - { - $arr_delay = ( $stop->{arrivalDelay} // 0 ) / 60; - $platform //= $stop->{arrivalPlatform}; - } - - if ( $stop->{departure} - and $dep = $strp->parse_datetime( $stop->{departure} ) ) - { - $dep_delay = ( $stop->{departureDelay} // 0 ) / 60; - $platform //= $stop->{departurePlatform}; - } - - push( - @route, - { - lat => $stop->{stop}{location}{latitude}, - lon => $stop->{stop}{location}{longitude}, - name => $stop->{stop}{name}, - arr => $arr, - dep => $dep, - arr_delay => $arr_delay, - dep_delay => $dep_delay, - platform => $platform, - } - ); - - } - return @route; -} - sub polyline_to_line_pairs { my (@polyline) = @_; my @line_pairs; @@ -541,138 +283,14 @@ sub polyline_to_line_pairs { push( @line_pairs, [ - [ $polyline[ $i - 1 ][1], $polyline[ $i - 1 ][0] ], - [ $polyline[$i][1], $polyline[$i][0] ] + [ $polyline[ $i - 1 ]{lat}, $polyline[ $i - 1 ]{lon} ], + [ $polyline[$i]{lat}, $polyline[$i]{lon} ] ] ); } return @line_pairs; } -sub intersection { - my ($self) = @_; - - my @trips = split( qr{;}, $self->stash('trips') ); - my @trip_ids = map { [ split( qr{,}, $_ ) ] } @trips; - - $self->render_later; - - my @polyline_requests - = map { $self->hafas->get_polyline_p( @{$_} ) } @trip_ids; - Mojo::Promise->all(@polyline_requests)->then( - sub { - my ( $pl1, $pl2 ) = map { $_->[0] } @_; - my @polyline1 = @{ $pl1->{polyline} }; - my @polyline2 = @{ $pl2->{polyline} }; - my @station_coordinates; - - my @markers; - my $next_stop; - - my $now = DateTime->now( time_zone => 'Europe/Berlin' ); - - my @line1_pairs = polyline_to_line_pairs(@polyline1); - my @line2_pairs = polyline_to_line_pairs(@polyline2); - - my @route1 - = stopovers_to_route( @{ $pl1->{raw}{stopovers} // [] } ); - my @route2 - = stopovers_to_route( @{ $pl2->{raw}{stopovers} // [] } ); - - my $train1_pos = $self->estimate_train_positions2( - now => $now, - route => \@route1, - features => $pl1->{raw}{polyline}{features}, - ); - - my $train2_pos = $self->estimate_train_positions2( - now => $now, - route => \@route2, - features => $pl2->{raw}{polyline}{features}, - ); - - my $intersection = estimate_train_intersection( - routes => [ \@route1, \@route2 ], - features => [ - $pl1->{raw}{polyline}{features}, - $pl2->{raw}{polyline}{features} - ], - ); - - for my $meeting_point ( @{ $intersection->{meeting_points} } ) { - push( - @station_coordinates, - [ - [ $meeting_point->{lat}, $meeting_point->{lon} ], - [ $meeting_point->{timestamp}->strftime('%H:%M') ] - ] - ); - } - - push( - @markers, - { - lat => $train1_pos->{position_now}[0], - lon => $train1_pos->{position_now}[1], - title => $pl1->{name} - }, - { - lat => $train2_pos->{position_now}[0], - lon => $train2_pos->{position_now}[1], - title => $pl2->{name} - }, - ); - - $self->render( - 'route_map', - title => "DBF", - hide_opts => 1, - with_map => 1, - intersection => 1, - train1_no => - scalar( $pl1->{raw}{line}{additionalName} // $pl1->{name} ), - train2_no => - scalar( $pl2->{raw}{line}{additionalName} // $pl2->{name} ), - likely_pair => $intersection->{stop_pair} - ? $intersection->{stop_pair}[0] - : undef, - time => scalar $intersection->{first_meeting_time}, - polyline_groups => [ - { - polylines => [ @line1_pairs, @line2_pairs ], - color => '#ffffff', - opacity => 0, - fit_bounds => 1, - }, - { - polylines => [@line1_pairs], - color => '#005080', - opacity => 0.6, - }, - { - polylines => [@line2_pairs], - color => '#800050', - opacity => 0.6, - } - ], - markers => [@markers], - station_coordinates => [@station_coordinates], - ); - } - )->catch( - sub { - my ($err) = @_; - $self->render( - 'route_map', - title => "DBF", - hide_opts => 1, - with_map => 1, - error => $err, - ); - } - )->wait; -} - sub backpropagate_delay { my ( $self, $prev_stop, $next_stop ) = @_; @@ -696,17 +314,30 @@ sub route { my ($self) = @_; my $trip_id = $self->stash('tripid'); my $line_no = $self->stash('lineno'); + my $hafas = $self->param('hafas'); my $from_name = $self->param('from'); my $to_name = $self->param('to'); $self->render_later; - $self->hafas->get_polyline_p( $trip_id, $line_no )->then( + my $service = 'DB'; + if ( $hafas + and $hafas ne '1' + and Travel::Status::DE::HAFAS::get_service($hafas) ) + { + $service = $hafas; + } + + $self->hafas->get_polyline_p( + id => $trip_id, + line => $line_no, + service => $service + )->then( sub { - my ($pl) = @_; + my ($journey) = @_; - my @polyline = @{ $pl->{polyline} }; + my @polyline = $journey->polyline; my @station_coordinates; my @markers; @@ -717,61 +348,61 @@ sub route { # used to draw the train's journey on the map my @line_pairs = polyline_to_line_pairs(@polyline); - my @route = stopovers_to_route( @{ $pl->{raw}{stopovers} // [] } ); + my @route = $journey->route; my $train_pos = $self->estimate_train_positions2( now => $now, route => \@route, - features => $pl->{raw}{polyline}{features}, + polyline => \@polyline, ); # Prepare from/to markers and name/time/delay overlays for stations for my $stop (@route) { - my @stop_lines = ( $stop->{name} ); + my @stop_lines = ( $stop->loc->name ); - if ( $from_name and $stop->{name} eq $from_name ) { + if ( $from_name and $stop->loc->name eq $from_name ) { push( @markers, { - lon => $stop->{lon}, - lat => $stop->{lat}, - title => $stop->{name}, + lon => $stop->loc->lon, + lat => $stop->loc->lat, + title => $stop->loc->name, icon => 'goldIcon', } ); } - if ( $to_name and $stop->{name} eq $to_name ) { + if ( $to_name and $stop->loc->name eq $to_name ) { push( @markers, { - lon => $stop->{lon}, - lat => $stop->{lat}, - title => $stop->{name}, + lon => $stop->loc->lon, + lat => $stop->loc->lat, + title => $stop->loc->name, icon => 'greenIcon', } ); } - if ( $stop->{platform} ) { - push( @stop_lines, 'Gleis ' . $stop->{platform} ); + 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} ); + 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} ); + 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], ] ); + [ [ $stop->loc->lat, $stop->loc->lon ], [@stop_lines], ] ); } push( @@ -779,34 +410,33 @@ sub route { { lat => $train_pos->{position_now}[0], lon => $train_pos->{position_now}[1], - title => $pl->{name} + title => $journey->name } ); $next_stop = $train_pos->{next_stop}; $self->render( 'route_map', - title => $pl->{name}, - hide_opts => 1, - with_map => 1, - ajax_req => "${trip_id}/${line_no}", - ajax_route => route_to_ajax( @{ $pl->{raw}{stopovers} // [] } ), + 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} } ), origin => { - name => $pl->{raw}{origin}{name}, - ts => $pl->{raw}{departure} - ? scalar $strp->parse_datetime( $pl->{raw}{departure} ) - : undef, + name => ( $journey->route )[0]->loc->name, + ts => ( $journey->route )[0]->dep, }, destination => { - name => $pl->{raw}{destination}{name}, - ts => $pl->{raw}{arrival} - ? scalar $strp->parse_datetime( $pl->{raw}{arrival} ) - : undef, + name => $journey->route_end, + ts => ( $journey->route )[-1]->arr, }, - train_no => scalar $pl->{raw}{line}{additionalName}, - operator => scalar $pl->{raw}{line}{operator}{name}, + train_no => $journey->number + ? ( $journey->type . ' ' . $journey->number ) + : undef, + operator => $journey->operator, next_stop => $next_stop, polyline_groups => [ { @@ -817,7 +447,7 @@ sub route { } ], station_coordinates => [@station_coordinates], - station_radius => + station_radius => ( $train_pos->{avg_inter_stop_beeline} > 500 ? 250 : 100 ), markers => [@markers], ); @@ -841,44 +471,56 @@ sub ajax_route { my ($self) = @_; my $trip_id = $self->stash('tripid'); my $line_no = $self->stash('lineno'); + my $hafas = $self->param('hafas'); delete $self->stash->{layout}; $self->render_later; - $self->hafas->get_polyline_p( $trip_id, $line_no )->then( + my $service = 'DB'; + if ( $hafas + and $hafas ne '1' + and Travel::Status::DE::HAFAS::get_service($hafas) ) + { + $service = $hafas; + } + + $self->hafas->get_polyline_p( + id => $trip_id, + line => $line_no, + service => $service + )->then( sub { - my ($pl) = @_; + my ($journey) = @_; my $now = DateTime->now( time_zone => 'Europe/Berlin' ); - my @route = stopovers_to_route( @{ $pl->{raw}{stopovers} // [] } ); + my @route = $journey->route; + my @polyline = $journey->polyline; my $train_pos = $self->estimate_train_positions2( now => $now, route => \@route, - features => $pl->{raw}{polyline}{features}, + polyline => \@polyline, ); - my @polyline = @{ $pl->{polyline} }; $self->render( '_map_infobox', - ajax_req => "${trip_id}/${line_no}", - ajax_route => route_to_ajax( @{ $pl->{raw}{stopovers} // [] } ), + ajax_req => "${trip_id}/${line_no}", + ajax_route => route_to_ajax(@route), ajax_polyline => join( '|', map { join( ';', @{$_} ) } @{ $train_pos->{positions} } ), origin => { - name => $pl->{raw}{origin}{name}, - ts => $pl->{raw}{departure} - ? scalar $strp->parse_datetime( $pl->{raw}{departure} ) - : undef, + name => ( $journey->route )[0]->loc->name, + ts => ( $journey->route )[0]->dep, }, destination => { - name => $pl->{raw}{destination}{name}, - ts => $pl->{raw}{arrival} - ? scalar $strp->parse_datetime( $pl->{raw}{arrival} ) - : undef, + name => $journey->route_end, + ts => ( $journey->route )[-1]->arr, }, + train_no => $journey->number + ? ( $journey->type . ' ' . $journey->number ) + : undef, next_stop => $train_pos->{next_stop}, ); } @@ -893,78 +535,4 @@ sub ajax_route { )->wait; } -sub search { - my ($self) = @_; - - my $t1 = $self->param('train1'); - my $t2 = $self->param('train2'); - - my $t1_data; - my $t2_data; - - my @requests; - - if ( not( $t1 and $t1 =~ m{^\S+\s+\d+$} ) - or ( $t2 and not $t2 =~ m{^\S+\s+\d+$} ) ) - { - $self->render( - 'trainsearch', - title => 'Fahrtverlauf', - hide_opts => 1, - error => $t1 - ? "Züge müssen im Format 'Zugtyp Nummer' angegeben werden, z.B. 'RE 1234'" - : undef, - ); - return; - } - - $self->render_later; - - push( @requests, $self->hafas->trainsearch_p( train_no => $t1 ) ); - - if ($t2) { - push( @requests, $self->hafas->trainsearch_p( train_no => $t2 ) ); - } - - Mojo::Promise->all(@requests)->then( - sub { - my ( $t1_data, $t2_data ) = @_; - - if ($t2_data) { - $self->redirect_to( - sprintf( - "/intersection/%s,0;%s,0", - $t1_data->[0]{trip_id}, - $t2_data->[0]{trip_id}, - ) - ); - } - else { - $self->redirect_to( - sprintf( "/map/%s/0", $t1_data->[0]{trip_id}, ) ); - } - } - )->catch( - sub { - my ($err) = @_; - $self->render( - 'trainsearch', - title => 'Fahrtverlauf', - hide_opts => 1, - error => $err - ); - } - )->wait; -} - -sub search_form { - my ($self) = @_; - - $self->render( - 'trainsearch', - title => 'Fahrtverlauf', - hide_opts => 1, - ); -} - 1; diff --git a/lib/DBInfoscreen/Controller/Static.pm b/lib/DBInfoscreen/Controller/Static.pm index e30b34f..927bf6e 100644 --- a/lib/DBInfoscreen/Controller/Static.pm +++ b/lib/DBInfoscreen/Controller/Static.pm @@ -1,6 +1,6 @@ package DBInfoscreen::Controller::Static; -# Copyright (C) 2011-2020 Daniel Friesel +# Copyright (C) 2011-2020 Birte Kristina Friesel # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -11,34 +11,6 @@ my %default = ( admode => 'deparr', ); -sub redirect { - my ($self) = @_; - my $input = $self->param('input'); - my $params = $self->req->params; - - $params->remove('input'); - - for my $param (qw(platforms 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; - - if ( $input =~ m{ ^ [a-zA-Z]{1,5} \s+ \d+ $ }x ) { - $self->redirect_to("/z/${input}?${params}"); - } - else { - $self->redirect_to("/${input}?${params}"); - } -} - sub geostop { my ($self) = @_; @@ -55,7 +27,6 @@ sub about { $self->render( 'about', hide_opts => 1, - version => $self->config->{version} ); } diff --git a/lib/DBInfoscreen/Controller/Stationboard.pm b/lib/DBInfoscreen/Controller/Stationboard.pm index 24df23e..b64c661 100644 --- a/lib/DBInfoscreen/Controller/Stationboard.pm +++ b/lib/DBInfoscreen/Controller/Stationboard.pm @@ -1,6 +1,6 @@ package DBInfoscreen::Controller::Stationboard; -# Copyright (C) 2011-2020 Daniel Friesel +# Copyright (C) 2011-2020 Birte Kristina Friesel # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -8,31 +8,101 @@ use Mojo::Base 'Mojolicious::Controller'; use DateTime; use DateTime::Format::Strptime; -use Encode qw(decode encode); -use File::Slurp qw(read_file write_file); -use List::Util qw(max uniq); +use Encode qw(decode encode); +use File::Slurp qw(read_file write_file); +use List::Util qw(max uniq); +use List::UtilsBy qw(uniq_by); use List::MoreUtils qw(); -use Mojo::JSON qw(decode_json); +use Mojo::JSON qw(decode_json encode_json); use Mojo::Promise; use Mojo::UserAgent; +use Travel::Status::DE::DBWagenreihung; +use Travel::Status::DE::HAFAS; use Travel::Status::DE::IRIS; use Travel::Status::DE::IRIS::Stations; use XML::LibXML; use utf8; -no if $] >= 5.018, warnings => 'experimental::smartmatch'; - my %default = ( mode => 'app', admode => 'deparr', ); +sub class_to_product { + my ( $self, $hafas ) = @_; + + my $bits = $hafas->get_active_service->{productbits}; + my $ret; + + for my $i ( 0 .. $#{$bits} ) { + $ret->{ 2**$i } + = ref( $bits->[$i] ) eq 'ARRAY' ? $bits->[$i][0] : $bits->[$i]; + } + + return $ret; +} + sub handle_no_results { - my ( $self, $station, $data ) = @_; + my ( $self, $station, $data, $hafas ) = @_; my $errstr = $data->{errstr}; + if ($hafas) { + $self->render_later; + my $service = 'DB'; + if ( $hafas ne '1' and Travel::Status::DE::HAFAS::get_service($hafas) ) + { + $service = $hafas; + } + Travel::Status::DE::HAFAS->new_p( + locationSearch => $station, + service => $service, + promise => 'Mojo::Promise', + user_agent => $self->ua, + )->then( + sub { + my ($status) = @_; + my @candidates = $status->results; + @candidates = map { [ $_->name, $_->eva ] } @candidates; + if ( @candidates == 1 and $candidates[0][0] ne $station ) { + my $s = $candidates[0][0]; + my $params = $self->req->params->to_string; + $self->redirect_to("/${s}?${params}"); + return; + } + for my $candidate (@candidates) { + $candidate->[0] =~ s{[&]#x0028;}{(}g; + $candidate->[0] =~ s{[&]#x0029;}{)}g; + } + my $err; + if ( not $errstr =~ m{LOCATION} ) { + $err = $errstr; + } + $self->render( + 'landingpage', + error => $err, + stationlist => \@candidates, + hide_opts => 0, + status => $data->{status} // 300, + ); + return; + } + )->catch( + sub { + my ($err) = @_; + $self->render( + 'landingpage', + error => ( $err // "Keine Abfahrten an '$station'" ), + hide_opts => 0, + status => $data->{status} // 500, + ); + return; + } + )->wait; + return; + } + my @candidates = map { [ $_->[1], $_->[0] ] } Travel::Status::DE::IRIS::Stations::get_station($station); if ( @@ -46,7 +116,7 @@ sub handle_no_results { 'landingpage', stationlist => \@candidates, hide_opts => 0, - status => 300, + status => $data->{status} // 300, ); return; } @@ -56,14 +126,16 @@ sub handle_no_results { 'landingpage', error => ( $errstr // "Keine Abfahrten an '$station'" ) . '. Das von DBF genutzte IRIS-Backend unterstützt im Regelfall nur innerdeutsche Zugfahrten.', - hide_opts => 0 + hide_opts => 0, + status => $data->{status} // 200, ); return; } $self->render( 'landingpage', error => ( $errstr // "Keine Abfahrten an '$station'" ), - hide_opts => 0 + hide_opts => 0, + status => $data->{status} // 404, ); return; } @@ -79,7 +151,6 @@ sub handle_no_results_json { if ($errstr) { $json = { api_version => $api_version, - version => $self->config->{version}, error => $errstr, }; } @@ -91,7 +162,6 @@ sub handle_no_results_json { { $json = { api_version => $api_version, - version => $self->config->{version}, error => 'ambiguous station code/name', candidates => \@candidates, }; @@ -99,7 +169,6 @@ sub handle_no_results_json { else { $json = { api_version => $api_version, - version => $self->config->{version}, error => ( $errstr // "Got no results for '$station'" ) }; } @@ -108,12 +177,13 @@ sub handle_no_results_json { $json = $self->render_to_string( json => $json ); $self->render( data => "$callback($json);", - format => 'json' + format => 'json', ); } else { $self->render( - json => $json, + json => $json, + status => $data->{status} // 300, ); } return; @@ -161,7 +231,9 @@ sub result_has_train_type { sub result_has_via { my ( $result, $via ) = @_; - my @route = $result->route_post; + my @route + = $result->can('route_post') ? $result->route_post : map { $_->loc->name } + $result->route; my $eq_result = List::MoreUtils::any { lc eq lc($via) } @route; @@ -186,11 +258,15 @@ sub result_has_via { } sub log_api_access { + my ($suffix) = @_; + $suffix //= q{}; + + my $file = "$ENV{DBFAKEDISPLAY_STATS}${suffix}"; my $counter = 1; - if ( -r $ENV{DBFAKEDISPLAY_STATS} ) { - $counter = read_file( $ENV{DBFAKEDISPLAY_STATS} ) + 1; + if ( -r $file ) { + $counter = read_file($file) + 1; } - write_file( $ENV{DBFAKEDISPLAY_STATS}, $counter ); + write_file( $file, $counter ); return; } @@ -211,7 +287,13 @@ sub json_route_diff { } # this branch is inefficient, but won't be taken frequently - elsif ( not( $route[$route_idx] ~~ \@sched_route ) ) { + elsif ( + not( + List::MoreUtils::any { $route[$route_idx] eq $_ } + @sched_route + ) + ) + { push( @json_route, { @@ -258,13 +340,29 @@ sub json_route_diff { } sub get_results_p { - my ( $station, %opt ) = @_; + my ( $self, $station, %opt ) = @_; my $data; - # 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 ( $opt{hafas} ) { + my $service = 'DB'; + if ( $opt{hafas} ne '1' + and Travel::Status::DE::HAFAS::get_service( $opt{hafas} ) ) + { + $service = $opt{hafas}; + } + return Travel::Status::DE::HAFAS->new_p( + service => $service, + station => $station, + arrivals => $opt{arrivals}, + cache => $opt{cache_iris_rt}, + lwp_options => { + timeout => 10, + agent => 'dbf.finalrewind.org/2' + }, + promise => 'Mojo::Promise', + user_agent => $self->ua, + ); + } if ( $ENV{DBFAKEDISPLAY_STATS} ) { log_api_access(); @@ -275,6 +373,12 @@ sub get_results_p { # if we have an exact match. Ask the backend otherwise. my @station_matches = Travel::Status::DE::IRIS::Stations::get_station($station); + + # Requests with EVA codes can be handled even if we do not know about them. + if ( @station_matches != 1 and $station =~ m{^\d+$} ) { + @station_matches = ( [ undef, undef, $station ] ); + } + if ( @station_matches == 1 ) { $station = $station_matches[0][2]; return Travel::Status::DE::IRIS->new_p( @@ -308,11 +412,13 @@ sub handle_request { my $station = $self->stash('station'); my $template = $self->param('mode') // 'app'; + 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} + lookahead => $self->config->{lookahead}, + hafas => $hafas, ); if ( $self->param('past') ) { @@ -321,13 +427,22 @@ sub handle_request { $opt{lookahead} += 60; } + if ( $self->param('admode') and $self->param('admode') eq 'arr' ) { + $opt{arrivals} = 1; + } + my $api_version = $Travel::Status::DE::IRIS::VERSION; $self->stash( departures => [] ); $self->stash( title => 'DBF' ); - $self->stash( version => $self->config->{version} ); - if ( not( $template ~~ [qw[app infoscreen json multi single text]] ) ) { + if ( + not( + List::MoreUtils::any { $template eq $_ } + (qw(app infoscreen json multi single text)) + ) + ) + { $template = 'app'; } @@ -354,7 +469,12 @@ 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'; } @@ -375,8 +495,8 @@ sub handle_request { if ( $self->param('train') and not $opt{datetime} ) { - # request results from twenty minutes ago to avoid train details suddenly - # becoming unavailable when its scheduled departure is reached. + # request results from twenty minutes ago to avoid train details suddenly + # becoming unavailable when its scheduled departure is reached. $opt{datetime} = DateTime->now( time_zone => 'Europe/Berlin' ) ->subtract( minutes => 20 ); $opt{lookahead} = $self->config->{lookahead} + 20; @@ -384,13 +504,21 @@ sub handle_request { $self->render_later; - get_results_p( $station, %opt )->then( + $self->get_results_p( $station, %opt )->then( sub { my ($status) = @_; my $data = { results => [ $status->results ], + hafas => $hafas ? $status : undef, station_ds100 => ( $status->station ? $status->station->{ds100} : undef ), + station_eva => ( + $status->station + ? ( $status->station->{uic} // $status->station->{eva} ) + : undef + ), + station_evas => + ( $status->station ? $status->station->{evas} : [] ), station_name => ( $status->station ? $status->station->{name} : $station ), }; @@ -400,7 +528,7 @@ sub handle_request { return; } if ( not @{ $data->{results} } ) { - $self->handle_no_results( $station, $data ); + $self->handle_no_results( $station, $data, $hafas ); return; } $self->handle_result($data); @@ -409,11 +537,24 @@ sub handle_request { sub { my ($err) = @_; if ( $template eq 'json' ) { - $self->handle_no_results_json( $station, { errstr => $err }, - $api_version ); + $self->handle_no_results_json( + $station, + { + errstr => $err, + status => ( $err =~ m{Ambiguous|LOCATION} ? 300 : 500 ), + }, + $api_version + ); return; } - $self->handle_no_results( $station, { errstr => $err } ); + $self->handle_no_results( + $station, + { + errstr => $err, + status => ( $err =~ m{Ambiguous|LOCATION} ? 300 : 500 ), + }, + $hafas + ); return; } )->wait; @@ -507,7 +648,7 @@ sub format_iris_result_info { if ( $template ne 'json' ) { push( @{$moreinfo}, - [ 'Außerplanmäßiger Halt in', $additional_line ] + [ 'Außerplanmäßiger Halt in', { text => $additional_line } ] ); } } @@ -517,7 +658,7 @@ sub format_iris_result_info { $info = 'Ohne Halt in: ' . $cancel_line . ( $info ? ' +++ ' : q{} ) . $info; if ( $template ne 'json' ) { - push( @{$moreinfo}, [ 'Ohne Halt in', $cancel_line ] ); + push( @{$moreinfo}, [ 'Ohne Halt in', { text => $cancel_line } ] ); } } @@ -529,19 +670,21 @@ sub format_iris_result_info { sub render_train { my ( $self, $result, $departure, $station_name, $template ) = @_; - $departure->{links} = []; - $departure->{route_pre_diff} = [ - $self->json_route_diff( - [ $result->route_pre ], - [ $result->sched_route_pre ] - ) - ]; - $departure->{route_post_diff} = [ - $self->json_route_diff( - [ $result->route_post ], - [ $result->sched_route_post ] - ) - ]; + $departure->{links} = []; + if ( $result->can('route_pre') ) { + $departure->{route_pre_diff} = [ + $self->json_route_diff( + [ $result->route_pre ], + [ $result->sched_route_pre ] + ) + ]; + $departure->{route_post_diff} = [ + $self->json_route_diff( + [ $result->route_post ], + [ $result->sched_route_post ] + ) + ]; + } if ( not $result->has_realtime ) { my $now = DateTime->now( time_zone => 'Europe/Berlin' ); @@ -554,35 +697,109 @@ sub render_train { } my $linetype = 'bahn'; - my @classes = $result->classes; - if ( @classes == 0 ) { - $linetype = 'ext'; - } - elsif ( grep { $_ eq 'S' } @classes ) { - $linetype = 'sbahn'; + + if ( $result->can('classes') ) { + my @classes = $result->classes; + if ( @classes == 0 ) { + $linetype = 'ext'; + } + elsif ( grep { $_ eq 'S' } @classes ) { + $linetype = 'sbahn'; + } + elsif ( grep { $_ eq 'F' } @classes ) { + $linetype = 'fern'; + } } - elsif ( grep { $_ eq 'F' } @classes ) { - $linetype = 'fern'; + elsif ( $result->can('class') ) { + if ( $result->class <= 2 ) { + $linetype = 'fern'; + } + elsif ( $result->class == 16 ) { + $linetype = 'sbahn'; + } + elsif ( $result->class == 32 ) { + $linetype = 'bus'; + } + elsif ( $result->class == 128 ) { + $linetype = 'ubahn'; + } + elsif ( $result->class == 256 ) { + $linetype = 'tram'; + } } $self->render_later; my $wagonorder_req = Mojo::Promise->new; - my $utilization_req = Mojo::Promise->new; my $occupancy_req = Mojo::Promise->new; my $stationinfo_req = Mojo::Promise->new; my $route_req = Mojo::Promise->new; - my @requests = ( - $wagonorder_req, $utilization_req, $occupancy_req, - $stationinfo_req, $route_req - ); + my @requests + = ( $wagonorder_req, $occupancy_req, $stationinfo_req, $route_req ); if ( $departure->{wr_link} ) { - $self->wagonorder->is_available_p( $result, $departure->{wr_link} ) + $self->wagonorder->get_p( $result->train_no, $departure->{wr_link} ) ->then( sub { - # great! + my ($wr_json) = @_; + eval { + my $wr + = Travel::Status::DE::DBWagenreihung->new( + from_json => $wr_json ); + $departure->{wr} = $wr; + $departure->{wr_text} = join( q{ • }, + map { $_->desc_short } + grep { $_->desc_short } $wr->groups ); + my $first = 0; + for my $group ( $wr->groups ) { + my $had_entry = 0; + for my $wagon ( $group->wagons ) { + 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'; + } + else { + $entry = $wagon->number + || ( + $wagon->type =~ m{AB} ? '½' + : $wagon->type =~ m{A} ? '1.' + : $wagon->type =~ m{B} ? '2.' + : $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 { @@ -595,33 +812,12 @@ sub render_train { return; } )->wait; - - # Looks like utilization data is only available for long-distance trains - # – and the few regional trains which also have wagon order data (e.g. - # around Stuttgart). Funky. - $self->marudor->get_train_utilization( train => $result )->then( - sub { - my ( $first, $second ) = @_; - $departure->{utilization} = [ $first, $second ]; - return; - }, - sub { - $departure->{utilization} = undef; - return; - } - )->finally( - sub { - $utilization_req->resolve; - return; - } - )->wait; } else { $wagonorder_req->resolve; - $utilization_req->resolve; } - $self->marudor->get_efa_occupancy( + $self->efa->get_efa_occupancy( eva => $result->station_uic, train_no => $result->train_no )->then( @@ -677,10 +873,11 @@ 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}; } return; @@ -696,112 +893,88 @@ sub render_train { } )->wait; - $self->hafas->get_route_timestamps_p( train => $result )->then( - sub { - my ( $route_ts, $route_info, $trainsearch ) = @_; + my %opt = ( train => $result ); - $departure->{trip_id} = $trainsearch->{trip_id}; + #if ( $self->languages =~ m{^en} ) { + # $opt{language} = 'en'; + #} - # If a train number changes on the way, IRIS routes are incomplete, - # whereas HAFAS data has all stops -> merge HAFAS stops into IRIS - # stops. This is a rare case, one point where it can be observed is - # the TGV service at Frankfurt/Karlsruhe/Mannheim. - if ( $route_info - and my @hafas_stations = @{ $route_info->{stations} // [] } ) - { - if ( my @iris_stations = @{ $departure->{route_pre_diff} } ) { - my @missing_pre; - for my $station (@hafas_stations) { - if ( - List::MoreUtils::any { $_->{name} eq $station } - @iris_stations - ) - { - unshift( - @{ $departure->{route_pre_diff} }, - @missing_pre - ); - last; + $self->hafas->get_route_p(%opt)->then( + sub { + my ( $route, $journey ) = @_; + + $departure->{trip_id} = $journey->id; + $departure->{operators} = [ $journey->operators ]; + $departure->{date} = $route->[0]{sched_dep} // $route->[0]{dep}; + + # Use HAFAS route as source of truth; ignore IRIS data + $departure->{route_pre_diff} = []; + $departure->{route_post_diff} = $route; + my $split; + for my $i ( 0 .. $#{ $departure->{route_post_diff} } ) { + if ( $departure->{route_post_diff}[$i]{name} eq $station_name ) + { + $split = $i; + if ( my $load = $route->[$i]{load} ) { + if ( %{$load} ) { + $departure->{utilization} + = [ $load->{FIRST}, $load->{SECOND} ]; } - push( - @missing_pre, - { - name => $station, - hafas => 1 - } - ); } + $departure->{tz_offset} = $route->[$i]{tz_offset}; + $departure->{local_dt_da} = $route->[$i]{local_dt_da}; + $departure->{local_sched_arr} + = $route->[$i]{local_sched_arr}; + $departure->{local_sched_dep} + = $route->[$i]{local_sched_dep}; + $departure->{is_annotated} = $route->[$i]{is_annotated}; + $departure->{prod_name} = $route->[$i]{prod_name}; + $departure->{direction} = $route->[$i]{direction}; + $departure->{operator} = $route->[$i]{operator}; + last; } - if ( my @iris_stations = @{ $departure->{route_post_diff} } ) { - my @missing_post; - for my $station ( reverse @hafas_stations ) { - if ( - List::MoreUtils::any { $_->{name} eq $station } - @iris_stations - ) - { - push( - @{ $departure->{route_post_diff} }, - @missing_post - ); - last; - } - unshift( - @missing_post, - { - name => $station, - hafas => 1 - } - ); - } + } + + if ( defined $split ) { + for my $i ( 0 .. $split - 1 ) { + push( + @{ $departure->{route_pre_diff} }, + shift( @{ $departure->{route_post_diff} } ) + ); } + + # remove entry for $station_name + shift( @{ $departure->{route_post_diff} } ); } - if ($route_ts) { - if ( $route_ts->{ $result->station }{rt_bogus} ) { - #$departure->{missing_realtime} = 1; + my @him_messages; + my @him_details; + for my $message ( $journey->messages ) { + if ( $message->code ) { + push( @him_details, + [ $message->short // q{}, { text => $message->text } ] + ); } - for my $elem ( - @{ $departure->{route_pre_diff} }, - @{ $departure->{route_post_diff} } - ) - { - for my $key ( keys %{ $route_ts->{ $elem->{name} } // {} } ) - { - $elem->{$key} = $route_ts->{ $elem->{name} }{$key}; - } - if ( $elem->{rt_bogus} ) { - $departure->{partially_missing_realtime} = 1; - } + else { + push( @him_messages, + [ $message->short // q{}, { text => $message->text } ] + ); } } - if ( $route_info and @{ $route_info->{messages} // [] } ) { - my $him = $route_info->{messages}; - my @him_messages; - $departure->{messages}{him} = $him; - for my $message ( @{$him} ) { - if ( $message->{display} ) { - push( @him_messages, - [ $message->{header}, $message->{lead} ] ); - if ( $message->{lead} =~ m{zuginfo.nrw/?\?msg=(\d+)} ) { - push( - @{ $departure->{links} }, - [ - "Großstörung", - "https://zuginfo.nrw/?msg=$1" - ] - ); - } - } + for my $m (@him_messages) { + if ( $m->[0] =~ s{: Information.}{:} ) { + $m->[1]{icon} = 'info_outline'; + } + elsif ( $m->[0] =~ s{: Störung.}{: } ) { + $m->[1]{icon} = 'warning'; } - for my $message ( @{ $departure->{moreinfo} // [] } ) { - my $m = $message->[1]; - @him_messages - = grep { $_->[0] !~ m{Information\. $m\.$} } - @him_messages; + elsif ( $m->[0] =~ s{: Bauarbeiten.}{: } ) { + $m->[1]{icon} = 'build'; } - unshift( @{ $departure->{moreinfo} }, @him_messages ); + $m->[0] =~ s{(?!<)->}{ → }; } + unshift( @{ $departure->{moreinfo} }, @him_messages ); + unshift( @{ $departure->{details} }, @him_details ); } )->catch( sub { @@ -814,59 +987,45 @@ sub render_train { } )->wait; - # currently useless due to lack of Open Data - if ( 0 and $self->param('detailed') ) { - my $cycle_req = Mojo::Promise->new; - push( @requests, $cycle_req ); - $self->wagonorder->has_cycle_p( $result->train_no )->then( - sub { - $departure->{has_cycle} = 1; - } - )->catch( - sub { - # nop - } - )->finally( - sub { - $cycle_req->resolve; - return; - } - )->wait; - $departure->{composition} - = $self->app->train_details_db->{ $departure->{train_no} }; - my @cycle_from; - my @cycle_to; - for my $cycle ( values %{ $departure->{composition}->{cycle} // {} } ) { - push( @cycle_from, @{ $cycle->{from} // [] } ); - push( @cycle_to, @{ $cycle->{to} // [] } ); - } - @cycle_from = sort { $a <=> $b } uniq @cycle_from; - @cycle_to = sort { $a <=> $b } uniq @cycle_to; - $departure->{cycle_from} - = [ map { [ $_, $self->app->train_details_db->{$_} ] } @cycle_from ]; - $departure->{cycle_to} - = [ map { [ $_, $self->app->train_details_db->{$_} ] } @cycle_to ]; - } - # Defer rendering until all requests have completed Mojo::Promise->all(@requests)->then( sub { - $self->render( - $template // '_train_details', - departure => $departure, - linetype => $linetype, - icetype => $self->app->ice_type_map->{ $departure->{train_no} }, - details => $departure->{composition} // {}, - 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') } ), + $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; } +# /z/:train/*station sub station_train_details { my ($self) = @_; my $train_no = $self->stash('train'); @@ -876,6 +1035,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, @@ -898,9 +1061,20 @@ sub station_train_details { $opt{lookahead} = $self->config->{lookahead} + 20; } + # Berlin Hbf exists twice: + # - BLS / 8011160 + # - BL / 8098160 (formerly "Berlin Hbf (tief)") + # Right now DBF assumes that station name -> EVA / DS100 is a unique map. + # This is not the case. Work around it here until dbf has been adjusted + # properly. + if ( $station eq 'Berlin Hbf' ) { + $opt{with_related} = 1; + } + $self->render_later; - get_results_p( $station, %opt )->then( + # Always performs an IRIS request + $self->get_results_p( $station, %opt )->then( sub { my ($status) = @_; my ($result) @@ -926,6 +1100,8 @@ sub station_train_details { departure => $result->departure ? $result->departure->strftime('%H:%M') : undef, + arrival_hidden => $result->arrival_hidden, + departure_hidden => $result->departure_hidden, train_type => $result->type // '', train_line => $result->line_no, train_no => $result->train_no, @@ -938,6 +1114,8 @@ sub station_train_details { arrival_is_cancelled => $result->arrival_is_cancelled, moreinfo => $moreinfo, delay => $result->delay, + arrival_delay => $result->arrival_delay, + departure_delay => $result->departure_delay, route_pre => [ $result->route_pre ], route_post => [ $result->route_post ], replaced_by => [ @@ -950,6 +1128,8 @@ sub station_train_details { wr_link => $result->sched_departure ? $result->sched_departure->strftime('%Y%m%d%H%M') : undef, + eva => $result->station_uic, + start => $result->start, }; $self->stash( title => $status->station->{name} @@ -966,22 +1146,31 @@ 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; } +# /z/:train sub train_details { my ($self) = @_; - my $train = $self->stash('train'); - - my ( $train_type, $train_no ) = ( $train =~ m{ ^ (\S+) \s+ (.*) $ }x ); + my $train = $self->stash('train'); + my $hafas = $self->param('hafas'); # TODO error handling @@ -989,16 +1178,13 @@ sub train_details { delete $self->stash->{layout}; } - my $api_version = $Travel::Status::DE::IRIS::VERSION; - $self->stash( departures => [] ); $self->stash( title => 'DBF' ); - $self->stash( version => $self->config->{version} ); my $res = { - train_type => $train_type, + train_type => undef, train_line => undef, - train_no => $train_no, + train_no => undef, route_pre_diff => [], route_post_diff => [], moreinfo => [], @@ -1006,92 +1192,236 @@ sub train_details { replacement_for => [], }; - $self->stash( title => "${train_type} ${train_no}" ); - $self->stash( hide_opts => 1 ); + my %opt; + if ( $train =~ m{[|]} ) { + $opt{trip_id} = $train; + } + else { + my ( $train_type, $train_no ) = ( $train =~ m{ ^ (\S+) \s+ (.*) $ }x ); + $res->{train_type} = $train_type; + $res->{train_no} = $train_no; + $self->stash( title => "${train_type} ${train_no}" ); + $opt{train_type} = $train_type; + $opt{train_no} = $train_no; + } + + my $service = 'DB'; + if ( $hafas + and $hafas ne '1' + and Travel::Status::DE::HAFAS::get_service($hafas) ) + { + $opt{service} = $hafas; + } + + #if ( $self->languages =~ m{^en} ) { + # $opt{language} = 'en'; + #} + + if ( my $date = $self->param('date') ) { + if ( $date + =~ m{ ^ (?<day> \d{1,2} ) [.] (?<month> \d{1,2} ) [.] (?<year> \d{4})? $ }x + ) + { + $opt{datetime} = DateTime->now( time_zone => 'Europe/Berlin' ); + $opt{datetime}->set( + day => $+{day}, + month => $+{month} + ); + if ( $+{year} ) { + $opt{datetime}->set( year => $+{year} ); + } + } + } + + $self->stash( hide_opts => 1 ); $self->render_later; my $linetype = 'bahn'; - $self->hafas->get_route_timestamps_p( - train_req => "${train_type} $train_no" )->then( + $self->hafas->get_route_p(%opt)->then( sub { - my ( $route_ts, $route_info, $trainsearch ) = @_; + my ( $route, $journey, $hafas_obj ) = @_; - $res->{trip_id} = $trainsearch->{trip_id}; + $res->{trip_id} = $journey->id; + $res->{date} = $route->[0]{sched_dep} // $route->[0]{dep}; - if ( not defined $trainsearch->{trainClass} ) { - $linetype = 'ext'; - } - elsif ( $trainsearch->{trainClass} <= 2 ) { - $linetype = 'fern'; + my $product = $journey->product; + + if ( my $req_name = $self->param('highlight') ) { + if ( my $p = $journey->product_at($req_name) ) { + $product = $p; + } } - elsif ( $trainsearch->{trainClass} <= 8 ) { - $linetype = 'bahn'; + + my $train_type = $res->{train_type} = $product->type // q{}; + my $train_no = $res->{train_no} = $product->number // q{}; + $res->{train_line} = $product->line_no // q{}; + $self->stash( title => $train_type . ' ' + . ( $train_no || $res->{train_line} ) ); + + if ( not defined $product->class ) { + $linetype = 'ext'; } - elsif ( $trainsearch->{trainClass} <= 16 ) { - $linetype = 'sbahn'; + else { + my $prod + = $self->class_to_product($hafas_obj)->{ $product->class } + // q{}; + if ( $prod eq 'ice' or $prod eq 'ic_ec' ) { + $linetype = 'fern'; + } + elsif ( $prod eq 's' ) { + $linetype = 'sbahn'; + } + elsif ( $prod eq 'bus' ) { + $linetype = 'bus'; + } + elsif ( $prod eq 'u' ) { + $linetype = 'ubahn'; + } + elsif ( $prod eq 'tram' ) { + $linetype = 'tram'; + } } - $res->{origin} = $route_info->{stations}[0]; - $res->{destination} = $route_info->{stations}[-1]; + $res->{origin} = $journey->route_start; + $res->{destination} = $journey->route_end; + $res->{operators} = [ $journey->operators ]; - $res->{route_post_diff} - = [ map { { name => $_ } } @{ $route_info->{stations} } ]; + $res->{route_post_diff} = $route; - if ($route_ts) { - for my $elem ( @{ $res->{route_post_diff} } ) { - for my $key ( keys %{ $route_ts->{ $elem->{name} } // {} } ) - { - $elem->{$key} = $route_ts->{ $elem->{name} }{$key}; + if ( my $req_name = $self->param('highlight') ) { + my $split; + for my $i ( 0 .. $#{ $res->{route_post_diff} } ) { + if ( $res->{route_post_diff}[$i]{name} eq $req_name ) { + $split = $i; + last; } } + if ( defined $split ) { + $self->stash( station_name => $req_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}; + } } - if ( $route_info and @{ $route_info->{messages} // [] } ) { - my $him = $route_info->{messages}; - my @him_messages; - for my $message ( @{$him} ) { - if ( $message->{display} ) { - push( @him_messages, - [ $message->{header}, $message->{lead} ] ); - if ( $message->{lead} =~ m{zuginfo.nrw/?\?msg=(\d+)} ) { - push( - @{ $res->{links} }, - [ - "Großstörung", - "https://zuginfo.nrw/?msg=$1" - ] - ); - } - } + my @him_messages; + my @him_details; + for my $message ( $journey->messages ) { + if ( $message->code ) { + push( @him_details, + [ $message->short // q{}, { text => $message->text } ] + ); + } + else { + push( @him_messages, + [ $message->short // q{}, { text => $message->text } ] + ); + } + } + for my $m (@him_messages) { + if ( $m->[0] =~ s{: Information.}{:} ) { + $m->[1]{icon} = 'info_outline'; + } + elsif ( $m->[0] =~ s{: Störung.}{: } ) { + $m->[1]{icon} = 'warning'; + } + elsif ( $m->[0] =~ s{: Bauarbeiten.}{: } ) { + $m->[1]{icon} = 'build'; } + } + if (@him_messages) { $res->{moreinfo} = [@him_messages]; } + if (@him_details) { + $res->{details} = [@him_details]; + } - $self->render( - $self->param('ajax') ? '_train_details' : 'train_details', - departure => $res, - linetype => $linetype, - icetype => $self->app->ice_type_map->{ $res->{train_no} }, - details => {}, #$departure->{composition} // {}, - dt_now => DateTime->now( time_zone => 'Europe/Berlin' ), - - #station_name => "FIXME",#$station_name, + $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', - exception => $e, - 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; @@ -1114,6 +1444,8 @@ sub handle_result { my $apiver = $self->param('version') // 0; my $callback = $self->param('callback'); my $via = $self->param('via'); + my $hafas = $self->param('hafas'); + my $hafas_obj = $data->{hafas}; my $now = DateTime->now( time_zone => 'Europe/Berlin' ); @@ -1124,13 +1456,12 @@ sub handle_result { if ( $template eq 'single' ) { if ( not @platforms ) { for my $result (@results) { + my $num_part + = $self->numeric_platform_part( $result->platform ); if ( - not( $self->numeric_platform_part( $result->platform ) ~~ - \@platforms ) - ) + not( List::MoreUtils::any { $num_part eq $_ } @platforms ) ) { - push( @platforms, - $self->numeric_platform_part( $result->platform ) ); + push( @platforms, $num_part ); } } @platforms = sort { $a <=> $b } @platforms; @@ -1145,7 +1476,10 @@ sub handle_result { } if ($show_realtime) { - if ( $admode eq 'arr' ) { + if ($hafas) { + @results = sort { $a->datetime <=> $b->datetime } @results; + } + elsif ( $admode eq 'arr' ) { @results = sort { ( $a->arrival // $a->departure ) <=> ( $b->arrival // $b->departure ) @@ -1159,44 +1493,77 @@ sub handle_result { } } + my $class_to_product + = $hafas_obj ? $self->class_to_product($hafas_obj) : {}; + @results = $self->filter_results(@results); for my $result (@results) { my $platform = ( split( qr{ }, $result->platform // '' ) )[0]; my $delay = $result->delay; - if ( $admode eq 'arr' and not $result->arrival ) { + if ( $admode eq 'arr' and not $hafas and not $result->arrival ) { next; } - if ( $admode eq 'dep' + if ( $admode eq 'dep' + and not $hafas and not $result->departure ) { next; } - my ( $info, $moreinfo ) - = $self->format_iris_result_info( $template, $result ); + my ( $info, $moreinfo ); + if ( $result->can('replacement_for') ) { + ( $info, $moreinfo ) + = $self->format_iris_result_info( $template, $result ); + } - my $time = $result->time; + my $time + = $result->can('time') + ? $result->time + : $result->sched_datetime->strftime('%H:%M'); my $linetype = 'bahn'; - my @classes = $result->classes; - if ( @classes == 0 ) { - $linetype = 'ext'; - } - elsif ( grep { $_ eq 'S' } @classes ) { - $linetype = 'sbahn'; + if ( $result->can('classes') ) { + my @classes = $result->classes; + if ( @classes == 0 ) { + $linetype = 'ext'; + } + elsif ( grep { $_ eq 'S' } @classes ) { + $linetype = 'sbahn'; + } + elsif ( grep { $_ eq 'F' } @classes ) { + $linetype = 'fern'; + } } - elsif ( grep { $_ eq 'F' } @classes ) { - $linetype = 'fern'; + elsif ( $result->can('class') ) { + my $prod = $class_to_product->{ $result->class } // q{}; + if ( $prod eq 'ice' or $prod eq 'ic_ec' ) { + $linetype = 'fern'; + } + elsif ( $prod eq 's' ) { + $linetype = 'sbahn'; + } + elsif ( $prod eq 'bus' ) { + $linetype = 'bus'; + } + elsif ( $prod eq 'u' ) { + $linetype = 'ubahn'; + } + elsif ( $prod eq 'tram' ) { + $linetype = 'tram'; + } } # ->time defaults to dep, so we only need to overwrite $time # if we want arrival times - if ( $admode eq 'arr' ) { + if ( $admode eq 'arr' and not $hafas ) { $time = $result->sched_arrival->strftime('%H:%M'); } if ($show_realtime) { - if ( ( $admode eq 'arr' and $result->arrival ) + if ($hafas) { + $time = $result->datetime->strftime('%H:%M'); + } + elsif ( ( $admode eq 'arr' and $result->arrival ) or not $result->departure ) { $time = $result->arrival->strftime('%H:%M'); @@ -1216,8 +1583,14 @@ sub handle_result { } if ( $template eq 'json' ) { - my @json_route = $self->json_route_diff( [ $result->route ], - [ $result->sched_route ] ); + my @json_route; + if ( $result->can('sched_route') ) { + @json_route = $self->json_route_diff( [ $result->route ], + [ $result->sched_route ] ); + } + else { + @json_route = map { $_->TO_JSON } $result->route; + } if ( $apiver eq '1' or $apiver eq '2' ) { @@ -1233,29 +1606,136 @@ sub handle_result { return; } 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->isa('Travel::Status::DE::IRIS::Result') ) { + 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->is_cancelled, + messages => { + delay => [ + map { + { + timestamp => $_->[0], + text => $_->[1] + } + } $result->delay_messages + ], + qos => [ + map { + { + timestamp => $_->[0], + text => $_->[1] + } + } $result->qos_messages + ], + }, + missingRealtime => ( + ( + not $result->has_realtime + and $result->start < $now + ) ? \1 : \0 + ), + 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) ], + } + ); } - if ( $result->sched_departure ) { - $sched_dep = $result->sched_departure->strftime('%H:%M'); + else { + push( + @departures, + { + delay => $result->delay, + direction => $result->direction, + destination => $result->destination, + isCancelled => $result->is_cancelled, + messages => [ $result->messages ], + platform => $result->platform, + route => \@json_route, + scheduledPlatform => $result->sched_platform, + scheduledTime => $result->sched_datetime->epoch, + time => $result->datetime->epoch, + train => $result->line, + trainNumber => $result->number, + 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{ } + ] + ); + } + else { + if ( $result->can('replacement_for') ) { push( @departures, { - delayArrival => $delay_arr, - delayDeparture => $delay_dep, - destination => $result->destination, - isCancelled => $result->is_cancelled, - messages => { + 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) ], + 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, + linetype => $linetype, + messages => { delay => [ map { { @@ -1273,104 +1753,82 @@ sub handle_result { } $result->qos_messages ], }, - missingRealtime => ( - ( - not $result->has_realtime - and $result->start < $now - ) ? \1 : \0 + station => $result->station, + moreinfo => $moreinfo, + delay => $delay, + arrival_delay => $result->arrival_delay, + departure_delay => $result->departure_delay, + missing_realtime => ( + not $result->has_realtime + and $result->start < $now ? 1 : 0 ), - 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) ], + route_pre => [ $result->route_pre ], + route_post => [ $result->route_post ], + 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, } ); } - } - 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{ } - ] - ); - } - else { - 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) ], - 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, - linetype => $linetype, - messages => { - delay => [ - map { { timestamp => $_->[0], text => $_->[1] } } - $result->delay_messages - ], - qos => [ - map { { timestamp => $_->[0], text => $_->[1] } } - $result->qos_messages - ], - }, - station => $result->station, - moreinfo => $moreinfo, - delay => $delay, - missing_realtime => ( - not $result->has_realtime - and $result->start < $now ? 1 : 0 - ), - route_pre => [ $result->route_pre ], - route_post => [ $result->route_post ], - 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 { + my $city = q{}; + if ( $result->station =~ m{ , ([^,]+) $ }x ) { + $city = $1; } - ); + push( + @departures, + { + time => $time, + sched_departure => + ( $result->sched_datetime and $admode ne 'arr' ) + ? $result->sched_datetime->strftime('%H:%M') + : undef, + departure => + ( $result->rt_datetime and $admode ne 'arr' ) + ? $result->rt_datetime->strftime('%H:%M') + : undef, + train => $result->name, + train_type => q{}, + train_line => $result->line, + train_no => $result->number, + journey_id => $result->id, + via => [ + map { $_->loc->name =~ s{,\Q$city\E}{}r } + $result->route_interesting(3) + ], + destination => $result->route_end =~ s{,\Q$city\E}{}r, + origin => $result->route_end =~ s{,\Q$city\E}{}r, + platform => $result->platform, + scheduled_platform => $result->sched_platform, + 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' + ? [ 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, + } + ); + } if ( $self->param('train') ) { $self->render_train( $result, $departures[-1], $data->{station_name} // $self->stash('station') ); @@ -1416,10 +1874,36 @@ sub handle_result { } else { 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 ( $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'; + } + } $self->render( $template, + description => 'Abfahrtstafel ' + . ( $via ? "$station_name via $via" : $station_name ), + api_link => $api_link, + api_text => $api_text, + api_icon => $api_icon, departures => \@departures, - ice_type => $self->app->ice_type_map, station => $station_name, version => $self->config->{version}, title => $via ? "$station_name → $via" : $station_name, @@ -1432,8 +1916,13 @@ sub handle_result { or $template eq 'multi' ), force_mobile => ( $template eq 'app' ), - nav_link => $self->url_for( 'station', station => $station_name ) - ->query( { detailed => $self->param('detailed') } ), + nav_link => + $self->url_for( 'station', station => $station_name )->query( + { + detailed => $self->param('detailed'), + hafas => $self->param('hafas') + } + ), ); } return; @@ -1442,29 +1931,153 @@ sub handle_result { sub stations_by_coordinates { my $self = shift; - my $lon = $self->param('lon'); - my $lat = $self->param('lat'); + my $lon = $self->param('lon'); + my $lat = $self->param('lat'); + my $hafas = $self->param('hafas'); if ( not $lon or not $lat ) { $self->render( json => { error => 'Invalid lon/lat received' } ); + return; } - 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], + + my $service = 'DB'; + if ( $hafas + and $hafas ne '1' + and Travel::Status::DE::HAFAS::get_service($hafas) ) + { + $service = $hafas; + } + + $self->render_later; + + my @iris = map { + { + ds100 => $_->[0][0], + name => $_->[0][1], + eva => $_->[0][2], + lon => $_->[0][3], + lat => $_->[0][4], + distance => $_->[1], + hafas => 0, + } + } Travel::Status::DE::IRIS::Stations::get_station_by_location( $lon, + $lat, 10 ); + + @iris = uniq_by { $_->{name} } @iris; + + Travel::Status::DE::HAFAS->new_p( + promise => 'Mojo::Promise', + user_agent => $self->ua, + service => $service, + geoSearch => { + lat => $lat, + lon => $lon + } + )->then( + sub { + my ($hafas) = @_; + my @hafas = map { + { + name => $_->name, + eva => $_->eva, + distance => $_->distance_m / 1000, + hafas => $service, + } + } $hafas->results; + if ( @hafas > 10 ) { + @hafas = @hafas[ 0 .. 9 ]; } - ); + my @results = map { $_->[0] } + sort { $a->[1] <=> $b->[1] } + map { [ $_, $_->{distance} ] } ( @iris, @hafas ); + $self->render( + json => { + candidates => [@results], + } + ); + } + )->catch( + sub { + my ($err) = @_; + $self->render( + json => { + candidates => [@iris], + warning => $err, + } + ); + } + )->wait; +} + +sub autocomplete { + my ($self) = @_; + + $self->res->headers->cache_control('max-age=31536000, immutable'); + + my $output = '$(function(){const stations='; + $output + .= encode_json( + [ map { $_->[1] } Travel::Status::DE::IRIS::Stations::get_stations() ] + ); + $output .= ";\n"; + $output + .= "\$('input.station').autocomplete({delay:0,minLength:3,source:stations});});\n"; + + $self->render( + format => 'js', + data => $output + ); +} + +sub redirect_to_station { + my ($self) = @_; + my $input = $self->param('input'); + my $params = $self->req->params; + + $params->remove('input'); + + for my $param (qw(platforms mode admode via)) { + if ( + not $params->param($param) + or ( exists $default{$param} + and $params->param($param) eq $default{$param} ) + ) + { + $params->remove($param); + } + } + + if ( $input =~ m{ ^ [a-zA-Z]{1,5} \s+ \d+ }x ) { + if ( $input =~ s{ \s* @ \s* (?<date> [0-9.]+) $ }{}x ) { + $params->param( date => $+{date} ); + } + elsif ( $input =~ s{ \s* [(] \s* (?<date> [0-9.]+) \s* [)] $ }{}x ) { + $params->param( date => $+{date} ); + } + $params = $params->to_string; + $self->redirect_to("/z/${input}?${params}"); + } + elsif ( $params->param('hafas') and $params->param('hafas') ne '1' ) { + $params = $params->to_string; + $self->redirect_to("/${input}?${params}"); + } + else { + my @candidates + = Travel::Status::DE::IRIS::Stations::get_station($input); + if ( + @candidates == 1 + and ( $input eq $candidates[0][0] + or lc($input) eq lc( $candidates[0][1] ) + or $input eq $candidates[0][2] ) + ) + { + $params->remove('hafas'); + } + else { + $params->param( hafas => 1 ); + } + $params = $params->to_string; + $self->redirect_to("/${input}?${params}"); } } diff --git a/lib/DBInfoscreen/Controller/Wagenreihung.pm b/lib/DBInfoscreen/Controller/Wagenreihung.pm index b7c6d84..03a607d 100644 --- a/lib/DBInfoscreen/Controller/Wagenreihung.pm +++ b/lib/DBInfoscreen/Controller/Wagenreihung.pm @@ -1,6 +1,6 @@ package DBInfoscreen::Controller::Wagenreihung; -# Copyright (C) 2011-2020 Daniel Friesel +# Copyright (C) 2011-2020 Birte Kristina Friesel # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -13,120 +13,20 @@ use utf8; use Travel::Status::DE::DBWagenreihung; use Travel::Status::DE::DBWagenreihung::Wagon; -sub get_zugbildung_db { - my ( $self, $train_no ) = @_; - - say $train_no; - - my $details = $self->app->train_details_db->{$train_no}; - - if ( not $details ) { - return; - } - - my @wagons; - - for my $wagon ( @{ $details->{wagons} } ) { - my $wagon_type = $wagon->{type}; - my $wagon_number = $wagon->{number}; - my %wagon = ( - fahrzeugnummer => "", - fahrzeugtyp => $wagon_type, - kategorie => $wagon_type =~ m{^[0-9.]+$} ? 'LOK' : '', - train_no => $train_no, - wagenordnungsnummer => $wagon_number, - positionamhalt => { - startprozent => 0, - endeprozent => 0, - startmeter => 0, - endemeter => 0, - } - ); - my $wagon = Travel::Status::DE::DBWagenreihung::Wagon->new(%wagon); - - if ( $details->{type} ) { - $wagon->set_traintype( $details->{type} ); - } - push( @wagons, $wagon ); - } - - my $pos = 0; - for my $wagon (@wagons) { - $wagon->{position}{start_percent} = $pos; - $wagon->{position}{end_percent} = $pos + 5; - $pos += 5; - } - - my $train_type = $details->{rawType}; - $train_type =~ s{ - .* }{}x; - - my $route_start = $details->{route}{start} // $details->{route}{preStart}; - my $route_end = $details->{route}{end} // $details->{route}{postEnd}; - my $route = "${route_start} → ${route_end}"; - - return { - route => $route, - train_type => $train_type, - wagons => [@wagons] - }; -} - -sub zugbildung_db { - my ($self) = @_; - - my $train_no = $self->param('train'); - - my $details = $self->get_zugbildung_db($train_no); - - if ( not $details ) { - $self->render( 'not_found', - message => "Keine Daten zu Zug ${train_no} bekannt" ); - return; - } +sub handle_wagenreihung_error { + my ( $self, $train_no, $err ) = @_; $self->render( - 'zugbildung_db', - wr_error => undef, - title => $details->{train_type} . ' ' . $train_no, - route => $details->{route}, - zb => $details, + 'wagenreihung', + title => "Zug $train_no", + wr_error => $err, train_no => $train_no, - wagons => $details->{wagons}, + wr => undef, + wref => undef, hide_opts => 1, ); } -sub handle_wagenreihung_error { - my ( $self, $train_no, $err ) = @_; - - my $details = $self->get_zugbildung_db($train_no); - if ( $details and @{ $details->{wagons} } ) { - my $wr_error - = "${err}. Ersatzweise werden die Solldaten laut Fahrplan angezeigt."; - $self->render( - 'zugbildung_db', - wr_error => $wr_error, - title => $details->{train_type} . ' ' . $train_no, - route => $details->{route}, - zb => $details, - train_no => $train_no, - wagons => $details->{wagons}, - hide_opts => 1, - ); - } - else { - $self->render( - 'wagenreihung', - title => "Zug $train_no", - wr_error => $err, - train_no => $train_no, - wr => undef, - wref => undef, - hide_opts => 1, - ); - } -} - sub wagenreihung { my ($self) = @_; my $train = $self->stash('train'); @@ -172,7 +72,7 @@ sub wagenreihung { e => $exit_side ? substr( $exit_side, 0, 1 ) : '', tt => $wr->train_type, tn => $train, - s => $wr->station_name, + s => $wr->station->{name}, p => $wr->platform }; @@ -218,10 +118,10 @@ sub wagenreihung { and $wnb2 =~ m{^\d+$} ) { - # We need to perform normalization in two cases: - # * wagon 1 is leftmost and its number is higher than wagon 2 - # * wagon 1 is rightmost and its number is lower than wagon 2 - # (-> the leftmost wagon has the highest number) + # We need to perform normalization in two cases: + # * wagon 1 is leftmost and its number is higher than wagon 2 + # * wagon 1 is rightmost and its number is lower than wagon 2 + # (-> the leftmost wagon has the highest number) # However, if wpa/wna und wpb/wnb do not match, we have a # winged train with different normalization requirements @@ -261,11 +161,17 @@ sub wagenreihung { $wref = b64_encode( encode_json($wref) ); + my $title = join( ' / ', + map { $wr->train_type . ' ' . $_ } $wr->train_numbers ); + $self->render( 'wagenreihung', - wr_error => undef, - title => join( ' / ', - map { $wr->train_type . ' ' . $_ } $wr->train_numbers ), + description => sprintf( + 'Ist-Wagenreihung %s in %s', + $title, $wr->station->{name} + ), + wr_error => undef, + title => $title, train_no => $train, wr => $wr, wref => $wref, @@ -278,7 +184,7 @@ sub wagenreihung { my ($err) = @_; $self->handle_wagenreihung_error( $train, - $err->{error}->{msg} // "Unbekannter Fehler" ); + $err->{error}->{msg} // $err // "Unbekannter Fehler" ); return; } )->wait; @@ -319,15 +225,15 @@ sub wagen { ); } - my $title = "Wagen $wagon_id"; + my $title = 'Wagen ' . $wagon_id; if ( $wref->{tt} and $wref->{tn} ) { $title = sprintf( '%s %s', $wref->{tt}, $wref->{tn} ); if ($wagon_no) { - $title .= " Wagen $wagon_no"; + $title .= ' Wagen ' . $wagon_no; } else { - $title .= " Wagen $wagon_id"; + $title .= ' Wagen ' . $wagon_id; } } @@ -351,6 +257,9 @@ sub wagen { $self->render( 'wagen', + description => ( $wref->{s} ? 'Position von ' : q{} ) + . $title + . ( $wref->{s} ? " in $wref->{s}" : q{} ), title => $title, wagon_files => [@wagon_files], wagon_data => $self->app->dbdb_wagon->{$wagon_id}, diff --git a/lib/DBInfoscreen/Helper/Marudor.pm b/lib/DBInfoscreen/Helper/EFA.pm index 8b2e5b2..2a7416e 100644 --- a/lib/DBInfoscreen/Helper/Marudor.pm +++ b/lib/DBInfoscreen/Helper/EFA.pm @@ -1,6 +1,6 @@ -package DBInfoscreen::Helper::Marudor; +package DBInfoscreen::Helper::EFA; -# Copyright (C) 2020 Daniel Friesel +# Copyright (C) 2020-2022 Birte Kristina Friesel # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -9,7 +9,7 @@ use warnings; use 5.020; use DateTime; -use Encode qw(decode encode); +use Encode qw(decode encode); use Mojo::JSON qw(decode_json); use Mojo::Promise; use Mojo::Util qw(url_escape); @@ -35,7 +35,7 @@ sub get_json_p { my $promise = Mojo::Promise->new; if ( my $content = $cache->thaw($url) ) { - $self->{log}->debug("marudor->get_json_p($url): cached"); + $self->{log}->debug("efa->get_json_p($url): cached"); if ( $content->{error} ) { return $promise->reject( $content->{error} ); } @@ -49,8 +49,7 @@ sub get_json_p { if ( my $err = $tx->error ) { $self->{log}->debug( -"marudor->get_json_p($url): HTTP $err->{code} $err->{message}" - ); + "efa->get_json_p($url): HTTP $err->{code} $err->{message}"); $cache->freeze( $url, { error => $err->{message} } ); $promise->reject( "GET $url returned HTTP $err->{code} $err->{message}"); @@ -60,8 +59,7 @@ sub get_json_p { my $res = $tx->res->json; if ( not $res ) { - $self->{log} - ->debug("marudor->get_json_p($url): empty response"); + $self->{log}->debug("efa->get_json_p($url): empty response"); $promise->reject("GET $url returned empty response"); return; } @@ -75,7 +73,7 @@ sub get_json_p { )->catch( sub { my ($err) = @_; - $self->{log}->debug("marudor->get_json_p($url): $err"); + $self->{log}->debug("efa->get_json_p($url): $err"); $cache->freeze( $url, { error => $err } ); $promise->reject($err); return; @@ -116,58 +114,4 @@ sub get_efa_occupancy { return $promise; } -sub get_train_utilization { - my ( $self, %opt ) = @_; - - my $promise = Mojo::Promise->new; - my $train = $opt{train}; - - if ( not $train->sched_departure ) { - $promise->reject("train has no departure"); - return $promise; - } - - my $train_no = $train->train_no; - my $this_station = $train->station; - my @route = $train->route_post; - my $next_station; - my $dep = $train->sched_departure->iso8601; - - if ( @route > 1 ) { - $next_station = $route[1]; - } - else { - $next_station = $route[0]; - } - - if ( not $next_station ) { - $promise->reject("train has no next_station"); - return $promise; - } - - $this_station - = url_escape( encode( 'utf-8', decode( 'iso-8859-15', $this_station ) ) ); - $next_station - = url_escape( encode( 'utf-8', decode( 'iso-8859-15', $next_station ) ) ); - - $self->get_json_p( $self->{realtime_cache}, -"https://marudor.de/api/hafas/v2/auslastung/${this_station}/${next_station}/${train_no}/${dep}" - )->then( - sub { - my ($utilization_json) = @_; - - $promise->resolve( $utilization_json->{first}, - $utilization_json->{second} ); - return; - } - )->catch( - sub { - $promise->reject; - return; - } - )->wait; - - return $promise; -} - 1; diff --git a/lib/DBInfoscreen/Helper/HAFAS.pm b/lib/DBInfoscreen/Helper/HAFAS.pm index 48632c0..cdb84f0 100644 --- a/lib/DBInfoscreen/Helper/HAFAS.pm +++ b/lib/DBInfoscreen/Helper/HAFAS.pm @@ -1,6 +1,6 @@ package DBInfoscreen::Helper::HAFAS; -# Copyright (C) 2011-2020 Daniel Friesel +# Copyright (C) 2011-2022 Birte Kristina Friesel # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -10,6 +10,7 @@ use 5.020; use DateTime; use Encode qw(decode encode); +use Travel::Status::DE::HAFAS; use Mojo::JSON qw(decode_json); use Mojo::Promise; use XML::LibXML; @@ -28,408 +29,216 @@ sub new { } -sub get_json_p { - my ( $self, $cache, $url ) = @_; +sub get_route_p { + my ( $self, %opt ) = @_; my $promise = Mojo::Promise->new; + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); - if ( my $content = $cache->thaw($url) ) { - return $promise->resolve($content); + my $hafas_promise; + + if ( $opt{trip_id} ) { + $hafas_promise = Travel::Status::DE::HAFAS->new_p( + service => $opt{service}, + journey => { + id => $opt{trip_id}, + }, + language => $opt{language}, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $self->{user_agent}->request_timeout(10) + ); + } + elsif ( $opt{train} ) { + $opt{train_req} = $opt{train}->type . ' ' . $opt{train}->train_no; + $opt{train_origin} = $opt{train}->origin; + } + else { + $opt{train_req} = $opt{train_type} . ' ' . $opt{train_no}; } - $self->{log}->debug("get_json_p($url)"); - - $self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} ) - ->then( + $hafas_promise //= Travel::Status::DE::HAFAS->new_p( + 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) + )->then( sub { - my ($tx) = @_; + my ($hafas) = @_; + my @results = $hafas->results; - if ( my $err = $tx->error ) { - $self->{log}->warn( - "hafas->get_json_p($url): HTTP $err->{code} $err->{message}" - ); - $promise->reject( - "GET $url returned HTTP $err->{code} $err->{message}"); - return; + if ( not @results ) { + return Mojo::Promise->reject( + "journeyMatch($opt{train_req}) found no results"); } - my $body - = encode( 'utf-8', decode( 'ISO-8859-15', $tx->res->body ) ); - $body =~ s{^TSLs[.]sls = }{}; - $body =~ s{;$}{}; - $body =~ s{(}{(}g; - $body =~ s{)}{)}g; - - my $json = decode_json($body); - - if ( not $json ) { - $self->{log}->debug("hafas->get_json_p($url): empty response"); - $promise->reject("GET $url returned empty response"); - return; + my $result = $results[0]; + if ( @results > 1 ) { + for my $journey (@results) { + if ( $opt{train_origin} + and ( $journey->route )[0]->loc->name eq + $opt{train_origin} ) + { + $result = $journey; + last; + } + } } - $cache->freeze( $url, $json ); - - $promise->resolve($json); - return; - } - )->catch( - sub { - my ($err) = @_; - $self->{log}->warn("hafas->get_json_p($url): $err"); - $promise->reject($err); - return; + return Travel::Status::DE::HAFAS->new_p( + journey => { + id => $result->id, + }, + language => $opt{language}, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $self->{user_agent}->request_timeout(10) + ); } - )->wait; - - return $promise; -} - -sub get_xml_p { - my ( $self, $cache, $url ) = @_; + ); - my $promise = Mojo::Promise->new; - - if ( my $content = $cache->thaw($url) ) { - return $promise->resolve($content); - } - - $self->{log}->debug("get_xml_p($url)"); - - $self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} ) - ->then( + $hafas_promise->then( sub { - my ($tx) = @_; - - if ( my $err = $tx->error ) { - $cache->freeze( $url, {} ); - $self->{log}->warn( - "hafas->get_xml_p($url): HTTP $err->{code} $err->{message}" - ); - $promise->reject( - "GET $url returned HTTP $err->{code} $err->{message}"); - return; - } - - my $body = decode( 'ISO-8859-15', $tx->res->body ); - - # <SDay text="... > ..."> is invalid XML, but present - # regardless. As it is the last tag, we just throw it away. - $body =~ s{<SDay [^>]*/>}{}s; - - # More fixes for invalid XML - $body =~ s{P&R}{P&R}; - $body =~ s{& }{& }g; - - # <Attribute [...] text="[...]"[...]"" /> is invalid XML. - # Work around it. - $body - =~ s{<Attribute([^>]+)text="([^"]*)"([^"=>]*)""}{<Attribute$1text="$2*$3*"}s; - - # Same for <HIMMessage lead="[...]"[...]"[...]" /> - $body - =~ s{<HIMMessage([^>]+)lead="([^"]*)"([^"=>]*)"([^"]*)"}{<Attribute$1text="$2*$3*$4"}s; - - # Dito for <HIMMessage [...] lead="[...]<br>[...]"> - # (replace line breaks with space) - while ( $body - =~ s{<HIMMessage([^>]+)lead="([^"]*)<br/?>([^"=]*)"}{<HIMMessage$1lead="$2 $3"}gis - ) - { - } - - # ... and <HIMMessage [...] lead="[...]<>[...]"> - # (replace <> with t$t) - while ( $body - =~ s{<HIMMessage([^>]+)lead="([^"]*)<>([^"=]*)"}{<HIMMessage$1lead="$2⬌$3"}gis - ) - { - } - - # ... and any other HTML tag inside an XML attribute - # (remove them entirely) - while ( $body - =~ s{<HIMMessage([^>]+)lead="([^"]*)<[^>]+>([^"=]*)"}{<HIMMessage$1lead="$2$3"}gis - ) - { - } - - my $tree; - - eval { $tree = XML::LibXML->load_xml( string => $body ) }; + my ($hafas) = @_; + my $journey = $hafas->result; + my @ret; + my $station_is_past = 1; - if ($@) { - $self->{log}->debug("hafas->get_xml_p($url): $@"); - $cache->freeze( $url, {} ); - $promise->reject; - return; + my $num_names = 0; + my $prev_name = q{}; + my $num_directions = 0; + my $prev_direction = q{}; + my $num_operators = 0; + my $prev_operator = q{}; + + for my $stop ( $journey->route ) { + my $prod = $stop->prod_dep // $stop->prod_arr; + if ( $prod and $prod->name and $prod->name ne $prev_name ) { + $num_names++; + $prev_name = $prod->name; + } + if ( $prod + and $prod->operator + and $prod->operator ne $prev_operator ) + { + $num_operators++; + $prev_operator = $prod->operator; + } + if ( $stop->direction and $stop->direction ne $prev_direction ) + { + $num_directions++; + $prev_direction = $stop->direction; + } } - my $ret = { - station => {}, - stations => [], - messages => [], - }; - - for my $station ( $tree->findnodes('/Journey/St') ) { - my $name = $station->getAttribute('name'); - my $adelay = $station->getAttribute('adelay'); - my $ddelay = $station->getAttribute('ddelay'); - push( @{ $ret->{stations} }, $name ); - $ret->{station}{$name} = { - adelay => $adelay, - ddelay => $ddelay, - }; - } + $prev_name = q{}; + $prev_direction = q{}; + $prev_operator = q{}; - for my $message ( $tree->findnodes('/Journey/HIMMessage') ) { - my $header = $message->getAttribute('header'); - my $lead = $message->getAttribute('lead'); - my $display = $message->getAttribute('display'); + for my $stop ( $journey->route ) { - # "something is wrong, but we're not telling what" is not helpful. - # Observed on RRX lines in NRW - if ( $header - =~ m{ : \s St..?rung. \s \(Quelle: \s zuginfo.nrw \) $ }x - and not $lead ) + my $prod = $stop->prod_dep // $stop->prod_arr; + my %annotation; + if ( $num_names > 1 + and $prod + and $prod->name + and $prod->name ne $prev_name ) + { + $prev_name = $annotation{prod_name} = $prod->name; + } + if ( $num_operators > 1 + and $prod + and $prod->operator + and $prod->operator ne $prev_operator ) { - next; + $prev_operator = $annotation{operator} = $prod->operator; + } + if ( $num_directions > 1 + and $stop->direction + and $stop->direction ne $prev_direction ) + { + $prev_direction = $annotation{direction} = $stop->direction; + } + + if (%annotation) { + $annotation{is_annotated} = 1; } push( - @{ $ret->{messages} }, + @ret, { - header => $header, - lead => $lead, - display => $display + name => $stop->loc->name, + eva => $stop->loc->eva, + 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, + arr_cancelled => $stop->arr_cancelled, + dep_cancelled => $stop->dep_cancelled, + tz_offset => $stop->tz_offset, + platform => $stop->platform, + sched_platform => $stop->sched_platform, + load => $stop->load, + isAdditional => $stop->is_additional, + isCancelled => ( + ( $stop->arr_cancelled or not $stop->sched_arr ) + and + ( $stop->dep_cancelled or not $stop->sched_dep ) + ), + %annotation, } ); - } - - $cache->freeze( $url, $ret ); - $promise->resolve($ret); - - return; - } - )->catch( - sub { - my ($err) = @_; - $self->{log}->warn("hafas->get_xml_p($url): $err"); - $promise->reject($err); - return; - } - )->wait; - - return $promise; -} - -sub trainsearch_p { - my ( $self, %opt ) = @_; - - my $base - = 'https://reiseauskunft.bahn.de/bin/trainsearch.exe/dn?L=vs_json&start=yes&rt=1'; - - if ( not $opt{date_yy} ) { - my $now = DateTime->now( time_zone => 'Europe/Berlin' ); - $opt{date_yy} = $now->strftime('%d.%m.%y'); - $opt{date_yyyy} = $now->strftime('%d.%m.%Y'); - } - - # IRIS reports trains with unknown type as type "-". HAFAS thinks otherwise - # and prefers the type to be left out entirely in this case. - $opt{train_req} =~ s{^- }{}; - - my $promise = Mojo::Promise->new; - - $self->get_json_p( $self->{realtime_cache}, - "${base}&date=$opt{date_yy}&trainname=$opt{train_req}" )->then( - sub { - my ($trainsearch) = @_; - - # Fallback: Take first result - my $result = $trainsearch->{suggestions}[0]; - - # Try finding a result for the current date - for my $suggestion ( @{ $trainsearch->{suggestions} // [] } ) { - - # Drunken API, sail with care. Both date formats are used interchangeably if ( - exists $suggestion->{depDate} - and ( $suggestion->{depDate} eq $opt{date_yy} - or $suggestion->{depDate} eq $opt{date_yyyy} ) + $station_is_past + and not $ret[-1]{isCancelled} + and $now->epoch < ( + $ret[-1]{rt_arr} // $ret[-1]{rt_dep} + // $ret[-1]{sched_arr} // $ret[-1]{sched_dep} // $now + )->epoch ) { - # Train numbers are not unique, e.g. IC 149 refers both to the - # InterCity service Amsterdam -> Berlin and to the InterCity service - # Koebenhavns Lufthavn st -> Aarhus. One workaround is making - # requests with the stationFilter=80 parameter. Checking the origin - # station seems to be the more generic solution, so we do that - # instead. - if ( $opt{train_origin} - and $suggestion->{dep} eq $opt{train_origin} ) - { - $result = $suggestion; - last; - } + $station_is_past = 0; } - } - - if ($result) { - - # The trip_id's date part doesn't seem to matter -- so far, HAFAS is - # happy as long as the date part starts with a number. HAFAS-internal - # tripIDs use this format (withouth leading zero for day of month < 10) - # though, so let's stick with it. - my $date_map = $opt{date_yyyy}; - $date_map =~ tr{.}{}d; - $result->{trip_id} = sprintf( '1|%d|%d|%d|%s', - $result->{id}, $result->{cycle}, - $result->{pool}, $date_map ); - $promise->resolve($result); - } - else { - $self->{log}->warn( - "hafas->trainsearch_p($opt{train_req}): train not found"); - $promise->reject("Zug $opt{train_req} nicht gefunden"); - } - - # do not propagate $promise->reject's return value to this promise. - # Perl implicitly returns the last statement, so we explicitly return - # nothing to avoid this. - return; - } - )->catch( - sub { - my ($err) = @_; - $self->{log}->warn("hafas->trainsearch_p($opt{train_req}): $err"); - $promise->reject($err); - - # do not propagate $promise->reject's return value to this promise - return; - } - )->wait; - - return $promise; -} - -sub get_route_timestamps_p { - my ( $self, %opt ) = @_; - - my $promise = Mojo::Promise->new; - my $now = DateTime->now( time_zone => 'Europe/Berlin' ); - - if ( $opt{train} ) { - $opt{date_yy} = $opt{train}->start->strftime('%d.%m.%y'); - $opt{date_yyyy} = $opt{train}->start->strftime('%d.%m.%Y'); - $opt{train_req} = $opt{train}->type . ' ' . $opt{train}->train_no; - $opt{train_origin} = $opt{train}->origin; - } - else { - $opt{date_yy} = $now->strftime('%d.%m.%y'); - $opt{date_yyyy} = $now->strftime('%d.%m.%Y'); - } - - my $base = 'https://reiseauskunft.bahn.de/bin/traininfo.exe/dn'; - my ( $trainsearch_result, $trainlink ); - - $self->trainsearch_p(%opt)->then( - sub { - ($trainsearch_result) = @_; - $trainlink = $trainsearch_result->{trainLink}; - return Mojo::Promise->all( - $self->get_json_p( - $self->{realtime_cache}, - "${base}/${trainlink}?rt=1&date=$opt{date_yy}&L=vs_json" - ), - $self->get_xml_p( - $self->{realtime_cache}, - "${base}/${trainlink}?rt=1&date=$opt{date_yy}&L=vs_java3" - ) - ); - } - )->then( - sub { - my ( $traininfo, $traindelay ) = @_; - $traininfo = $traininfo->[0]; - $traindelay = $traindelay->[0]; - if ( not $traininfo or $traininfo->{error} ) { - $promise->reject; - return; - } - $trainsearch_result->{trainClass} - = $traininfo->{suggestions}[0]{trainClass}; - my $ret = {}; - - my $strp = DateTime::Format::Strptime->new( - pattern => '%d.%m.%y %H:%M', - time_zone => 'Europe/Berlin', - ); - - my $station_is_past = 1; - - for - my $station ( @{ $traininfo->{suggestions}[0]{locations} // [] } ) - { - my $name = $station->{name}; - my $arr = $station->{arrDate} . ' ' . $station->{arrTime}; - my $dep = $station->{depDate} . ' ' . $station->{depTime}; - $ret->{$name} = { - sched_arr => scalar $strp->parse_datetime($arr), - sched_dep => scalar $strp->parse_datetime($dep), - }; - if ( exists $traindelay->{station}{$name} ) { - my $delay = $traindelay->{station}{$name}; - if ( $ret->{$name}{sched_arr} - and $delay->{adelay} - and $delay->{adelay} =~ m{^\d+$} ) - { - $ret->{$name}{rt_arr} = $ret->{$name}{sched_arr} - ->clone->add( minutes => $delay->{adelay} ); + $ret[-1]{isPast} = $station_is_past; + if ( $stop->tz_offset ) { + if ( $stop->sched_arr ) { + $ret[-1]{local_sched_arr} + = $stop->sched_arr->clone->add( + minutes => $stop->tz_offset ); } - if ( $ret->{$name}{sched_dep} - and $delay->{ddelay} - and $delay->{ddelay} =~ m{^\d+$} ) - { - $ret->{$name}{rt_dep} = $ret->{$name}{sched_dep} - ->clone->add( minutes => $delay->{ddelay} ); - if ( - ( - defined $delay->{adelay} - and $delay->{adelay} eq q{} - ) - or ( defined $delay->{ddelay} - and $delay->{ddelay} eq q{} ) - ) - { - $ret->{$name}{rt_bogus} = 1; - } - if ( $delay->{ddelay} and $delay->{ddelay} eq 'cancel' ) - { - $ret->{$name}{isCancelled} = 1; - } + if ( $stop->sched_dep ) { + $ret[-1]{local_sched_dep} + = $stop->sched_dep->clone->add( + minutes => $stop->tz_offset ); } - if ( - $station_is_past - and not $ret->{$name}{isCancelled} - and $now->epoch < ( - $ret->{$name}{rt_arr} // $ret->{$name}{rt_dep} - // $ret->{$name}{sched_arr} - // $ret->{$name}{sched_dep} // $now - )->epoch - ) - { - $station_is_past = 0; + if ( $stop->rt_arr ) { + $ret[-1]{local_rt_arr} = $stop->rt_arr->clone->add( + minutes => $stop->tz_offset ); + } + if ( $stop->rt_dep ) { + $ret[-1]{local_rt_dep} = $stop->rt_dep->clone->add( + minutes => $stop->tz_offset ); } - $ret->{$name}{isPast} = $station_is_past; + $ret[-1]{local_dt_ad} = $ret[-1]{local_rt_arr} + // $ret[-1]{local_sched_arr} // $ret[-1]{local_rt_dep} + // $ret[-1]{local_sched_dep}; + $ret[-1]{local_dt_da} = $ret[-1]{local_rt_dep} + // $ret[-1]{local_sched_dep} // $ret[-1]{local_rt_arr} + // $ret[-1]{local_sched_arr}; } } - $promise->resolve( $ret, $traindelay // {}, $trainsearch_result ); + $promise->resolve( \@ret, $journey, $hafas ); return; } )->catch( sub { - $promise->reject; + my ($err) = @_; + $promise->reject($err); return; } )->wait; @@ -438,68 +247,37 @@ sub get_route_timestamps_p { } # Input: (HAFAS TripID, line number) -# Output: Promise returning a -# https://github.com/public-transport/hafas-client/blob/4/docs/trip.md instance -# on success +# Output: Promise returning a Travel::Status::DE::HAFAS::Journey instance on success sub get_polyline_p { - my ( $self, $trip_id, $line ) = @_; + my ( $self, %opt ) = @_; - my $api = $self->{api}; - my $url = "${api}/trips/${trip_id}?lineName=${line}&polyline=true"; - my $log_url = $url; - my $cache = $self->{realtime_cache}; + my $trip_id = $opt{id}; + my $line = $opt{line}; + my $service = $opt{service}; my $promise = Mojo::Promise->new; - $log_url =~ s{://\K[^:]+:[^@]+\@}{***@}; - - if ( my $content = $cache->thaw($url) ) { - $promise->resolve($content); - $self->{log}->debug("GET $log_url (cached)"); - return $promise; - } - - $self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} ) - ->then( + Travel::Status::DE::HAFAS->new_p( + service => $service, + journey => { + id => $trip_id, + name => $line, + }, + with_polyline => 1, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $self->{user_agent}->request_timeout(10) + )->then( sub { - my ($tx) = @_; - - if ( my $err = $tx->error ) { - $self->{log}->warn( -"hafas->get_polyline_p($log_url): HTTP $err->{code} $err->{message}" - ); - $promise->reject( - "GET $log_url returned HTTP $err->{code} $err->{message}"); - return; - } - - $self->{log}->debug("GET $log_url (OK)"); - my $json = decode_json( $tx->res->body ); - my @coordinate_list; - - for my $feature ( @{ $json->{polyline}{features} } ) { - if ( exists $feature->{geometry}{coordinates} ) { - push( @coordinate_list, $feature->{geometry}{coordinates} ); - } - - #if ($feature->{type} eq 'Feature') { - # say "Feature " . $feature->{properties}{name}; - #} - } - - my $ret = { - name => $json->{line}{name} // '?', - polyline => [@coordinate_list], - raw => $json, - }; + my ($hafas) = @_; + my $journey = $hafas->result; - $cache->freeze( $url, $ret ); - $promise->resolve($ret); + $promise->resolve($journey); return; } )->catch( sub { my ($err) = @_; - $self->{log}->debug("GET $log_url (error: $err)"); + $self->{log}->debug("HAFAS->new_p($trip_id, $line) error: $err"); $promise->reject($err); return; } diff --git a/lib/DBInfoscreen/Helper/Wagonorder.pm b/lib/DBInfoscreen/Helper/Wagonorder.pm index 469eda6..5cdee40 100644 --- a/lib/DBInfoscreen/Helper/Wagonorder.pm +++ b/lib/DBInfoscreen/Helper/Wagonorder.pm @@ -1,6 +1,6 @@ package DBInfoscreen::Helper::Wagonorder; -# Copyright (C) 2011-2020 Daniel Friesel +# Copyright (C) 2011-2020 Birte Kristina Friesel # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -24,170 +24,11 @@ sub new { } -sub is_available_p { - my ( $self, $train, $wr_link ) = @_; - my $promise = Mojo::Promise->new; - - $self->check_wagonorder_p( $train->train_no, $wr_link )->then( - sub { - my ($body) = @_; - $promise->resolve($body); - return; - }, - sub { - if ( $train->is_wing ) { - my $wing = $train->wing_of; - return $self->check_wagonorder_p( $wing->train_no, $wr_link ); - } - else { - $promise->reject; - return; - } - } - )->then( - sub { - my ($body) = @_; - $promise->resolve($body); - return; - }, - sub { - $promise->reject; - return; - } - )->wait; - - return $promise; -} - -sub get_dbdb_p { - my ( $self, $url ) = @_; - - my $promise = Mojo::Promise->new; - - my $cache = $self->{main_cache}; - - if ( my $content = $cache->get($url) ) { - if ($content) { - return $promise->resolve($content); - } - else { - return $promise->reject; - } - } - - $self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} ) - ->then( - sub { - my ($tx) = @_; - if ( $tx->result->is_success ) { - my $body = $tx->result->body; - $cache->set( $url, $body ); - $promise->resolve($body); - } - else { - $cache->set( $url, q{} ); - $promise->reject; - } - return; - } - )->catch( - sub { - $cache->set( $url, q{} ); - $promise->reject; - return; - } - )->wait; - return $promise; -} - -sub head_dbdb_p { - my ( $self, $url ) = @_; - - my $promise = Mojo::Promise->new; - - my $cache = $self->{main_cache}; - - if ( my $content = $cache->get($url) ) { - $self->{log}->debug("wagonorder->head_dbdb_p($url): cached ($content)"); - if ( $content eq 'y' ) { - return $promise->resolve; - } - else { - return $promise->reject; - } - } - - $self->{user_agent}->request_timeout(5)->head_p( $url => $self->{header} ) - ->then( - sub { - my ($tx) = @_; - if ( $tx->result->is_success ) { - $self->{log}->debug("wagonorder->head_dbdb_p($url): y"); - $cache->set( $url, 'y' ); - $promise->resolve; - } - else { - $self->{log}->debug("wagonorder->head_dbdb_p($url): n"); - $cache->set( $url, 'n' ); - $promise->reject; - } - return; - } - )->catch( - sub { - $self->{log}->debug("wagonorder->head_dbdb_p($url): n"); - $cache->set( $url, 'n' ); - $promise->reject; - return; - } - )->wait; - return $promise; -} - -sub has_cycle_p { - my ( $self, $train_no ) = @_; - - return $self->head_dbdb_p( - "https://lib.finalrewind.org/dbdb/db_umlauf/${train_no}.svg"); -} - -sub check_wagonorder_p { - my ( $self, $train_no, $wr_link ) = @_; - - my $promise = Mojo::Promise->new; - - $self->head_dbdb_p( - "https://lib.finalrewind.org/dbdb/has_wagonorder/${train_no}/${wr_link}" - )->then( - sub { - $promise->resolve; - return; - } - )->catch( - sub { - $self->get_p( $train_no, $wr_link )->then( - sub { - $promise->resolve; - return; - } - )->catch( - sub { - $promise->reject; - return; - } - )->wait; - return; - } - )->wait; - - return $promise; -} - sub get_p { my ( $self, $train_no, $api_ts ) = @_; my $url - = "https://www.apps-bahn.de/wr/wagenreihung/1.0/${train_no}/${api_ts}"; + = "https://ist-wr.noncd.db.de/wagenreihung/1.0/${train_no}/${api_ts}"; my $cache = $self->{realtime_cache}; diff --git a/lib/DBInfoscreen/I18N/en.pm b/lib/DBInfoscreen/I18N/en.pm new file mode 100644 index 0000000..3abb70f --- /dev/null +++ b/lib/DBInfoscreen/I18N/en.pm @@ -0,0 +1,84 @@ +package DBInfoscreen::I18N::en; + +# Copyright (C) 2023 Birte Kristina Friesel +# +# SPDX-License-Identifier: AGPL-3.0-or-later + +use Mojo::Base 'DBInfoscreen::I18N'; + +our %Lexicon = ( + + # common + 'Stationen in der Umgebung suchen' => 'Find stops nearby', + + # layouts/app + 'Mehrdeutige Eingabe' => 'Ambiguous input', + 'Bitte eine Station aus der Liste auswählen' => + 'Please select a station from the list', + 'Zug / Station' => 'Enter train number or station name', + 'Zug, Stationsname oder Ril100-Kürzel' => + 'train, station name, or DS100 code', + 'Abfahrtstafel' => 'Show departures', + 'Weitere Einstellungen' => 'Preferences', + 'Zeiten inkl. Verspätung angeben' => 'Include delay in timestamps', + 'Verspätungen erst ab 5 Minuten anzeigen' => 'Hide delays below 5 minutes', + 'Mehr Details' => 'Verbose mode', +'Betriebliche Bahnhofstrennungen berücksichtigen (z.B. "Hbf (Fern+Regio)" vs. "Hbf (S)")' + => 'Respect split stations; do not join them', + 'Bereits abgefahrene Züge anzeigen' => 'Include past trains', + 'Formular verstecken' => 'Hide form', + 'Nur Züge über' => 'Only show trains via', + 'Bahnhof 1, Bhf2, ... (oder regulärer Ausdruck)' => + 'Station 1, 2, ... (or regular expression)', + 'Gleise' => 'Platforms', + 'Ankunfts- oder Abfahrtszeit anzeigen?' => 'Show arrival or departure?', + 'Abfahrt bevorzugen' => 'prefer departure', + 'Nur Abfahrt' => 'departure only', + 'Nur Ankunft' => 'arrival only', + 'Anzeigen' => 'Submit', + 'Datenschutz' => 'Privacy', + 'Impressum' => 'Imprint', + + # landing page + 'Oder hier angeben:' => 'Or enter manually:', + + # train details + 'Gleis' => 'Platform', + 'An:' => 'Arr', + 'Ab:' => 'Dep', + 'Plan:' => 'Sched', + 'Auslastung unbekannt' => 'Occupancy unknown', + 'Geringe Auslastung' => 'Low occupancy', + 'Hohe Auslastung' => 'High occupancy', + 'Sehr hohe Auslastung' => 'Very high occupancy', + 'Zug ist ausgebucht' => 'Fully booked', + 'Geringe Auslastung erwartet' => 'Low occupancy expected', + 'Hohe Auslastung erwartet' => 'High occupancy expected', + 'Sehr hohe Auslastung erwartet' => 'Very high occupancy expected', + 'Meldungen' => 'Messages', + 'Fahrtverlauf am' => 'Route on', + 'Betrieb' => 'Operator', + 'Karte' => 'Map', + 'Wagen' => 'Composition', + + # wagon order + 'Nach' => 'To', + 'in Abschnitt' => 'in sections', + 'Wagen ' => 'carriage ', + + # map + 'Fahrt' => 'Trip', + 'von' => 'from', + 'nach' => 'to', + 'Nächster Halt:' => 'Next stop:', + 'um' => 'at', + 'auf Gleis' => 'on platform', + 'Aufenthalt in' => 'Stopped in', + 'an Gleis' => 'on platform', + 'bis' => 'until', + 'Abfahrt in' => 'Departs', + 'von Gleis' => 'from platform', + 'Endstation erreicht um' => 'Terminus reached at', +); + +1; |