From 503d31430696a55a5b097eb2107155f1ba42f5e0 Mon Sep 17 00:00:00 2001
From: Daniel Friesel <derf@finalrewind.org>
Date: Sat, 13 Jun 2020 10:29:14 +0200
Subject: store more message details

---
 bin/hafas-m                   | 32 +++++++++++++++++++++++++------
 lib/Travel/Status/DE/HAFAS.pm | 44 ++++++++++++++++++++++++++++++++++---------
 2 files changed, 61 insertions(+), 15 deletions(-)

diff --git a/bin/hafas-m b/bin/hafas-m
index 048e077..7b2491b 100755
--- a/bin/hafas-m
+++ b/bin/hafas-m
@@ -146,10 +146,14 @@ sub display_result {
 
 	for my $line (@lines) {
 
-		my $d = $line->[6];
-		if ( $d->messages ) {
-			print "\n";
-			for my $msg ( $d->messages ) {
+		my $d             = $line->[6];
+		my $first_message = 1;
+		for my $msg ( $d->messages ) {
+			if ( $msg->{ref_count} == 1 ) {
+				if ($first_message) {
+					print "\n";
+					$first_message = 0;
+				}
 				printf( "# %s\n", $msg );
 			}
 		}
@@ -175,12 +179,28 @@ if ( my $err = $status->errstr ) {
 	exit 2;
 }
 
-for my $d ( $status->results() ) {
+my $message_id = 1;
+for my $m ( $status->messages ) {
+	if ( $m->{ref_count} > 1 ) {
+		$m->{id} = $message_id++;
+		printf( "# (%d) %s\n# %s\n\n", $m->{id}, $m->{header}, $m->{lead} );
+	}
+}
+
+for my $d ( $status->results ) {
 
 	if ( $ignore_late and $d->delay ) {
 		next;
 	}
 
+	my $info_line = $d->info // q{};
+
+	for my $message ( $d->messages ) {
+		if ( $message->{ref_count} > 1 ) {
+			$info_line = sprintf( '(%d) %s', $message->{id}, $info_line );
+		}
+	}
+
 	push(
 		@output,
 		[
@@ -191,7 +211,7 @@ for my $d ( $status->results() ) {
 			$d->train,
 			$d->route_end,
 			( $d->platform // q{} ) . ( $d->is_changed_platform ? ' !' : q{} ),
-			$d->info,
+			$info_line,
 			$d
 		]
 	);
diff --git a/lib/Travel/Status/DE/HAFAS.pm b/lib/Travel/Status/DE/HAFAS.pm
index 884b006..010b1f9 100644
--- a/lib/Travel/Status/DE/HAFAS.pm
+++ b/lib/Travel/Status/DE/HAFAS.pm
@@ -10,6 +10,7 @@ no if $] >= 5.018, warnings => 'experimental::smartmatch';
 use Carp qw(confess);
 use DateTime;
 use DateTime::Format::Strptime;
+use List::Util qw(any);
 use LWP::UserAgent;
 use POSIX qw(strftime);
 use Travel::Status::DE::HAFAS::Result;
@@ -124,6 +125,8 @@ sub new {
 		developer_mode => $conf{developer_mode},
 		exclusive_mots => $conf{exclusive_mots},
 		excluded_mots  => $conf{excluded_mots},
+		messages       => [],
+		results        => [],
 		station        => $conf{station},
 		ua             => $ua,
 		post           => {
@@ -171,10 +174,6 @@ sub new {
 	# errors in delay="...") when setting the language to dutch/italian.
 	# No, I don't know why.
 
-	if ( $ref->{developer_mode} ) {
-		say $ref->{raw_xml};
-	}
-
 	$ref->{tree} = XML::LibXML->load_xml(
 		string => $ref->{raw_xml},
 	);
@@ -184,6 +183,7 @@ sub new {
 	}
 
 	$ref->check_input_error;
+	$ref->prepare_results;
 	return $ref;
 }
 
@@ -282,16 +282,39 @@ sub similar_stops {
 	return;
 }
 
-sub results {
+sub add_message_node {
+	my ( $self, $node ) = @_;
+
+	my $header = $node->getAttribute('header');
+	my $lead   = $node->getAttribute('lead');
+
+	for my $message ( @{ $self->{messages} } ) {
+		if ( $header eq $message->{header} and $lead eq $message->{lead} ) {
+			$message->{ref_count}++;
+			return $message;
+		}
+	}
+	my $message = {
+		header    => $header,
+		lead      => $lead,
+		ref_count => 1,
+	};
+	push( @{ $self->{messages} }, $message );
+	return $message;
+}
+
+sub messages {
+	my ($self) = @_;
+	return @{ $self->{messages} };
+}
+
+sub prepare_results {
 	my ($self) = @_;
 	my $mode = $self->{post}->{boardType};
 
 	my $xp_element = XML::LibXML::XPathExpression->new('//Journey');
 	my $xp_msg     = XML::LibXML::XPathExpression->new('./HIMMessage');
 
-	if ( defined $self->{results} ) {
-		return @{ $self->{results} };
-	}
 	if ( not defined $self->{tree} ) {
 		return;
 	}
@@ -326,7 +349,7 @@ sub results {
 		}
 
 		for my $n (@message_nodes) {
-			push( @messages, $n->getAttribute('header') );
+			push( @messages, $self->add_message_node($n) );
 		}
 
 		# Some backends report dd.mm.yy, some report dd.mm.yyyy
@@ -369,7 +392,10 @@ sub results {
 			)
 		);
 	}
+}
 
+sub results {
+	my ($self) = @_;
 	return @{ $self->{results} };
 }
 
-- 
cgit v1.2.3