Switch to new bahn.de carriage formation API (WiP) (c74b91b0) · Commits · derf / db-infoscreen

cpanfile

+1 −1

Original line number	Original line	Diff line number	Diff line
	@@ -10,7 +10,7 @@ requires 'List::UtilsBy';
	requires 'LWP::UserAgent';		requires 'LWP::UserAgent';
	requires 'LWP::Protocol::https';		requires 'LWP::Protocol::https';
	requires 'Mojolicious';		requires 'Mojolicious';
	requires 'Travel::Status::DE::DBWagenreihung', '== 0.14';		requires 'Travel::Status::DE::DBWagenreihung', '== 0.15';
	requires 'Travel::Status::DE::EFA', '>= 2.02';		requires 'Travel::Status::DE::EFA', '>= 2.02';
	requires 'Travel::Status::DE::HAFAS', '>= 5.06';		requires 'Travel::Status::DE::HAFAS', '>= 5.06';
	requires 'Travel::Status::DE::IRIS';		requires 'Travel::Status::DE::IRIS';

lib/DBInfoscreen.pm

+1 −1

Original line number	Original line	Diff line number	Diff line
	@@ -313,7 +313,7 @@ sub startup {

	$r->get('/dyn/:av/autocomplete.js')->to('stationboard#autocomplete');		$r->get('/dyn/:av/autocomplete.js')->to('stationboard#autocomplete');

	$r->get('/_wr/:train/:departure')->to('wagenreihung#wagenreihung');		$r->get('/carriage-formation')->to('wagenreihung#wagenreihung');
	$r->get('/w/*wagon')->to('wagenreihung#wagen');		$r->get('/w/*wagon')->to('wagenreihung#wagen');

	$r->get('/_ajax_mapinfo/:tripid/:lineno')->to('map#ajax_route');		$r->get('/_ajax_mapinfo/:tripid/:lineno')->to('map#ajax_route');

lib/DBInfoscreen/Controller/Stationboard.pm

+34 −23

Original line number	Original line	Diff line number	Diff line
	@@ -773,23 +773,29 @@ sub render_train {
	my @requests		my @requests
	= ( $wagonorder_req, $occupancy_req, $stationinfo_req, $route_req );		= ( $wagonorder_req, $occupancy_req, $stationinfo_req, $route_req );

	if ( $departure->{wr_link} ) {		if ( $departure->{wr_dt} ) {
	$self->wagonorder->get_p( $result->train_no, $departure->{wr_link} )		$self->wagonorder->get_p(
	->then(		train_type => $result->type,
			train_number => $result->train_no,
			datetime => $departure->{wr_dt},
			eva => $departure->{eva}
			)->then(
	sub {		sub {
	my ($wr_json) = @_;		my ( $wr_json, $wr_param ) = @_;
	eval {		eval {
	my $wr		my $wr
	= Travel::Status::DE::DBWagenreihung->new(		= Travel::Status::DE::DBWagenreihung->new(
	from_json => $wr_json );		from_json => $wr_json );
	$departure->{wr} = $wr;		$departure->{wr} = $wr;
			$departure->{wr_link} = join( '&',
			map { $_ . '=' . $wr_param->{$_} } keys %{$wr_param} );
	$departure->{wr_text} = join( q{ • },		$departure->{wr_text} = join( q{ • },
	map { $_->desc_short }		map { $_->desc_short }
	grep { $_->desc_short } $wr->groups );		grep { $_->desc_short } $wr->groups );
	my $first = 0;		my $first = 0;
	for my $group ( $wr->groups ) {		for my $group ( $wr->groups ) {
	my $had_entry = 0;		my $had_entry = 0;
	for my $wagon ( $group->wagons ) {		for my $wagon ( $group->carriages ) {
	if (		if (
	not( $wagon->is_locomotive		not( $wagon->is_locomotive
	or $wagon->is_powercar )		or $wagon->is_powercar )
	@@ -808,14 +814,23 @@ sub render_train {
	$entry = 'X';		$entry = 'X';
	$class = 'closed';		$class = 'closed';
	}		}
			elsif ( $wagon->number ) {
			$entry = $wagon->number;
			}
	else {		else {
	$entry = $wagon->number		$entry = $wagon->type;
	\|\| (
	$wagon->type =~ m{AB} ? '½'		#if ($wagon->has_first_class) {
	: $wagon->type =~ m{A} ? '1.'		# if ($wagon->has_second_class) {
	: $wagon->type =~ m{B} ? '2.'		# $entry = '½';
	: $wagon->type		# }
	);		# else {
			# $entry = '1.';
			# }
			#}
			#else {
			# $entry = '2.';
			#}
	}		}
	if (		if (
	$group->train_no ne $departure->{train_no} )		$group->train_no ne $departure->{train_no} )
	@@ -838,7 +853,7 @@ sub render_train {
	return;		return;
	},		},
	sub {		sub {
	$departure->{wr_link} = undef;		$departure->{wr_dt} = undef;
	return;		return;
	}		}
	)->finally(		)->finally(
	@@ -1160,9 +1175,7 @@ sub station_train_details {
	map { $_->type . q{ } . $_->train_no }		map { $_->type . q{ } . $_->train_no }
	$result->replacement_for		$result->replacement_for
	],		],
	wr_link => $result->sched_departure		wr_dt => $result->sched_departure,
	? $result->sched_departure->strftime('%Y%m%d%H%M')
	: undef,
	eva => $result->station_uic,		eva => $result->station_uic,
	start => $result->start,		start => $result->start,
	};		};
	@@ -1526,7 +1539,7 @@ sub handle_efa {
	replacement_for => [],		replacement_for => [],
	route_pre => [],		route_pre => [],
	route_post => [],		route_post => [],
	wr_link => undef,		wr_dt => undef,
	}		}
	);		);
	}		}
	@@ -1901,9 +1914,8 @@ sub handle_result {
	map { $_->type . q{ } . $_->train_no }		map { $_->type . q{ } . $_->train_no }
	$result->replacement_for		$result->replacement_for
	],		],
	wr_link => $result->sched_departure		wr_dt => $result->sched_departure,
	? $result->sched_departure->strftime('%Y%m%d%H%M')		eva => $result->station_uic,
	: undef,
	}		}
	);		);
	}		}
	@@ -1955,9 +1967,8 @@ sub handle_result {
	: [],		: [],
	route_post => $admode eq 'arr' ? []		route_post => $admode eq 'arr' ? []
	: [ map { $_->loc->name } $result->route ],		: [ map { $_->loc->name } $result->route ],
	wr_link => $result->sched_datetime		wr_dt => $result->sched_datetime,
	? $result->sched_datetime->strftime('%Y%m%d%H%M')		eva => $result->station_uic,
	: undef,
	}		}
	);		);
	}		}

