From 13e307081e3ee411353ef9248b8b0b8d523a0d6c Mon Sep 17 00:00:00 2001
From: Daniel Friesel <derf@finalrewind.org>
Date: Sat, 5 Dec 2020 17:15:24 +0100
Subject: actually add Marudor.pm. Oops.

---
 lib/DBInfoscreen/Controller/Stationboard.pm |   4 +
 lib/DBInfoscreen/Helper/Marudor.pm          | 120 ++++++++++++++++++++++++++++
 2 files changed, 124 insertions(+)
 create mode 100644 lib/DBInfoscreen/Helper/Marudor.pm

diff --git a/lib/DBInfoscreen/Controller/Stationboard.pm b/lib/DBInfoscreen/Controller/Stationboard.pm
index a09a1df..90478a4 100644
--- a/lib/DBInfoscreen/Controller/Stationboard.pm
+++ b/lib/DBInfoscreen/Controller/Stationboard.pm
@@ -479,6 +479,10 @@ sub render_train {
 				return;
 			}
 		)->wait;
+
+		# Looks like utilization data is only available for long-distance trains
+		# – and the few regional trains which also have wagon order data (e.g.
+		# around Stuttgart). Funky.
 		$self->marudor->get_train_utilization( train => $result )->then(
 			sub {
 				my ( $first, $second ) = @_;
diff --git a/lib/DBInfoscreen/Helper/Marudor.pm b/lib/DBInfoscreen/Helper/Marudor.pm
new file mode 100644
index 0000000..41ba81e
--- /dev/null
+++ b/lib/DBInfoscreen/Helper/Marudor.pm
@@ -0,0 +1,120 @@
+package DBInfoscreen::Helper::Marudor;
+
+# Copyright (C) 2020 Daniel Friesel
+#
+# SPDX-License-Identifier: BSD-2-Clause
+
+use strict;
+use warnings;
+use 5.020;
+
+use DateTime;
+use Encode qw(decode encode);
+use Mojo::JSON qw(decode_json);
+use Mojo::Promise;
+use XML::LibXML;
+
+sub new {
+	my ( $class, %opt ) = @_;
+
+	my $version = $opt{version};
+
+	$opt{header}
+	  = { 'User-Agent' =>
+"dbf/${version} on $opt{root_url} +https://finalrewind.org/projects/db-fakedisplay"
+	  };
+
+	return bless( \%opt, $class );
+
+}
+
+sub get_json_p {
+	my ( $self, $cache, $url ) = @_;
+
+	my $promise = Mojo::Promise->new;
+
+	if ( my $content = $cache->thaw($url) ) {
+		return $promise->resolve($content);
+	}
+
+	$self->{log}->debug("get_json_p($url)");
+
+	$self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} )
+	  ->then(
+		sub {
+			my ($tx) = @_;
+
+			if ( my $err = $tx->error ) {
+				$self->{log}->debug(
+"marudor->get_json_p($url): HTTP $err->{code} $err->{message}"
+				);
+				$promise->reject(
+					"GET $url returned HTTP $err->{code} $err->{message}");
+				return;
+			}
+
+			my $res = $tx->res->json;
+
+			$cache->freeze( $url, $res );
+
+			$promise->resolve($res);
+
+			return;
+		}
+	)->catch(
+		sub {
+			my ($err) = @_;
+			$self->{log}->debug("marudor->get_json_p($url): $err");
+			$promise->reject($err);
+			return;
+		}
+	)->wait;
+
+	return $promise;
+}
+
+sub get_train_utilization {
+	my ( $self, %opt ) = @_;
+
+	my $promise = Mojo::Promise->new;
+	my $train   = $opt{train};
+
+	if ( not $train->sched_departure ) {
+		$promise->reject("train has no departure");
+		return $promise;
+	}
+
+	my $train_no     = $train->train_no;
+	my $this_station = $train->station;
+	my @route        = $train->route_post;
+	my $next_station;
+	my $dep = $train->sched_departure->epoch . '000';
+
+	if ( @route > 1 ) {
+		$next_station = $route[1];
+	}
+	else {
+		$next_station = $route[0];
+	}
+
+	$self->get_json_p( $self->{realtime_cache},
+"https://marudor.de/api/hafas/v1/auslastung/${this_station}/${next_station}/${train_no}/${dep}"
+	)->then(
+		sub {
+			my ($utilization_json) = @_;
+
+			$promise->resolve( $utilization_json->{first},
+				$utilization_json->{second} );
+			return;
+		}
+	)->catch(
+		sub {
+			$promise->reject;
+			return;
+		}
+	)->wait;
+
+	return $promise;
+}
+
+1;
-- 
cgit v1.2.3