Commit 65aab8c7 authored by Birte Kristina Friesel's avatar Birte Kristina Friesel
Browse files

use non-blocking requests for train details

parent 3c7f39d0

lib/DBInfoscreen/Controller/Stationboard.pm

+109 −89
Original line number Diff line number Diff line
@@ -419,8 +419,36 @@ sub render_train { 
		$departure->{wr_link} = undef;

	}



	my ( $route_ts, $route_info, $trainsearch )

	  = $self->hafas->get_route_timestamps( train => $result );

	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_later;



	$self->hafas->get_route_timestamps_p( train => $result )->then(

		sub {

			my ( $route_ts, $route_info, $trainsearch ) = @_;



			$departure->{trip_id} = $trainsearch->{trip_id};
@@ -439,7 +467,10 @@ sub render_train { 
							@iris_stations

						  )

						{

					unshift( @{ $departure->{route_pre_diff} }, @missing_pre );

							unshift(

								@{ $departure->{route_pre_diff} },

								@missing_pre

							);

							last;

						}

						push(
@@ -459,7 +490,10 @@ sub render_train { 
							@iris_stations

						  )

						{

					push( @{ $departure->{route_post_diff} }, @missing_post );

							push(

								@{ $departure->{route_post_diff} },

								@missing_post

							);

							last;

						}

						unshift(
@@ -478,7 +512,8 @@ sub render_train { 
					@{ $departure->{route_post_diff} }

				  )

				{

			for my $key ( keys %{ $route_ts->{ $elem->{name} } // {} } ) {

					for my $key ( keys %{ $route_ts->{ $elem->{name} } // {} } )

					{

						$elem->{$key} = $route_ts->{ $elem->{name} }{$key};

					}

				}
@@ -489,42 +524,25 @@ sub render_train { 
				$departure->{messages}{him} = $him;

				for my $message ( @{$him} ) {

					if ( $message->{display} ) {

				push( @him_messages, [ $message->{header}, $message->{lead} ] );

						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;

					  = 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';

	)->catch(

		sub {

			# nop

		}



	)->finally(

		sub {

			$self->render(

				'_train_details',

				departure => $departure,
@@ -534,6 +552,8 @@ sub render_train { 
				station_name => $station_name,

			);

		}

	)->wait;

}



sub handle_result {

	my ( $self, $data ) = @_;

lib/DBInfoscreen/Helper/HAFAS.pm

+128 −194
Original line number Diff line number Diff line
@@ -24,46 +24,13 @@ sub new { 


}



sub hafas_json_req {

	my ( $self, $cache, $url ) = @_;



	if ( my $content = $cache->thaw($url) ) {

		return $content;

	}



	my $res

	  = eval { $self->{user_agent}->get( $url => $self->{header} )->result };



	if ($@) {

		$self->{log}->debug("hafas_json_req($url): $@");

		return;

	}

	if ( $res->is_error ) {

		return;

	}



	my $body = encode( 'utf-8', decode( 'ISO-8859-15', $res->body ) );



	$body =~ s{^TSLs[.]sls = }{};

	$body =~ s{;$}{};

	$body =~ s{(}{(}g;

	$body =~ s{)}{)}g;



	my $json = decode_json($body);



	$cache->freeze( $url, $json );



	return $json;

}



sub get_json_p {

	my ( $self, $cache, $url ) = @_;



	my $promise = Mojo::Promise->new;



	if ( my $content = $cache->thaw($url) ) {

		$promise->resolve($content);

		return $promise;

		return $promise->resolve($content);

	}



	$self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} )
@@ -106,26 +73,31 @@ sub get_json_p { 
	return $promise;

}



sub hafas_xml_req {

sub get_xml_p {

	my ( $self, $cache, $url ) = @_;



	my $promise = Mojo::Promise->new;



	if ( my $content = $cache->thaw($url) ) {

		return $content;

		return $promise->resolve($content);

	}



	my $res

	  = eval { $self->{user_agent}->get( $url => $self->{header} )->result };

	$self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} )

	  ->then(

		sub {

			my ($tx) = @_;



	if ($@) {

		$self->{log}->debug("hafas_xml_req($url): $@");

		return;

	}

	if ( $res->is_error ) {

			if ( my $err = $tx->error ) {

				$cache->freeze( $url, {} );

				$self->{log}->warn(

					"hafas->get_xml_p($url): HTTP $err->{code} $err->{message}"

				);

				$promise->reject(

					"GET $url returned HTTP $err->{code} $err->{message}");

				return;

			}



	my $body = decode( 'ISO-8859-15', $res->body );

			my $body = decode( 'ISO-8859-15', $tx->res->body );



			# <SDay text="... &gt; ..."> is invalid HTML, but present

			# regardless. As it is the last tag, we just throw it away.
@@ -137,6 +109,7 @@ sub hafas_xml_req { 


			if ($@) {

				$cache->freeze( $url, {} );

				$promise->reject;

				return;

			}
@@ -172,70 +145,14 @@ sub hafas_xml_req { 
			}



			$cache->freeze( $url, $ret );

			$promise->resolve($ret);



	return $ret;

}



sub trainsearch {

	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 $trainsearch = $self->hafas_json_req( $self->{realtime_cache},

		"${base}&date=$opt{date_yy}&trainname=$opt{train_no}" );



	if ( not $trainsearch ) {

			return;

		}



	# 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} )

		  )

		{

			# 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;

			}

		}

	}



	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 );

	)->catch(

		sub {

		}



	return $result;

	)->wait;

}



sub trainsearch_p {
@@ -320,9 +237,11 @@ sub trainsearch_p { 
	return $promise;

}



sub get_route_timestamps {

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');
@@ -335,26 +254,29 @@ sub get_route_timestamps { 
		$opt{date_yyyy} = $now->strftime('%d.%m.%Y');

	}



	my $trainsearch_result = $self->trainsearch(%opt);



	if ( not $trainsearch_result ) {

		return;

	}



	my $trainlink = $trainsearch_result->{trainLink};



	my $base = 'https://reiseauskunft.bahn.de/bin/traininfo.exe/dn';

	my ( $trainsearch_result, $trainlink, $traininfo );



	my $traininfo = $self->hafas_json_req( $self->{realtime_cache},

	$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;

			}



	my $traindelay = $self->hafas_xml_req( $self->{realtime_cache},

			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 $strp = DateTime::Format::Strptime->new(
@@ -362,7 +284,9 @@ sub get_route_timestamps { 
				time_zone => 'Europe/Berlin',

			);



	for my $station ( @{ $traininfo->{suggestions}[0]{locations} // [] } ) {

			for

			  my $station ( @{ $traininfo->{suggestions}[0]{locations} // [] } )

			{

				my $name = $station->{name};

				my $arr  = $station->{arrDate} . ' ' . $station->{arrTime};

				my $dep  = $station->{depDate} . ' ' . $station->{depTime};
@@ -389,7 +313,17 @@ sub get_route_timestamps { 
				}

			}



	return ( $ret, $traindelay // {}, $trainsearch_result );

			$promise->resolve( $ret, $traindelay // {}, $trainsearch_result );

			return;

		}

	)->catch(

		sub {

			$promise->reject;

			return;

		}

	)->wait;



	return $promise;

}



# Input: (HAFAS TripID, line number)