Directly use DBRIS::Formation for wagon order; enable proxy support thereHEAD4.37.15main

4 files changed, 67 insertions, 128 deletions

diff --git a/lib/DBInfoscreen/Controller/Stationboard.pm b/lib/DBInfoscreen/Controller/Stationboard.pm
index 4a46821..0787896 100644
--- a/lib/DBInfoscreen/Controller/Stationboard.pm
+++ b/lib/DBInfoscreen/Controller/Stationboard.pm
@@ -854,21 +854,24 @@ sub render_train {
 	  = ( $wagonorder_req, $occupancy_req, $stationinfo_req, $route_req );
 
 	if ( $departure->{wr_dt} ) {
-		$self->wagonorder->get_p(
-			train_type   => $result->type,
-			train_number => $result->train_no,
-			datetime     => $departure->{wr_dt},
-			eva          => $departure->{eva}
+		$self->dbris->get_wagonorder_p(
+			train_type => $result->type,
+			train_no   => $result->train_no,
+			datetime   => $departure->{wr_dt},
+			eva        => $departure->{eva}
 		)->then(
 			sub {
-				my ( $wr_json, $wr_param ) = @_;
+				my ($wr) = @_;
 				eval {
-					my $wr
-					  = Travel::Status::DE::DBRIS::Formation->new(
-						json => $wr_json );
+					$wr                   = $wr->result;
 					$departure->{wr}      = $wr;
-					$departure->{wr_link} = join( '&',
-						map { $_ . '=' . $wr_param->{$_} } keys %{$wr_param} );
+					$departure->{wr_link} = sprintf(
+						'tt=%s&tn=%s&dt=%d&eva=%d',
+						$result->type,
+						$result->train_no,
+						$departure->{wr_dt}->clone->set_time_zone('UTC')->epoch,
+						$departure->{eva}
+					);
 					$departure->{wr_text} = join( q{ • },
 						map { $_->desc_short }
 						grep { $_->desc_short } $wr->groups );
diff --git a/lib/DBInfoscreen/Controller/Wagenreihung.pm b/lib/DBInfoscreen/Controller/Wagenreihung.pm
index b9f0ee3..43a04f3 100644
--- a/lib/DBInfoscreen/Controller/Wagenreihung.pm
+++ b/lib/DBInfoscreen/Controller/Wagenreihung.pm
@@ -10,6 +10,7 @@ use Mojo::Util qw(b64_encode b64_decode);
 
 use utf8;
 
+use DateTime;
 use Travel::Status::DE::DBRIS::Formation;
 
 sub handle_wagenreihung_error {
@@ -30,25 +31,27 @@ sub wagenreihung {
 	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}";
+	my $train_type = $self->param('tt');
+	my $train_no   = $self->param('tn');
+	my $eva        = $self->param('eva');
+	my $dt         = DateTime->from_epoch(
+		epoch     => $self->param('dt'),
+		time_zone => 'UTC'
+	);
+
+	my $train = "${train_type} ${train_no}";
 
 	$self->render_later;
 
-	$self->wagonorder->get_p( param => $self->req->query_params->to_hash )
-	  ->then(
+	$self->dbris->get_wagonorder_p(
+		train_type => $train_type,
+		train_no   => $train_no,
+		datetime   => $dt,
+		eva        => $eva,
+	)->then(
 		sub {
-			my ($json) = @_;
-			my $wr;
-			eval {
-				$wr
-				  = Travel::Status::DE::DBRIS::Formation->new( json => $json );
-			};
-			if ($@) {
-				$self->handle_wagenreihung_error( $train, scalar $@ );
-				return;
-			}
+			my ($status) = @_;
+			my $wr = $status->result;
 
 			if ( $exit_side and $exit_side =~ m{^a} ) {
 				if ( $wr->sectors and defined $wr->direction ) {
@@ -172,10 +175,11 @@ sub wagenreihung {
 				wref        => $wref,
 				exit_dir    => $exit_dir,
 				hide_opts   => 1,
-				ts          => $json->{ts},
+
+				#ts          => $json->{ts},
 			);
 		}
-	  )->catch(
+	)->catch(
 		sub {
 			my ($err) = @_;
 
@@ -183,7 +187,7 @@ sub wagenreihung {
 				$err // "Unbekannter Fehler" );
 			return;
 		}
-	  )->wait;
+	)->wait;
 
 }
 
diff --git a/lib/DBInfoscreen/Helper/DBRIS.pm b/lib/DBInfoscreen/Helper/DBRIS.pm
index e780213..593dc90 100644
--- a/lib/DBInfoscreen/Helper/DBRIS.pm
+++ b/lib/DBInfoscreen/Helper/DBRIS.pm
@@ -29,8 +29,8 @@ sub new {
 
 }
 
-sub get_journey_p {
-	my ( $self, %opt ) = @_;
+sub get_agent {
+	my ($self) = @_;
 
 	my $agent = $self->{user_agent};
 
@@ -40,11 +40,17 @@ sub get_journey_p {
 		$agent->proxy->https($proxy);
 	}
 
+	return $agent;
+}
+
+sub get_journey_p {
+	my ( $self, %opt ) = @_;
+
 	return Travel::Status::DE::DBRIS->new_p(
 		journey    => $opt{id},
 		cache      => $self->{realtime_cache},
 		promise    => 'Mojo::Promise',
-		user_agent => $agent->request_timeout(10)
+		user_agent => $self->get_agent->request_timeout(10)
 	);
 }
 
@@ -56,20 +62,12 @@ sub get_polyline_p {
 	my $trip_id = $opt{id};
 	my $promise = Mojo::Promise->new;
 
-	my $agent = $self->{user_agent};
-
-	if ( my $proxy = $ENV{DBFAKEDISPLAY_DBRIS_PROXY} ) {
-		$agent = Mojo::UserAgent->new;
-		$agent->proxy->http($proxy);
-		$agent->proxy->https($proxy);
-	}
-
 	Travel::Status::DE::DBRIS->new_p(
 		journey       => $trip_id,
 		with_polyline => 1,
 		cache         => $self->{realtime_cache},
 		promise       => 'Mojo::Promise',
-		user_agent    => $agent->request_timeout(10)
+		user_agent    => $self->get_agent->request_timeout(10)
 	)->then(
 		sub {
 			my ($dbris) = @_;
@@ -90,4 +88,25 @@ sub get_polyline_p {
 	return $promise;
 }
 
+sub get_wagonorder_p {
+	my ( $self, %opt ) = @_;
+
+	$self->{log}
+	  ->debug("get_wagonorder_p($opt{train_type} $opt{train_no} @ $opt{eva})");
+
+	return Travel::Status::DE::DBRIS->new_p(
+		cache         => $self->{main_cache},
+		failure_cache => $self->{realtime_cache},
+		promise       => 'Mojo::Promise',
+		user_agent    => $self->get_agent->request_timeout(10),
+		formation     => {
+			departure    => $opt{datetime},
+			eva          => $opt{eva},
+			train_type   => $opt{train_type},
+			train_number => $opt{train_no}
+		},
+		developer_mode => $self->{log}->is_level('debug') ? 1 : 0,
+	);
+}
+
 1;
diff --git a/lib/DBInfoscreen/Helper/Wagonorder.pm b/lib/DBInfoscreen/Helper/Wagonorder.pm
index 9981244..8ec1a06 100644
--- a/lib/DBInfoscreen/Helper/Wagonorder.pm
+++ b/lib/DBInfoscreen/Helper/Wagonorder.pm
@@ -25,93 +25,6 @@ sub new {
 
 }
 
-sub get_p {
-	my ( $self, %opt ) = @_;
-
-	my %param;
-
-	if ( $opt{param} ) {
-		%param = %{ $opt{param} };
-		delete $param{e};
-	}
-	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{$_} } sort keys %param ) );
-
-	my $promise = Mojo::Promise->new;
-
-	if ( my $content = $self->{main_cache}->thaw($url) ) {
-		$self->{log}->debug("wagonorder->get_p($url): cached");
-		if ( $content->{error} ) {
-			return $promise->reject(
-"GET $url: HTTP $content->{error}{code} $content->{error}{message} (cachd)"
-			);
-		}
-		return $promise->resolve( $content, \%param );
-	}
-
-	if ( my $content = $self->{realtime_cache}->thaw($url) ) {
-		$self->{log}->debug("wagonorder->get_p($url): cached");
-		if ( $content->{error} ) {
-			return $promise->reject(
-"GET $url: HTTP $content->{error}{code} $content->{error}{message} (cachd)"
-			);
-		}
-		return $promise->resolve( $content, \%param );
-	}
-
-	$self->{user_agent}->request_timeout(10)->get_p( $url => $self->{header} )
-	  ->then(
-		sub {
-			my ($tx) = @_;
-
-			if ( my $err = $tx->error ) {
-				my $json = {
-					error => {
-						id  => $err->{code},
-						msg => $err->{message}
-					}
-				};
-				$self->{log}->debug(
-					"wagonorder->get_p($url): HTTP $err->{code} $err->{message}"
-				);
-				$self->{realtime_cache}->freeze( $url, $json );
-				$promise->reject("GET $url: HTTP $err->{code} $err->{message}");
-				return;
-			}
-
-			$self->{log}->debug("wagonorder->get_p($url): OK");
-			my $json = $tx->res->json;
-			$json->{ts} = DateTime->now( time_zone => 'Europe/Berlin' )
-			  ->strftime('%d.%m.%Y %H:%M');
-
-			$self->{main_cache}->freeze( $url, $json );
-			$promise->resolve( $json, \%param );
-			return;
-		}
-	)->catch(
-		sub {
-			my ($err) = @_;
-			$self->{log}->warn("wagonorder->get_p($url): $err");
-			$promise->reject("GET $url: $err");
-			return;
-		}
-	)->wait;
-	return $promise;
-}
-
 sub get_stationinfo_p {
 	my ( $self, $eva ) = @_;