Switch to new bahn.de carriage formation API (WiP)

3 files changed, 94 insertions, 68 deletions

diff --git a/lib/DBInfoscreen/Controller/Stationboard.pm b/lib/DBInfoscreen/Controller/Stationboard.pm
index 2729c19..66bf402 100644
--- a/lib/DBInfoscreen/Controller/Stationboard.pm
+++ b/lib/DBInfoscreen/Controller/Stationboard.pm
@@ -773,23 +773,29 @@ sub render_train {
 	my @requests
 	  = ( $wagonorder_req, $occupancy_req, $stationinfo_req, $route_req );
 
-	if ( $departure->{wr_link} ) {
-		$self->wagonorder->get_p( $result->train_no, $departure->{wr_link} )
-		  ->then(
+	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 {
-				my ($wr_json) = @_;
+				my ( $wr_json, $wr_param ) = @_;
 				eval {
 					my $wr
 					  = Travel::Status::DE::DBWagenreihung->new(
 						from_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->wagons ) {
+						for my $wagon ( $group->carriages ) {
 							if (
 								not(   $wagon->is_locomotive
 									or $wagon->is_powercar )
@@ -808,14 +814,23 @@ sub render_train {
 									$entry = 'X';
 									$class = 'closed';
 								}
+								elsif ( $wagon->number ) {
+									$entry = $wagon->number;
+								}
 								else {
-									$entry = $wagon->number
-									  || (
-										  $wagon->type =~ m{AB} ? '½'
-										: $wagon->type =~ m{A}  ? '1.'
-										: $wagon->type =~ m{B}  ? '2.'
-										:                         $wagon->type
-									  );
+									$entry = $wagon->type;
+
+									#if ($wagon->has_first_class) {
+									#	if ($wagon->has_second_class) {
+									#		$entry = '½';
+									#	}
+									#	else {
+									#		$entry = '1.';
+									#	}
+									#}
+									#else {
+									#	$entry = '2.';
+									#}
 								}
 								if (
 									$group->train_no ne $departure->{train_no} )
@@ -838,7 +853,7 @@ sub render_train {
 				return;
 			},
 			sub {
-				$departure->{wr_link} = undef;
+				$departure->{wr_dt} = undef;
 				return;
 			}
 		)->finally(
@@ -1160,9 +1175,7 @@ sub station_train_details {
 					map { $_->type . q{ } . $_->train_no }
 					  $result->replacement_for
 				],
-				wr_link => $result->sched_departure
-				? $result->sched_departure->strftime('%Y%m%d%H%M')
-				: undef,
+				wr_dt => $result->sched_departure,
 				eva   => $result->station_uic,
 				start => $result->start,
 			};
@@ -1526,7 +1539,7 @@ sub handle_efa {
 				replacement_for => [],
 				route_pre       => [],
 				route_post      => [],
-				wr_link         => undef,
+				wr_dt           => undef,
 			}
 		);
 	}
@@ -1901,9 +1914,8 @@ sub handle_result {
 							map { $_->type . q{ } . $_->train_no }
 							  $result->replacement_for
 						],
-						wr_link => $result->sched_departure
-						? $result->sched_departure->strftime('%Y%m%d%H%M')
-						: undef,
+						wr_dt => $result->sched_departure,
+						eva   => $result->station_uic,
 					}
 				);
 			}
@@ -1955,9 +1967,8 @@ sub handle_result {
 						: [],
 						route_post => $admode eq 'arr' ? []
 						: [ map { $_->loc->name } $result->route ],
-						wr_link => $result->sched_datetime
-						? $result->sched_datetime->strftime('%Y%m%d%H%M')
-						: undef,
+						wr_dt => $result->sched_datetime,
+						eva   => $result->station_uic,
 					}
 				);
 			}
