diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/DBInfoscreen.pm | 7 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Controller/Map.pm | 988 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Controller/Stationboard.pm | 624 | ||||
| -rw-r--r-- | lib/DBInfoscreen/Controller/Wagenreihung.pm | 3 | 
4 files changed, 1085 insertions, 537 deletions
| diff --git a/lib/DBInfoscreen.pm b/lib/DBInfoscreen.pm index 1828737..e7bdf80 100644 --- a/lib/DBInfoscreen.pm +++ b/lib/DBInfoscreen.pm @@ -142,8 +142,9 @@ sub startup {  	$self->helper(  		'handle_no_results_json' => sub { -			my ( $self, $backend, $station, $errstr, $api_version, $callback ) -			  = @_; +			my ( $self, $backend, $station, $errstr, $api_version ) = @_; + +			my $callback = $self->param('callback');  			$self->res->headers->access_control_allow_origin(q{*});  			my $json; @@ -315,7 +316,9 @@ sub startup {  	$r->get('/_wr/:train/:departure')->to('wagenreihung#wagenreihung'); +	$r->get('/_ajax_mapinfo/:tripid/:lineno')->to('map#ajax_route');  	$r->get('/map/:tripid/:lineno')->to('map#route'); +	$r->get('/intersection/:trips')->to('map#intersection');  	$self->defaults( layout => 'app' ); diff --git a/lib/DBInfoscreen/Controller/Map.pm b/lib/DBInfoscreen/Controller/Map.pm index 8ff68d7..4497a4a 100644 --- a/lib/DBInfoscreen/Controller/Map.pm +++ b/lib/DBInfoscreen/Controller/Map.pm @@ -7,11 +7,21 @@ use Mojo::Promise;  use DateTime;  use DateTime::Format::Strptime;  use Geo::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', +	time_zone => 'Europe/Berlin', +); +  chomp $dbf_version; +# Input: (HAFAS TripID, line number) +# Output: Promise returning a +# https://github.com/public-transport/hafas-client/blob/4/docs/trip.md instance +# on success  sub get_hafas_polyline_p {  	my ( $self, $trip_id, $line ) = @_; @@ -22,6 +32,7 @@ sub get_hafas_polyline_p {  	if ( my $content = $cache->thaw($url) ) {  		$promise->resolve($content); +		$self->app->log->debug("GET $url (cached)");  		return $promise;  	} @@ -31,6 +42,7 @@ sub get_hafas_polyline_p {  	  ->then(  		sub {  			my ($tx) = @_; +			$self->app->log->debug("GET $url (OK)");  			my $json = decode_json( $tx->res->body );  			my @coordinate_list; @@ -56,6 +68,7 @@ sub get_hafas_polyline_p {  	)->catch(  		sub {  			my ($err) = @_; +			$self->app->log->debug("GET $url (error: $err)");  			$promise->reject($err);  		}  	)->wait; @@ -63,6 +76,646 @@ sub get_hafas_polyline_p {  	return $promise;  } +sub get_route_indexes { +	my ( $features, $from_name, $to_name ) = @_; +	my ( $from_index, $to_index ); + +	for my $i ( 0 .. $#{$features} ) { +		my $this_point = $features->[$i]; +		if (    not defined $from_index +			and $this_point->{properties}{type} +			and $this_point->{properties}{type} eq 'stop' +			and $this_point->{properties}{name} eq $from_name ) +		{ +			$from_index = $i; +		} +		elsif ( $this_point->{properties}{type} +			and $this_point->{properties}{type} eq 'stop' +			and $this_point->{properties}{name} eq $to_name ) +		{ +			$to_index = $i; +			last; +		} +	} +	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} +#   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 +# 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 $now = $opt{now}; + +	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 @train_positions; + +	my $time_complete = $now->epoch - $from_dt->epoch; +	my $time_total    = $to_dt->epoch - $from_dt->epoch; + +	my @completion_ratios +	  = map { ( $time_complete + ( $_ * 2 ) ) / $time_total } ( 0 .. 45 ); + +	my $geo = Geo::Distance->new; + +	my ( $from_index, $to_index ) +	  = get_route_indexes( $features, $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}; +			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, [ $lat, $lon ] ); +					} +				} +				if ( @train_positions == @completion_ratios ) { +					return @train_positions; +				} +			} +		} +		if (@train_positions) { +			return @train_positions; +		} +	} +	else { +		for my $ratio (@completion_ratios) { +			my $lat +			  = $opt{from}{lat} + ( $opt{to}{lat} - $opt{from}{lat} ) * $ratio; +			my $lon +			  = $opt{from}{lon} + ( $opt{to}{lon} - $opt{from}{lon} ) * $ratio; +			push( @train_positions, [ $lat, $lon ] ); +		} +		return @train_positions; +	} +	return [ $opt{to}{lat}, $opt{to}{lon} ]; +} + +# Input: +#   now: DateTime +#   route: hash +#     lat: float +#     lon: float +#     name: str +#     arr: DateTime +#     dep: DateTime +#   features: ref to transport.rest features list +#  Output: +#    next_stop: {type, station} +#    positions: [current position [lat, lon], 2s from now, 4s from now, ...] +sub estimate_train_positions2 { +	my (%opt) = @_; +	my $now   = $opt{now}; +	my @route = @{ $opt{route} // [] }; + +	my @train_positions; +	my $next_stop; + +	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} ) +		{ + +			# (current position, future positons...) in 2 second steps +			@train_positions = estimate_train_positions( +				from     => $route[ $i - 1 ], +				to       => $route[$i], +				now      => $now, +				features => $opt{features}, +			); + +			$next_stop = { +				type    => 'next', +				station => $route[$i], +			}; +			last; +		} +		if ( $route[ $i - 1 ]{dep} and $now <= $route[ $i - 1 ]{dep} ) { +			@train_positions +			  = ( [ $route[ $i - 1 ]{lat}, $route[ $i - 1 ]{lon} ] ); +			$next_stop = { +				type    => 'present', +				station => $route[ $i - 1 ], +			}; +			last; +		} +	} + +	if ( not $next_stop ) { +		@train_positions = ( [ $route[-1]{lat}, $route[-1]{lon} ] ); +		$next_stop       = { +			type    => 'present', +			station => $route[-1] +		}; +	} + +	my $position_now = shift @train_positions; + +	return { +		next_stop    => $next_stop, +		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; +} + +sub route_to_ajax { +	my (@stopovers) = @_; + +	my @route_entries; + +	for my $stop (@stopovers) { +		my @stop_entries = ( $stop->{stop}{name} ); +		my $platform; + +		if ( $stop->{arrival} +			and my $arr = $strp->parse_datetime( $stop->{arrival} ) ) +		{ +			my $delay = ( $stop->{arrivalDelay} // 0 ) / 60; +			$platform = $stop->{arrivalPlatform}; + +			push( @stop_entries, $arr->epoch, $delay ); +		} +		else { +			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{}; + +			push( @stop_entries, $dep->epoch, $delay, $platform ); +		} +		else { +			push( @stop_entries, q{}, q{}, q{} ); +		} + +		push( @route_entries, join( ';', @stop_entries ) ); +	} + +	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; +	for my $i ( 1 .. $#polyline ) { +		push( +			@line_pairs, +			[ +				[ $polyline[ $i - 1 ][1], $polyline[ $i - 1 ][0] ], +				[ $polyline[$i][1],       $polyline[$i][0] ] +			] +		); +	} +	return @line_pairs; +} + +sub intersection { +	my ($self) = @_; + +	my @trips    = split( qr{;}, $self->stash('trips') ); +	my @trip_ids = map { [ split( qr{,}, $_ ) ] } @trips; + +	$self->render_later; + +	my @polyline_requests +	  = map { $self->get_hafas_polyline_p( @{$_} ) } @trip_ids; +	Mojo::Promise->all(@polyline_requests)->then( +		sub { +			my ( $pl1, $pl2 ) = map { $_->[0] } @_; +			my @polyline1 = @{ $pl1->{polyline} }; +			my @polyline2 = @{ $pl2->{polyline} }; +			my @station_coordinates; + +			my @markers; +			my $next_stop; + +			my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + +			my @line1_pairs = polyline_to_line_pairs(@polyline1); +			my @line2_pairs = polyline_to_line_pairs(@polyline2); + +			my @route1 +			  = stopovers_to_route( @{ $pl1->{raw}{stopovers} // [] } ); +			my @route2 +			  = stopovers_to_route( @{ $pl2->{raw}{stopovers} // [] } ); + +			my $train1_pos = estimate_train_positions2( +				now      => $now, +				route    => \@route1, +				features => $pl1->{raw}{polyline}{features}, +			); + +			my $train2_pos = estimate_train_positions2( +				now      => $now, +				route    => \@route2, +				features => $pl2->{raw}{polyline}{features}, +			); + +			my $intersection = estimate_train_intersection( +				routes   => [ \@route1, \@route2 ], +				features => [ +					$pl1->{raw}{polyline}{features}, +					$pl2->{raw}{polyline}{features} +				], +			); + +			for my $meeting_point ( @{ $intersection->{meeting_points} } ) { +				push( +					@station_coordinates, +					[ +						[ $meeting_point->{lat}, $meeting_point->{lon} ], +						[ $meeting_point->{timestamp}->strftime('%H:%M') ] +					] +				); +			} + +			push( +				@markers, +				{ +					lat   => $train1_pos->{position_now}[0], +					lon   => $train1_pos->{position_now}[1], +					title => $pl1->{name} +				}, +				{ +					lat   => $train2_pos->{position_now}[0], +					lon   => $train2_pos->{position_now}[1], +					title => $pl2->{name} +				}, +			); + +			$self->render( +				'route_map', +				title        => "DBF", +				hide_opts    => 1, +				with_map     => 1, +				intersection => 1, +				train1_no => +				  scalar( $pl1->{raw}{line}{additionalName} // $pl1->{name} ), +				train2_no => +				  scalar( $pl2->{raw}{line}{additionalName} // $pl2->{name} ), +				likely_pair => $intersection->{stop_pair} +				? $intersection->{stop_pair}[0] +				: undef, +				time            => scalar $intersection->{first_meeting_time}, +				polyline_groups => [ +					{ +						polylines  => [ @line1_pairs, @line2_pairs ], +						color      => '#ffffff', +						opacity    => 0, +						fit_bounds => 1, +					}, +					{ +						polylines => [@line1_pairs], +						color     => '#005080', +						opacity   => 0.6, +					}, +					{ +						polylines => [@line2_pairs], +						color     => '#800050', +						opacity   => 0.6, +					} +				], +				markers             => [@markers], +				station_coordinates => [@station_coordinates], +			); +		} +	)->catch( +		sub { +			my ($err) = @_; +			$self->render( +				'route_map', +				title     => "DBF", +				hide_opts => 1, +				with_map  => 1, +				error     => $err, +			); +		} +	)->wait; +} +  sub route {  	my ($self)  = @_;  	my $trip_id = $self->stash('tripid'); @@ -78,262 +731,95 @@ sub route {  			my ($pl) = @_;  			my @polyline = @{ $pl->{polyline} }; -			my @line_pairs;  			my @station_coordinates; -			my @route;  			my @markers;  			my $next_stop; -			my $now  = DateTime->now( time_zone => 'Europe/Berlin' ); -			my $strp = DateTime::Format::Strptime->new( -				pattern   => '%Y-%m-%dT%H:%M:%S.000%z', -				time_zone => 'Europe/Berlin', -			); +			my $now = DateTime->now( time_zone => 'Europe/Berlin' ); -			for my $i ( 1 .. $#polyline ) { -				push( -					@line_pairs, -					[ -						[ $polyline[ $i - 1 ][1], $polyline[ $i - 1 ][0] ], -						[ $polyline[$i][1],       $polyline[$i][0] ] -					] -				); -			} +			# used to draw the train's journey on the map +			my @line_pairs = polyline_to_line_pairs(@polyline); -			for my $stop ( @{ $pl->{raw}{stopovers} // [] } ) { -				my @stop_lines = ( $stop->{stop}{name} ); -				my ( $platform, $arr, $dep, $arr_delay, $dep_delay ); +			my @route = stopovers_to_route( @{ $pl->{raw}{stopovers} // [] } ); -				if ( $from_name and $stop->{stop}{name} eq $from_name ) { +			# 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->{stop}{location}{longitude}, -							lat   => $stop->{stop}{location}{latitude}, -							title => $stop->{stop}{name}, +							lon   => $stop->{lon}, +							lat   => $stop->{lat}, +							title => $stop->{name},  							icon  => 'goldIcon',  						}  					);  				} -				if ( $to_name and $stop->{stop}{name} eq $to_name ) { +				if ( $to_name and $stop->{name} eq $to_name ) {  					push(  						@markers,  						{ -							lon   => $stop->{stop}{location}{longitude}, -							lat   => $stop->{stop}{location}{latitude}, -							title => $stop->{stop}{name}, +							lon   => $stop->{lon}, +							lat   => $stop->{lat}, +							title => $stop->{name},  							icon  => 'greenIcon',  						}  					);  				} -				if (    $stop->{arrival} -					and $arr = $strp->parse_datetime( $stop->{arrival} ) ) -				{ -					$arr_delay = ( $stop->{arrivalDelay} // 0 ) / 60; -					$platform //= $stop->{arrivalPlatform}; -					my $arr_line = $arr->strftime('Ankunft: %H:%M'); -					if ($arr_delay) { -						$arr_line .= sprintf( ' (%+d)', $arr_delay ); +				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->{departure} -					and $dep = $strp->parse_datetime( $stop->{departure} ) ) -				{ -					$dep_delay = ( $stop->{departureDelay} // 0 ) / 60; -					$platform //= $stop->{departurePlatform}; -					my $dep_line = $dep->strftime('Abfahrt: %H:%M'); -					if ($dep_delay) { -						$dep_line .= sprintf( ' (%+d)', $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 );  				} -				if ($platform) { -					splice( @stop_lines, 1, 0, "Gleis $platform" ); -				} - -				push( -					@station_coordinates, -					[ -						[ -							$stop->{stop}{location}{latitude}, -							$stop->{stop}{location}{longitude} -						], -						[@stop_lines], -					] -				); -				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, -					} -				); - +				push( @station_coordinates, +					[ [ $stop->{lat}, $stop->{lon} ], [@stop_lines], ] );  			} -			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} ) -				{ -					my $from_dt   = $route[ $i - 1 ]{dep}; -					my $to_dt     = $route[$i]{arr}; -					my $from_name = $route[ $i - 1 ]{name}; -					my $to_name   = $route[$i]{name}; - -					my $route_part_completion_ratio -					  = ( $now->epoch - $from_dt->epoch ) -					  / ( $to_dt->epoch - $from_dt->epoch ); - -					my $title = $pl->{name}; -					if ( $route[$i]{arr_delay} ) { -						$title .= sprintf( ' (%+d)', $route[$i]{arr_delay} ); -					} - -					my $geo = Geo::Distance->new; -					my ( $from_index, $to_index ); +			my $train_pos = estimate_train_positions2( +				now      => $now, +				route    => \@route, +				features => $pl->{raw}{polyline}{features}, +			); -					for my $j ( 0 .. $#{ $pl->{raw}{polyline}{features} } ) { -						my $this_point = $pl->{raw}{polyline}{features}[$j]; -						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 ) -						{ -							$from_index = $j; -						} -						elsif ( $this_point->{properties}{type} -							and $this_point->{properties}{type} eq 'stop' -							and $this_point->{properties}{name} eq $to_name ) -						{ -							$to_index = $j; -							last; -						} -					} -					if ( $from_index and $to_index ) { -						my $total_distance = 0; -						for my $j ( $from_index + 1 .. $to_index ) { -							my $prev = $pl->{raw}{polyline}{features}[ $j - 1 ] -							  {geometry}{coordinates}; -							my $this -							  = $pl->{raw}{polyline}{features}[$j]{geometry} -							  {coordinates}; -							if ( $prev and $this ) { -								$total_distance += $geo->distance( -									'kilometer', $prev->[0], $prev->[1], -									$this->[0],  $this->[1] -								); -							} -						} -						my $marker_distance -						  = $total_distance * $route_part_completion_ratio; -						$total_distance = 0; -						for my $j ( $from_index + 1 .. $to_index ) { -							my $prev = $pl->{raw}{polyline}{features}[ $j - 1 ] -							  {geometry}{coordinates}; -							my $this -							  = $pl->{raw}{polyline}{features}[$j]{geometry} -							  {coordinates}; -							if ( $prev and $this ) { -								$total_distance += $geo->distance( -									'kilometer', $prev->[0], $prev->[1], -									$this->[0],  $this->[1] -								); -							} -							if ( $total_distance > $marker_distance ) { -								push( -									@markers, -									{ -										lon   => $this->[0], -										lat   => $this->[1], -										title => $title -									} -								); -								$next_stop = { -									type    => 'next', -									station => $route[$i], -								}; -								last; -							} -						} -					} -					else { -						push( -							@markers, -							{ -								lat => $route[ $i - 1 ]{lat} + ( -									( $route[$i]{lat} - $route[ $i - 1 ]{lat} ) -									* $route_part_completion_ratio -								), -								lon => $route[ $i - 1 ]{lon} + ( -									( $route[$i]{lon} - $route[ $i - 1 ]{lon} ) -									* $route_part_completion_ratio -								), -								title => $title -							} -						); -						$next_stop = { -							type    => 'next', -							station => $route[$i], -						}; -					} -					last; -				} -				if ( $route[ $i - 1 ]{dep} and $now <= $route[ $i - 1 ]{dep} ) { -					my $title = $pl->{name}; -					if ( $route[$i]{arr_delay} ) { -						$title .= sprintf( ' (%+d)', $route[$i]{arr_delay} ); -					} -					push( -						@markers, -						{ -							lat   => $route[ $i - 1 ]{lat}, -							lon   => $route[ $i - 1 ]{lon}, -							title => $title -						} -					); -					$next_stop = { -						type    => 'present', -						station => $route[ $i - 1 ], -					}; -					last; +			push( +				@markers, +				{ +					lat   => $train_pos->{position_now}[0], +					lon   => $train_pos->{position_now}[1], +					title => $pl->{name}  				} -			} -			if ( not @markers ) { -				push( -					@markers, -					{ -						lat   => $route[-1]{lat}, -						lon   => $route[-1]{lon}, -						title => $route[-1]{name} . ' - Endstation', -					} -				); -				$next_stop = { -					type    => 'present', -					station => $route[-1] -				}; -			} +			); +			$next_stop = $train_pos->{next_stop};  			$self->render(  				'route_map', -				title     => $pl->{name}, -				hide_opts => 1, -				with_map  => 1, -				origin    => { +				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} } ), +				origin => {  					name => $pl->{raw}{origin}{name}, -					ts   => $pl->{raw}{dep_line} +					ts   => $pl->{raw}{departure}  					? scalar $strp->parse_datetime( $pl->{raw}{departure} )  					: undef,  				}, @@ -363,14 +849,68 @@ sub route {  			my ($err) = @_;  			$self->render(  				'route_map', -				title       => "DBF", -				hide_opts   => 1, -				with_map    => 1, -				error       => $err, -				origin      => undef, -				destination => undef, +				title     => "DBF", +				hide_opts => 1, +				with_map  => 1, +				error     => $err, +			); + +		} +	)->wait; +} + +sub ajax_route { +	my ($self)  = @_; +	my $trip_id = $self->stash('tripid'); +	my $line_no = $self->stash('lineno'); + +	delete $self->stash->{layout}; + +	$self->render_later; + +	$self->get_hafas_polyline_p( $trip_id, $line_no )->then( +		sub { +			my ($pl) = @_; + +			my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + +			my @route = stopovers_to_route( @{ $pl->{raw}{stopovers} // [] } ); + +			my $train_pos = estimate_train_positions2( +				now      => $now, +				route    => \@route, +				features => $pl->{raw}{polyline}{features},  			); +			my @polyline = @{ $pl->{polyline} }; +			$self->render( +				'_map_infobox', +				ajax_req   => "${trip_id}/${line_no}", +				ajax_route => route_to_ajax( @{ $pl->{raw}{stopovers} // [] } ), +				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, +				}, +				destination => { +					name => $pl->{raw}{destination}{name}, +					ts   => $pl->{raw}{arrival} +					? scalar $strp->parse_datetime( $pl->{raw}{arrival} ) +					: undef, +				}, +				next_stop => $train_pos->{next_stop}, +			); +		} +	)->catch( +		sub { +			my ($err) = @_; +			$self->render( +				'_error', +				error => $err, +			);  		}  	)->wait;  } diff --git a/lib/DBInfoscreen/Controller/Stationboard.pm b/lib/DBInfoscreen/Controller/Stationboard.pm index 4a9c94d..253cbcb 100644 --- a/lib/DBInfoscreen/Controller/Stationboard.pm +++ b/lib/DBInfoscreen/Controller/Stationboard.pm @@ -11,6 +11,7 @@ use File::Slurp qw(read_file write_file);  use List::Util qw(max);  use List::MoreUtils qw();  use Mojo::JSON qw(decode_json); +use Mojo::Promise;  use Travel::Status::DE::HAFAS;  use Travel::Status::DE::IRIS;  use Travel::Status::DE::IRIS::Stations; @@ -504,25 +505,13 @@ sub get_results_for {  }  sub handle_request { -	my ($self)  = @_; +	my ($self) = @_;  	my $station = $self->stash('station'); -	my $via     = $self->param('via'); -	my @platforms = split( /,/, $self->param('platforms') // q{} ); -	my @lines     = split( /,/, $self->param('lines')     // q{} ); -	my $template       = $self->param('mode')          // 'app'; -	my $hide_low_delay = $self->param('hidelowdelay')  // 0; -	my $hide_opts      = $self->param('hide_opts')     // 0; -	my $show_realtime  = $self->param('show_realtime') // 0; -	my $show_details   = $self->param('detailed')      // 0; -	my $backend        = $self->param('backend')       // 'iris'; -	my $admode         = $self->param('admode')        // 'deparr'; -	my $apiver         = $self->param('version')       // 0; -	my $callback       = $self->param('callback'); -	my $with_related   = !$self->param('no_related'); -	my $limit       = $self->param('limit') // 0; -	my @train_types = split( /,/, $self->param('train_types') // q{} ); -	my %opt         = ( +	my $template = $self->param('mode')    // 'app'; +	my $backend  = $self->param('backend') // 'iris'; +	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, @@ -568,6 +557,8 @@ sub handle_request {  		$template = 'app';  	} +	$self->param( mode => $template ); +  	if ( not $station ) {  		$self->render( 'landingpage', show_intro => 1 );  		return; @@ -582,35 +573,312 @@ sub handle_request {  		$opt{with_related} = 1;  	} -	my @departures; -	my $data        = get_results_for( $backend, $station, %opt ); -	my $results_ref = $data->{results}; -	my $errstr      = $data->{errstr}; -	my @results     = @{$results_ref}; +	my $data   = get_results_for( $backend, $station, %opt ); +	my $errstr = $data->{errstr}; -	if ( not @results and $template eq 'json' ) { +	if ( not @{ $data->{results} } and $template eq 'json' ) {  		$self->handle_no_results_json( $backend, $station, $errstr, -			$api_version, $callback ); +			$api_version );  		return;  	} -	# foo/bar used to mean "departures for foo via bar". This is now -	# deprecated, but most of these cases are handled here. -	if ( not @results and $station =~ m{/} ) { -		( $station, $via ) = split( qr{/}, $station ); -		$self->param( station => $station ); -		$self->param( via     => $via ); -		$data        = get_results_for( $backend, $station, %opt ); -		$results_ref = $data->{results}; -		$errstr      = $data->{errstr}; -		@results     = @{$results_ref}; -	} - -	if ( not @results ) { +	if ( not @{ $data->{results} } ) {  		$self->handle_no_results( $backend, $station, $errstr );  		return;  	} +	$self->handle_result($data); +} + +sub filter_results { +	my ( $self, @results ) = @_; + +	if ( my $train = $self->param('train') ) { +		@results = grep { result_is_train( $_, $train ) } @results; +	} + +	if ( my @lines = split( /,/, $self->param('lines') // q{} ) ) { +		@results = grep { result_has_line( $_, @lines ) } @results; +	} + +	if ( my @platforms = split( /,/, $self->param('platforms') // q{} ) ) { +		@results = grep { result_has_platform( $_, @platforms ) } @results; +	} + +	if ( my $via = $self->param('via') ) { +		$via =~ s{ , \s* }{|}gx; +		@results = grep { result_has_via( $_, $via ) } @results; +	} + +	if ( my @train_types = split( /,/, $self->param('train_types') // q{} ) ) { +		@results = grep { result_has_train_type( $_, @train_types ) } @results; +	} + +	if ( my $limit = $self->param('limit') ) { +		if ( $limit =~ m{ ^ \d+ $ }x ) { +			splice( @results, $limit ); +		} +	} + +	return @results; +} + +sub format_iris_result_info { +	my ( $self, $template, $result ) = @_; +	my ( $info, $moreinfo ); + +	my $delaymsg +	  = join( ', ', map { $_->[1] } $result->delay_messages ); +	my $qosmsg = join( ' +++ ', map { $_->[1] } $result->qos_messages ); +	if ( $result->is_cancelled ) { +		$info = "Fahrt fällt aus: ${delaymsg}"; +	} +	elsif ( $result->departure_is_cancelled ) { +		$info = "Zug endet hier: ${delaymsg}"; +	} +	elsif ( $result->delay and $result->delay > 0 ) { +		if ( $template eq 'app' or $template eq 'infoscreen' ) { +			$info = $delaymsg; +		} +		else { +			$info = sprintf( 'ca. +%d%s%s', +				$result->delay, $delaymsg ? q{: } : q{}, $delaymsg ); +		} +	} +	if (    $result->replacement_for +		and $template ne 'app' +		and $template ne 'infoscreen' ) +	{ +		for my $rep ( $result->replacement_for ) { +			$info = sprintf( +				'Ersatzzug für %s %s %s%s', +				$rep->type, $rep->train_no, +				$info ? '+++ ' : q{}, $info // q{} +			); +		} +	} +	if ( $info and $qosmsg ) { +		$info .= ' +++ '; +	} +	$info .= $qosmsg; + +	if ( $result->additional_stops and not $result->is_cancelled ) { +		my $additional_line = join( q{, }, $result->additional_stops ); +		$info +		  = 'Zusätzliche Halte: ' +		  . $additional_line +		  . ( $info ? ' +++ ' : q{} ) +		  . $info; +		if ( $template ne 'json' ) { +			push( @{$moreinfo}, [ 'Zusätzliche Halte', $additional_line ] ); +		} +	} + +	if ( $result->canceled_stops and not $result->is_cancelled ) { +		my $cancel_line = join( q{, }, $result->canceled_stops ); +		$info +		  = 'Ohne Halt in: ' . $cancel_line . ( $info ? ' +++ ' : q{} ) . $info; +		if ( $template ne 'json' ) { +			push( @{$moreinfo}, [ 'Ohne Halt in', $cancel_line ] ); +		} +	} + +	push( @{$moreinfo}, $result->messages ); + +	return ( $info, $moreinfo ); +} + +sub format_hafas_result_info { +	my ( $self, $result ) = @_; +	my ( $info, $moreinfo ); + +	$info = $result->info; +	if ($info) { +		$moreinfo = [ [ 'HAFAS', $info ] ]; +	} +	if ( $result->delay and $result->delay > 0 ) { +		if ($info) { +			$info = 'ca. +' . $result->delay . ': ' . $info; +		} +		else { +			$info = 'ca. +' . $result->delay; +		} +	} +	push( @{$moreinfo}, map { [ 'HAFAS', $_ ] } $result->messages ); + +	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 ] +		) +	]; + +	$departure->{trip_id} +	  = get_hafas_trip_id( $self->ua, $self->app->cache_iris_main, $result ); + +	if ( +		$departure->{wr_link} +		and not check_wagonorder_with_wings( +			$self->ua, $self->app->cache_iris_main, +			$result,   $departure->{wr_link} +		) +	  ) +	{ +		$departure->{wr_link} = undef; +	} + +	my ( $route_ts, $route_info ) = get_route_timestamps( +		$self->ua, +		$self->app->cache_iris_main, +		$self->app->cache_iris_rt, +		{ train => $result } +	); + +	# If a train number changes on the way, IRIS routes are incomplete, +	# whereas HAFAS data has all stops -> merge HAFAS stops into IRIS +	# stops. This is a rare case, one point where it can be observed is +	# the TGV service at Frankfurt/Karlsruhe/Mannheim. +	if ( $route_info +		and my @hafas_stations = @{ $route_info->{stations} // [] } ) +	{ +		if ( my @iris_stations = @{ $departure->{route_pre_diff} } ) { +			my @missing_pre; +			for my $station (@hafas_stations) { +				if ( +					List::MoreUtils::any { $_->{name} eq $station } +					@iris_stations +				  ) +				{ +					unshift( @{ $departure->{route_pre_diff} }, @missing_pre ); +					last; +				} +				push( +					@missing_pre, +					{ +						name  => $station, +						hafas => 1 +					} +				); +			} +		} +		if ( my @iris_stations = @{ $departure->{route_post_diff} } ) { +			my @missing_post; +			for my $station ( reverse @hafas_stations ) { +				if ( +					List::MoreUtils::any { $_->{name} eq $station } +					@iris_stations +				  ) +				{ +					push( @{ $departure->{route_post_diff} }, @missing_post ); +					last; +				} +				unshift( +					@missing_post, +					{ +						name  => $station, +						hafas => 1 +					} +				); +			} +		} +	} +	if ($route_ts) { +		for my $elem ( +			@{ $departure->{route_pre_diff} }, +			@{ $departure->{route_post_diff} } +		  ) +		{ +			for my $key ( keys %{ $route_ts->{ $elem->{name} } // {} } ) { +				$elem->{$key} = $route_ts->{ $elem->{name} }{$key}; +			} +		} +	} +	if ( $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} ] ); +			} +		} +		for my $message ( @{ $departure->{moreinfo} // [] } ) { +			my $m = $message->[1]; +			@him_messages +			  = grep { $_->[0] !~ m{Information\. $m\.$} } @him_messages; +		} +		unshift( @{ $departure->{moreinfo} }, @him_messages ); +	} + +	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'; +	} +	elsif ( $departure->{train_line} +		and $departure->{train_line} =~ m{^S\d} ) +	{ +		$linetype = 'sbahn'; +	} + +	$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, +	); +} + +sub handle_result { +	my ( $self, $data ) = @_; + +	my @results = @{ $data->{results} }; +	my @departures; + +	my @platforms      = split( /,/, $self->param('platforms') // q{} ); +	my $template       = $self->param('mode') // 'app'; +	my $hide_low_delay = $self->param('hidelowdelay') // 0; +	my $hide_opts      = $self->param('hide_opts') // 0; +	my $show_realtime  = $self->param('show_realtime') // 0; +	my $show_details   = $self->param('detailed') // 0; +	my $backend        = $self->param('backend') // 'iris'; +	my $admode         = $self->param('admode') // 'deparr'; +	my $apiver         = $self->param('version') // 0; +	my $callback       = $self->param('callback'); +	my $via            = $self->param('via'); + +	if ( $self->param('ajax') ) { +		delete $self->stash->{layout}; +	} +  	if ( $template eq 'single' ) {  		if ( not @platforms ) {  			for my $result (@results) { @@ -649,30 +917,7 @@ sub handle_request {  		}  	} -	if ( my $train = $self->param('train') ) { -		@results = grep { result_is_train( $_, $train ) } @results; -	} - -	if (@lines) { -		@results = grep { result_has_line( $_, @lines ) } @results; -	} - -	if (@platforms) { -		@results = grep { result_has_platform( $_, @platforms ) } @results; -	} - -	if ($via) { -		$via =~ s{ , \s* }{|}gx; -		@results = grep { result_has_via( $_, $via ) } @results; -	} - -	if (@train_types) { -		@results = grep { result_has_train_type( $_, @train_types ) } @results; -	} - -	if ( $limit and $limit =~ m{ ^ \d+ $ }x ) { -		splice( @results, $limit ); -	} +	@results = $self->filter_results(@results);  	for my $result (@results) {  		my $platform = ( split( qr{ }, $result->platform // '' ) )[0]; @@ -689,84 +934,11 @@ sub handle_request {  		}  		my ( $info, $moreinfo );  		if ( $backend eq 'iris' ) { -			my $delaymsg -			  = join( ', ', map { $_->[1] } $result->delay_messages ); -			my $qosmsg = join( ' +++ ', map { $_->[1] } $result->qos_messages ); -			if ( $result->is_cancelled ) { -				$info = "Fahrt fällt aus: ${delaymsg}"; -			} -			elsif ( $result->departure_is_cancelled ) { -				$info = "Zug endet hier: ${delaymsg}"; -			} -			elsif ( $result->delay and $result->delay > 0 ) { -				if ( $template eq 'app' or $template eq 'infoscreen' ) { -					$info = $delaymsg; -				} -				else { -					$info = sprintf( 'ca. +%d%s%s', -						$result->delay, $delaymsg ? q{: } : q{}, $delaymsg ); -				} -			} -			if (    $result->replacement_for -				and $template ne 'app' -				and $template ne 'infoscreen' ) -			{ -				for my $rep ( $result->replacement_for ) { -					$info = sprintf( -						'Ersatzzug für %s %s %s%s', -						$rep->type, $rep->train_no, -						$info ? '+++ ' : q{}, $info // q{} -					); -				} -			} -			if ( $info and $qosmsg ) { -				$info .= ' +++ '; -			} -			$info .= $qosmsg; - -			if ( $result->additional_stops and not $result->is_cancelled ) { -				my $additional_line = join( q{, }, $result->additional_stops ); -				$info -				  = 'Zusätzliche Halte: ' -				  . $additional_line -				  . ( $info ? ' +++ ' : q{} ) -				  . $info; -				if ( $template ne 'json' ) { -					push( -						@{$moreinfo}, -						[ 'Zusätzliche Halte', $additional_line ] -					); -				} -			} - -			if ( $result->canceled_stops and not $result->is_cancelled ) { -				my $cancel_line = join( q{, }, $result->canceled_stops ); -				$info -				  = 'Ohne Halt in: ' -				  . $cancel_line -				  . ( $info ? ' +++ ' : q{} ) -				  . $info; -				if ( $template ne 'json' ) { -					push( @{$moreinfo}, [ 'Ohne Halt in', $cancel_line ] ); -				} -			} - -			push( @{$moreinfo}, $result->messages ); +			( $info, $moreinfo ) +			  = $self->format_iris_result_info( $template, $result );  		}  		else { -			$info = $result->info; -			if ($info) { -				$moreinfo = [ [ 'HAFAS', $info ] ]; -			} -			if ( $result->delay and $result->delay > 0 ) { -				if ($info) { -					$info = 'ca. +' . $result->delay . ': ' . $info; -				} -				else { -					$info = 'ca. +' . $result->delay; -				} -			} -			push( @{$moreinfo}, map { [ 'HAFAS', $_ ] } $result->messages ); +			( $info, $moreinfo ) = $self->format_hafas_result_info($result);  		}  		my $time = $result->time; @@ -1026,131 +1198,9 @@ sub handle_request {  				}  			);  			if ( $self->param('train') ) { -				$departures[-1]{route_pre_diff} = [ -					$self->json_route_diff( -						[ $result->route_pre ], -						[ $result->sched_route_pre ] -					) -				]; -				$departures[-1]{route_post_diff} = [ -					$self->json_route_diff( -						[ $result->route_post ], -						[ $result->sched_route_post ] -					) -				]; - -				$departures[-1]{trip_id} -				  = get_hafas_trip_id( $self->ua, $self->app->cache_iris_main, -					$result ); - -				if ( -					$departures[-1]{wr_link} -					and not check_wagonorder_with_wings( -						$self->ua, $self->app->cache_iris_main, -						$result,   $departures[-1]{wr_link} -					) -				  ) -				{ -					$departures[-1]{wr_link} = undef; -				} - -				my ( $route_ts, $route_info ) = get_route_timestamps( -					$self->ua, -					$self->app->cache_iris_main, -					$self->app->cache_iris_rt, -					{ train => $result } -				); - -             # If a train number changes on the way, IRIS routes are incomplete, -             # whereas HAFAS data has all stops -> merge HAFAS stops into IRIS -             # stops. This is a rare case, one point where it can be observed is -             # the TGV service at Frankfurt/Karlsruhe/Mannheim. -				if ( $route_info -					and my @hafas_stations -					= @{ $route_info->{stations} // [] } ) -				{ -					if ( my @iris_stations -						= @{ $departures[-1]{route_pre_diff} } ) -					{ -						my @missing_pre; -						for my $station (@hafas_stations) { -							if ( -								List::MoreUtils::any { $_->{name} eq $station } -								@iris_stations -							  ) -							{ -								unshift( -									@{ $departures[-1]{route_pre_diff} }, -									@missing_pre -								); -								last; -							} -							push( -								@missing_pre, -								{ -									name  => $station, -									hafas => 1 -								} -							); -						} -					} -					if ( my @iris_stations -						= @{ $departures[-1]{route_post_diff} } ) -					{ -						my @missing_post; -						for my $station ( reverse @hafas_stations ) { -							if ( -								List::MoreUtils::any { $_->{name} eq $station } -								@iris_stations -							  ) -							{ -								push( -									@{ $departures[-1]{route_post_diff} }, -									@missing_post -								); -								last; -							} -							unshift( -								@missing_post, -								{ -									name  => $station, -									hafas => 1 -								} -							); -						} -					} -				} -				if ($route_ts) { -					for my $elem ( -						@{ $departures[-1]{route_pre_diff} }, -						@{ $departures[-1]{route_post_diff} } -					  ) -					{ -						for my $key ( -							keys %{ $route_ts->{ $elem->{name} } // {} } ) -						{ -							$elem->{$key} = $route_ts->{ $elem->{name} }{$key}; -						} -					} -				} -				if ( $route_info and @{ $route_info->{messages} // [] } ) { -					my $him = $route_info->{messages}; -					my @him_messages; -					$departures[-1]{messages}{him} = $him; -					for my $message ( @{$him} ) { -						if ( $message->{display} ) { -							push( @him_messages, -								[ $message->{header}, $message->{lead} ] ); -						} -					} -					for my $message ( @{ $departures[-1]{moreinfo} // [] } ) { -						my $m = $message->[1]; -						@him_messages -						  = grep { $_->[0] !~ m{Information\. $m\.$} } -						  @him_messages; -					} -					unshift( @{ $departures[-1]{moreinfo} }, @him_messages ); -				} +				$self->render_train( $result, $departures[-1], +					$data->{station_name} // $self->stash('station') ); +				return;  			}  		}  		else { @@ -1182,10 +1232,6 @@ sub handle_request {  		}  	} -	if ( $self->param('ajax') ) { -		delete $self->stash->{layout}; -	} -  	if ( $template eq 'json' ) {  		$self->res->headers->access_control_allow_origin(q{*});  		my $json = $self->render_to_string( @@ -1223,52 +1269,8 @@ sub handle_request {  			format => 'text',  		);  	} -	elsif ( my $train = $self->param('train') ) { - -		my ($departure) = @departures; - -		if ($departure) { - -			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'; -			} -			elsif ( $departure->{train_line} -				and $departure->{train_line} =~ m{^S\d} ) -			{ -				$linetype = 'sbahn'; -			} - -			$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 => $data->{station_name} // $station, -			); -		} -		else { -			$self->render('not_found'); -		} -	}  	else { -		my $station_name = $data->{station_name} // $station; +		my $station_name = $data->{station_name} // $self->stash('station');  		$self->render(  			$template,  			departures       => \@departures, diff --git a/lib/DBInfoscreen/Controller/Wagenreihung.pm b/lib/DBInfoscreen/Controller/Wagenreihung.pm index a87bb29..7b59227 100644 --- a/lib/DBInfoscreen/Controller/Wagenreihung.pm +++ b/lib/DBInfoscreen/Controller/Wagenreihung.pm @@ -25,6 +25,7 @@ sub get_wagenreihung_p {  	if ( my $content = $cache->thaw($url) ) {  		$promise->resolve($content); +		$self->app->log->debug("GET $url (cached)");  		return $promise;  	} @@ -33,6 +34,7 @@ sub get_wagenreihung_p {  	  ->then(  		sub {  			my ($tx) = @_; +			$self->app->log->debug("GET $url (OK)");  			my $body = decode( 'utf-8', $tx->res->body );  			my $json = JSON->new->decode($body); @@ -42,6 +44,7 @@ sub get_wagenreihung_p {  	)->catch(  		sub {  			my ($err) = @_; +			$self->app->log->debug("GET $url (error: $err)");  			$promise->reject($err);  		}  	)->wait; | 
