summaryrefslogtreecommitdiff
path: root/lib/DBInfoscreen
diff options
context:
space:
mode:
Diffstat (limited to 'lib/DBInfoscreen')
-rw-r--r--lib/DBInfoscreen/Controller/Map.pm1521
-rw-r--r--lib/DBInfoscreen/Controller/Static.pm48
-rw-r--r--lib/DBInfoscreen/Controller/Stationboard.pm3142
-rw-r--r--lib/DBInfoscreen/Controller/Wagenreihung.pm274
-rw-r--r--lib/DBInfoscreen/Helper/DBRIS.pm93
-rw-r--r--lib/DBInfoscreen/Helper/EFA.pm162
-rw-r--r--lib/DBInfoscreen/Helper/HAFAS.pm513
-rw-r--r--lib/DBInfoscreen/Helper/MOTIS.pm82
-rw-r--r--lib/DBInfoscreen/Helper/Wagonorder.pm147
-rw-r--r--lib/DBInfoscreen/I18N/en.pm84
10 files changed, 4535 insertions, 1531 deletions
diff --git a/lib/DBInfoscreen/Controller/Map.pm b/lib/DBInfoscreen/Controller/Map.pm
index 36075f1..0a597e1 100644
--- a/lib/DBInfoscreen/Controller/Map.pm
+++ b/lib/DBInfoscreen/Controller/Map.pm
@@ -1,39 +1,47 @@
package DBInfoscreen::Controller::Map;
+# Copyright (C) 2011-2020 Birte Kristina Friesel
+# Copyright (C) 2025 networkException <git@nwex.de>
+#
+# SPDX-License-Identifier: AGPL-3.0-or-later
+
use Mojo::Base 'Mojolicious::Controller';
-use Mojo::JSON qw(decode_json);
+use Mojo::JSON qw(decode_json encode_json);
use Mojo::Promise;
use DateTime;
use DateTime::Format::Strptime;
-use Geo::Distance;
+use GIS::Distance;
use List::Util qw();
-my $dbf_version = qx{git describe --dirty} || 'experimental';
-
my $strp = DateTime::Format::Strptime->new(
- pattern => '%Y-%m-%dT%H:%M:%S.000%z',
+ pattern => '%Y-%m-%dT%H:%M:%S%z',
time_zone => 'Europe/Berlin',
);
-chomp $dbf_version;
-
+# Input:
+# - polyline: [{lat, lon, name?}, ...]
+# - from_name: station name
+# - to_name: station name
+# Ouptut:
+# - from_index: polyline index where name eq from_name
+# - to_index: polyline index where name eq 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];
+ my $name = $this_point->{name} // $this_point->{stop}->{name};
+
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 $name
+ and $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 ( $name
+ and $name eq $to_name )
{
$to_index = $i;
last;
@@ -42,108 +50,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 $geo = Geo::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 += $geo->distance(
- 'kilometer', $prev->[0], $prev->[1],
- $this->[0], $this->[1]
- );
- }
- }
- 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 += $geo->distance(
- 'kilometer', $prev->[0], $prev->[1],
- $this->[0], $this->[1]
- );
- 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}
+# {arr => DateTime, 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/4/docs/trip.md features array
+# {arr => DateTime, dep => DateTime, name => str, lat => float, lon => float}
+# route: Travel::Status::DE::HAFAS::Journey->route
+# polyline: Travel::Status::DE::HAFAS::Journey->polyline (list of lon/lat hashes)
# Output: list of estimated train positions in [lat, lon] format.
# - 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};
- my $to_dt = $opt{to}{arr};
+ 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 $route = $opt{route};
+ my $polyline = $opt{polyline};
my @train_positions;
@@ -153,34 +83,32 @@ sub estimate_train_positions {
my @completion_ratios
= map { ( $time_complete + ( $_ * 2 ) ) / $time_total } ( 0 .. 45 );
- my $geo = Geo::Distance->new;
+ 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 += $geo->distance(
- 'kilometer', $prev->[0], $prev->[1],
- $this->[0], $this->[1]
- );
+ $total_distance
+ += $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 += $geo->distance(
- 'kilometer', $prev->[0], $prev->[1],
- $this->[0], $this->[1]
- );
+ $total_distance
+ += $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 ) {
@@ -192,10 +120,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 ] );
}
@@ -210,6 +138,11 @@ 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;
@@ -224,54 +157,73 @@ sub estimate_train_positions {
# Input:
# now: DateTime
-# route: hash
+# route: arrayref of hashrefs
# lat: float
# lon: float
# name: str
# arr: DateTime
# dep: DateTime
-# features: ref to transport.rest features list
+# arr_delay: int
+# dep_delay: int
+# 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, ...]
sub estimate_train_positions2 {
- my (%opt) = @_;
+ my ( $self, %opt ) = @_;
my $now = $opt{now};
my @route = @{ $opt{route} // [] };
my @train_positions;
my $next_stop;
+ my $distance = GIS::Distance->new;
+ my $stop_distance_sum = 0;
+ my $avg_inter_stop_beeline = 0;
for my $i ( 1 .. $#route ) {
- if ( $route[$i]{arr}
- and $route[ $i - 1 ]{dep}
- and $now > $route[ $i - 1 ]{dep}
- and $now < $route[$i]{arr} )
+ 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} ) )
{
+ # 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 = {
type => 'next',
station => $route[$i],
};
- last;
}
- if ( $route[ $i - 1 ]{dep} and $now <= $route[ $i - 1 ]{dep} ) {
+ if ( not $next_stop
+ and ( $route[ $i - 1 ]{dep} // $route[ $i - 1 ]{arr} )
+ and $now <= ( $route[ $i - 1 ]{dep} // $route[ $i - 1 ]{arr} ) )
+ {
@train_positions
= ( [ $route[ $i - 1 ]{lat}, $route[ $i - 1 ]{lon} ] );
$next_stop = {
type => 'present',
station => $route[ $i - 1 ],
};
- last;
}
+ $stop_distance_sum += $distance->distance_metal(
+ $route[ $i - 1 ]{lat}, $route[ $i - 1 ]{lon},
+ $route[$i]{lat}, $route[$i]{lon}
+ ) / 1000;
+ }
+
+ if ($#route) {
+ $avg_inter_stop_beeline = $stop_distance_sum / $#route;
}
if ( @route and not $next_stop ) {
@@ -285,167 +237,30 @@ sub estimate_train_positions2 {
my $position_now = shift @train_positions;
return {
- next_stop => $next_stop,
- position_now => $position_now,
- positions => \@train_positions,
+ next_stop => $next_stop,
+ avg_inter_stop_beeline => $avg_inter_stop_beeline,
+ position_now => $position_now,
+ positions => \@train_positions,
};
}
-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 $geo = Geo::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 = $geo->distance(
- 'kilometer',
- $train1_positions[$i1][2],
- $train1_positions[$i1][1],
- $train2_positions[$i2][2],
- $train2_positions[$i2][1]
- )
- ) < 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,
- }
- );
- }
- $i1++;
- $i2++;
- }
- }
- }
-
- $ret->{meeting_points} = \@meeting_points;
-
- return $ret;
-}
-
+# input: [{
+# name, platform,
+# arr, arr_cancelled, arr_delay,
+# dep, dep_cancelled, dep_delay
+# }]
sub route_to_ajax {
my (@stopovers) = @_;
my @route_entries;
for my $stop (@stopovers) {
- my @stop_entries = ( $stop->{stop}{name} );
+ my @stop_entries = ( $stop->{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 );
}
@@ -453,11 +268,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 );
}
@@ -471,56 +284,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;
@@ -528,122 +291,504 @@ 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) = @_;
+sub backpropagate_delay {
+ my ( $self, $prev_stop, $next_stop ) = @_;
- my @trips = split( qr{;}, $self->stash('trips') );
- my @trip_ids = map { [ split( qr{,}, $_ ) ] } @trips;
+ if ( ( $next_stop->{arr_delay} || $next_stop->{dep_delay} )
+ and not( $prev_stop->{dep_delay} || $prev_stop->{arr_delay} ) )
+ {
+ $self->log->debug("need to back-propagate delay");
+ my $delay = $next_stop->{arr_delay} || $next_stop->{dep_delay};
+ if ( $prev_stop->{arr} ) {
+ $prev_stop->{arr}->add( minutes => $delay );
+ $prev_stop->{arr_delay} = $delay;
+ }
+ if ( $prev_stop->{dep} ) {
+ $prev_stop->{dep}->add( minutes => $delay );
+ $prev_stop->{dep_delay} = $delay;
+ }
+ }
+}
- $self->render_later;
+sub route_efa {
+ my ($self) = @_;
+ my $trip_id = $self->stash('tripid');
+ my $backend = $self->param('efa');
+
+ my $stopseq;
+ if ( $trip_id
+ =~ m{ ^ ([^@]*) @ ([^@]*) [(] ([^T]*) T ([^)]*) [)] (.*) $ }x )
+ {
+ $stopseq = {
+ stateless => $1,
+ stop_id => $2,
+ date => $3,
+ time => $4,
+ key => $5
+ };
+ }
+ else {
+ $self->render(
+ 'route_map',
+ title => "DBF",
+ hide_opts => 1,
+ with_map => 1,
+ error => "cannot parse trip ID: $trip_id",
+ );
+ return;
+ }
+
+ $self->efa->get_polyline_p(
+ stopseq => $stopseq,
+ service => $backend,
+ )->then(
+ sub {
+ my ($trip) = @_;
+ my $now = DateTime->now( time_zone => 'Europe/Berlin' );
+ my @markers;
+ my @polyline = $trip->polyline( fallback => 1 );
+ my @line_pairs = polyline_to_line_pairs(@polyline);
+ my @route = $trip->route;
+
+ my $ref_route = [
+ map {
+ {
+ name => $_->full_name,
+ platform => $_->platform,
+ arr => $_->arr,
+ dep => $_->dep,
+ arr_delay => $_->arr_delay,
+ dep_delay => $_->dep_delay,
+ lat => $_->latlon->[0],
+ lon => $_->latlon->[1]
+ }
+ } @route
+ ];
+
+ for my $pl (@polyline) {
+ if ( $pl->{stop} ) {
+ $pl->{name} = $pl->{stop}->full_name;
+ }
+ }
+
+ my $train_pos = $self->estimate_train_positions2(
+ now => $now,
+ route => $ref_route,
+ polyline => \@polyline,
+ );
+
+ my @station_coordinates;
+ for my $stop (@route) {
+ my @stop_lines = ( $stop->full_name );
+ if ( $stop->platform ) {
+ push( @stop_lines, 'Gleis ' . $stop->platform );
+ }
+ if ( $stop->arr ) {
+ my $arr_line = $stop->arr->strftime('Ankunft: %H:%M');
+ if ( $stop->arr_delay ) {
+ $arr_line .= sprintf( ' (%+d)', $stop->arr_delay );
+ }
+ push( @stop_lines, $arr_line );
+ }
+ if ( $stop->dep ) {
+ my $dep_line = $stop->dep->strftime('Abfahrt: %H:%M');
+ if ( $stop->dep_delay ) {
+ $dep_line .= sprintf( ' (%+d)', $stop->dep_delay );
+ }
+ push( @stop_lines, $dep_line );
+ }
+
+ push( @station_coordinates, [ $stop->latlon, [@stop_lines], ] );
+ }
+
+ push(
+ @markers,
+ {
+ lat => $train_pos->{position_now}[0],
+ lon => $train_pos->{position_now}[1],
+ title => $trip->name,
+ }
+ );
+
+ $self->render(
+ 'route_map',
+ description => "Karte für " . $trip->name,
+ title => $trip->name,
+ hide_opts => 1,
+ with_map => 1,
+ ajax_req => "${trip_id}/0",
+ ajax_route => route_to_ajax( @{$ref_route} ),
+ ajax_polyline => join( '|',
+ map { join( ';', @{$_} ) } @{ $train_pos->{positions} } ),
+ origin => {
+ name => ( $trip->route )[0]->full_name,
+ ts => ( $trip->route )[0]->dep,
+ },
+ destination => {
+ name => ( $trip->route )[-1]->full_name,
+ ts => ( $trip->route )[-1]->arr,
+ },
+ train_no => $trip->number
+ ? ( $trip->type // q{} . ' ' . $trip->number )
+ : undef,
+ operator => $trip->operator,
+ next_stop => $train_pos->{next_stop},
+ polyline_groups => [
+ {
+ polylines => \@line_pairs,
+ color => '#00838f',
+ opacity => 0.6,
+ fit_bounds => 1,
+ }
+ ],
+ station_coordinates => \@station_coordinates,
+ station_radius => 100,
+ markers => \@markers,
+ );
+ }
+ )->catch(
+ sub {
+ my ($err) = @_;
+ $self->render(
+ 'route_map',
+ title => "DBF",
+ hide_opts => 1,
+ with_map => 1,
+ error => $err,
+ );
+ }
+ )->wait;
+}
+
+sub route_dbris {
+ my ($self) = @_;
+ my $trip_id = $self->stash('tripid');
+
+ my $from_name = $self->param('from');
+ my $to_name = $self->param('to');
- my @polyline_requests
- = map { $self->hafas->get_polyline_p( @{$_} ) } @trip_ids;
- Mojo::Promise->all(@polyline_requests)->then(
+ $self->dbris->get_polyline_p( id => $trip_id )->then(
sub {
- my ( $pl1, $pl2 ) = map { $_->[0] } @_;
- my @polyline1 = @{ $pl1->{polyline} };
- my @polyline2 = @{ $pl2->{polyline} };
+ my ($journey) = @_;
+
+ my @polyline = $journey->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);
+ # used to draw the train's journey on the map
+ my @line_pairs = polyline_to_line_pairs(@polyline);
- my @route1
- = stopovers_to_route( @{ $pl1->{raw}{stopovers} // [] } );
- my @route2
- = stopovers_to_route( @{ $pl2->{raw}{stopovers} // [] } );
+ my @route = $journey->route;
- my $train1_pos = estimate_train_positions2(
- now => $now,
- route => \@route1,
- features => $pl1->{raw}{polyline}{features},
+ my $train_pos = $self->estimate_train_positions2(
+ now => $now,
+ route => [
+ map {
+ {
+ name => $_->name,
+ arr => $_->arr,
+ dep => $_->dep,
+ arr_delay => $_->arr_delay,
+ dep_delay => $_->dep_delay,
+ lat => $_->lat,
+ lon => $_->lon
+ }
+ } @route
+ ],
+ polyline => \@polyline,
);
- my $train2_pos = estimate_train_positions2(
- now => $now,
- route => \@route2,
- features => $pl2->{raw}{polyline}{features},
+ # Prepare from/to markers and name/time/delay overlays for stations
+ for my $stop (@route) {
+ my @stop_lines = ( $stop->name );
+
+ if ( $from_name and $stop->name eq $from_name ) {
+ push(
+ @markers,
+ {
+ lon => $stop->lon,
+ lat => $stop->lat,
+ title => $stop->name,
+ icon => 'goldIcon',
+ }
+ );
+ }
+ if ( $to_name and $stop->name eq $to_name ) {
+ push(
+ @markers,
+ {
+ lon => $stop->lon,
+ lat => $stop->lat,
+ title => $stop->name,
+ icon => 'greenIcon',
+ }
+ );
+ }
+
+ if ( $stop->platform ) {
+ push( @stop_lines, 'Gleis ' . $stop->platform );
+ }
+ if ( $stop->arr ) {
+ my $arr_line = $stop->arr->strftime('Ankunft: %H:%M');
+ if ( $stop->arr_delay ) {
+ $arr_line .= sprintf( ' (%+d)', $stop->arr_delay );
+ }
+ push( @stop_lines, $arr_line );
+ }
+ if ( $stop->dep ) {
+ my $dep_line = $stop->dep->strftime('Abfahrt: %H:%M');
+ if ( $stop->dep_delay ) {
+ $dep_line .= sprintf( ' (%+d)', $stop->dep_delay );
+ }
+ push( @stop_lines, $dep_line );
+ }
+
+ push( @station_coordinates,
+ [ [ $stop->lat, $stop->lon ], [@stop_lines], ] );
+ }
+
+ push(
+ @markers,
+ {
+ lat => $train_pos->{position_now}[0],
+ lon => $train_pos->{position_now}[1],
+ title => $journey->train,
+ }
);
- my $intersection = estimate_train_intersection(
- routes => [ \@route1, \@route2 ],
- features => [
- $pl1->{raw}{polyline}{features},
- $pl2->{raw}{polyline}{features}
+ $self->render(
+ 'route_map',
+ description => "Karte für " . $journey->train,
+ title => $journey->train,
+ hide_opts => 1,
+ with_map => 1,
+ ajax_req => "${trip_id}/0",
+ ajax_route => route_to_ajax(
+ map {
+ {
+ name => $_->name,
+ platform => $_->platform,
+ arr => $_->arr,
+ arr_cancelled => $_->is_cancelled,
+ arr_delay => $_->arr_delay,
+ dep => $_->dep,
+ dep_cancelled => $_->is_cancelled,
+ dep_delay => $_->dep_delay,
+ }
+ } $journey->route
+ ),
+ ajax_polyline => join(
+ '|',
+ map { join( ';', @{$_} ) } @{ $train_pos->{positions} }
+ ),
+ origin => {
+ name => ( $journey->route )[0]->name,
+ ts => ( $journey->route )[0]->dep,
+ },
+ destination => {
+ name => ( $journey->route )[-1]->name,
+ ts => ( $journey->route )[-1]->arr,
+ },
+ train_no => $journey->number
+ ? ( $journey->type // q{} . ' ' . $journey->number )
+ : undef,
+ next_stop => $train_pos->{next_stop},
+ polyline_groups => [
+ {
+ polylines => [@line_pairs],
+ color => '#00838f',
+ opacity => 0.6,
+ fit_bounds => 1,
+ }
],
+ station_coordinates => [@station_coordinates],
+ station_radius =>
+ ( $train_pos->{avg_inter_stop_beeline} > 500 ? 250 : 100 ),
+ markers => [@markers],
+ );
+ }
+ )->catch(
+ sub {
+ my ($err) = @_;
+ $self->render(
+ 'route_map',
+ title => "DBF",
+ hide_opts => 1,
+ with_map => 1,
+ error => $err,
);
- for my $meeting_point ( @{ $intersection->{meeting_points} } ) {
- push(
- @station_coordinates,
- [
- [ $meeting_point->{lat}, $meeting_point->{lon} ],
- [ $meeting_point->{timestamp}->strftime('%H:%M') ]
- ]
- );
+ }
+ )->wait;
+}
+
+sub route_motis {
+ my ($self) = @_;
+
+ my $service = $self->param('motis') // 'transitous';
+ my $trip_id = $self->stash('tripid');
+
+ my $from_name = $self->param('from');
+ my $to_name = $self->param('to');
+
+ $self->motis->get_polyline_p(
+ service => $service,
+ id => $trip_id,
+ )->then(
+ sub {
+ my ($trip) = @_;
+
+ my @polyline = $trip->polyline;
+ my @station_coordinates;
+
+ my @markers;
+
+ my $now = DateTime->now( time_zone => 'Europe/Berlin' );
+
+ # used to draw the train's journey on the map
+ my @line_pairs = polyline_to_line_pairs(@polyline);
+
+ my @stopovers = $trip->stopovers;
+
+ my $train_pos = $self->estimate_train_positions2(
+ now => $now,
+ route => [
+ map {
+ {
+ name => $_->stop->name,
+ arr => $_->arrival,
+ dep => $_->departure,
+ arr_delay => $_->arrival_delay,
+ dep_delay => $_->departure_delay,
+ lat => $_->stop->lat,
+ lon => $_->stop->lon,
+ }
+ } @stopovers
+ ],
+ polyline => \@polyline,
+ );
+
+ # Prepare from/to markers and name/time/delay overlays for stations
+ for my $stopover (@stopovers) {
+ my $stop = $stopover->stop;
+ my @stop_lines = ( $stop->name );
+
+ if ( $from_name and $stop->name eq $from_name ) {
+ push(
+ @markers,
+ {
+ lon => $stop->lon,
+ lat => $stop->lat,
+ title => $stop->name,
+ icon => 'goldIcon',
+ }
+ );
+ }
+ if ( $to_name and $stop->name eq $to_name ) {
+ push(
+ @markers,
+ {
+ lon => $stop->lon,
+ lat => $stop->lat,
+ title => $stop->name,
+ icon => 'greenIcon',
+ }
+ );
+ }
+
+ if ( $stopover->track ) {
+ push( @stop_lines, 'Gleis ' . $stop->track );
+ }
+ if ( $stopover->arrival ) {
+ my $arr_line
+ = $stopover->arrival->strftime('Ankunft: %H:%M');
+ if ( $stopover->arrival_delay ) {
+ $arr_line
+ .= sprintf( ' (%+d)', $stopover->arrival_delay );
+ }
+ push( @stop_lines, $arr_line );
+ }
+ if ( $stopover->departure ) {
+ my $dep_line
+ = $stopover->departure->strftime('Abfahrt: %H:%M');
+ if ( $stopover->departure_delay ) {
+ $dep_line
+ .= sprintf( ' (%+d)', $stopover->departure_delay );
+ }
+ push( @stop_lines, $dep_line );
+ }
+
+ push( @station_coordinates,
+ [ [ $stop->lat, $stop->lon ], [@stop_lines], ] );
}
push(
@markers,
{
- lat => $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}
- },
+ lat => $train_pos->{position_now}[0],
+ lon => $train_pos->{position_now}[1],
+ title => $trip->route_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},
+ description => "Karte für " . $trip->route_name,
+ title => $trip->route_name,
+ hide_opts => 1,
+ with_map => 1,
+ ajax_req => "${trip_id}/0",
+ ajax_route => route_to_ajax(
+ map {
+ {
+ name => $_->stop->name,
+ platform => $_->track,
+ arr => $_->arrival,
+ arr_cancelled => $_->is_cancelled,
+ arr_delay => $_->arrival_delay,
+ dep => $_->departure,
+ dep_cancelled => $_->is_cancelled,
+ dep_delay => $_->departure_delay,
+ }
+ } $trip->stopovers
+ ),
+ ajax_polyline => join(
+ '|',
+ map { join( ';', @{$_} ) } @{ $train_pos->{positions} }
+ ),
+ origin => {
+ name => ( $trip->stopovers )[0]->stop->name,
+ ts => ( $trip->stopovers )[0]->departure,
+ },
+ destination => {
+ name => ( $trip->stopovers )[-1]->stop->name,
+ ts => ( $trip->stopovers )[-1]->arrival,
+ },
+ train_no => undef, # FIXME: Better value?
+ next_stop => $train_pos->{next_stop},
polyline_groups => [
{
- polylines => [ @line1_pairs, @line2_pairs ],
- color => '#ffffff',
- opacity => 0,
+ polylines => [@line_pairs],
+ color => '#00838f',
+ opacity => 0.6,
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],
+ station_radius =>
+ ( $train_pos->{avg_inter_stop_beeline} > 500 ? 250 : 100 ),
+ markers => [@markers],
);
}
)->catch(
@@ -656,6 +801,7 @@ sub intersection {
with_map => 1,
error => $err,
);
+
}
)->wait;
}
@@ -664,118 +810,165 @@ 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(
+ if ( $self->param('dbris') ) {
+ return $self->route_dbris;
+ }
+ if ( $self->param('motis') ) {
+ return $self->route_motis;
+ }
+ if ( $self->param('efa') ) {
+ return $self->route_efa;
+ }
+
+ my $service = 'ÖBB';
+ if ( $hafas
+ and $hafas ne '1'
+ and Travel::Status::DE::HAFAS::get_service($hafas) )
+ {
+ $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;
- my $next_stop;
my $now = DateTime->now( time_zone => 'Europe/Berlin' );
# used to draw the train's journey on the map
my @line_pairs = polyline_to_line_pairs(@polyline);
- my @route = stopovers_to_route( @{ $pl->{raw}{stopovers} // [] } );
+ my @route = $journey->route;
+
+ my $train_pos = $self->estimate_train_positions2(
+ now => $now,
+ route => [
+ map {
+ {
+ name => $_->loc->name,
+ arr => $_->arr,
+ dep => $_->dep,
+ arr_delay => $_->arr_delay,
+ dep_delay => $_->dep_delay,
+ lat => $_->loc->lat,
+ lon => $_->loc->lon
+ }
+ } @route
+ ],
+ polyline => \@polyline,
+ );
# 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], ] );
}
- my $train_pos = estimate_train_positions2(
- now => $now,
- route => \@route,
- features => $pl->{raw}{polyline}{features},
- );
-
push(
@markers,
{
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} // [] } ),
- ajax_polyline => join( '|',
- map { join( ';', @{$_} ) } @{ $train_pos->{positions} } ),
+ description => "Karte für " . $journey->name,
+ title => $journey->name,
+ hide_opts => 1,
+ with_map => 1,
+ ajax_req => "${trip_id}/${line_no}",
+ ajax_route => route_to_ajax(
+ map {
+ {
+ name => $_->loc->name,
+ platform => $_->platform,
+ arr => $_->arr,
+ arr_cancelled => $_->arr_cancelled,
+ arr_delay => $_->arr_delay,
+ dep => $_->dep,
+ dep_cancelled => $_->dep_cancelled,
+ dep_delay => $_->dep_delay,
+ }
+ } $journey->route
+ ),
+ ajax_polyline => join(
+ '|',
+ map { join( ';', @{$_} ) } @{ $train_pos->{positions} }
+ ),
origin => {
- name => $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},
- next_stop => $next_stop,
+ train_no => $journey->number
+ ? ( $journey->type // q{} . ' ' . $journey->number )
+ : undef,
+ operator => $journey->operator,
+ next_stop => $train_pos->{next_stop},
polyline_groups => [
{
polylines => [@line_pairs],
@@ -785,7 +978,9 @@ sub route {
}
],
station_coordinates => [@station_coordinates],
- markers => [@markers],
+ station_radius =>
+ ( $train_pos->{avg_inter_stop_beeline} > 500 ? 250 : 100 ),
+ markers => [@markers],
);
}
)->catch(
@@ -803,53 +998,172 @@ sub route {
)->wait;
}
-sub ajax_route {
+sub ajax_route_efa {
my ($self) = @_;
+ my $backend = $self->param('efa');
my $trip_id = $self->stash('tripid');
- my $line_no = $self->stash('lineno');
- delete $self->stash->{layout};
-
- $self->render_later;
+ my $stopseq;
+ if ( $trip_id
+ =~ m{ ^ ([^@]*) @ ([^@]*) [(] ([^T]*) T ([^)]*) [)] (.*) $ }x )
+ {
+ $stopseq = {
+ stateless => $1,
+ stop_id => $2,
+ date => $3,
+ time => $4,
+ key => $5
+ };
+ }
+ else {
+ $self->render(
+ '_error',
+ error => "cannot parse trip ID: $trip_id",
+ );
+ return;
+ }
- $self->hafas->get_polyline_p( $trip_id, $line_no )->then(
+ $self->efa->get_polyline_p(
+ stopseq => $stopseq,
+ service => $backend
+ )->then(
sub {
- my ($pl) = @_;
+ my ($trip) = @_;
my $now = DateTime->now( time_zone => 'Europe/Berlin' );
- my @route = stopovers_to_route( @{ $pl->{raw}{stopovers} // [] } );
+ my @polyline = $trip->polyline( fallback => 1 );
+ my @route = $trip->route;
+
+ my $ref_route = [
+ map {
+ {
+ name => $_->full_name,
+ platform => $_->platform,
+ arr => $_->arr,
+ dep => $_->dep,
+ arr_delay => $_->arr_delay,
+ dep_delay => $_->dep_delay,
+ lat => $_->latlon->[0],
+ lon => $_->latlon->[1]
+ }
+ } @route
+ ];
+
+ for my $pl (@polyline) {
+ if ( $pl->{stop} ) {
+ $pl->{name} = $pl->{stop}->full_name;
+ }
+ }
- my $train_pos = estimate_train_positions2(
+ my $train_pos = $self->estimate_train_positions2(
now => $now,
- route => \@route,
- features => $pl->{raw}{polyline}{features},
+ route => $ref_route,
+ 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}/0",
+ ajax_route => route_to_ajax( @{$ref_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 => ( $trip->route )[0]->full_name,
+ ts => ( $trip->route )[0]->dep,
},
destination => {
- name => $pl->{raw}{destination}{name},
- ts => $pl->{raw}{arrival}
- ? scalar $strp->parse_datetime( $pl->{raw}{arrival} )
- : undef,
+ name => ( $trip->route )[-1]->full_name,
+ ts => ( $trip->route )[-1]->arr,
},
+ train_no => $trip->number
+ ? ( $trip->type // q{} . ' ' . $trip->number )
+ : undef,
next_stop => $train_pos->{next_stop},
);
}
)->catch(
sub {
+ sub {
+ my ($err) = @_;
+ $self->render(
+ '_error',
+ error => $err,
+ );
+ }
+ }
+ )->wait;
+}
+
+sub ajax_route_dbris {
+ my ($self) = @_;
+ my $trip_id = $self->stash('tripid');
+
+ $self->dbris->get_polyline_p( id => $trip_id )->then(
+ sub {
+ my ($journey) = @_;
+
+ my $now = DateTime->now( time_zone => 'Europe/Berlin' );
+
+ my @route = $journey->route;
+ my @polyline = $journey->polyline;
+
+ my $train_pos = $self->estimate_train_positions2(
+ now => $now,
+ route => [
+ map {
+ {
+ name => $_->name,
+ arr => $_->arr,
+ dep => $_->dep,
+ arr_delay => $_->arr_delay,
+ dep_delay => $_->dep_delay,
+ lat => $_->lat,
+ lon => $_->lon
+ }
+ } @route
+ ],
+ polyline => \@polyline,
+ );
+
+ $self->render(
+ '_map_infobox',
+ ajax_req => "${trip_id}/0",
+ ajax_route => route_to_ajax(
+ map {
+ {
+ name => $_->name,
+ platform => $_->platform,
+ arr => $_->arr,
+ arr_cancelled => $_->is_cancelled,
+ arr_delay => $_->arr_delay,
+ dep => $_->dep,
+ dep_cancelled => $_->is_cancelled,
+ dep_delay => $_->dep_delay,
+ }
+ } @route
+ ),
+ ajax_polyline => join(
+ '|',
+ map { join( ';', @{$_} ) } @{ $train_pos->{positions} }
+ ),
+ origin => {
+ name => ( $journey->route )[0]->name,
+ ts => ( $journey->route )[0]->dep,
+ },
+ destination => {
+ name => ( $journey->route )[-1]->name,
+ ts => ( $journey->route )[-1]->arr,
+ },
+ train_no => $journey->number
+ ? ( $journey->type . ' ' . $journey->number )
+ : undef,
+ next_stop => $train_pos->{next_stop},
+ platform_type => q{},
+ );
+ }
+ )->catch(
+ sub {
my ($err) = @_;
$self->render(
'_error',
@@ -859,77 +1173,216 @@ sub ajax_route {
)->wait;
}
-sub search {
+sub ajax_route_motis {
my ($self) = @_;
- my $t1 = $self->param('train1');
- my $t2 = $self->param('train2');
+ my $service = $self->param('motis') // 'transitous';
+ my $trip_id = $self->stash('tripid');
+
+ $self->motis->get_polyline_p(
+ service => $service,
+ id => $trip_id,
+ )->then(
+ sub {
+ my ($trip) = @_;
- my $t1_data;
- my $t2_data;
+ my $now = DateTime->now( time_zone => 'Europe/Berlin' );
- my @requests;
+ my @stopovers = $trip->stopovers;
+ my @polyline = $trip->polyline;
- 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;
- }
+ my $train_pos = $self->estimate_train_positions2(
+ now => $now,
+ route => [
+ map {
+ {
+ name => $_->stop->name,
+ arr => $_->arrival,
+ dep => $_->departure,
+ arr_delay => $_->arrival_delay,
+ dep_delay => $_->departure_delay,
+ lat => $_->stop->lat,
+ lon => $_->stop->lon,
+ }
+ } @stopovers
+ ],
+ polyline => \@polyline,
+ );
+
+ $self->render(
+ '_map_infobox',
+ ajax_req => "${trip_id}/0",
+ ajax_route => route_to_ajax(
+ map {
+ {
+ name => $_->stop->name,
+ platform => $_->track,
+ arr => $_->arrival,
+ arr_cancelled => $_->is_cancelled,
+ arr_delay => $_->arrival_delay,
+ dep => $_->departure,
+ dep_cancelled => $_->is_cancelled,
+ dep_delay => $_->departure_delay,
+ }
+ } @stopovers
+ ),
+ ajax_polyline => join(
+ '|',
+ map { join( ';', @{$_} ) } @{ $train_pos->{positions} }
+ ),
+ origin => {
+ name => ( $trip->stopovers )[0]->stop->name,
+ ts => ( $trip->stopovers )[0]->departure,
+ },
+ destination => {
+ name => ( $trip->stopovers )[-1]->stop->name,
+ ts => ( $trip->stopovers )[-1]->arrival,
+ },
+ train_no => undef, # FIXME
+ next_stop => $train_pos->{next_stop},
+ platform_type => q{},
+ );
+ }
+ )->catch(
+ sub {
+ my ($err) = @_;
+ $self->render(
+ '_error',
+ error => $err,
+ );
+ }
+ )->wait;
+}
+
+sub ajax_route {
+ my ($self) = @_;
+
+ delete $self->stash->{layout};
$self->render_later;
- push( @requests, $self->hafas->trainsearch_p( train_no => $t1 ) );
+ if ( $self->param('dbris') ) {
+ return $self->ajax_route_dbris;
+ }
+ if ( $self->param('motis') ) {
+ return $self->ajax_route_motis;
+ }
+ if ( $self->param('efa') ) {
+ return $self->ajax_route_efa;
+ }
+
+ my $trip_id = $self->stash('tripid');
+ my $line_no = $self->stash('lineno');
+ my $hafas = $self->param('hafas');
- if ($t2) {
- push( @requests, $self->hafas->trainsearch_p( train_no => $t2 ) );
+ my $service = 'ÖBB';
+ if ( $hafas
+ and $hafas ne '1'
+ and Travel::Status::DE::HAFAS::get_service($hafas) )
+ {
+ $service = $hafas;
}
- Mojo::Promise->all(@requests)->then(
+ $self->hafas->get_polyline_p(
+ id => $trip_id,
+ line => $line_no,
+ service => $service
+ )->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}, ) );
- }
+ my ($journey) = @_;
+
+ my $now = DateTime->now( time_zone => 'Europe/Berlin' );
+
+ my @route = $journey->route;
+ my @polyline = $journey->polyline;
+
+ my $train_pos = $self->estimate_train_positions2(
+ now => $now,
+ route => [
+ map {
+ {
+ name => $_->loc->name,
+ arr => $_->arr,
+ dep => $_->dep,
+ arr_delay => $_->arr_delay,
+ dep_delay => $_->dep_delay,
+ lat => $_->loc->lat,
+ lon => $_->loc->lon
+ }
+ } @route
+ ],
+ polyline => \@polyline,
+ );
+
+ $self->render(
+ '_map_infobox',
+ ajax_req => "${trip_id}/${line_no}",
+ ajax_route => route_to_ajax(
+ map {
+ {
+ name => $_->loc->name,
+ platform => $_->platform,
+ arr => $_->arr,
+ arr_cancelled => $_->arr_cancelled,
+ arr_delay => $_->arr_delay,
+ dep => $_->dep,
+ dep_cancelled => $_->dep_cancelled,
+ dep_delay => $_->dep_delay,
+ }
+ } @route
+ ),
+ ajax_polyline => join(
+ '|',
+ map { join( ';', @{$_} ) } @{ $train_pos->{positions} }
+ ),
+ origin => {
+ name => ( $journey->route )[0]->loc->name,
+ ts => ( $journey->route )[0]->dep,
+ },
+ destination => {
+ name => $journey->route_end,
+ ts => ( $journey->route )[-1]->arr,
+ },
+ train_no => $journey->number
+ ? ( $journey->type . ' ' . $journey->number )
+ : undef,
+ next_stop => $train_pos->{next_stop},
+ );
}
)->catch(
sub {
my ($err) = @_;
$self->render(
- 'trainsearch',
- title => 'Fahrtverlauf',
- hide_opts => 1,
- error => $err
+ '_error',
+ error => $err,
);
}
)->wait;
}
-sub search_form {
- my ($self) = @_;
+sub coverage {
+ my ($self) = @_;
+ my $backend = lc( $self->stash('backend') );
+ my $service = $self->stash('service');
+
+ my $coverage = {};
+
+ if ( $backend eq 'efa' ) {
+ $coverage = $self->efa->get_coverage($service);
+ }
+ elsif ( $backend eq 'hafas' ) {
+ $coverage = $self->hafas->get_coverage($service);
+ }
+ elsif ( $backend eq 'motis' ) {
+ $coverage = $self->motis->get_coverage($service);
+ }
$self->render(
- 'trainsearch',
- title => 'Fahrtverlauf',
+ 'coverage_map',
+ title => "Abdeckung $service",
hide_opts => 1,
+ with_map => 1,
+ coverage => encode_json($coverage),
);
}
diff --git a/lib/DBInfoscreen/Controller/Static.pm b/lib/DBInfoscreen/Controller/Static.pm
index 4b324bd..9a57f05 100644
--- a/lib/DBInfoscreen/Controller/Static.pm
+++ b/lib/DBInfoscreen/Controller/Static.pm
@@ -1,46 +1,24 @@
package DBInfoscreen::Controller::Static;
-use Mojo::Base 'Mojolicious::Controller';
-# Copyright (C) 2011-2019 Daniel Friesel <derf+dbf@finalrewind.org>
-# License: 2-Clause BSD
+# Copyright (C) 2011-2020 Birte Kristina Friesel
+#
+# SPDX-License-Identifier: AGPL-3.0-or-later
+
+use Mojo::Base 'Mojolicious::Controller';
my %default = (
mode => 'app',
admode => 'deparr',
);
-my $dbf_version = qx{git describe --dirty} || 'experimental';
-
-sub redirect {
- my ($self) = @_;
- my $station = $self->param('station');
- my $params = $self->req->params;
-
- $params->remove('station');
-
- 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;
-
- $self->redirect_to("/${station}?${params}");
-}
-
-sub geolocation {
+sub geostop {
my ($self) = @_;
$self->render(
- 'geolocation',
- with_geolocation => 1,
- hide_opts => 1
+ 'geostop',
+ with_geostop => 1,
+ hide_opts => 1,
+ hide_footer => 1,
);
}
@@ -50,20 +28,20 @@ sub about {
$self->render(
'about',
hide_opts => 1,
- version => $dbf_version
+ hide_footer => 1,
);
}
sub privacy {
my ($self) = @_;
- $self->render( 'privacy', hide_opts => 1 );
+ $self->render( 'privacy', hide_opts => 1, hide_footer => 1 );
}
sub imprint {
my ($self) = @_;
- $self->render( 'imprint', hide_opts => 1 );
+ $self->render( 'imprint', hide_opts => 1, hide_footer => 1 );
}
1;
diff --git a/lib/DBInfoscreen/Controller/Stationboard.pm b/lib/DBInfoscreen/Controller/Stationboard.pm
index 1ea238c..3e07f90 100644
--- a/lib/DBInfoscreen/Controller/Stationboard.pm
+++ b/lib/DBInfoscreen/Controller/Stationboard.pm
@@ -1,17 +1,24 @@
package DBInfoscreen::Controller::Stationboard;
-use Mojo::Base 'Mojolicious::Controller';
-# Copyright (C) 2011-2019 Daniel Friesel <derf+dbf@finalrewind.org>
-# License: 2-Clause BSD
+# Copyright (C) 2011-2020 Birte Kristina Friesel
+#
+# SPDX-License-Identifier: AGPL-3.0-or-later
+
+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);
+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::DBRIS;
+use Travel::Status::DE::DBRIS::Formation;
+use Travel::Status::DE::EFA;
use Travel::Status::DE::HAFAS;
use Travel::Status::DE::IRIS;
use Travel::Status::DE::IRIS::Stations;
@@ -19,36 +26,197 @@ use XML::LibXML;
use utf8;
-no if $] >= 5.018, warnings => 'experimental::smartmatch';
+my %default = (
+ mode => 'app',
+ admode => 'deparr',
+);
-my $dbf_version = qx{git describe --dirty} || 'experimental';
+sub class_to_product {
+ my ( $self, $hafas ) = @_;
-chomp $dbf_version;
+ my $bits = $hafas->get_active_service->{productbits};
+ my $ret;
-my %default = (
- backend => 'iris',
- mode => 'app',
- admode => 'deparr',
-);
+ for my $i ( 0 .. $#{$bits} ) {
+ $ret->{ 2**$i }
+ = ref( $bits->[$i] ) eq 'ARRAY' ? $bits->[$i][0] : $bits->[$i];
+ }
-sub result_is_train {
- my ( $result, $train ) = @_;
+ return $ret;
+}
- if ( $result->can('train_id') ) {
+sub handle_no_results {
+ my ( $self, $station, $data, $hafas, $efa ) = @_;
- # IRIS
- if ( $train eq $result->type . ' ' . $result->train_no ) {
- return 1;
+ my $errstr = $data->{errstr};
+
+ if ($efa) {
+ if ( $errstr =~ m{ambiguous} and $efa->name_candidates ) {
+ $self->render(
+ 'landingpage',
+ stationlist => [ $efa->name_candidates ],
+ hide_opts => 0,
+ status => $data->{status} // 300,
+ );
}
- return 0;
+ else {
+ $self->render(
+ 'landingpage',
+ error => ( $errstr // "Keine Abfahrten an '$station'" ),
+ hide_opts => 0,
+ status => $data->{status} // 404,
+ );
+ }
+ return;
+ }
+ elsif ($hafas) {
+ $self->render_later;
+ my $service = 'ÖBB';
+ 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 => $service eq 'PKP' ? Mojo::UserAgent->new : $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 (
+ @candidates > 1
+ or ( @candidates == 1
+ and $candidates[0][0] ne $station
+ and $candidates[0][1] ne $station )
+ )
+ {
+ $self->render(
+ 'landingpage',
+ stationlist => \@candidates,
+ hide_opts => 0,
+ status => $data->{status} // 300,
+ );
+ return;
+ }
+ if ( $data->{station_ds100} and $data->{station_ds100} =~ m{ ^ [OPQXYZ] }x )
+ {
+ $self->render(
+ 'landingpage',
+ error => ( $errstr // "Keine Abfahrten an '$station'" )
+ . '. Das von DBF genutzte IRIS-Backend unterstützt im Regelfall nur innerdeutsche Zugfahrten.',
+ hide_opts => 0,
+ status => $data->{status} // 200,
+ );
+ return;
+ }
+ $self->render(
+ 'landingpage',
+ error => ( $errstr // "Keine Abfahrten an '$station'" ),
+ hide_opts => 0,
+ status => $data->{status} // 404,
+ );
+ return;
+}
+
+sub handle_no_results_json {
+ my ( $self, $station, $data, $api_version ) = @_;
+
+ my $errstr = $data->{errstr};
+ my $callback = $self->param('callback');
+
+ $self->res->headers->access_control_allow_origin(q{*});
+ my $json;
+ if ($errstr) {
+ $json = {
+ api_version => $api_version,
+ error => $errstr,
+ };
}
else {
- # HAFAS
- if ( $train eq $result->type . ' ' . $result->train ) {
- return 1;
+ my @candidates = map { { code => $_->[0], name => $_->[1] } }
+ Travel::Status::DE::IRIS::Stations::get_station($station);
+ if ( @candidates > 1
+ or ( @candidates == 1 and $candidates[0]{code} ne $station ) )
+ {
+ $json = {
+ api_version => $api_version,
+ error => 'ambiguous station code/name',
+ candidates => \@candidates,
+ };
}
- return 0;
+ else {
+ $json = {
+ api_version => $api_version,
+ error => ( $errstr // "Got no results for '$station'" )
+ };
+ }
+ }
+ if ($callback) {
+ $json = $self->render_to_string( json => $json );
+ $self->render(
+ data => "$callback($json);",
+ format => 'json',
+ );
}
+ else {
+ $self->render(
+ json => $json,
+ status => $data->{status} // 300,
+ );
+ }
+ return;
+}
+
+sub result_is_train {
+ my ( $result, $train ) = @_;
+
+ if ( $train eq $result->type . ' ' . $result->train_no ) {
+ return 1;
+ }
+ return 0;
}
sub result_has_line {
@@ -84,134 +252,292 @@ sub result_has_train_type {
sub result_has_via {
my ( $result, $via ) = @_;
- if ( not $result->can('route_post') ) {
+ my @route;
+
+ if ( $result->isa('Travel::Status::DE::IRIS::Result') ) {
+ @route = ( $result->route_post, $result->sched_route_post );
+ }
+ elsif ( $result->isa('Travel::Status::DE::HAFAS::Journey') ) {
+ @route = map { $_->loc->name } $result->route;
+ }
+ elsif ( $result->isa('Travel::Status::DE::EFA::Departure') ) {
+ @route = map { $_->full_name } $result->route_post;
+ }
+ my $eq_result = List::MoreUtils::any { lc eq lc($via) } @route;
+
+ if ($eq_result) {
return 1;
}
- my @route = $result->route_post;
+ my ( $re1_result, $re2_result );
- if ( List::MoreUtils::any { m{$via}i } @route ) {
- return 1;
+ eval {
+ $re2_result = List::MoreUtils::any { m{\Q$via\E}i } @route;
+ };
+ eval {
+ $re1_result = List::MoreUtils::any { m{$via}i } @route;
+ };
+
+ if ($@) {
+ return $re2_result || $eq_result;
}
- return 0;
+
+ return $re1_result || $re2_result || $eq_result;
}
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;
}
-sub get_results_for {
- my ( $backend, $station, %opt ) = @_;
- my $data;
+sub json_route_diff {
+ my ( $self, $route, $sched_route ) = @_;
+ my @json_route;
+ my @route = @{$route};
+ my @sched_route = @{$sched_route};
- # Cache::File has UTF-8 problems, so strip it (and any other potentially
- # problematic chars).
- my $cache_str = $station;
- $cache_str =~ tr{[0-9a-zA-Z -]}{}cd;
-
- if ( $backend eq 'iris' ) {
-
- if ( $ENV{DBFAKEDISPLAY_STATS} ) {
- log_api_access();
- }
-
- # requests with DS100 codes should be preferred (they avoid
- # encoding problems on the IRIS server). However, only use them
- # if we have an exact match. Ask the backend otherwise.
- my @station_matches
- = Travel::Status::DE::IRIS::Stations::get_station($station);
- if ( @station_matches == 1 ) {
- $station = $station_matches[0][0];
- my $status = Travel::Status::DE::IRIS->new(
- station => $station,
- main_cache => $opt{cache_iris_main},
- realtime_cache => $opt{cache_iris_rt},
- log_dir => $ENV{DBFAKEDISPLAY_XMLDUMP_DIR},
- lookbehind => 20,
- lwp_options => {
- timeout => 10,
- agent => 'dbf.finalrewind.org/2'
- },
- %opt
- );
- $data = {
- results => [ $status->results ],
- errstr => $status->errstr,
- station_name =>
- ( $status->station ? $status->station->{name} : $station ),
- };
+ my $route_idx = 0;
+ my $sched_idx = 0;
+
+ while ( $route_idx <= $#route and $sched_idx <= $#sched_route ) {
+ if ( $route[$route_idx] eq $sched_route[$sched_idx] ) {
+ push( @json_route, { name => $route[$route_idx] } );
+ $route_idx++;
+ $sched_idx++;
}
- elsif ( @station_matches > 1 ) {
- $data = {
- results => [],
- errstr => 'Ambiguous station name',
- };
+
+ # this branch is inefficient, but won't be taken frequently
+ elsif (
+ not(
+ List::MoreUtils::any { $route[$route_idx] eq $_ }
+ @sched_route
+ )
+ )
+ {
+ push(
+ @json_route,
+ {
+ name => $route[$route_idx],
+ isAdditional => 1
+ }
+ );
+ $route_idx++;
}
else {
- $data = {
- results => [],
- errstr => 'Unknown station name',
- };
+ push(
+ @json_route,
+ {
+ name => $sched_route[$sched_idx],
+ isCancelled => 1
+ }
+ );
+ $sched_idx++;
}
}
- elsif ( $backend eq 'ris' ) {
- $data = $opt{cache_hafas}->thaw($cache_str);
- if ( not $data ) {
- if ( $ENV{DBFAKEDISPLAY_STATS} ) {
- log_api_access();
+ while ( $route_idx <= $#route ) {
+ push(
+ @json_route,
+ {
+ name => $route[$route_idx],
+ isAdditional => 1,
+ isCancelled => 0
+ }
+ );
+ $route_idx++;
+ }
+ while ( $sched_idx <= $#sched_route ) {
+ push(
+ @json_route,
+ {
+ name => $sched_route[$sched_idx],
+ isAdditional => 0,
+ isCancelled => 1
}
- my $status = Travel::Status::DE::HAFAS->new(
- station => $station,
- excluded_mots => [qw[bus ferry ondemand tram u]],
- lwp_options => {
+ );
+ $sched_idx++;
+ }
+ return @json_route;
+}
+
+sub get_results_p {
+ my ( $self, $station, %opt ) = @_;
+ my $data;
+
+ if ( $opt{dbris} ) {
+ if ( $station =~ m{ [@] L = (?<eva> \d+ ) [@] }x ) {
+ return Travel::Status::DE::DBRIS->new_p(
+ station => {
+ eva => $+{eva},
+ id => $station,
+ },
+ cache => $opt{cache_iris_rt},
+ lwp_options => {
timeout => 10,
agent => 'dbf.finalrewind.org/2'
},
- %opt
+ promise => 'Mojo::Promise',
+ user_agent => Mojo::UserAgent->new,
);
- $data = {
- results => [ $status->results ],
- errstr => $status->errstr,
- };
- $opt{cache_hafas}->freeze( $cache_str, $data );
}
+ my $promise = Mojo::Promise->new;
+ Travel::Status::DE::DBRIS->new_p(
+ locationSearch => $station,
+ cache => $opt{cache_iris_main},
+ lwp_options => {
+ timeout => 10,
+ agent => 'dbf.finalrewind.org/2'
+ },
+ promise => 'Mojo::Promise',
+ user_agent => Mojo::UserAgent->new,
+ )->then(
+ sub {
+ my ($dbris) = @_;
+ $promise->reject( 'station disambiguation', $dbris );
+ return;
+ }
+ )->catch(
+ sub {
+ my ($err) = @_;
+ $promise->reject("'$err' while trying to look up '$station'");
+ return;
+ }
+ )->wait;
+ return $promise;
}
- else {
- $data = {
- results => [],
- errstr => "Backend '$backend' not supported",
- };
+ if ( $opt{efa} ) {
+ my $service = 'VRR';
+ if ( $opt{efa} ne '1'
+ and Travel::Status::DE::EFA::get_service( $opt{efa} ) )
+ {
+ $service = $opt{efa};
+ }
+ return Travel::Status::DE::EFA->new_p(
+ service => $service,
+ name => $station,
+ full_routes => 1,
+ cache => $opt{cache_iris_rt},
+ lwp_options => {
+ timeout => 10,
+ agent => 'dbf.finalrewind.org/2'
+ },
+ promise => 'Mojo::Promise',
+ user_agent => Mojo::UserAgent->new,
+ );
+ }
+ if ( $opt{hafas} ) {
+ my $service = 'ÖBB';
+ 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 => $service eq 'PKP' ? Mojo::UserAgent->new : $self->ua,
+ );
+ }
+
+ if ( $ENV{DBFAKEDISPLAY_STATS} ) {
+ log_api_access();
+ }
+
+ # requests with DS100 codes should be preferred (they avoid
+ # encoding problems on the IRIS server). However, only use them
+ # if we have an exact match. Ask the backend otherwise.
+ my @station_matches
+ = Travel::Status::DE::IRIS::Stations::get_station($station);
+
+ # 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 ] );
}
- return $data;
+ if ( @station_matches == 1 ) {
+ $station = $station_matches[0][2];
+ return Travel::Status::DE::IRIS->new_p(
+ iris_base => $ENV{DBFAKEDISPLAY_IRIS_BASE},
+ station => $station,
+ main_cache => $opt{cache_iris_main},
+ realtime_cache => $opt{cache_iris_rt},
+ log_dir => $ENV{DBFAKEDISPLAY_XMLDUMP_DIR},
+ lookbehind => 20,
+ lwp_options => {
+ timeout => 10,
+ agent => 'dbf.finalrewind.org/2'
+ },
+ promise => 'Mojo::Promise',
+ user_agent => Mojo::UserAgent->new,
+ get_station => \&Travel::Status::DE::IRIS::Stations::get_station,
+ meta => Travel::Status::DE::IRIS::Stations::get_meta(),
+ %opt
+ );
+ }
+ elsif ( @station_matches > 1 ) {
+ return Mojo::Promise->reject('Ambiguous station name');
+ }
+ else {
+ return Mojo::Promise->reject('Unknown station name');
+ }
}
-sub handle_request {
+sub handle_board_request {
my ($self) = @_;
my $station = $self->stash('station');
- my $template = $self->param('mode') // 'app';
- my $backend = $self->param('backend') // 'iris';
+ my $template = $self->param('mode') // 'app';
+ my $dbris = $self->param('dbris');
+ my $efa = $self->param('efa');
+ my $hafas = $self->param('hafas');
my $with_related = !$self->param('no_related');
my %opt = (
- cache_hafas => $self->app->cache_hafas,
cache_iris_main => $self->app->cache_iris_main,
cache_iris_rt => $self->app->cache_iris_rt,
+ lookahead => $self->config->{lookahead},
+ dbris => $dbris,
+ efa => $efa,
+ hafas => $hafas,
);
- my $api_version
- = $backend eq 'iris'
- ? $Travel::Status::DE::IRIS::VERSION
- : $Travel::Status::DE::HAFAS::VERSION;
+ if ( $self->param('past') ) {
+ $opt{datetime} = DateTime->now( time_zone => 'Europe/Berlin' )
+ ->subtract( minutes => 60 );
+ $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 => $dbf_version );
+
+ if (
+ not(
+ List::MoreUtils::any { $template eq $_ }
+ (qw(app infoscreen json multi single text))
+ )
+ )
+ {
+ $template = 'app';
+ }
if ( defined $station and $station =~ s{ [.] txt $ }{}x ) {
$template = 'text';
@@ -236,45 +562,115 @@ 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';
}
- if ( not( $template ~~ [qw[app infoscreen json multi single text]] ) ) {
- $template = 'app';
- }
-
$self->param( mode => $template );
if ( not $station ) {
+ $self->param( rt => 1 );
$self->render( 'landingpage', show_intro => 1 );
return;
}
- if ( $template eq 'json' ) {
- $backend = 'iris';
- $opt{lookahead} = 120;
- }
+ # pre-fill station / train input form
+ $self->stash( input => $station );
+ $self->param( input => $station );
if ($with_related) {
$opt{with_related} = 1;
}
- my $data = get_results_for( $backend, $station, %opt );
- my $errstr = $data->{errstr};
+ if ( $self->param('train') and not $opt{datetime} ) {
- if ( not @{ $data->{results} } and $template eq 'json' ) {
- $self->handle_no_results_json( $backend, $station, $errstr,
- $api_version );
- return;
+ # 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;
}
- if ( not @{ $data->{results} } ) {
- $self->handle_no_results( $backend, $station, $errstr );
- return;
- }
+ $self->render_later;
+
+ $self->get_results_p( $station, %opt )->then(
+ sub {
+ my ($status) = @_;
+ if ($dbris) {
+ $self->render_board_dbris( $station, $status );
+ return;
+ }
+ if ($efa) {
+ $self->render_board_efa( $station, $status );
+ return;
+ }
+ my $data = {
+ results => [ $status->results ],
+ hafas => $hafas ? $status : undef,
+ 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 ),
+ };
- $self->handle_result($data);
+ if ( not @{ $data->{results} } and $template eq 'json' ) {
+ $self->handle_no_results_json( $station, $data, $api_version );
+ return;
+ }
+ if ( not @{ $data->{results} } ) {
+ $self->handle_no_results( $station, $data, $hafas );
+ return;
+ }
+ $self->render_board_hafas($data);
+ }
+ )->catch(
+ sub {
+ my ( $err, $status ) = @_;
+ if ( $dbris and $err eq 'station disambiguation' ) {
+ for my $result ( $status->results ) {
+ if ( defined $result->eva ) {
+ $self->redirect_to(
+ '/' . $result->id . '?dbris=bahn.de' );
+ return;
+ }
+ }
+ }
+ if ( $template eq 'json' ) {
+ $self->handle_no_results_json(
+ $station,
+ {
+ errstr => $err,
+ status =>
+ ( $err =~ m{[Aa]mbiguous|LOCATION} ? 300 : 500 ),
+ },
+ $api_version
+ );
+ return;
+ }
+ $self->handle_no_results(
+ $station,
+ {
+ errstr => $err,
+ status => ( $err =~ m{[Aa]mbiguous|LOCATION} ? 300 : 500 ),
+ },
+ $hafas,
+ $efa ? $status : undef
+ );
+ return;
+ }
+ )->wait;
}
sub filter_results {
@@ -318,12 +714,18 @@ sub format_iris_result_info {
= join( ', ', map { $_->[1] } $result->delay_messages );
my $qosmsg = join( ' +++ ', map { $_->[1] } $result->qos_messages );
if ( $result->is_cancelled ) {
- $info = "Fahrt fällt aus: ${delaymsg}";
+ $info = "Fahrt fällt aus";
+ if ($delaymsg) {
+ $info .= ": ${delaymsg}";
+ }
}
elsif ( $result->departure_is_cancelled ) {
- $info = "Zug endet hier: ${delaymsg}";
+ $info = "Zug endet hier";
+ if ($delaymsg) {
+ $info .= ": ${delaymsg}";
+ }
}
- elsif ( $result->delay and $result->delay > 0 ) {
+ elsif ( $result->delay and $result->delay >= 20 ) {
if ( $template eq 'app' or $template eq 'infoscreen' ) {
$info = $delaymsg;
}
@@ -339,7 +741,7 @@ sub format_iris_result_info {
for my $rep ( $result->replacement_for ) {
$info = sprintf(
'Ersatzzug für %s %s %s%s',
- $rep->type, $rep->train_no,
+ $rep->type, $rep->train_no,
$info ? '+++ ' : q{}, $info // q{}
);
}
@@ -357,7 +759,10 @@ sub format_iris_result_info {
. ( $info ? ' +++ ' : q{} )
. $info;
if ( $template ne 'json' ) {
- push( @{$moreinfo}, [ 'Zusätzliche Halte', $additional_line ] );
+ push(
+ @{$moreinfo},
+ [ 'Außerplanmäßiger Halt in', { text => $additional_line } ]
+ );
}
}
@@ -366,7 +771,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 } ] );
}
}
@@ -375,212 +780,1474 @@ sub format_iris_result_info {
return ( $info, $moreinfo );
}
-sub format_hafas_result_info {
- my ( $self, $result ) = @_;
- my ( $info, $moreinfo );
-
- $info = $result->info;
- if ($info) {
- $moreinfo = [ [ 'HAFAS', $info ] ];
+sub render_train {
+ my ( $self, $result, $departure, $station_name, $template ) = @_;
+
+ $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 ( $result->delay and $result->delay > 0 ) {
- if ($info) {
- $info = 'ca. +' . $result->delay . ': ' . $info;
+
+ if ( not $result->has_realtime ) {
+ my $now = DateTime->now( time_zone => 'Europe/Berlin' );
+ if ( $result->start < $now ) {
+ $departure->{missing_realtime} = 1;
}
else {
- $info = 'ca. +' . $result->delay;
+ $departure->{no_realtime_yet} = 1;
}
}
- push( @{$moreinfo}, map { [ 'HAFAS', $_ ] } $result->messages );
-
- return ( $info, $moreinfo );
-}
-
-sub render_train {
- my ( $self, $result, $departure, $station_name ) = @_;
-
- $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 ]
- )
- ];
my $linetype = 'bahn';
- if ( $departure->{train_type} eq 'S' ) {
- $linetype = 'sbahn';
- }
- elsif ($departure->{train_type} eq 'IC'
- or $departure->{train_type} eq 'ICE'
- or $departure->{train_type} eq 'EC'
- or $departure->{train_type} eq 'ECE'
- or $departure->{train_type} eq 'EN' )
- {
- $linetype = 'fern';
- }
- elsif ($departure->{train_type} eq 'THA'
- or $departure->{train_type} eq 'TGV'
- or $departure->{train_type} eq 'FLX'
- or $departure->{train_type} eq 'NJ' )
- {
- $linetype = 'ext';
+
+ 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 ( $departure->{train_line}
- and $departure->{train_line} =~ m{^S\d} )
- {
- $linetype = 'sbahn';
+ 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;
- # if wagonorder->is_available_p takes longer than get_route_timestamps_p,
- # we'll have a useless (non-working) wagonorder link. That's okay.
- if ( $departure->{wr_link} ) {
- $self->wagonorder->is_available_p( $result, $departure->{wr_link} )
- ->then(
+ my $wagonorder_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, $occupancy_req, $stationinfo_req, $route_req );
+
+ if ( $departure->{wr_dt} ) {
+ $self->wagonorder->get_p(
+ train_type => $result->type,
+ train_number => $result->train_no,
+ datetime => $departure->{wr_dt},
+ eva => $departure->{eva}
+ )->then(
sub {
- # great!
+ my ( $wr_json, $wr_param ) = @_;
+ eval {
+ my $wr
+ = Travel::Status::DE::DBRIS::Formation->new(
+ json => $wr_json );
+ $departure->{wr} = $wr;
+ $departure->{wr_link} = join( '&',
+ map { $_ . '=' . $wr_param->{$_} } keys %{$wr_param} );
+ $departure->{wr_text} = join( q{ • },
+ map { $_->desc_short }
+ grep { $_->desc_short } $wr->groups );
+ my $first = 0;
+ for my $group ( $wr->groups ) {
+ my $had_entry = 0;
+ for my $wagon ( $group->carriages ) {
+ if (
+ not( $wagon->is_locomotive
+ or $wagon->is_powercar )
+ )
+ {
+ my $class;
+ if ($first) {
+ push(
+ @{ $departure->{wr_preview} },
+ [ '•', 'meta' ]
+ );
+ $first = 0;
+ }
+ my $entry;
+ if ( $wagon->is_closed ) {
+ $entry = 'X';
+ $class = 'closed';
+ }
+ elsif ( $wagon->number ) {
+ $entry = $wagon->number;
+ }
+ else {
+ if ( $wagon->has_first_class ) {
+ if ( $wagon->has_second_class ) {
+ $entry = '½';
+ }
+ else {
+ $entry = '1.';
+ }
+ }
+ elsif ( $wagon->has_second_class ) {
+ $entry = '2.';
+ }
+ else {
+ $entry = $wagon->type;
+ }
+ }
+ if (
+ $group->train_no ne $departure->{train_no} )
+ {
+ $class = 'otherno';
+ }
+ push(
+ @{ $departure->{wr_preview} },
+ [ $entry, $class ]
+ );
+ $had_entry = 1;
+ }
+ }
+ if ($had_entry) {
+ $first = 1;
+ }
+ }
+ };
+ $departure->{wr_text} ||= 'Wagen';
return;
},
sub {
- $departure->{wr_link} = undef;
+ $departure->{wr_dt} = undef;
+ return;
+ }
+ )->finally(
+ sub {
+ $wagonorder_req->resolve;
return;
}
)->wait;
}
+ else {
+ $wagonorder_req->resolve;
+ }
- $self->hafas->get_route_timestamps_p( train => $result )->then(
+ $self->efa->get_efa_occupancy(
+ eva => $result->station_uic,
+ train_no => $result->train_no
+ )->then(
+ sub {
+ my ($occupancy) = @_;
+ $departure->{occupancy} = $occupancy;
+ return;
+ },
sub {
- my ( $route_ts, $route_info, $trainsearch ) = @_;
+ $departure->{occupancy} = undef;
+ return;
+ }
+ )->finally(
+ sub {
+ $occupancy_req->resolve;
+ return;
+ }
+ )->wait;
- $departure->{trip_id} = $trainsearch->{trip_id};
+ $self->wagonorder->get_stationinfo_p( $result->station_uic )->then(
+ sub {
+ my ($station_info) = @_;
+ my ($platform_number) = ( $result->platform =~ m{(\d+)} );
+ if ( not defined $platform_number ) {
+ return;
+ }
+ my $platform_info = $station_info->{$platform_number};
+ if ( not $platform_info ) {
+ return;
+ }
+ my $prev_stop = ( $result->route_pre )[-1];
+ my $next_stop = ( $result->route_post )[0];
+ my $direction;
- # 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 ( $platform_info->{kopfgleis} and $next_stop ) {
+ $direction = $platform_info->{direction} eq 'r' ? 'l' : 'r';
+ }
+ elsif ( $platform_info->{kopfgleis} ) {
+ $direction = $platform_info->{direction};
+ }
+ elsif ( $prev_stop
+ and exists $platform_info->{direction_from}{$prev_stop} )
{
- 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;
+ $direction = $platform_info->{direction_from}{$prev_stop};
+ }
+ elsif ( $next_stop
+ and exists $platform_info->{direction_from}{$next_stop} )
+ {
+ $direction
+ = $platform_info->{direction_from}{$next_stop} eq 'r'
+ ? 'l'
+ : 'r';
+ }
+
+ if ($direction) {
+ $departure->{wr_direction} = $direction;
+ $departure->{wr_direction_num} = $direction eq 'l' ? 0 : 100;
+ }
+ elsif ( $platform_info->{direction} ) {
+ $departure->{wr_direction} = 'a' . $platform_info->{direction};
+ $departure->{wr_direction_num}
+ = $platform_info->{direction} eq 'l' ? 0 : 100;
+ }
+
+ return;
+ },
+ sub {
+ # errors don't matter here
+ return;
+ }
+ )->finally(
+ sub {
+ $stationinfo_req->resolve;
+ return;
+ }
+ )->wait;
+
+ my %opt = ( train => $result );
+
+ #if ( $self->languages =~ m{^en} ) {
+ # $opt{language} = 'en';
+ #}
+
+ $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 ( 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} } );
+ }
+
+ 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 } ]
+ );
}
- 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
- )
+ }
+ 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';
+ }
+ $m->[0] =~ s{(?!<)->}{ → };
+ }
+ unshift( @{ $departure->{moreinfo} }, @him_messages );
+ unshift( @{ $departure->{details} }, @him_details );
+ }
+ )->catch(
+ sub {
+ # nop
+ }
+ )->finally(
+ sub {
+ $route_req->resolve;
+ return;
+ }
+ )->wait;
+
+ # Defer rendering until all requests have completed
+ Mojo::Promise->all(@requests)->then(
+ sub {
+ $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(
{
- push(
- @{ $departure->{route_post_diff} },
- @missing_post
- );
- last;
+ detailed => $self->param('detailed'),
+ hafas => $self->param('hafas')
}
- unshift(
- @missing_post,
+ ),
+ },
+ );
+ }
+ )->wait;
+}
+
+# /z/:train/*station
+sub station_train_details {
+ my ($self) = @_;
+ my $train_no = $self->stash('train');
+ my $station = $self->stash('station');
+
+ if ( $self->param('ajax') ) {
+ 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,
+ );
+
+ my $api_version = $Travel::Status::DE::IRIS::VERSION;
+
+ $self->stash( departures => [] );
+ $self->stash( title => 'DBF' );
+ $self->stash( version => $self->config->{version} );
+
+ if ( $self->param('past') ) {
+ $opt{datetime} = DateTime->now( time_zone => 'Europe/Berlin' )
+ ->subtract( minutes => 80 );
+ $opt{lookahead} = $self->config->{lookahead} + 80;
+ }
+ else {
+ $opt{datetime} = DateTime->now( time_zone => 'Europe/Berlin' )
+ ->subtract( minutes => 20 );
+ $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;
+
+ # Always performs an IRIS request
+ $self->get_results_p( $station, %opt )->then(
+ sub {
+ my ($status) = @_;
+ my ($result)
+ = grep { result_is_train( $_, $train_no ) } $status->results;
+
+ if ( not $result ) {
+ die("Train not found\n");
+ }
+
+ my ( $info, $moreinfo )
+ = $self->format_iris_result_info( 'app', $result );
+
+ my $result_info = {
+ 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,
+ arrival_hidden => $result->arrival_hidden,
+ departure_hidden => $result->departure_hidden,
+ train_type => $result->type // '',
+ train_line => $result->line_no,
+ train_no => $result->train_no,
+ destination => $result->destination,
+ origin => $result->origin,
+ platform => $result->platform,
+ scheduled_platform => $result->sched_platform,
+ is_cancelled => $result->is_cancelled,
+ departure_is_cancelled => $result->departure_is_cancelled,
+ 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 => [
+ map { $_->type . q{ } . $_->train_no } $result->replaced_by
+ ],
+ replacement_for => [
+ map { $_->type . q{ } . $_->train_no }
+ $result->replacement_for
+ ],
+ wr_dt => $result->sched_departure,
+ eva => $result->station_uic,
+ start => $result->start,
+ };
+
+ $self->stash( title => $status->station->{name}
+ // $self->stash('station') );
+ $self->stash( hide_opts => 1 );
+
+ $self->render_train(
+ $result,
+ $result_info,
+ $status->station->{name} // $self->stash('station'),
+ $self->param('ajax') ? '_train_details' : 'train_details'
+ );
+ }
+ )->catch(
+ sub {
+ my ($errstr) = @_;
+ $self->respond_to(
+ json => {
+ json => {
+ error =>
+"Keine Abfahrt von $train_no in $station gefunden: $errstr",
+ },
+ status => 404,
+ },
+ any => {
+ template => 'landingpage',
+ error =>
+"Keine Abfahrt von $train_no in $station gefunden: $errstr",
+ status => 404,
+ },
+ );
+ return;
+ }
+ )->wait;
+}
+
+sub train_details_dbris {
+ my ($self) = @_;
+ my $trip_id = $self->stash('train');
+
+ $self->render_later;
+
+ $self->dbris->get_journey_p( id => $trip_id )->then(
+ sub {
+ my ($dbris) = @_;
+ my $trip = $dbris->result;
+
+ my ( @him_messages, @him_details );
+ for my $message ( $trip->messages ) {
+ if ( not $message->{ueberschrift} ) {
+ push(
+ @him_messages,
+ [
+ q{},
{
- name => $station,
- hafas => 1
+ icon => $message->{prioritaet} eq 'HOCH'
+ ? 'warning'
+ : 'info',
+ text => $message->{text}
}
- );
- }
+ ]
+ );
}
}
- if ($route_ts) {
- for my $elem (
- @{ $departure->{route_pre_diff} },
- @{ $departure->{route_post_diff} }
+
+ for my $attribute ( $trip->attributes ) {
+ push(
+ @him_details,
+ [
+ q{},
+ {
+ text => $attribute->{value}
+ . (
+ $attribute->{teilstreckenHinweis}
+ ? q { } . $attribute->{teilstreckenHinweis}
+ : q{}
+ )
+ }
+ ]
+ );
+ }
+
+ my $now = DateTime->now( time_zone => 'Europe/Berlin' );
+ my $res = {
+ trip_id => $trip_id,
+ train_line => $trip->train,
+ train_no => $trip->number,
+ origin => ( $trip->route )[0]->name,
+ destination => ( $trip->route )[-1]->name,
+ operators => [],
+ linetype => 'bahn',
+ route_pre_diff => [],
+ route_post_diff => [],
+ moreinfo => [@him_messages],
+ details => [@him_details],
+ replaced_by => [],
+ replacement_for => [],
+ };
+
+ my $line = $trip->train;
+ if ( $line =~ m{ STR }x ) {
+ $res->{linetype} = 'tram';
+ }
+ elsif ( $line =~ m{ ^ S }x ) {
+ $res->{linetype} = 'sbahn';
+ }
+ elsif ( $line =~ m{ U }x ) {
+ $res->{linetype} = 'ubahn';
+ }
+ elsif ( $line =~ m{ Bus }x ) {
+ $res->{linetype} = 'bus';
+ }
+ elsif ( $line =~ m{ ^ [EI]CE? }x ) {
+ $res->{linetype} = 'fern';
+ }
+ elsif ( $line =~ m{ EST | FLX }x ) {
+ $res->{linetype} = 'ext';
+ }
+
+ my $station_is_past = 1;
+ for my $stop ( $trip->route ) {
+
+ push(
+ @{ $res->{route_post_diff} },
+ {
+ name => $stop->name,
+ eva => $stop->eva,
+ id => $stop->id,
+ sched_arr => $stop->sched_arr,
+ sched_dep => $stop->sched_dep,
+ rt_arr => $stop->rt_arr,
+ rt_dep => $stop->rt_dep,
+ arr_delay => $stop->arr_delay,
+ dep_delay => $stop->dep_delay,
+ platform => $stop->platform,
+ }
+ );
+ if (
+ $station_is_past
+ and $now->epoch < (
+ $res->{route_post_diff}[-1]{rt_arr}
+ // $res->{route_post_diff}[-1]{rt_dep}
+ // $res->{route_post_diff}[-1]{sched_arr}
+ // $res->{route_post_diff}[-1]{sched_dep} // $now
+ )->epoch
)
{
- for my $key ( keys %{ $route_ts->{ $elem->{name} } // {} } )
+ $station_is_past = 0;
+ }
+ $res->{route_post_diff}[-1]{isPast} = $station_is_past;
+ }
+
+ if ( my $req_id = $self->param('highlight') ) {
+ my $split;
+ for my $i ( 0 .. $#{ $res->{route_post_diff} } ) {
+ if ( $res->{route_post_diff}[$i]{eva} eq $req_id ) {
+ $split = $i;
+ last;
+ }
+ }
+ if ( defined $split ) {
+ $self->stash(
+ station_name => $res->{route_post_diff}[$split]{name} );
+ for my $i ( 0 .. $split - 1 ) {
+ push(
+ @{ $res->{route_pre_diff} },
+ shift( @{ $res->{route_post_diff} } )
+ );
+ }
+ my $station_info = shift( @{ $res->{route_post_diff} } );
+ $res->{eva} = $station_info->{eva};
+ if ( $station_info->{sched_arr} ) {
+ $res->{sched_arrival}
+ = $station_info->{sched_arr}->strftime('%H:%M');
+ }
+ if ( $station_info->{rt_arr} ) {
+ $res->{arrival}
+ = $station_info->{rt_arr}->strftime('%H:%M');
+ }
+ if ( $station_info->{sched_dep} ) {
+ $res->{sched_departure}
+ = $station_info->{sched_dep}->strftime('%H:%M');
+ }
+ if ( $station_info->{rt_dep} ) {
+ $res->{departure}
+ = $station_info->{rt_dep}->strftime('%H:%M');
+ }
+ $res->{arrival_is_cancelled}
+ = $station_info->{arr_cancelled};
+ $res->{departure_is_cancelled}
+ = $station_info->{dep_cancelled};
+ $res->{is_cancelled} = $res->{arrival_is_cancelled}
+ || $res->{arrival_is_cancelled};
+ $res->{tz_offset} = $station_info->{tz_offset};
+ $res->{local_dt_da} = $station_info->{local_dt_da};
+ $res->{local_sched_arr} = $station_info->{local_sched_arr};
+ $res->{local_sched_dep} = $station_info->{local_sched_dep};
+ $res->{is_annotated} = $station_info->{is_annotated};
+ $res->{prod_name} = $station_info->{prod_name};
+ $res->{direction} = $station_info->{direction};
+ $res->{operator} = $station_info->{operator};
+ $res->{platform} = $station_info->{platform};
+ $res->{scheduled_platform}
+ = $station_info->{sched_platform};
+ }
+ }
+
+ $self->respond_to(
+ json => {
+ json => {
+ journey => $trip,
+ },
+ },
+ any => {
+ template => $self->param('ajax')
+ ? '_train_details'
+ : 'train_details',
+ description => sprintf(
+ '%s %s%s%s nach %s',
+ $res->{train_type},
+ $res->{train_line} // $res->{train_no},
+ $res->{origin} ? ' von ' : q{},
+ $res->{origin} // q{},
+ $res->{destination} // 'unbekannt'
+ ),
+ departure => $res,
+ linetype => $res->{linetype},
+ dt_now => DateTime->now( time_zone => 'Europe/Berlin' ),
+ },
+ );
+ }
+ )->catch(
+ sub {
+ my ($e) = @_;
+ $self->respond_to(
+ json => {
+ json => {
+ error => $e,
+ },
+ status => 500,
+ },
+ any => {
+ template => 'exception',
+ message => $e,
+ exception => undef,
+ snapshot => {},
+ status => 500,
+ },
+ );
+ }
+ )->wait;
+}
+
+sub train_details_efa {
+ my ($self) = @_;
+ my $trip_id = $self->stash('train');
+
+ my $stopseq;
+ if ( $trip_id
+ =~ m{ ^ ([^@]*) @ ([^@]*) [(] ([^T]*) T ([^)]*) [)] (.*) $ }x )
+ {
+ $stopseq = {
+ stateless => $1,
+ stop_id => $2,
+ date => $3,
+ time => $4,
+ key => $5
+ };
+ }
+ else {
+ $self->render( 'not_found', status => 404 );
+ return;
+ }
+
+ $self->render_later;
+
+ Travel::Status::DE::EFA->new_p(
+ service => $self->param('efa'),
+ stopseq => $stopseq,
+ cache => $self->app->cache_iris_rt,
+ lwp_options => {
+ timeout => 10,
+ agent => 'dbf.finalrewind.org/2'
+ },
+ promise => 'Mojo::Promise',
+ user_agent => Mojo::UserAgent->new,
+ )->then(
+ sub {
+ my ($efa) = @_;
+ my $trip = $efa->result;
+
+ my $now = DateTime->now( time_zone => 'Europe/Berlin' );
+ my $res = {
+ trip_id => $trip_id,
+ train_type => $trip->type,
+ train_line => $trip->line,
+ train_no => $trip->number,
+ origin => ( $trip->route )[0]->full_name,
+ destination => ( $trip->route )[-1]->full_name,
+ operators => [ $trip->operator ],
+ linetype => lc( $trip->product ) =~ tr{a-z}{}cdr,
+ route_pre_diff => [],
+ route_post_diff => [],
+ moreinfo => [],
+ replaced_by => [],
+ replacement_for => [],
+ };
+
+ if ( $res->{linetype} =~ m{strab|stra.?enbahn} ) {
+ $res->{linetype} = 'tram';
+ }
+ elsif ( $res->{linetype} =~ m{bus} ) {
+ $res->{linetype} = 'bus';
+ }
+
+ my $station_is_past = 1;
+ for my $stop ( $trip->route ) {
+
+ push(
+ @{ $res->{route_post_diff} },
{
- $elem->{$key} = $route_ts->{ $elem->{name} }{$key};
+ name => $stop->full_name,
+ id => $stop->id_code,
+ sched_arr => $stop->sched_arr,
+ sched_dep => $stop->sched_dep,
+ rt_arr => $stop->rt_arr,
+ rt_dep => $stop->rt_dep,
+ arr_delay => $stop->arr_delay,
+ dep_delay => $stop->dep_delay,
+ platform => $stop->platform,
}
+ );
+ if (
+ $station_is_past
+ and $now->epoch < (
+ $res->{route_post_diff}[-1]{rt_arr}
+ // $res->{route_post_diff}[-1]{rt_dep}
+ // $res->{route_post_diff}[-1]{sched_arr}
+ // $res->{route_post_diff}[-1]{sched_dep} // $now
+ )->epoch
+ )
+ {
+ $station_is_past = 0;
}
+ $res->{route_post_diff}[-1]{isPast} = $station_is_past;
}
- if ( $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 ( my $req_id = $self->param('highlight') ) {
+ my $split;
+ for my $i ( 0 .. $#{ $res->{route_post_diff} } ) {
+ if ( $res->{route_post_diff}[$i]{id} eq $req_id ) {
+ $split = $i;
+ last;
}
}
- for my $message ( @{ $departure->{moreinfo} // [] } ) {
- my $m = $message->[1];
- @him_messages
- = grep { $_->[0] !~ m{Information\. $m\.$} }
- @him_messages;
+ if ( defined $split ) {
+ $self->stash(
+ station_name => $res->{route_post_diff}[$split]{name} );
+ for my $i ( 0 .. $split - 1 ) {
+ push(
+ @{ $res->{route_pre_diff} },
+ shift( @{ $res->{route_post_diff} } )
+ );
+ }
+ my $station_info = shift( @{ $res->{route_post_diff} } );
+ $res->{eva} = $station_info->{eva};
+ if ( $station_info->{sched_arr} ) {
+ $res->{sched_arrival}
+ = $station_info->{sched_arr}->strftime('%H:%M');
+ }
+ if ( $station_info->{rt_arr} ) {
+ $res->{arrival}
+ = $station_info->{rt_arr}->strftime('%H:%M');
+ }
+ if ( $station_info->{sched_dep} ) {
+ $res->{sched_departure}
+ = $station_info->{sched_dep}->strftime('%H:%M');
+ }
+ if ( $station_info->{rt_dep} ) {
+ $res->{departure}
+ = $station_info->{rt_dep}->strftime('%H:%M');
+ }
+ $res->{arrival_is_cancelled}
+ = $station_info->{arr_cancelled};
+ $res->{departure_is_cancelled}
+ = $station_info->{dep_cancelled};
+ $res->{is_cancelled} = $res->{arrival_is_cancelled}
+ || $res->{arrival_is_cancelled};
+ $res->{tz_offset} = $station_info->{tz_offset};
+ $res->{local_dt_da} = $station_info->{local_dt_da};
+ $res->{local_sched_arr} = $station_info->{local_sched_arr};
+ $res->{local_sched_dep} = $station_info->{local_sched_dep};
+ $res->{is_annotated} = $station_info->{is_annotated};
+ $res->{prod_name} = $station_info->{prod_name};
+ $res->{direction} = $station_info->{direction};
+ $res->{operator} = $station_info->{operator};
+ $res->{platform} = $station_info->{platform};
+ $res->{scheduled_platform}
+ = $station_info->{sched_platform};
}
- unshift( @{ $departure->{moreinfo} }, @him_messages );
}
+
+ $self->respond_to(
+ json => {
+ json => {
+ journey => $trip,
+ },
+ },
+ any => {
+ template => $self->param('ajax')
+ ? '_train_details'
+ : 'train_details',
+ description => sprintf(
+ '%s %s%s%s nach %s',
+ $res->{train_type},
+ $res->{train_line} // $res->{train_no},
+ $res->{origin} ? ' von ' : q{},
+ $res->{origin} // q{},
+ $res->{destination} // 'unbekannt'
+ ),
+ departure => $res,
+ linetype => $res->{linetype},
+ dt_now => DateTime->now( time_zone => 'Europe/Berlin' ),
+ },
+ );
}
)->catch(
sub {
- # nop
+ my ($e) = @_;
+ $self->respond_to(
+ json => {
+ json => {
+ error => $e,
+ },
+ status => 500,
+ },
+ any => {
+ template => 'exception',
+ message => $e,
+ exception => undef,
+ snapshot => {},
+ status => 500,
+ },
+ );
}
- )->finally(
+ )->wait;
+}
+
+# /z/:train
+sub train_details {
+ my ($self) = @_;
+ my $train = $self->stash('train');
+ my $dbris = $self->param('dbris');
+ my $efa = $self->param('efa');
+ my $hafas = $self->param('hafas');
+
+ # TODO error handling
+
+ if ( $self->param('ajax') ) {
+ delete $self->stash->{layout};
+ }
+
+ $self->stash( departures => [] );
+ $self->stash( title => 'DBF' );
+
+ if ($dbris) {
+ return $self->train_details_dbris;
+ }
+ if ($efa) {
+ return $self->train_details_efa;
+ }
+
+ my $res = {
+ train_type => undef,
+ train_line => undef,
+ train_no => undef,
+ route_pre_diff => [],
+ route_post_diff => [],
+ moreinfo => [],
+ replaced_by => [],
+ replacement_for => [],
+ };
+
+ 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_p(%opt)->then(
sub {
- $self->render(
- '_train_details',
- departure => $departure,
- linetype => $linetype,
- icetype => $self->app->ice_type_map->{ $departure->{train_no} },
- dt_now => DateTime->now( time_zone => 'Europe/Berlin' ),
- station_name => $station_name,
+ my ( $route, $journey, $hafas_obj ) = @_;
+
+ $res->{trip_id} = $journey->id;
+ $res->{date} = $route->[0]{sched_dep} // $route->[0]{dep};
+
+ my $product = $journey->product;
+
+ if ( my $req_name = $self->param('highlight') ) {
+ if ( my $p = $journey->product_at($req_name) ) {
+ $product = $p;
+ }
+ }
+
+ 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';
+ }
+ else {
+ my $prod
+ = $self->class_to_product($hafas_obj)->{ $product->class }
+ // q{};
+ if ( $prod =~ m{ ^ ice? | inter-?cit }ix ) {
+ $linetype = 'fern';
+ }
+ elsif ( $prod =~ m{ s-bahn | urban | rapid }ix ) {
+ $linetype = 'sbahn';
+ }
+ elsif ( $prod =~ m{ bus }ix ) {
+ $linetype = 'bus';
+ }
+ elsif ( $prod =~ m{ metro | u-bahn | subway }ix ) {
+ $linetype = 'ubahn';
+ }
+ elsif ( $prod =~ m{ tram }ix ) {
+ $linetype = 'tram';
+ }
+ }
+
+ $res->{origin} = $journey->route_start;
+ $res->{destination} = $journey->route_end;
+ $res->{operators} = [ $journey->operators ];
+
+ $res->{route_post_diff} = $route;
+
+ 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};
+ }
+ }
+
+ 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->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->respond_to(
+ json => {
+ json => {
+ error => $e,
+ },
+ status => 500,
+ },
+ any => {
+ template => 'exception',
+ message => $e,
+ exception => undef,
+ snapshot => {},
+ status => 500,
+ },
+ );
+ }
+ else {
+ $self->render( 'not_found', status => 404 );
+ }
+ }
)->wait;
}
-sub handle_result {
+sub render_board_dbris {
+ my ( $self, $station_id, $dbris ) = @_;
+ my $template = $self->param('mode') // 'app';
+ my $hide_low_delay = $self->param('hidelowdelay') // 0;
+ my $hide_opts = $self->param('hide_opts') // 0;
+ my $show_realtime = $self->param('rt') // $self->param('show_realtime')
+ // 1;
+
+ my $station_name;
+ if ( $station_id =~ m{ [@] O = (?<name> [^@]+) [@] }x ) {
+ $station_name = $+{name};
+ }
+
+ my @departures;
+
+ if ( $self->param('ajax') ) {
+ delete $self->stash->{layout};
+ }
+
+ my @results = $self->filter_results( $dbris->results );
+
+ @results = map { $_->[1] } sort { $a->[0] <=> $b->[0] }
+ map { [ $_->dep, $_ ] } @results;
+
+ for my $result (@results) {
+ my $time;
+
+ if ( $template eq 'json' ) {
+ push( @departures, $result );
+ next;
+ }
+
+ if ( $show_realtime and $result->rt_dep ) {
+ $time = $result->rt_dep->strftime('%H:%M');
+ }
+ else {
+ $time = $result->sched_dep->strftime('%H:%M');
+ }
+
+ my $linetype = $result->line;
+ if ( $linetype =~ m{ STR }x ) {
+ $linetype = 'tram';
+ }
+ elsif ( $linetype =~ m{ ^ S }x ) {
+ $linetype = 'sbahn';
+ }
+ elsif ( $linetype =~ m{ U }x ) {
+ $linetype = 'ubahn';
+ }
+ elsif ( $linetype =~ m{ Bus }x ) {
+ $linetype = 'bus';
+ }
+ elsif ( $linetype =~ m{ ^ [EI]CE? }x ) {
+ $linetype = 'fern';
+ }
+ elsif ( $linetype =~ m{ EST | FLX }x ) {
+ $linetype = 'ext';
+ }
+ else {
+ $linetype = 'bahn';
+ }
+
+ my $delay = $result->delay;
+
+ push(
+ @departures,
+ {
+ time => $time,
+ sched_departure => $result->sched_dep->strftime('%H:%M'),
+ departure => $result->rt_dep
+ ? $result->rt_dep->strftime('%H:%M')
+ : undef,
+ train => $result->train_mid,
+ train_type => q{},
+ train_line => $result->line,
+ train_no => $result->maybe_train_no,
+ journey_id => $result->id,
+ via => [ $result->via ],
+ origin => q{},
+ destination => $result->destination,
+ platform => $result->rt_platform // $result->platform,
+ scheduled_platform => $result->platform,
+ is_cancelled => $result->is_cancelled,
+ linetype => $linetype,
+ delay => $delay,
+ is_bit_delayed =>
+ ( $delay and $delay > 0 and $delay < 5 ? 1 : 0 ),
+ is_delayed => ( $delay and $delay >= 5 ? 1 : 0 ),
+ has_realtime => defined $delay ? 1 : 0,
+ station => $result->stop_eva,
+ replaced_by => [],
+ replacement_for => [],
+ route_pre => [],
+ route_post => [ $result->via ],
+ wr_dt => undef,
+ }
+ );
+ }
+
+ if ( $template eq 'json' ) {
+ $self->res->headers->access_control_allow_origin(q{*});
+ my $json = {
+ departures => \@departures,
+ };
+ $self->render(
+ json => $json,
+ );
+ }
+ else {
+ $self->render(
+ $template,
+ description => "Abfahrtstafel $station_name",
+ departures => \@departures,
+ station => $station_name,
+ version => $self->config->{version},
+ title => $station_name,
+ refresh_interval => $template eq 'app' ? 0 : 120,
+ hide_opts => $hide_opts,
+ hide_footer => $hide_opts,
+ hide_low_delay => $hide_low_delay,
+ show_realtime => $show_realtime,
+ load_marquee => (
+ $template eq 'single'
+ or $template eq 'multi'
+ ),
+ force_mobile => ( $template eq 'app' ),
+ );
+ }
+}
+
+sub render_board_efa {
+ my ( $self, $station_name, $efa ) = @_;
+ my $template = $self->param('mode') // 'app';
+ my $hide_low_delay = $self->param('hidelowdelay') // 0;
+ my $hide_opts = $self->param('hide_opts') // 0;
+ my $show_realtime = $self->param('rt') // $self->param('show_realtime')
+ // 1;
+
+ my @departures;
+
+ if ( $self->param('ajax') ) {
+ delete $self->stash->{layout};
+ }
+
+ my @results = $self->filter_results( $efa->results );
+
+ for my $result (@results) {
+ my $time;
+
+ if ( $template eq 'json' ) {
+ push( @departures, $result );
+ next;
+ }
+
+ if ( $show_realtime and $result->rt_datetime ) {
+ $time = $result->rt_datetime->strftime('%H:%M');
+ }
+ else {
+ $time = $result->sched_datetime->strftime('%H:%M');
+ }
+
+ my $linetype = $result->mot_name // 'bahn';
+ if ( $linetype =~ m{ s-bahn | urban | rapid }ix ) {
+ $linetype = 'sbahn';
+ }
+ elsif ( $linetype =~ m{ metro | u-bahn | subway }ix ) {
+ $linetype = 'ubahn';
+ }
+ elsif ( $linetype =~ m{ bus }ix ) {
+ $linetype = 'bus';
+ }
+ elsif ( $linetype =~ m{ tram }ix ) {
+ $linetype = 'tram';
+ }
+ elsif ( $linetype =~ m{ ^ ice? | inter-?cit }ix ) {
+ $linetype = 'fern';
+ }
+ elsif ( $linetype eq 'sonstige' ) {
+ $linetype = 'ext';
+ }
+
+ my $delay = $result->delay;
+
+ push(
+ @departures,
+ {
+ time => $time,
+ sched_departure => $result->sched_datetime->strftime('%H:%M'),
+ departure => $result->rt_datetime
+ ? $result->rt_datetime->strftime('%H:%M')
+ : undef,
+ train => $result->line,
+ train_type => q{},
+ train_line => $result->line,
+ train_no => $result->train_no,
+ journey_id => $result->id,
+ via => [ map { $_->name } $result->route_interesting ],
+ origin => $result->origin,
+ destination => $result->destination,
+ platform => $result->platform,
+ is_cancelled => $result->is_cancelled,
+ linetype => $linetype,
+ delay => $delay,
+ is_bit_delayed =>
+ ( $delay and $delay > 0 and $delay < 5 ? 1 : 0 ),
+ is_delayed => ( $delay and $delay >= 5 ? 1 : 0 ),
+ has_realtime => defined $delay ? 1 : 0,
+ occupancy => $result->occupancy,
+ station => $efa->stop->id_code,
+ replaced_by => [],
+ replacement_for => [],
+ route_pre => [ map { $_->full_name } $result->route_pre ],
+ route_post => [ map { $_->full_name } $result->route_post ],
+ wr_dt => undef,
+ }
+ );
+ }
+
+ if ( $template eq 'json' ) {
+ $self->res->headers->access_control_allow_origin(q{*});
+ my $json = {
+ departures => \@departures,
+ };
+ $self->render(
+ json => $json,
+ );
+ }
+ else {
+ $self->render(
+ $template,
+ description => "Abfahrtstafel $station_name",
+ departures => \@departures,
+ station => $efa->stop->name,
+ version => $self->config->{version},
+ title => $efa->stop->name // $station_name,
+ refresh_interval => $template eq 'app' ? 0 : 120,
+ hide_opts => $hide_opts,
+ hide_footer => $hide_opts,
+ hide_low_delay => $hide_low_delay,
+ show_realtime => $show_realtime,
+ load_marquee => (
+ $template eq 'single'
+ or $template eq 'multi'
+ ),
+ force_mobile => ( $template eq 'app' ),
+ );
+ }
+}
+
+# For HAFAS and IRIS departure elements
+sub render_board_hafas {
my ( $self, $data ) = @_;
my @results = @{ $data->{results} };
my @departures;
my @platforms = split( /,/, $self->param('platforms') // q{} );
- my $template = $self->param('mode') // 'app';
+ my $template = $self->param('mode') // 'app';
my $hide_low_delay = $self->param('hidelowdelay') // 0;
- my $hide_opts = $self->param('hide_opts') // 0;
- my $show_realtime = $self->param('show_realtime') // 0;
- my $show_details = $self->param('detailed') // 0;
- my $backend = $self->param('backend') // 'iris';
- my $admode = $self->param('admode') // 'deparr';
- my $apiver = $self->param('version') // 0;
- my $callback = $self->param('callback');
- my $via = $self->param('via');
+ my $hide_opts = $self->param('hide_opts') // 0;
+ my $show_realtime = $self->param('rt') // $self->param('show_realtime')
+ // 1;
+ my $show_details = $self->param('detailed') // 0;
+ my $admode = $self->param('admode') // 'deparr';
+ 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' );
if ( $self->param('ajax') ) {
delete $self->stash->{layout};
@@ -589,13 +2256,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;
@@ -609,64 +2275,117 @@ sub handle_result {
map { [ $self->numeric_platform_part( $_->platform ), $_ ] } @results;
}
- if ( $backend eq 'iris' and $show_realtime ) {
- if ( $admode eq 'arr' ) {
- @results = sort {
- ( $a->arrival // $a->departure )
- <=> ( $b->arrival // $b->departure )
- } @results;
+ if ($show_realtime) {
+ if ($hafas) {
+ @results = sort { $a->datetime <=> $b->datetime } @results;
+ }
+ elsif ( $admode eq 'arr' ) {
+ @results = map { $_->[1] }
+ sort { $a->[0] <=> $b->[0] }
+ map {
+ [
+ (
+ $_->sched_arrival ? $_->arrival_is_cancelled
+ : $_->is_cancelled
+ ) ? ( $_->sched_arrival // $_->sched_departure )
+ : ( $_->arrival // $_->departure ),
+ $_
+ ]
+ } @results;
}
else {
- @results = sort {
- ( $a->departure // $a->arrival )
- <=> ( $b->departure // $b->arrival )
- } @results;
+ @results = map { $_->[1] }
+ sort { $a->[0] <=> $b->[0] }
+ map {
+ [
+ (
+ $_->sched_departure ? $_->departure_is_cancelled
+ : $_->is_cancelled
+ ) ? ( $_->sched_departure // $_->sched_arrival )
+ : ( $_->departure // $_->arrival ),
+ $_
+ ]
+ } @results;
}
}
+ 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 ( $backend eq 'iris' and $admode eq 'arr' and not $result->arrival )
- {
+ if ( $admode eq 'arr' and not $hafas and not $result->arrival ) {
next;
}
- if ( $backend eq 'iris'
- and $admode eq 'dep'
+ if ( $admode eq 'dep'
+ and not $hafas
and not $result->departure )
{
next;
}
my ( $info, $moreinfo );
- if ( $backend eq 'iris' ) {
+ if ( $result->can('replacement_for') ) {
( $info, $moreinfo )
= $self->format_iris_result_info( $template, $result );
}
- else {
- ( $info, $moreinfo ) = $self->format_hafas_result_info($result);
- }
-
- my $time = $result->time;
- if ( $backend eq 'iris' ) {
+ my $time
+ = $result->can('time')
+ ? $result->time
+ : $result->sched_datetime->strftime('%H:%M');
+ my $linetype = 'bahn';
- # ->time defaults to dep, so we only need to overwrite $time
- # if we want arrival times
- if ( $admode eq 'arr' ) {
- $time = $result->sched_arrival->strftime('%H:%M');
+ if ( $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 ( $result->can('class') ) {
+ my $prod = $class_to_product->{ $result->class } // q{};
+ if ( $prod =~ m{ ^ ice? | inter-?cit }ix ) {
+ $linetype = 'fern';
+ }
+ elsif ( $prod =~ m{ s-bahn | urban | rapid }ix ) {
+ $linetype = 'sbahn';
}
+ elsif ( $prod =~ m{ bus }ix ) {
+ $linetype = 'bus';
+ }
+ elsif ( $prod =~ m{ metro | u-bahn | subway }ix ) {
+ $linetype = 'ubahn';
+ }
+ elsif ( $prod =~ m{ tram }ix ) {
+ $linetype = 'tram';
+ }
+ }
- if ($show_realtime) {
- if ( ( $admode eq 'arr' and $result->arrival )
- or not $result->departure )
- {
- $time = $result->arrival->strftime('%H:%M');
- }
- else {
- $time = $result->departure->strftime('%H:%M');
- }
+ # ->time defaults to dep, so we only need to overwrite $time
+ # if we want arrival times
+ if ( $admode eq 'arr' and not $hafas ) {
+ $time = $result->sched_arrival->strftime('%H:%M');
+ }
+
+ if ($show_realtime) {
+ 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');
+ }
+ else {
+ $time = $result->departure->strftime('%H:%M');
}
}
@@ -674,80 +2393,168 @@ sub handle_result {
if ($info) {
$info =~ s{ (?: ca [.] \s* )? [+] [ 1 2 3 4 ] $ }{}x;
}
- if ( $delay and $delay < 5 ) {
- $delay = undef;
- }
}
if ($info) {
$info =~ s{ (?: ca [.] \s* )? [+] (\d+) }{Verspätung ca $1 Min.}x;
}
if ( $template eq 'json' ) {
- my @json_route = $self->json_route_diff( [ $result->route ],
- [ $result->sched_route ] );
+ 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' ) {
- push(
- @departures,
+ if ( $apiver eq '1' or $apiver eq '2' ) {
+
+ # no longer supported
+ $self->handle_no_results_json(
+ undef,
{
- delay => $delay,
- destination => $result->destination,
- isCancelled => $result->can('is_cancelled')
- ? $result->is_cancelled
- : undef,
- messages => {
- delay => [
- map {
- {
- timestamp => $_->[0],
- text => $_->[1]
- }
- } $result->delay_messages
- ],
- qos => [
- map {
- {
- timestamp => $_->[0],
- text => $_->[1]
- }
- } $result->qos_messages
- ],
- },
- platform => $result->platform,
- route => \@json_route,
- scheduledPlatform => $result->sched_platform,
- time => $time,
- train => $result->train,
- via => [ $result->route_interesting(3) ],
- }
+ errstr =>
+ "JSON API version=${apiver} is no longer supported"
+ },
+ $Travel::Status::DE::IRIS::VERSION
);
+ return;
}
- elsif ( $apiver eq '2' ) {
- my ( $delay_arr, $delay_dep, $sched_arr, $sched_dep );
- if ( $result->arrival ) {
- $delay_arr = $result->arrival->subtract_datetime(
- $result->sched_arrival )->in_units('minutes');
- }
- if ( $result->departure ) {
- $delay_dep = $result->departure->subtract_datetime(
- $result->sched_departure )->in_units('minutes');
- }
- if ( $result->sched_arrival ) {
- $sched_arr = $result->sched_arrival->strftime('%H:%M');
+ elsif ( $apiver eq 'raw' ) {
+ push( @departures, $result );
+ }
+ else { # apiver == 3
+ if ( $result->isa('Travel::Status::DE::IRIS::Result') ) {
+ my ( $delay_arr, $delay_dep, $sched_arr, $sched_dep );
+ 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->can('is_cancelled')
- ? $result->is_cancelled
+ 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,
- messages => {
+ 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 {
{
@@ -765,188 +2572,104 @@ sub handle_result {
} $result->qos_messages
],
},
- platform => $result->platform,
- route => \@json_route,
- scheduledPlatform => $result->sched_platform,
- scheduledArrival => $sched_arr,
- scheduledDeparture => $sched_dep,
- train => $result->train,
- via => [ $result->route_interesting(3) ],
+ station => $result->station,
+ moreinfo => $moreinfo,
+ delay => $delay,
+ is_bit_delayed =>
+ ( $delay and $delay > 0 and $delay < 5 ? 1 : 0 ),
+ is_delayed => ( $delay and $delay >= 5 ? 1 : 0 ),
+ arrival_delay => $result->arrival_delay,
+ departure_delay => $result->departure_delay,
+ has_realtime => $result->has_realtime,
+ missing_realtime => (
+ not $result->has_realtime
+ and $result->start < $now ? 1 : 0
+ ),
+ 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_dt => $result->sched_departure,
+ eva => $result->station_uic,
}
);
}
- else { # apiver == 3
- my ( $delay_arr, $delay_dep, $sched_arr, $sched_dep );
- if ( $result->arrival ) {
- $delay_arr = $result->arrival->subtract_datetime(
- $result->sched_arrival )->in_units('minutes');
- }
- if ( $result->departure ) {
- $delay_dep = $result->departure->subtract_datetime(
- $result->sched_departure )->in_units('minutes');
- }
- if ( $result->sched_arrival ) {
- $sched_arr = $result->sched_arrival->strftime('%H:%M');
- }
- if ( $result->sched_departure ) {
- $sched_dep = $result->sched_departure->strftime('%H:%M');
+ else {
+ my $city = q{};
+ if ( $result->station =~ m{ , ([^,]+) $ }x ) {
+ $city = $1;
}
push(
@departures,
{
- delayArrival => $delay_arr,
- delayDeparture => $delay_dep,
- destination => $result->destination,
- isCancelled => $result->can('is_cancelled')
- ? $result->is_cancelled
+ time => $time,
+ sched_departure =>
+ ( $result->sched_datetime and $admode ne 'arr' )
+ ? $result->sched_datetime->strftime('%H:%M')
: undef,
- messages => {
- delay => [
- map {
- {
- timestamp => $_->[0],
- text => $_->[1]
- }
- } $result->delay_messages
- ],
- qos => [
- map {
- {
- timestamp => $_->[0],
- text => $_->[1]
- }
- } $result->qos_messages
- ],
- },
+ 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,
- 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) ],
+ scheduled_platform => $result->sched_platform,
+ load => $result->load // {},
+ info => $info,
+ is_cancelled => $result->is_cancelled,
+ linetype => $linetype,
+ station => $result->station,
+ moreinfo => $moreinfo,
+ delay => $delay,
+ is_bit_delayed =>
+ ( $delay and $delay > 0 and $delay < 5 ? 1 : 0 ),
+ is_delayed => ( $delay and $delay >= 5 ? 1 : 0 ),
+ has_realtime => defined $delay ? 1 : 0,
+ replaced_by => [],
+ replacement_for => [],
+ route_pre => $admode eq 'arr'
+ ? [ map { $_->loc->name } $result->route ]
+ : [],
+ route_post => $admode eq 'arr' ? []
+ : [ map { $_->loc->name } $result->route ],
+ wr_dt => $result->sched_datetime,
+ eva => $result->station_uic,
}
);
}
- }
- elsif ( $template eq 'text' ) {
- push(
- @departures,
- [
- sprintf( '%5s %s%s',
- $result->is_cancelled ? '--:--' : $time,
- ( $delay and $delay > 0 ) ? q{+} : q{},
- $delay || q{} ),
- $result->train,
- $result->destination,
- $platform // q{ }
- ]
- );
- }
- elsif ( $backend eq 'iris' ) {
- push(
- @departures,
- {
- time => $time,
- sched_arrival => $result->sched_arrival
- ? $result->sched_arrival->strftime('%H:%M')
- : undef,
- sched_departure => $result->sched_departure
- ? $result->sched_departure->strftime('%H:%M')
- : undef,
- arrival => $result->arrival
- ? $result->arrival->strftime('%H:%M')
- : undef,
- departure => $result->departure
- ? $result->departure->strftime('%H:%M')
- : undef,
- train => $result->train,
- train_type => $result->type // '',
- train_line => $result->line_no,
- train_no => $result->train_no,
- via => [ $result->route_interesting(3) ],
- destination => $result->destination,
- origin => $result->origin,
- platform => $result->platform,
- scheduled_platform => $result->sched_platform,
- info => $info,
- is_cancelled => $result->is_cancelled,
- departure_is_cancelled => $result->departure_is_cancelled,
- arrival_is_cancelled => $result->arrival_is_cancelled,
- messages => {
- delay => [
- map { { timestamp => $_->[0], text => $_->[1] } }
- $result->delay_messages
- ],
- qos => [
- map { { timestamp => $_->[0], text => $_->[1] } }
- $result->qos_messages
- ],
- },
- moreinfo => $moreinfo,
- delay => $delay,
- 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,
- }
- );
if ( $self->param('train') ) {
$self->render_train( $result, $departures[-1],
$data->{station_name} // $self->stash('station') );
return;
}
}
- else {
- push(
- @departures,
- {
- time => $time,
- train => $result->train,
- train_type => $result->type,
- destination => $result->destination,
- platform => $platform,
- changed_platform => $result->is_changed_platform,
- info => $info,
- is_cancelled => $result->can('is_cancelled')
- ? $result->is_cancelled
- : undef,
- messages => {
- delay => [],
- qos => [],
- },
- moreinfo => $moreinfo,
- delay => $delay,
- additional_stops => [],
- canceled_stops => [],
- replaced_by => [],
- replacement_for => [],
- }
- );
- }
}
if ( $template eq 'json' ) {
$self->res->headers->access_control_allow_origin(q{*});
- my $json = $self->render_to_string(
- json => {
- departures => \@departures,
- }
- );
+ my $json = {
+ departures => \@departures,
+ };
if ($callback) {
+ $json = $self->render_to_string( json => $json );
$self->render(
data => "$callback($json);",
format => 'json'
@@ -954,8 +2677,7 @@ sub handle_result {
}
else {
$self->render(
- data => $json,
- format => 'json'
+ json => $json,
);
}
}
@@ -978,14 +2700,40 @@ 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;
+ if ( not $hafas ) {
+ if ( $data->{station_eva} >= 8100000
+ and $data->{station_eva} < 8200000 )
+ {
+ $params->param( hafas => 'ÖBB' );
+ }
+ elsif ( $data->{station_eva} >= 8500000
+ and $data->{station_eva} < 8600000 )
+ {
+ $params->param( hafas => 'BLS' );
+ }
+ if ( $params->param('hafas') ) {
+ $api_link
+ = '/' . $data->{station_eva} . '?' . $params->to_string;
+ $api_text = 'Auf Nahverkehr wechseln';
+ $api_icon = 'train';
+ }
+ }
$self->render(
$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,
- version => $dbf_version,
+ station => $station_name,
+ version => $self->config->{version},
title => $via ? "$station_name → $via" : $station_name,
- refresh_interval => $template eq 'app' ? 0 : 120,
+ refresh_interval => $template eq 'app' ? 0 : 120,
hide_opts => $hide_opts,
+ hide_footer => $hide_opts,
hide_low_delay => $hide_low_delay,
show_realtime => $show_realtime,
load_marquee => (
@@ -993,6 +2741,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'),
+ hafas => $self->param('hafas')
+ }
+ ),
);
}
return;
@@ -1001,30 +2756,297 @@ 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 $efa_service = $self->param('efa');
+ my $hafas = $self->param('hafas');
if ( not $lon or not $lat ) {
$self->render( json => { error => 'Invalid lon/lat received' } );
+ return;
}
- else {
- my @candidates = map {
+
+ my $service = 'ÖBB';
+ if ( $hafas
+ and $hafas ne '1'
+ and Travel::Status::DE::HAFAS::get_service($hafas) )
+ {
+ $service = $hafas;
+ }
+
+ $self->render_later;
+
+ if ($efa_service) {
+ Travel::Status::DE::EFA->new_p(
+ promise => 'Mojo::Promise',
+ user_agent => $self->ua,
+ service => $efa_service,
+ coord => {
+ lat => $lat,
+ lon => $lon
+ }
+ )->then(
+ sub {
+ my ($efa) = @_;
+ my @efa = map {
+ {
+ name => $_->full_name,
+ eva => $_->id =~ s{:}{%3A}gr,
+ distance => $_->distance_m / 1000,
+ efa => $efa_service,
+ }
+ } $efa->results;
+ $self->render(
+ json => {
+ candidates => [@efa],
+ }
+ );
+ }
+ )->catch(
+ sub {
+ my ($err) = @_;
+ $self->render(
+ json => {
+ candidates => [],
+ warning => $err,
+ }
+ );
+ }
+ )->wait;
+ return;
+ }
+
+ my @iris = map {
+ {
+ ds100 => $_->[0][0],
+ 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 => $service eq 'PKP' ? Mojo::UserAgent->new : $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 backend_list {
+ my ($self) = @_;
+
+ my %place_map = (
+ AT => 'Österreich',
+ CH => 'Schweiz',
+ 'CH-BE' => 'Kanton Bern',
+ 'CH-GE' => 'Kanton Genf',
+ 'CH-LU' => 'Kanton Luzern',
+ 'CH-ZH' => 'Kanton Zürich',
+ DE => 'Deutschland',
+ 'DE-BB' => 'Brandenburg',
+ 'DE-BW' => 'Baden-Württemberg',
+ 'DE-BE' => 'Berlin',
+ 'DE-BY' => 'Bayern',
+ 'DE-HB' => 'Bremen',
+ 'DE-HE' => 'Hessen',
+ 'DE-MV' => 'Mecklenburg-Vorpommern',
+ 'DE-NI' => 'Niedersachsen',
+ 'DE-NW' => 'Nordrhein-Westfalen',
+ 'DE-RP' => 'Rheinland-Pfalz',
+ 'DE-SH' => 'Schleswig-Holstein',
+ 'DE-ST' => 'Sachsen-Anhalt',
+ 'DE-TH' => 'Thüringen',
+ DK => 'Dänemark',
+ 'GB-NIR' => 'Nordirland',
+ LI => 'Liechtenstein',
+ LU => 'Luxembourg',
+ IE => 'Irland',
+ 'US-CA' => 'California',
+ 'US-TX' => 'Texas',
+ );
+
+ my @backends = (
+ {
+ name => 'Deutsche Bahn',
+ type => 'IRIS-TTS',
+ }
+ );
+
+ for my $backend ( Travel::Status::DE::EFA::get_services() ) {
+ push(
+ @backends,
{
- 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],
+ name => $backend->{name},
+ shortname => $backend->{shortname},
+ homepage => $backend->{homepage},
+ regions => [
+ map { $place_map{$_} // $_ }
+ @{ $backend->{coverage}{regions} }
+ ],
+ has_area => $backend->{coverage}{area} ? 1 : 0,
+ type => 'EFA',
+ efa => 1,
+ }
+ );
+ }
+
+ for my $backend ( Travel::Status::DE::HAFAS::get_services() ) {
+ if ( $backend->{shortname} eq 'DB' ) {
+
+ # HTTP 503 Service Temporarily Unavailable as of 2025-01-08 ~10:30 UTC
+ # (I bet it's actually Permanently Unavailable)
+ next;
+ }
+ if ( $backend->{shortname} eq 'VRN' ) {
+
+ # HTTP 403 Forbidden as of 2025-03-03
+ next;
+ }
+ push(
+ @backends,
+ {
+ name => $backend->{name},
+ shortname => $backend->{shortname},
+ homepage => $backend->{homepage},
+ regions => [
+ map { $place_map{$_} // $_ }
+ @{ $backend->{coverage}{regions} }
+ ],
+ has_area => $backend->{coverage}{area} ? 1 : 0,
+ type => 'HAFAS',
+ hafas => 1,
}
);
}
+
+ $self->render(
+ 'select_backend',
+ backends => \@backends,
+ hide_opts => 1,
+ hide_footer => 1
+ );
+}
+
+sub autocomplete {
+ my ($self) = @_;
+
+ $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('efa') ) {
+ $params->remove('hafas');
+ $params = $params->to_string;
+ $self->redirect_to("/${input}?${params}");
+ }
+ elsif ( $params->param('hafas') and $params->param('hafas') ne '1' ) {
+ $params->remove('efa');
+ $params = $params->to_string;
+ $self->redirect_to("/${input}?${params}");
+ }
+ else {
+ $params->remove('efa');
+ my @candidates
+ = Travel::Status::DE::IRIS::Stations::get_station($input);
+ if (
+ @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}");
+ }
}
1;
diff --git a/lib/DBInfoscreen/Controller/Wagenreihung.pm b/lib/DBInfoscreen/Controller/Wagenreihung.pm
index ecdb129..b9f0ee3 100644
--- a/lib/DBInfoscreen/Controller/Wagenreihung.pm
+++ b/lib/DBInfoscreen/Controller/Wagenreihung.pm
@@ -1,77 +1,267 @@
package DBInfoscreen::Controller::Wagenreihung;
+
+# Copyright (C) 2011-2020 Birte Kristina Friesel
+#
+# SPDX-License-Identifier: AGPL-3.0-or-later
+
use Mojo::Base 'Mojolicious::Controller';
+use Mojo::JSON qw(decode_json encode_json);
+use Mojo::Util qw(b64_encode b64_decode);
-# Copyright (C) 2011-2019 Daniel Friesel <derf+dbf@finalrewind.org>
-# License: 2-Clause BSD
+use utf8;
-use Travel::Status::DE::DBWagenreihung;
+use Travel::Status::DE::DBRIS::Formation;
-my $dbf_version = qx{git describe --dirty} || 'experimental';
+sub handle_wagenreihung_error {
+ my ( $self, $train, $err ) = @_;
-chomp $dbf_version;
+ $self->render(
+ 'wagenreihung',
+ title => $train,
+ wr_error => $err,
+ wr => undef,
+ wref => undef,
+ hide_opts => 1,
+ status => 500,
+ );
+}
sub wagenreihung {
- my ($self) = @_;
- my $train = $self->stash('train');
- my $departure = $self->stash('departure');
+ my ($self) = @_;
+ my $exit_side = $self->param('e');
+
+ my $train_type = $self->param('category');
+ my $train_no = $self->param('number');
+ my $train = "${train_type} ${train_no}";
$self->render_later;
- $self->wagonorder->get_p( $train, $departure )->then(
+ $self->wagonorder->get_p( param => $self->req->query_params->to_hash )
+ ->then(
sub {
my ($json) = @_;
my $wr;
eval {
$wr
- = Travel::Status::DE::DBWagenreihung->new(
- from_json => $json );
+ = Travel::Status::DE::DBRIS::Formation->new( json => $json );
};
if ($@) {
- $self->render(
- 'wagenreihung',
- title => "Zug $train",
- wr_error => scalar $@,
- train_no => $train,
- wr => undef,
- hide_opts => 1,
- );
+ $self->handle_wagenreihung_error( $train, scalar $@ );
+ return;
+ }
+
+ if ( $exit_side and $exit_side =~ m{^a} ) {
+ if ( $wr->sectors and defined $wr->direction ) {
+ my $section_0 = ( $wr->sectors )[0];
+ my $direction = $wr->direction;
+ if ( $section_0->name eq 'A' and $direction == 0 ) {
+ $exit_side =~ s{^a}{};
+ }
+ elsif ( $section_0->name ne 'A' and $direction == 100 ) {
+ $exit_side =~ s{^a}{};
+ }
+ else {
+ $exit_side = ( $exit_side eq 'ar' ) ? 'l' : 'r';
+ }
+ }
+ else {
+ $exit_side = undef;
+ }
}
- if ( $wr->has_bad_wagons ) {
+ my $wref = {
+ e => $exit_side ? substr( $exit_side, 0, 1 ) : '',
+ tt => $wr->train_type,
+ tn => $train_no,
+ p => $wr->platform
+ };
+
+ #if ( $wr->has_bad_wagons ) {
+
+ # # create fake positions as the correct ones are not available
+ # my $pos = 0;
+ # for my $wagon ( $wr->wagons ) {
+ # $wagon->{position}{start_percent} = $pos;
+ # $wagon->{position}{end_percent} = $pos + 4;
+ # $pos += 4;
+ # }
+ #}
+ if ( defined $wr->direction and scalar $wr->carriages > 2 ) {
+
+ # wagenlexikon images only know one orientation. They assume
+ # that the second class (i.e., the wagon with the lowest
+ # wagon number) is in the leftmost carriage(s). We define the
+ # wagon with the lowest start_percent value to be leftmost
+ # and invert the direction passed on to $wref if it is not
+ # the wagon with the lowest wagon number.
- # create fake positions as the correct ones are not available
- my $pos = 0;
- for my $wagon ( $wr->wagons ) {
- $wagon->{position}{start_percent} = $pos;
- $wagon->{position}{end_percent} = $pos + 4;
- $pos += 4;
+ # Note that we need to check both the first two and the last two
+ # wagons as the train may consist of several wings. If their
+ # order differs, we do not show a direction, as we do not
+ # handle that case yet.
+
+ my @wagons = $wr->carriages;
+
+ # skip first/last wagon as it may be a locomotive
+ my $wna1 = $wagons[1]->number;
+ my $wna2 = $wagons[2]->number;
+ my $wnb1 = $wagons[-3]->number;
+ my $wnb2 = $wagons[-2]->number;
+ my $wpa1 = $wagons[1]->start_percent;
+ my $wpa2 = $wagons[2]->start_percent;
+ my $wpb1 = $wagons[-3]->start_percent;
+ my $wpb2 = $wagons[-2]->start_percent;
+
+ if ( $wna1 =~ m{^\d+$}
+ and $wna2 =~ m{^\d+$}
+ and $wnb1 =~ m{^\d+$}
+ 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)
+
+ # However, if wpa/wna und wpb/wnb do not match, we have a
+ # winged train with different normalization requirements
+ # in its wings. We do not handle that case yet.
+ if ( ( $wna1 <=> $wna2 ) != ( $wnb1 <=> $wnb2 ) ) {
+
+ # unhandled. Do not set $wref->{d}.
+ }
+ elsif (( $wpa1 < $wpa2 and $wna1 > $wna2 )
+ or ( $wpa1 > $wpa2 and $wna1 < $wna2 ) )
+ {
+ # perform normalization
+ $wref->{d} = 100 - $wr->direction;
+ }
+ else {
+ # no normalization required
+ $wref->{d} = $wr->direction;
+ }
+ }
+ }
+
+ my $exit_dir = 'unknown';
+ if ( defined $wr->direction and $exit_side ) {
+ if ( $wr->direction == 0 and $exit_side eq 'l' ) {
+ $exit_dir = 'left';
+ }
+ elsif ( $wr->direction == 0 and $exit_side eq 'r' ) {
+ $exit_dir = 'right';
+ }
+ elsif ( $wr->direction == 100 and $exit_side eq 'l' ) {
+ $exit_dir = 'right';
+ }
+ elsif ( $wr->direction == 100 and $exit_side eq 'r' ) {
+ $exit_dir = 'left';
}
}
+ $wref = b64_encode( encode_json($wref) );
+
+ my $title = join( ' / ', map { $_->{name} } $wr->trains );
+
$self->render(
'wagenreihung',
- wr_error => undef,
- title => join( ' / ',
- map { $wr->train_type . ' ' . $_ } $wr->train_numbers ),
- train_no => $train,
- wr => $wr,
- hide_opts => 1,
+ description => sprintf( 'Ist-Wagenreihung %s', $title ),
+ wr_error => undef,
+ title => $title,
+ wr => $wr,
+ wref => $wref,
+ exit_dir => $exit_dir,
+ hide_opts => 1,
+ ts => $json->{ts},
);
}
- )->catch(
+ )->catch(
sub {
my ($err) = @_;
- $self->render(
- 'wagenreihung',
- title => "Zug $train",
- wr_error => scalar $err,
- train_no => $train,
- wr => undef,
- hide_opts => 1,
- );
+
+ $self->handle_wagenreihung_error( $train,
+ $err // "Unbekannter Fehler" );
+ return;
+ }
+ )->wait;
+
+}
+
+sub wagen {
+ my ($self) = @_;
+ my $wagon_id = $self->stash('wagon');
+ my $wagon_no = $self->param('n');
+ my $section = $self->param('s');
+ my $wref = $self->param('r');
+
+ if ( not $self->app->dbdb_wagon->{$wagon_id} ) {
+ $self->render(
+ 'not_found',
+ message => "Keine Daten zu Wagentyp \"${wagon_id}\" vorhanden",
+ hide_opts => 1
+ );
+ return;
+ }
+
+ eval { $wref = decode_json( b64_decode($wref) ); };
+ if ($@) {
+ $wref = {};
+ }
+
+ $wref->{wn} = $wagon_no;
+ $wref->{ws} = $section;
+
+ my @wagon_files
+ = ("https://lib.finalrewind.org/dbdb/db_wagen/${wagon_id}.png");
+
+ if ( $self->app->dbdb_wagon->{"${wagon_id}_u"} ) {
+ @wagon_files = (
+ "https://lib.finalrewind.org/dbdb/db_wagen/${wagon_id}_u.png",
+ "https://lib.finalrewind.org/dbdb/db_wagen/${wagon_id}_l.png"
+ );
+ }
+
+ 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;
+ }
+ else {
+ $title .= ' Wagen ' . $wagon_id;
+ }
+ }
+
+ if ( defined $wref->{d} and $wref->{e} ) {
+ if ( $wref->{d} == 0 and $wref->{e} eq 'l' ) {
+ $wref->{e} = 'd';
+ }
+ elsif ( $wref->{d} == 0 and $wref->{e} eq 'r' ) {
+ $wref->{e} = 'u';
+ }
+ elsif ( $wref->{d} == 100 and $wref->{e} eq 'l' ) {
+ $wref->{e} = 'u';
+ }
+ elsif ( $wref->{d} == 100 and $wref->{e} eq 'r' ) {
+ $wref->{e} = 'd';
}
- )->wait;
+ }
+ else {
+ $wref->{e} = '';
+ }
+ $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},
+ wref => $wref,
+ hide_opts => 1,
+ );
}
1;
diff --git a/lib/DBInfoscreen/Helper/DBRIS.pm b/lib/DBInfoscreen/Helper/DBRIS.pm
new file mode 100644
index 0000000..e780213
--- /dev/null
+++ b/lib/DBInfoscreen/Helper/DBRIS.pm
@@ -0,0 +1,93 @@
+package DBInfoscreen::Helper::DBRIS;
+
+# Copyright (C) 2025 Birte Kristina Friesel
+#
+# SPDX-License-Identifier: AGPL-3.0-or-later
+
+use strict;
+use warnings;
+use 5.020;
+
+use DateTime;
+use Encode qw(decode encode);
+use Travel::Status::DE::DBRIS;
+use Mojo::JSON qw(decode_json);
+use Mojo::Promise;
+use Mojo::UserAgent;
+
+sub new {
+ my ( $class, %opt ) = @_;
+
+ my $version = $opt{version};
+
+ $opt{header}
+ = { 'User-Agent' =>
+"dbf/${version} on $opt{root_url} +https://finalrewind.org/projects/db-fakedisplay"
+ };
+
+ return bless( \%opt, $class );
+
+}
+
+sub get_journey_p {
+ my ( $self, %opt ) = @_;
+
+ my $agent = $self->{user_agent};
+
+ if ( my $proxy = $ENV{DBFAKEDISPLAY_DBRIS_PROXY} ) {
+ $agent = Mojo::UserAgent->new;
+ $agent->proxy->http($proxy);
+ $agent->proxy->https($proxy);
+ }
+
+ return Travel::Status::DE::DBRIS->new_p(
+ journey => $opt{id},
+ cache => $self->{realtime_cache},
+ promise => 'Mojo::Promise',
+ user_agent => $agent->request_timeout(10)
+ );
+}
+
+# Input: TripID
+# Output: Promise returning a Travel::Status::DE::DBRIS::Journey instance on success
+sub get_polyline_p {
+ my ( $self, %opt ) = @_;
+
+ my $trip_id = $opt{id};
+ my $promise = Mojo::Promise->new;
+
+ my $agent = $self->{user_agent};
+
+ if ( my $proxy = $ENV{DBFAKEDISPLAY_DBRIS_PROXY} ) {
+ $agent = Mojo::UserAgent->new;
+ $agent->proxy->http($proxy);
+ $agent->proxy->https($proxy);
+ }
+
+ Travel::Status::DE::DBRIS->new_p(
+ journey => $trip_id,
+ with_polyline => 1,
+ cache => $self->{realtime_cache},
+ promise => 'Mojo::Promise',
+ user_agent => $agent->request_timeout(10)
+ )->then(
+ sub {
+ my ($dbris) = @_;
+ my $journey = $dbris->result;
+
+ $promise->resolve($journey);
+ return;
+ }
+ )->catch(
+ sub {
+ my ($err) = @_;
+ $self->{log}->debug("DBRIS->new_p($trip_id) error: $err");
+ $promise->reject($err);
+ return;
+ }
+ )->wait;
+
+ return $promise;
+}
+
+1;
diff --git a/lib/DBInfoscreen/Helper/EFA.pm b/lib/DBInfoscreen/Helper/EFA.pm
new file mode 100644
index 0000000..0e7f7d7
--- /dev/null
+++ b/lib/DBInfoscreen/Helper/EFA.pm
@@ -0,0 +1,162 @@
+package DBInfoscreen::Helper::EFA;
+
+# Copyright (C) 2020-2022 Birte Kristina Friesel
+#
+# SPDX-License-Identifier: AGPL-3.0-or-later
+
+use strict;
+use warnings;
+use 5.020;
+
+use DateTime;
+use Encode qw(decode encode);
+use Mojo::JSON qw(decode_json);
+use Mojo::Promise;
+use Mojo::Util qw(url_escape);
+use Travel::Status::DE::EFA;
+
+sub new {
+ my ( $class, %opt ) = @_;
+
+ my $version = $opt{version};
+
+ $opt{header}
+ = { 'User-Agent' =>
+"dbf/${version} on $opt{root_url} +https://finalrewind.org/projects/db-fakedisplay"
+ };
+
+ return bless( \%opt, $class );
+
+}
+
+sub get_polyline_p {
+ my ( $self, %opt ) = @_;
+
+ my $stopseq = $opt{stopseq};
+ my $service = $opt{service};
+ my $promise = Mojo::Promise->new;
+
+ Travel::Status::DE::EFA->new_p(
+ service => $service,
+ stopseq => $stopseq,
+ cache => $self->{realtime_cache},
+ promise => 'Mojo::Promise',
+ user_agent => $self->{user_agent}->request_timeout(10)
+ )->then(
+ sub {
+ my ($efa) = @_;
+ my $journey = $efa->result;
+
+ $promise->resolve($journey);
+ return;
+ }
+ )->catch(
+ sub {
+ my ($err) = @_;
+ $self->{log}->debug("EFA->new_p($stopseq) error: $err");
+ $promise->reject($err);
+ return;
+ }
+ )->wait;
+
+ return $promise;
+}
+
+sub get_coverage {
+ my ( $self, $service ) = @_;
+
+ my $service_definition = Travel::Status::DE::EFA::get_service($service);
+
+ if ( not $service_definition ) {
+ return {};
+ }
+
+ return $service_definition->{coverage}{area} // {};
+}
+
+sub get_json_p {
+ my ( $self, $cache, $url ) = @_;
+
+ my $promise = Mojo::Promise->new;
+
+ if ( my $content = $cache->thaw($url) ) {
+ $self->{log}->debug("efa->get_json_p($url): cached");
+ if ( $content->{error} ) {
+ return $promise->reject( $content->{error} );
+ }
+ return $promise->resolve($content);
+ }
+
+ $self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} )
+ ->then(
+ sub {
+ my ($tx) = @_;
+
+ if ( my $err = $tx->error ) {
+ $self->{log}->debug(
+ "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}");
+ return;
+ }
+
+ my $res = $tx->res->json;
+
+ if ( not $res ) {
+ $self->{log}->debug("efa->get_json_p($url): empty response");
+ $promise->reject("GET $url returned empty response");
+ return;
+ }
+
+ $cache->freeze( $url, $res );
+
+ $promise->resolve($res);
+
+ return;
+ }
+ )->catch(
+ sub {
+ my ($err) = @_;
+ $self->{log}->debug("efa->get_json_p($url): $err");
+ $cache->freeze( $url, { error => $err } );
+ $promise->reject($err);
+ return;
+ }
+ )->wait;
+
+ return $promise;
+}
+
+sub get_efa_occupancy {
+ my ( $self, %opt ) = @_;
+
+ my $eva = $opt{eva};
+ my $train_no = $opt{train_no};
+ my $promise = Mojo::Promise->new;
+
+ $self->get_json_p( $self->{realtime_cache},
+ "https://vrrf.finalrewind.org/_eva/occupancy-by-eva/${eva}.json" )
+ ->then(
+ sub {
+ my ($utilization_json) = @_;
+
+ if ( $utilization_json->{train}{$train_no}{occupancy} ) {
+ $promise->resolve(
+ $utilization_json->{train}{$train_no}{occupancy} );
+ return;
+ }
+ $promise->reject;
+ 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 0206bed..e16bad8 100644
--- a/lib/DBInfoscreen/Helper/HAFAS.pm
+++ b/lib/DBInfoscreen/Helper/HAFAS.pm
@@ -1,14 +1,20 @@
package DBInfoscreen::Helper::HAFAS;
+# Copyright (C) 2011-2022 Birte Kristina Friesel
+#
+# SPDX-License-Identifier: AGPL-3.0-or-later
+
use strict;
use warnings;
use 5.020;
+use utf8;
use DateTime;
use Encode qw(decode encode);
+use Travel::Status::DE::HAFAS;
use Mojo::JSON qw(decode_json);
use Mojo::Promise;
-use XML::LibXML;
+use Mojo::UserAgent;
sub new {
my ( $class, %opt ) = @_;
@@ -24,301 +30,237 @@ sub new {
}
-sub get_json_p {
- my ( $self, $cache, $url ) = @_;
+sub get_coverage {
+ my ( $self, $service ) = @_;
- my $promise = Mojo::Promise->new;
+ my $service_definition = Travel::Status::DE::HAFAS::get_service($service);
- if ( my $content = $cache->thaw($url) ) {
- return $promise->resolve($content);
+ if ( not $service_definition ) {
+ return {};
}
- $self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} )
- ->then(
- sub {
- my ($tx) = @_;
-
- 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;
- }
- my $body
- = encode( 'utf-8', decode( 'ISO-8859-15', $tx->res->body ) );
-
- $body =~ s{^TSLs[.]sls = }{};
- $body =~ s{;$}{};
- $body =~ s{&#x0028;}{(}g;
- $body =~ s{&#x0029;}{)}g;
-
- my $json = decode_json($body);
-
- $cache->freeze( $url, $json );
-
- $promise->resolve($json);
- return;
- }
- )->catch(
- sub {
- my ($err) = @_;
- $self->{log}->warn("get($url): $err");
- $promise->reject($err);
- return;
- }
- )->wait;
-
- return $promise;
+ return $service_definition->{coverage}{area} // {};
}
-sub get_xml_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);
- }
-
- $self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} )
- ->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 $hafas_promise;
- my $body = decode( 'ISO-8859-15', $tx->res->body );
+ my $agent = $self->{user_agent};
+ if ( $opt{service} and $opt{service} eq 'PKP' ) {
- # <SDay text="... &gt; ..."> is invalid HTML, but present
- # regardless. As it is the last tag, we just throw it away.
- $body =~ s{<SDay [^>]*/>}{}s;
-
- my $tree;
+ # PKP needs proxying
+ $agent = Mojo::UserAgent->new;
+ }
- eval { $tree = XML::LibXML->load_xml( string => $body ) };
+ if ( $opt{trip_id} ) {
+ $hafas_promise = Travel::Status::DE::HAFAS->new_p(
+ service => $opt{service} // 'ÖBB',
+ journey => {
+ id => $opt{trip_id},
+ },
+ language => $opt{language},
+ cache => $self->{realtime_cache},
+ promise => 'Mojo::Promise',
+ user_agent => $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};
+ }
- if ($@) {
- $cache->freeze( $url, {} );
- $promise->reject;
- return;
- }
+ $hafas_promise //= Travel::Status::DE::HAFAS->new_p(
+ service => $opt{service} // 'ÖBB',
+ journeyMatch => $opt{train_req} =~ s{^- }{}r,
+ datetime => ( $opt{train} ? $opt{train}->start : $opt{datetime} ),
+ language => $opt{language},
+ cache => $self->{realtime_cache},
+ promise => 'Mojo::Promise',
+ user_agent => $agent->request_timeout(10)
+ )->then(
+ sub {
+ my ($hafas) = @_;
+ my @results = $hafas->results;
- 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,
- };
+ if ( not @results ) {
+ return Mojo::Promise->reject(
+ "journeyMatch($opt{train_req}) found no results");
}
- for my $message ( $tree->findnodes('/Journey/HIMMessage') ) {
- my $header = $message->getAttribute('header');
- my $lead = $message->getAttribute('lead');
- my $display = $message->getAttribute('display');
- push(
- @{ $ret->{messages} },
+ 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} )
{
- header => $header,
- lead => $lead,
- display => $display
+ $result = $journey;
+ last;
}
- );
+ }
}
- $cache->freeze( $url, $ret );
- $promise->resolve($ret);
-
- return;
- }
- )->catch(
- sub {
+ return Travel::Status::DE::HAFAS->new_p(
+ service => $opt{service} // 'ÖBB',
+ journey => {
+ id => $result->id,
+ },
+ language => $opt{language},
+ cache => $self->{realtime_cache},
+ promise => 'Mojo::Promise',
+ user_agent => $agent->request_timeout(10)
+ );
}
- )->wait;
-}
-
-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');
- }
-
- my $promise = Mojo::Promise->new;
+ );
- $self->get_json_p( $self->{realtime_cache},
- "${base}&date=$opt{date_yy}&trainname=$opt{train_no}" )->then(
+ $hafas_promise->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} )
- )
+ my ($hafas) = @_;
+ my $journey = $hafas->result;
+ my @ret;
+ my $station_is_past = 1;
+
+ 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 )
{
- # 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;
- }
+ $num_operators++;
+ $prev_operator = $prod->operator;
+ }
+ if ( $stop->direction and $stop->direction ne $prev_direction )
+ {
+ $num_directions++;
+ $prev_direction = $stop->direction;
}
}
- 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 {
- $promise->reject("Zug $opt{train_no} 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) = @_;
- $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;
-
- 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_no} = $opt{train}->type . ' ' . $opt{train}->train_no;
- $opt{train_origin} = $opt{train}->origin;
- }
- else {
- my $now = DateTime->now( time_zone => 'Europe/Berlin' );
- $opt{date_yy} = $now->strftime('%d.%m.%y');
- $opt{date_yyyy} = $now->strftime('%d.%m.%Y');
- }
+ $prev_name = q{};
+ $prev_direction = q{};
+ $prev_operator = q{};
- my $base = 'https://reiseauskunft.bahn.de/bin/traininfo.exe/dn';
- my ( $trainsearch_result, $trainlink, $traininfo );
+ for my $stop ( $journey->route ) {
- $self->trainsearch_p(%opt)->then(
- sub {
- ($trainsearch_result) = @_;
- $trainlink = $trainsearch_result->{trainLink};
- return $self->get_json_p( $self->{realtime_cache},
- "${base}/${trainlink}?rt=1&date=$opt{date_yy}&L=vs_json" );
- }
- )->then(
- sub {
- ($traininfo) = @_;
- if ( not $traininfo or $traininfo->{error} ) {
- $promise->reject;
- return;
- }
- return $self->get_xml_p( $self->{realtime_cache},
- "${base}/${trainlink}?rt=1&date=$opt{date_yy}&L=vs_java3" );
- }
- )->then(
- sub {
- my ($traindelay) = @_;
- my $ret = {};
+ 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 )
+ {
+ $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;
+ }
- my $strp = DateTime::Format::Strptime->new(
- pattern => '%d.%m.%y %H:%M',
- time_zone => 'Europe/Berlin',
- );
+ if (%annotation) {
+ $annotation{is_annotated} = 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+$} )
+ push(
+ @ret,
{
- $ret->{$name}{rt_arr} = $ret->{$name}{sched_arr}
- ->clone->add( minutes => $delay->{adelay} );
+ 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,
}
- 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 (
+ $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
+ )
+ {
+ $station_is_past = 0;
+ }
+ $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 ( $stop->sched_dep ) {
+ $ret[-1]{local_sched_dep}
+ = $stop->sched_dep->clone->add(
+ minutes => $stop->tz_offset );
+ }
+ 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[-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;
@@ -327,55 +269,44 @@ 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 $url
- = "https://2.db.transport.rest/trips/${trip_id}?lineName=${line}&polyline=true";
- my $cache = $self->{realtime_cache};
+ my $trip_id = $opt{id};
+ my $line = $opt{line};
+ my $service = $opt{service} // 'ÖBB';
my $promise = Mojo::Promise->new;
- if ( my $content = $cache->thaw($url) ) {
- $promise->resolve($content);
- $self->{log}->debug("GET $url (cached)");
- return $promise;
+ my $agent = $self->{user_agent};
+ if ( $opt{service} and $opt{service} eq 'PKP' ) {
+
+ # PKP needs proxying
+ $agent = Mojo::UserAgent->new;
}
- $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 => $agent->request_timeout(10)
+ )->then(
sub {
- my ($tx) = @_;
- $self->{log}->debug("GET $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 $url (error: $err)");
+ $self->{log}->debug("HAFAS->new_p($trip_id, $line) error: $err");
$promise->reject($err);
return;
}
diff --git a/lib/DBInfoscreen/Helper/MOTIS.pm b/lib/DBInfoscreen/Helper/MOTIS.pm
new file mode 100644
index 0000000..002a601
--- /dev/null
+++ b/lib/DBInfoscreen/Helper/MOTIS.pm
@@ -0,0 +1,82 @@
+package DBInfoscreen::Helper::MOTIS;
+
+# Copyright (C) 2025 networkException <git@nwex.de>
+#
+# SPDX-License-Identifier: AGPL-3.0-or-later
+
+use strict;
+use warnings;
+use 5.020;
+
+use DateTime;
+use Encode qw(decode encode);
+use Travel::Status::MOTIS;
+use Mojo::JSON qw(decode_json);
+use Mojo::Promise;
+
+sub new {
+ my ( $class, %opt ) = @_;
+
+ my $version = $opt{version};
+
+ $opt{header}
+ = { 'User-Agent' =>
+"dbf/${version} on $opt{root_url} +https://finalrewind.org/projects/db-fakedisplay"
+ };
+
+ return bless( \%opt, $class );
+
+}
+
+sub get_coverage {
+ my ( $self, $service ) = @_;
+
+ my $service_definition = Travel::Status::MOTIS::get_service($service);
+
+ if ( not $service_definition ) {
+ return {};
+ }
+
+ return $service_definition->{coverage}{area} // {};
+}
+
+# Input: TripID
+# Output: Promise returning a Travel::Status::MOTIS::Trip instance on success
+sub get_polyline_p {
+ my ( $self, %opt ) = @_;
+
+ my $trip_id = $opt{id};
+ my $service = $opt{service} // 'transitous';
+
+ my $promise = Mojo::Promise->new;
+
+ my $agent = $self->{user_agent};
+
+ Travel::Status::MOTIS->new_p(
+ cache => $self->{realtime_cache},
+ promise => 'Mojo::Promise',
+ user_agent => $agent->request_timeout(10),
+
+ service => $service,
+ trip_id => $trip_id,
+ )->then(
+ sub {
+ my ($motis) = @_;
+ my $trip = $motis->result;
+
+ $promise->resolve($trip);
+ return;
+ }
+ )->catch(
+ sub {
+ my ($err) = @_;
+ $self->{log}->debug("MOTIS->new_p($trip_id) error: $err");
+ $promise->reject($err);
+ return;
+ }
+ )->wait;
+
+ return $promise;
+}
+
+1;
diff --git a/lib/DBInfoscreen/Helper/Wagonorder.pm b/lib/DBInfoscreen/Helper/Wagonorder.pm
index 5f0555d..9981244 100644
--- a/lib/DBInfoscreen/Helper/Wagonorder.pm
+++ b/lib/DBInfoscreen/Helper/Wagonorder.pm
@@ -1,9 +1,14 @@
package DBInfoscreen::Helper::Wagonorder;
+# Copyright (C) 2011-2020 Birte Kristina Friesel
+#
+# SPDX-License-Identifier: AGPL-3.0-or-later
+
use strict;
use warnings;
use 5.020;
+use DateTime;
use Mojo::Promise;
sub new {
@@ -20,113 +25,117 @@ sub new {
}
-sub is_available_p {
- my ( $self, $train, $wr_link ) = @_;
- my $promise = Mojo::Promise->new;
+sub get_p {
+ my ( $self, %opt ) = @_;
- $self->check_wagonorder_p( $train->train_no, $wr_link )->then(
- sub {
- $promise->resolve;
- 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 {
- $promise->resolve;
- return;
- },
- sub {
- $promise->reject;
- return;
- }
- )->wait;
+ my %param;
- return $promise;
-}
+ if ( $opt{param} ) {
+ %param = %{ $opt{param} };
+ delete $param{e};
+ }
+ else {
+ my $datetime = $opt{datetime}->clone->set_time_zone('UTC');
+ %param = (
+ administrationId => 80,
+ category => $opt{train_type},
+ date => $datetime->strftime('%Y-%m-%d'),
+ evaNumber => $opt{eva},
+ number => $opt{train_number},
+ time => $datetime->rfc3339 =~ s{(?=Z)}{.000}r
+ );
+ }
-sub check_wagonorder_p {
- my ( $self, $train_no, $wr_link ) = @_;
+ my $url = sprintf( '%s?%s',
+'https://www.bahn.de/web/api/reisebegleitung/wagenreihung/vehicle-sequence',
+ join( '&', map { $_ . '=' . $param{$_} } sort keys %param ) );
my $promise = Mojo::Promise->new;
- my $url
- = "https://lib.finalrewind.org/dbdb/has_wagonorder/${train_no}/${wr_link}";
- my $cache = $self->{main_cache};
-
- if ( my $content = $cache->get($url) ) {
- if ( $content eq 'y' ) {
- return $promise->resolve;
+ if ( my $content = $self->{main_cache}->thaw($url) ) {
+ $self->{log}->debug("wagonorder->get_p($url): cached");
+ if ( $content->{error} ) {
+ return $promise->reject(
+"GET $url: HTTP $content->{error}{code} $content->{error}{message} (cachd)"
+ );
}
- else {
- return $promise->reject;
+ return $promise->resolve( $content, \%param );
+ }
+
+ if ( my $content = $self->{realtime_cache}->thaw($url) ) {
+ $self->{log}->debug("wagonorder->get_p($url): cached");
+ if ( $content->{error} ) {
+ return $promise->reject(
+"GET $url: HTTP $content->{error}{code} $content->{error}{message} (cachd)"
+ );
}
+ return $promise->resolve( $content, \%param );
}
- $self->{user_agent}->request_timeout(5)->head_p( $url => $self->{header} )
+ $self->{user_agent}->request_timeout(10)->get_p( $url => $self->{header} )
->then(
sub {
my ($tx) = @_;
- if ( $tx->result->is_success ) {
- $cache->set( $url, 'y' );
- $promise->resolve;
- }
- else {
- $cache->set( $url, 'n' );
- $promise->reject;
+
+ if ( my $err = $tx->error ) {
+ my $json = {
+ error => {
+ id => $err->{code},
+ msg => $err->{message}
+ }
+ };
+ $self->{log}->debug(
+ "wagonorder->get_p($url): HTTP $err->{code} $err->{message}"
+ );
+ $self->{realtime_cache}->freeze( $url, $json );
+ $promise->reject("GET $url: HTTP $err->{code} $err->{message}");
+ return;
}
+
+ $self->{log}->debug("wagonorder->get_p($url): OK");
+ my $json = $tx->res->json;
+ $json->{ts} = DateTime->now( time_zone => 'Europe/Berlin' )
+ ->strftime('%d.%m.%Y %H:%M');
+
+ $self->{main_cache}->freeze( $url, $json );
+ $promise->resolve( $json, \%param );
return;
}
)->catch(
sub {
- $cache->set( $url, 'n' );
- $promise->reject;
+ my ($err) = @_;
+ $self->{log}->warn("wagonorder->get_p($url): $err");
+ $promise->reject("GET $url: $err");
return;
}
)->wait;
return $promise;
}
-sub get_p {
- my ( $self, $train_no, $api_ts ) = @_;
+sub get_stationinfo_p {
+ my ( $self, $eva ) = @_;
- my $url
- = "https://www.apps-bahn.de/wr/wagenreihung/1.0/${train_no}/${api_ts}";
-
- my $cache = $self->{realtime_cache};
+ my $url = "https://lib.finalrewind.org/dbdb/s/${eva}.json";
+ my $cache = $self->{main_cache};
my $promise = Mojo::Promise->new;
if ( my $content = $cache->thaw($url) ) {
- $self->{log}->debug("GET $url (cached)");
return $promise->resolve($content);
}
- $self->{user_agent}->request_timeout(10)->get_p( $url => $self->{header} )
+ $self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} )
->then(
sub {
my ($tx) = @_;
if ( my $err = $tx->error ) {
- $self->{log}->warn(
- "wagonorder->get_p($url): HTTP $err->{code} $err->{message}"
- );
- $promise->reject(
- "GET $url returned HTTP $err->{code} $err->{message}");
+ $cache->freeze( $url, {} );
+ $promise->reject("HTTP $err->{code} $err->{message}");
return;
}
- $self->{log}->debug("GET $url (OK)");
- my $json = $tx->res->json;
-
+ my $json = $tx->result->json;
$cache->freeze( $url, $json );
$promise->resolve($json);
return;
@@ -134,8 +143,8 @@ sub get_p {
)->catch(
sub {
my ($err) = @_;
- $self->{log}->warn("GET $url: $err");
- $promise->reject("GET $url: $err");
+ $cache->freeze( $url, {} );
+ $promise->reject($err);
return;
}
)->wait;
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;
generated by cgit v1.2.3 (git 2.39.1) at 2025-09-02 21:33:19 +0000