diff --git a/lib/DBInfoscreen/Controller/Wagenreihung.pm b/lib/DBInfoscreen/Controller/Wagenreihung.pm
index 03a607d..bfda626 100644
--- a/lib/DBInfoscreen/Controller/Wagenreihung.pm
+++ b/lib/DBInfoscreen/Controller/Wagenreihung.pm
@@ -14,28 +14,31 @@ use Travel::Status::DE::DBWagenreihung;
 use Travel::Status::DE::DBWagenreihung::Wagon;
 
 sub handle_wagenreihung_error {
-	my ( $self, $train_no, $err ) = @_;
+	my ( $self, $train, $err ) = @_;
 
 	$self->render(
 		'wagenreihung',
-		title     => "Zug $train_no",
+		title     => $train,
 		wr_error  => $err,
-		train_no  => $train_no,
 		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;
@@ -50,8 +53,8 @@ sub wagenreihung {
 			}
 
 			if ( $exit_side and $exit_side =~ m{^a} ) {
-				if ( $wr->sections and defined $wr->direction ) {
-					my $section_0 = ( $wr->sections )[0];
+				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}{};
@@ -71,22 +74,21 @@ sub wagenreihung {
 			my $wref = {
 				e  => $exit_side ? substr( $exit_side, 0, 1 ) : '',
 				tt => $wr->train_type,
-				tn => $train,
-				s  => $wr->station->{name},
+				tn => $train_no,
 				p  => $wr->platform
 			};
 
-			if ( $wr->has_bad_wagons ) {
+			#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;
-				}
-			}
-			elsif ( defined $wr->direction and scalar $wr->wagons > 2 ) {
+			#	# 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
@@ -100,17 +102,17 @@ sub wagenreihung {
 				# order differs, we do not show a direction, as we do not
 				# handle that case yet.
 
-				my @wagons = $wr->wagons;
+				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]{position}{start_percent};
-				my $wpa2 = $wagons[2]{position}{start_percent};
-				my $wpb1 = $wagons[-3]{position}{start_percent};
-				my $wpb2 = $wagons[-2]{position}{start_percent};
+				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+$}
@@ -161,22 +163,17 @@ sub wagenreihung {
 
 			$wref = b64_encode( encode_json($wref) );
 
-			my $title = join( ' / ',
-				map { $wr->train_type . ' ' . $_ } $wr->train_numbers );
+			my $title = join( ' / ', map { $_->{name} } $wr->trains );
 
 			$self->render(
 				'wagenreihung',
-				description => sprintf(
-					'Ist-Wagenreihung %s in %s',
-					$title, $wr->station->{name}
-				),
-				wr_error  => undef,
-				title     => $title,
-				train_no  => $train,
-				wr        => $wr,
-				wref      => $wref,
-				exit_dir  => $exit_dir,
-				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,
 			);
 		}
 	)->catch(
@@ -184,7 +181,7 @@ sub wagenreihung {
 			my ($err) = @_;
 
 			$self->handle_wagenreihung_error( $train,
-				$err->{error}->{msg} // $err // "Unbekannter Fehler" );
+				$err // "Unbekannter Fehler" );
 			return;
 		}
 	)->wait;
diff --git a/lib/DBInfoscreen/Helper/Wagonorder.pm b/lib/DBInfoscreen/Helper/Wagonorder.pm
index 5cdee40..33c7272 100644
--- a/lib/DBInfoscreen/Helper/Wagonorder.pm
+++ b/lib/DBInfoscreen/Helper/Wagonorder.pm
@@ -25,10 +25,28 @@ sub new {
 }
 
 sub get_p {
-	my ( $self, $train_no, $api_ts ) = @_;
+	my ( $self, %opt ) = @_;
 
-	my $url
-	  = "https://ist-wr.noncd.db.de/wagenreihung/1.0/${train_no}/${api_ts}";
+	my %param;
+
+	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};
 
@@ -39,7 +57,7 @@ sub get_p {
 		if ( $content->{error} ) {
 			return $promise->reject($content);
 		}
-		return $promise->resolve($content);
+		return $promise->resolve( $content, \%param );
 	}
 
 	$self->{user_agent}->request_timeout(10)->get_p( $url => $self->{header} )
@@ -66,7 +84,7 @@ sub get_p {
 			my $json = $tx->res->json;
 
 			$cache->freeze( $url, $json );
-			$promise->resolve($json);
+			$promise->resolve( $json, \%param );
 			return;
 		}
 	)->catch(