train details: show expected utilization (via marudor.de)

5 files changed, 79 insertions, 1 deletions

diff --git a/lib/DBInfoscreen.pm b/lib/DBInfoscreen.pm
index ed81638..b04fb03 100644
--- a/lib/DBInfoscreen.pm
+++ b/lib/DBInfoscreen.pm
@@ -1,4 +1,5 @@
 package DBInfoscreen;
+
 # Copyright (C) 2011-2020 Daniel Friesel
 #
 # SPDX-License-Identifier: BSD-2-Clause
@@ -7,6 +8,7 @@ use Mojo::Base 'Mojolicious';
 
 use Cache::File;
 use DBInfoscreen::Helper::HAFAS;
+use DBInfoscreen::Helper::Marudor;
 use DBInfoscreen::Helper::Wagonorder;
 use File::Slurp qw(read_file);
 use JSON;
@@ -114,6 +116,20 @@ sub startup {
 	);
 
 	$self->helper(
+		marudor => sub {
+			my ($self) = @_;
+			state $hafas = DBInfoscreen::Helper::Marudor->new(
+				log            => $self->app->log,
+				main_cache     => $self->app->cache_iris_main,
+				realtime_cache => $self->app->cache_iris_rt,
+				root_url       => $self->url_for('/')->to_abs,
+				user_agent     => $self->ua,
+				version        => $VERSION,
+			);
+		}
+	);
+
+	$self->helper(
 		wagonorder => sub {
 			my ($self) = @_;
 			state $hafas = DBInfoscreen::Helper::Wagonorder->new(
@@ -316,6 +332,35 @@ sub startup {
 	);
 
 	$self->helper(
+		'utilization_icon' => sub {
+			my ( $self,  $utilization ) = @_;
+			my ( $first, $second )      = @{ $utilization // [ 0, 0 ] };
+			my $sum = ( $first + $second ) / 2;
+
+			my @symbols
+			  = (
+				qw(hourglass_empty person_outline people priority_high not_interested)
+			  );
+			my $text = 'Auslastung unbekannt';
+
+			if ( $sum > 3.5 ) {
+				$text = 'Zug ist ausgebucht';
+			}
+			elsif ( $sum >= 2.5 ) {
+				$text = 'Sehr hohe Auslastung';
+			}
+			elsif ( $sum >= 1.5 ) {
+				$text = 'Hohe Auslastung';
+			}
+			elsif ( $sum >= 1 ) {
+				$text = 'Geringe Auslastung';
+			}
+
+			return ( $text, $symbols[$first], $symbols[$second] );
+		}
+	);
+
+	$self->helper(
 		'numeric_platform_part' => sub {
 			my ( $self, $platform ) = @_;
 
diff --git a/lib/DBInfoscreen/Controller/Stationboard.pm b/lib/DBInfoscreen/Controller/Stationboard.pm
index b65aedb..a09a1df 100644
--- a/lib/DBInfoscreen/Controller/Stationboard.pm
+++ b/lib/DBInfoscreen/Controller/Stationboard.pm
@@ -1,4 +1,5 @@
 package DBInfoscreen::Controller::Stationboard;
+
 # Copyright (C) 2011-2020 Daniel Friesel
 #
 # SPDX-License-Identifier: BSD-2-Clause
@@ -457,6 +458,7 @@ sub render_train {
 	$self->render_later;
 
 	my $wagonorder_req  = Mojo::Promise->new;
+	my $utilization_req = Mojo::Promise->new;
 	my $stationinfo_req = Mojo::Promise->new;
 	my $route_req       = Mojo::Promise->new;
 
@@ -477,9 +479,26 @@ sub render_train {
 				return;
 			}
 		)->wait;
+		$self->marudor->get_train_utilization( train => $result )->then(
+			sub {
+				my ( $first, $second ) = @_;
+				$departure->{utilization} = [ $first, $second ];
+				return;
+			},
+			sub {
+				$departure->{utilization} = undef;
+				return;
+			}
+		)->finally(
+			sub {
+				$utilization_req->resolve;
+				return;
+			}
+		)->wait;
 	}
 	else {
 		$wagonorder_req->resolve;
+		$utilization_req->resolve;
 	}
 
 	$self->wagonorder->get_stationinfo_p( $result->station_uic )->then(
@@ -646,7 +665,8 @@ sub render_train {
 	)->wait;
 
 	# Defer rendering until all requests have completed
-	Mojo::Promise->all( $wagonorder_req, $stationinfo_req, $route_req )->then(
+	Mojo::Promise->all( $wagonorder_req, $utilization_req, $stationinfo_req,
+		$route_req )->then(
 		sub {
 			$self->render(
 				$template // '_train_details',
diff --git a/lib/DBInfoscreen/Helper/HAFAS.pm b/lib/DBInfoscreen/Helper/HAFAS.pm
index 5b02e9e..fd688db 100644
--- a/lib/DBInfoscreen/Helper/HAFAS.pm
+++ b/lib/DBInfoscreen/Helper/HAFAS.pm
@@ -1,4 +1,5 @@
 package DBInfoscreen::Helper::HAFAS;
+
 # Copyright (C) 2011-2020 Daniel Friesel
 #
 # SPDX-License-Identifier: BSD-2-Clause
@@ -36,6 +37,8 @@ sub get_json_p {
 		return $promise->resolve($content);
 	}
 
+	$self->{log}->debug("get_json_p($url)");
+
 	$self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} )
 	  ->then(
 		sub {
@@ -85,6 +88,8 @@ sub get_xml_p {
 		return $promise->resolve($content);
 	}
 
+	$self->{log}->debug("get_xml_p($url)");
+
 	$self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} )
 	  ->then(
 		sub {
diff --git a/templates/_train_details.html.ep b/templates/_train_details.html.ep
index 05f4dec..e1ce093 100644
--- a/templates/_train_details.html.ep
+++ b/templates/_train_details.html.ep
@@ -120,6 +120,13 @@
 %     }
     </div>
 
+%   if (my $u = $departure->{utilization}) {
+      <div class="verbose">
+%       my ($text, $icon1, $icon2) = utilization_icon($u);
+        <%= $text %><span style="padding-right: 0.5em;">.</span> 1. <i class="material-icons" aria-hidden="true" style="padding-right: 0.5em; vertical-align: bottom;"><%= $icon1 %></i> 2. <i class="material-icons" aria-hidden="true" style="vertical-align: bottom;"><%= $icon2 %></i>
+      </div>
+%   }
+
 %   if ($departure->{moreinfo} and @{$departure->{moreinfo}}) {
       Meldungen:
       <ul>
diff --git a/templates/about.html.ep b/templates/about.html.ep
index 155dd8b..f4b9b33 100644
--- a/templates/about.html.ep
+++ b/templates/about.html.ep
@@ -13,6 +13,7 @@
 		Wagenreihung: <a href="https://finalrewind.org/projects/Travel-Status-DE-DBWagenreihung/">Travel::Status::DE::DBWagenreihung</a>
 		v<%= $Travel::Status::DE::DBWagenreihung::VERSION %><br/>
 		Karte: <a href="https://v5.db.transport.rest/">transport.rest</a> von <a href="https://github.com/derhuerst">@derhuerst</a><br/>
+		Zugauslastung: <a href="https://docs.marudor.de/">marudor.de</a><br/>
 		<br/>
 		Grundlage der <a href="https://data.deutschebahn.com/dataset/zugbildungsplanzugbildungsplan-zpar">Wagengattungsdaten</a> © DB Fernverkehr AG, lizensiert unter CC-BY 4.0
 		<br/>