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

8 files changed, 131 insertions, 114 deletions

diff --git a/cpanfile b/cpanfile
index ec7f440..abd0203 100644
--- a/cpanfile
+++ b/cpanfile
@@ -10,7 +10,7 @@ requires 'List::UtilsBy';
 requires 'LWP::UserAgent';
 requires 'LWP::Protocol::https';
 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::HAFAS', '>= 5.06';
 requires 'Travel::Status::DE::IRIS';
diff --git a/lib/DBInfoscreen.pm b/lib/DBInfoscreen.pm
index 2e15eb3..fd1aaf8 100644
--- a/lib/DBInfoscreen.pm
+++ b/lib/DBInfoscreen.pm
@@ -313,7 +313,7 @@ sub startup {
 
 	$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('/_ajax_mapinfo/:tripid/:lineno')->to('map#ajax_route');
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(
diff --git a/templates/_train_details.html.ep b/templates/_train_details.html.ep
index c0248d9..49edc3e 100644
--- a/templates/_train_details.html.ep
+++ b/templates/_train_details.html.ep
@@ -128,7 +128,7 @@
 %       $left = q{};
 %       $right = '▶';
 %     }
-      <a href="/_wr/<%= $departure->{train_no} %>/<%= $departure->{wr_link} %>?e=<%= $departure->{wr_direction} // '' %>">
+      <a href="/carriage-formation?<%= $departure->{wr_link} %>&amp;e=<%= $departure->{wr_direction} // '' %>">
       %= $left
       % for my $entry ((defined $departure->{wr_direction_num} and $departure->{wr_direction_num} != $wr->direction) ? reverse @{$departure->{wr_preview} // []} : @{$departure->{wr_preview} // []}) {
         % if ($entry->[1]) {
@@ -152,7 +152,7 @@
 %       }
 %     }
 %     if ($departure->{wr_link}) {
-        <a class="smallbutton" href="/_wr/<%= $departure->{train_no} %>/<%= $departure->{wr_link} %>?e=<%= $departure->{wr_direction} // '' %>"><i class="material-icons" aria-hidden="true">train</i> <%= $departure->{wr_text} || 'Wagen' %>
+        <a class="smallbutton" href="/carriage-formation?<%= $departure->{wr_link} %>&amp;e=<%= $departure->{wr_direction} // '' %>"><i class="material-icons" aria-hidden="true">train</i> <%= $departure->{wr_text} || 'Wagen' %>
         </a>
 %     }
 %     if ($departure->{train_type} and $departure->{train_no} and (not param('hafas') or param('hafas') eq 'DB')) {
diff --git a/templates/_wagon.html.ep b/templates/_wagon.html.ep
index 59a2ca1..46d07b7 100644
--- a/templates/_wagon.html.ep
+++ b/templates/_wagon.html.ep
@@ -1,19 +1,19 @@
 % my $bg = '';
 % my $extra_class = '';
-% if ($wagon->is_first_class) {
-%   $extra_class .= ' firstclass';
-% }
+% #if ($wagon->has_first_class) {
+% #  $extra_class .= ' firstclass';
+% #}
 % if ($wagon->is_locomotive or $wagon->is_powercar) {
 %   $extra_class .= ' powercar';
 % }
 % if ($wagon->is_closed) {
 %   $extra_class .= ' closed';
 % }
-% if ($wagon->train_no ne $train_no) {
+% if ($group->train_no ne $train_no) {
 %   $extra_class .= ' nondestwagon';
 % }
   <div class="wagon <%= $extra_class %>" style="
-  top: <%= $wagon->{position}{start_percent} %>%; bottom: <%= 100 - $wagon->{position}{end_percent} %>%; <%= $bg %>">
+  top: <%= $wagon->start_percent %>%; bottom: <%= 100 - $wagon->end_percent %>%; <%= $bg %>">
 %   if ($wagon->is_locomotive or $wagon->is_powercar) {
 %   }
 %   elsif ($wagon->is_closed) {
@@ -21,25 +21,19 @@
 %   }
 %   else {
 %=    $wagon->number // '?'
-%     if ($wagon->has_accessibility) {
+%     if(0){ #if ($wagon->has_wheelchair_space) {
         <i class="material-icons" style="font-size: 20px;">accessible</i>
 %     }
-%     if ($wagon->has_bistro) {
+%     if(0){ #if ($wagon->has_bistro) {
         <i class="material-icons">restaurant</i>
 %     }
-%     if ($wagon->has_compartments) {
-        <!--<i class="material-icons">folder</i>-->
-%     }
-%     if ($wagon->has_quiet_area) {
+%     if(0){ #if ($wagon->has_quiet_zone) {
         <i class="tiny material-icons">volume_off</i>
 %     }
-%     if ($wagon->has_phone_area) {
-        <i class="material-icons">smartphone</i>
-%     }
-%     if ($wagon->has_family_area) {
+%     if(0){ #if ($wagon->has_family_zone) {
         <i class="material-icons">people</i>
 %     }
-%     if ($wagon->has_bahn_comfort) {
+%     if(0){ #if ($wagon->has_bahn_comfort) {
         <i class="material-icons">star</i>
 %     }
 %   }
@@ -55,9 +49,9 @@
   </div>
   </div>
   <div class="details" style="
-  top: <%= $wagon->{position}{start_percent} %>%; bottom: <%= 100 - $wagon->{position}{end_percent} %>%;">
+  top: <%= $wagon->start_percent %>%; bottom: <%= 100 - $wagon->end_percent %>%;">
 %   if ($exit_dir ne 'right') {
-%     if (my $img = wagon_image($wagon->train_subtype // $wr->train_type // '?', $wagon->type, $wagon->uic_id)) {
+%     if (my $img = wagon_image($wr->train_type // '?', $wagon->type, $wagon->uic_id)) {
         <a class="type" href="/w/<%= $img %>?n=<%= $wagon->number // '' %>&amp;s=<%= $wagon->section %>&amp;r=<%= $wref %>"><%= $wagon->type %></a>
 %     }
 %     else {
@@ -67,7 +61,7 @@
 %     }
 %   }
 %   my $uic_id = $wagon->uic_id;
-%   if (length($uic_id) != 12) {
+%   if (length($uic_id) != 12 and length($uic_id) != 14) {
       <span class="uicunknown"><%= $uic_id %></span>
 %   }
 %   elsif (substr($uic_id, 0, 2) >= 90) {
@@ -77,7 +71,7 @@
       <span class="uicexchange"><%= substr($uic_id, 0, 2) %></span><span class="uiccountry"><%= substr($uic_id, 2, 2) %></span><span class="uic56"><%= substr($uic_id, 4, 2) %></span><span class="uic78"><%= substr($uic_id, 6, 2) %></span><span class="uicno"><%= substr($uic_id, 8, 3) %></span><span class="uiccheck"><%= substr($uic_id, 11) %></span>
 %   }
 %   if ($exit_dir eq 'right') {
-%     if (my $img = wagon_image($wagon->train_subtype // $wr->train_type // '?', $wagon->type, $wagon->uic_id)) {
+%     if (my $img = wagon_image($wr->train_type // '?', $wagon->type, $wagon->uic_id)) {
         <a class="type" href="/w/<%= $img %>?n=<%= $wagon->number // '' %>&amp;s=<%= $wagon->section %>&amp;r=<%= $wref %>"><%= $wagon->type %></a>
 %     }
 %     else {
@@ -89,15 +83,15 @@
 %   if ($multi and $first) {
       <br/>
       <span class="groupno">
-%       if (scalar $wr->train_nos > 1) {
-          <%= $wr->train_type %> <%= ($wr->groups)[$wagon->group_index]->train_no %>
+%       if (scalar $wr->train_numbers > 1) {
+          <%= $group->train_type %> <%= $group->train_no %>
 %       }
 %       if (scalar $wr->destinations > 1) {
-          → <%= $wr->{data}{istformation}{allFahrzeuggruppe}[$wagon->group_index]{zielbetriebsstellename} %>
+          → <%= $group->destination %>
 %       }
       </span>
-      % if ($multi and ($wr->groups)[$wagon->group_index]->desc_short) {
-        <span class="grouptype"><%= ($wr->groups)[$wagon->group_index]->desc_short %></span>
+      % if ($multi and $group->desc_short) {
+        <span class="grouptype"><%= $group->desc_short %></span>
 %     }
 %   }
   </div>
diff --git a/templates/wagenreihung.html.ep b/templates/wagenreihung.html.ep
index 6781dca..0af66bd 100644
--- a/templates/wagenreihung.html.ep
+++ b/templates/wagenreihung.html.ep
@@ -9,42 +9,39 @@
 % else {
   <div class="container">
     <div style="text-align: center;">
-      <%= $wr->station->{name} %> Gleis <%= $wr->platform %><br/>
+      Gleis <%= $wr->platform %><br/>
     </div>
   </div>
   <div class="container">
     <div class="wagonorder exit-<%= stash('exit_dir') // 'unknown'%>">
-%     if (not $wr->has_bad_wagons) {
-%       for my $section ($wr->sections) {
-          <div class="section" style="
-          top: <%= $section->{start_percent} %>%; bottom: <%= 100 - $section->{end_percent} %>%;">
-%=          $section->{name}
-          </div>
-%       }
+%     for my $sector ($wr->sectors) {
+        <div class="section" style="
+        top: <%= $sector->start_percent %>%; bottom: <%= 100 - $sector->end_percent %>%;">
+%=        $sector->name
+        </div>
 %     }
 %     for my $group ($wr->groups) {
 %       my $first = 1;
-%       for my $wagon ($group->wagons) {
-%=        include '_wagon', wr => $wr, wagon => $wagon, first => $first, multi => (scalar $wr->destinations) - 1 + (scalar $wr->train_nos) - 1, wref => $wref, exit_dir => stash('exit_dir');
+%       for my $wagon ($group->carriages) {
+%=        include '_wagon', wr => $wr, group => $group, wagon => $wagon, first => $first, multi => (scalar $wr->destinations) - 1 + (scalar $wr->train_numbers) - 1, wref => $wref, exit_dir => stash('exit_dir'), train_no => param('number');
 %         $first = 0;
 %       }
 %     }
       </div>
-      <div style="text-align: center;">
-%=      join( ' / ', map { $_->{name} } $wr->origins )
-        →
-%=      join( ' / ', map { $_->{name} } $wr->destinations )
-      </div>
     % for my $group ($wr->groups) {
       % if ($group->description) {
         <div style="text-align: center;">
           %= $group->description
-          % if (scalar $wr->groups > 1 and $group->has_sections) {
-            in Abschnitt <%= join(q{}, sort $group->sections) %>
+          % if (scalar $wr->groups > 1 and $group->has_sectors) {
+            in Abschnitt <%= join(q{}, sort $group->sectors) %>
           % }
         </div>
       % }
     % }
+      <div style="text-align: center;">
+        nach
+%=      join( ' / ', map { $_->{name} } $wr->destinations )
+      </div>
 <!--  <div>
       Legende: ♿ Behindertengerechte Ausstattung / 🍴 Bistro/Restaurant / 🚪 Abteile vorhanden
     </div>