lib/DBInfoscreen/Controller/Wagenreihung.pm

+37 −40

Original line number	Original line	Diff line number	Diff line
	@@ -14,28 +14,31 @@ use Travel::Status::DE::DBWagenreihung;
	use Travel::Status::DE::DBWagenreihung::Wagon;		use Travel::Status::DE::DBWagenreihung::Wagon;

	sub handle_wagenreihung_error {		sub handle_wagenreihung_error {
	my ( $self, $train_no, $err ) = @_;		my ( $self, $train, $err ) = @_;

	$self->render(		$self->render(
	'wagenreihung',		'wagenreihung',
	title => "Zug $train_no",		title => $train,
	wr_error => $err,		wr_error => $err,
	train_no => $train_no,
	wr => undef,		wr => undef,
	wref => undef,		wref => undef,
	hide_opts => 1,		hide_opts => 1,
			status => 500,
	);		);
	}		}

	sub wagenreihung {		sub wagenreihung {
	my ($self) = @_;		my ($self) = @_;
	my $train = $self->stash('train');
	my $departure = $self->stash('departure');
	my $exit_side = $self->param('e');		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->render_later;

	$self->wagonorder->get_p( $train, $departure )->then(		$self->wagonorder->get_p( param => $self->req->query_params->to_hash )
			->then(
	sub {		sub {
	my ($json) = @_;		my ($json) = @_;
	my $wr;		my $wr;
	@@ -50,8 +53,8 @@ sub wagenreihung {
	}		}

	if ( $exit_side and $exit_side =~ m{^a} ) {		if ( $exit_side and $exit_side =~ m{^a} ) {
	if ( $wr->sections and defined $wr->direction ) {		if ( $wr->sectors and defined $wr->direction ) {
	my $section_0 = ( $wr->sections )[0];		my $section_0 = ( $wr->sectors )[0];
	my $direction = $wr->direction;		my $direction = $wr->direction;
	if ( $section_0->name eq 'A' and $direction == 0 ) {		if ( $section_0->name eq 'A' and $direction == 0 ) {
	$exit_side =~ s{^a}{};		$exit_side =~ s{^a}{};
	@@ -71,22 +74,21 @@ sub wagenreihung {
	my $wref = {		my $wref = {
	e => $exit_side ? substr( $exit_side, 0, 1 ) : '',		e => $exit_side ? substr( $exit_side, 0, 1 ) : '',
	tt => $wr->train_type,		tt => $wr->train_type,
	tn => $train,		tn => $train_no,
	s => $wr->station->{name},
	p => $wr->platform		p => $wr->platform
	};		};

	if ( $wr->has_bad_wagons ) {		#if ( $wr->has_bad_wagons ) {

	# create fake positions as the correct ones are not available		# # create fake positions as the correct ones are not available
	my $pos = 0;		# my $pos = 0;
	for my $wagon ( $wr->wagons ) {		# for my $wagon ( $wr->wagons ) {
	$wagon->{position}{start_percent} = $pos;		# $wagon->{position}{start_percent} = $pos;
	$wagon->{position}{end_percent} = $pos + 4;		# $wagon->{position}{end_percent} = $pos + 4;
	$pos += 4;		# $pos += 4;
	}		# }
	}		#}
	elsif ( defined $wr->direction and scalar $wr->wagons > 2 ) {		if ( defined $wr->direction and scalar $wr->carriages > 2 ) {

	# wagenlexikon images only know one orientation. They assume		# wagenlexikon images only know one orientation. They assume
	# that the second class (i.e., the wagon with the lowest		# that the second class (i.e., the wagon with the lowest
	@@ -100,17 +102,17 @@ sub wagenreihung {
	# order differs, we do not show a direction, as we do not		# order differs, we do not show a direction, as we do not
	# handle that case yet.		# handle that case yet.

	my @wagons = $wr->wagons;		my @wagons = $wr->carriages;

	# skip first/last wagon as it may be a locomotive		# skip first/last wagon as it may be a locomotive
	my $wna1 = $wagons[1]->number;		my $wna1 = $wagons[1]->number;
	my $wna2 = $wagons[2]->number;		my $wna2 = $wagons[2]->number;
	my $wnb1 = $wagons[-3]->number;		my $wnb1 = $wagons[-3]->number;
	my $wnb2 = $wagons[-2]->number;		my $wnb2 = $wagons[-2]->number;
	my $wpa1 = $wagons[1]{position}{start_percent};		my $wpa1 = $wagons[1]->start_percent;
	my $wpa2 = $wagons[2]{position}{start_percent};		my $wpa2 = $wagons[2]->start_percent;
	my $wpb1 = $wagons[-3]{position}{start_percent};		my $wpb1 = $wagons[-3]->start_percent;
	my $wpb2 = $wagons[-2]{position}{start_percent};		my $wpb2 = $wagons[-2]->start_percent;

	if ( $wna1 =~ m{^\d+$}		if ( $wna1 =~ m{^\d+$}
	and $wna2 =~ m{^\d+$}		and $wna2 =~ m{^\d+$}
	@@ -161,18 +163,13 @@ sub wagenreihung {

	$wref = b64_encode( encode_json($wref) );		$wref = b64_encode( encode_json($wref) );

	my $title = join( ' / ',		my $title = join( ' / ', map { $_->{name} } $wr->trains );
	map { $wr->train_type . ' ' . $_ } $wr->train_numbers );

	$self->render(		$self->render(
	'wagenreihung',		'wagenreihung',
	description => sprintf(		description => sprintf( 'Ist-Wagenreihung %s', $title ),
	'Ist-Wagenreihung %s in %s',
	$title, $wr->station->{name}
	),
	wr_error => undef,		wr_error => undef,
	title => $title,		title => $title,
	train_no => $train,
	wr => $wr,		wr => $wr,
	wref => $wref,		wref => $wref,
	exit_dir => $exit_dir,		exit_dir => $exit_dir,
	@@ -184,7 +181,7 @@ sub wagenreihung {
	my ($err) = @_;		my ($err) = @_;

	$self->handle_wagenreihung_error( $train,		$self->handle_wagenreihung_error( $train,
	$err->{error}->{msg} // $err // "Unbekannter Fehler" );		$err // "Unbekannter Fehler" );
	return;		return;
	}		}
	)->wait;		)->wait;

lib/DBInfoscreen/Helper/Wagonorder.pm

+23 −5

Original line number	Original line	Diff line number	Diff line
	@@ -25,10 +25,28 @@ sub new {
	}		}

	sub get_p {		sub get_p {
	my ( $self, $train_no, $api_ts ) = @_;		my ( $self, %opt ) = @_;

	my $url		my %param;
	= "https://ist-wr.noncd.db.de/wagenreihung/1.0/${train_no}/${api_ts}";
			if ( $opt{param} ) {
			%param = %{ $opt{param} };
			}
			else {
			my $datetime = $opt{datetime}->clone->set_time_zone('UTC');
			%param = (
			administrationId => 80,
			category => $opt{train_type},
			date => $datetime->strftime('%Y-%m-%d'),
			evaNumber => $opt{eva},
			number => $opt{train_number},
			time => $datetime->rfc3339 =~ s{(?=Z)}{.000}r
			);
			}

			my $url = sprintf( '%s?%s',
			'https://www.bahn.de/web/api/reisebegleitung/wagenreihung/vehicle-sequence',
			join( '&', map { $_ . '=' . $param{$_} } keys %param ) );

	my $cache = $self->{realtime_cache};		my $cache = $self->{realtime_cache};

	@@ -39,7 +57,7 @@ sub get_p {
	if ( $content->{error} ) {		if ( $content->{error} ) {
	return $promise->reject($content);		return $promise->reject($content);
	}		}
	return $promise->resolve($content);		return $promise->resolve( $content, \%param );
	}		}

	$self->{user_agent}->request_timeout(10)->get_p( $url => $self->{header} )		$self->{user_agent}->request_timeout(10)->get_p( $url => $self->{header} )
	@@ -66,7 +84,7 @@ sub get_p {
	my $json = $tx->res->json;		my $json = $tx->res->json;

	$cache->freeze( $url, $json );		$cache->freeze( $url, $json );
	$promise->resolve($json);		$promise->resolve( $json, \%param );
	return;		return;
	}		}
	)->catch(		)->catch(

Admin message