Add support for stop-specific messages in journeys

5 files changed, 77 insertions, 15 deletions

diff --git a/Build.PL b/Build.PL
index 140ffad..c6e7d36 100644
--- a/Build.PL
+++ b/Build.PL
@@ -29,6 +29,7 @@ Module::Build->new(
 		'List::Util'                 => 0,
 		'LWP::UserAgent'             => 0,
 		'LWP::Protocol::https'       => 0,
+		'Scalar::Util'               => 0,
 	},
 	script_files  => 'bin/',
 	sign          => 1,
diff --git a/bin/hafas-m b/bin/hafas-m
index 7df631f..42b0681 100755
--- a/bin/hafas-m
+++ b/bin/hafas-m
@@ -371,9 +371,24 @@ elsif ( $opt{journey} ) {
 		$delay_fmt = $delay_len + 3;
 	}
 
+	my $message_id = 1;
+
 	for my $stop ( $result->route ) {
+		my $msg_line = q{};
+		for my $message ( $stop->messages ) {
+			if (    $message->ref_count > 0
+				and $message->code ne
+				'text.journeystop.product.or.direction.changes.stop.message'
+				and $message->text ne 'Halt entfällt' )
+			{
+				if ( not $message->{id} ) {
+					$message->{id} = $message_id++;
+				}
+				$msg_line .= sprintf( ' (%d)', $message->{id} );
+			}
+		}
 		printf(
-"%5s %s %5s %-${delay_fmt}s%${occupancy_len}s%-${occupancy_len}s %s%s\n",
+"%5s %s %5s %-${delay_fmt}s%${occupancy_len}s%-${occupancy_len}s %s%s%s\n",
 			$stop->arr_cancelled ? '--:--'
 			: ( $stop->arr ? $stop->arr->strftime('%H:%M') : q{} ),
 			( $stop->arr and $stop->dep ) ? '→' : q{ },
@@ -385,7 +400,8 @@ elsif ( $opt{journey} ) {
 			$stop->load->{SECOND} ? display_occupancy( $stop->load->{SECOND} )
 			: q{},
 			$stop->loc->name,
-			$stop->direction ? sprintf( '  → %s', $stop->direction ) : q{}
+			$stop->direction ? sprintf( ' → %s', $stop->direction ) : q{},
+			$msg_line,
 		);
 	}
 
@@ -401,6 +417,16 @@ elsif ( $opt{journey} ) {
 		}
 		printf( "%s\n", $msg->text );
 	}
+
+	for my $msg ( $status->messages ) {
+		if ( $msg->{id} ) {
+			say '';
+			if ( $msg->short ) {
+				printf( "(%d) %s\n", $msg->{id}, $msg->short );
+			}
+			printf( "(%d) %s\n", $msg->{id}, $msg->text );
+		}
+	}
 	exit 0;
 }
 
diff --git a/cpanfile b/cpanfile
index 3473989..e33f559 100644
--- a/cpanfile
+++ b/cpanfile
@@ -8,6 +8,7 @@ requires 'List::MoreUtils';
 requires 'List::Util';
 requires 'LWP::UserAgent';
 requires 'LWP::Protocol::https';
+requires 'Scalar::Util';
 
 on test => sub {
 	requires 'File::Slurp';
diff --git a/lib/Travel/Status/DE/HAFAS/Journey.pm b/lib/Travel/Status/DE/HAFAS/Journey.pm
index d8d63ff..eb00272 100644
--- a/lib/Travel/Status/DE/HAFAS/Journey.pm
+++ b/lib/Travel/Status/DE/HAFAS/Journey.pm
@@ -8,7 +8,8 @@ use 5.014;
 
 use parent 'Class::Accessor';
 use DateTime::Format::Strptime;
-use List::Util qw(any);
+use List::Util   qw(any);
+use Scalar::Util qw(weaken);
 use Travel::Status::DE::HAFAS::Stop;
 
 our $VERSION = '5.00';
@@ -110,17 +111,18 @@ sub new {
 	for my $stop ( @{ $journey->{stopL} // [] } ) {
 		my $loc = $locL->[ $stop->{locX} ];
 
-		push(
-			@stops,
-			{
-				loc          => $loc,
-				stop         => $stop,
-				common       => $opt{common},
-				date         => $date,
-				datetime_ref => $datetime_ref,
-				strp_obj     => $hafas->{strptime_obj},
-			}
-		);
+		my $stopref = {
+			loc          => $loc,
+			stop         => $stop,
+			common       => $opt{common},
+			hafas        => $hafas,
+			date         => $date,
+			datetime_ref => $datetime_ref,
+		};
+
+		weaken( $stopref->{hafas} );
+
+		push( @stops, $stopref );
 
 		$route_end = $loc->name;
 	}
diff --git a/lib/Travel/Status/DE/HAFAS/Stop.pm b/lib/Travel/Status/DE/HAFAS/Stop.pm
index 5763465..5d2ab36 100644
--- a/lib/Travel/Status/DE/HAFAS/Stop.pm
+++ b/lib/Travel/Status/DE/HAFAS/Stop.pm
@@ -29,7 +29,8 @@ sub new {
 	my $common       = $opt{common};
 	my $date         = $opt{date};
 	my $datetime_ref = $opt{datetime_ref};
-	my $strp_obj     = $opt{strp_obj};
+	my $hafas        = $opt{hafas};
+	my $strp_obj     = $opt{hafas}{strptime_obj};
 
 	my $sched_arr = $stop->{aTimeS};
 	my $rt_arr    = $stop->{aTimeR};
@@ -69,6 +70,21 @@ sub new {
 	my $arr_cancelled = $stop->{aCncl};
 	my $dep_cancelled = $stop->{dCncl};
 
+	my @messages;
+	for my $msg ( @{ $stop->{msgL} // [] } ) {
+		if ( $msg->{type} eq 'REM' and defined $msg->{remX} ) {
+			push( @messages,
+				$hafas->add_message( $opt{common}{remL}[ $msg->{remX} ] ) );
+		}
+		elsif ( $msg->{type} eq 'HIM' and defined $msg->{himX} ) {
+			push( @messages,
+				$hafas->add_message( $opt{common}{himL}[ $msg->{himX} ], 1 ) );
+		}
+		else {
+			say "Unknown message type $msg->{type}";
+		}
+	}
+
 	my $tco = {};
 	for my $tco_id ( @{ $stop->{dTrnCmpSX}{tcocX} // [] } ) {
 		my $tco_kv = $common->{tcocL}[$tco_id];
@@ -94,6 +110,7 @@ sub new {
 		is_changed_platform => $changed_platform,
 		platform            => $rt_platform // $sched_platform,
 		load                => $tco,
+		messages            => \@messages,
 	};
 
 	bless( $ref, $obj );
@@ -121,6 +138,15 @@ sub handle_day_change {
 	return $timestr;
 }
 
+sub messages {
+	my ($self) = @_;
+
+	if ( $self->{messages} ) {
+		return @{ $self->{messages} };
+	}
+	return;
+}
+
 sub TO_JSON {
 	my ($self) = @_;
 
@@ -225,6 +251,12 @@ Departure or arrival delay in minutes.
 
 Direction signage from this stop on, undef if unchanged.
 
+=item $journey->messages
+
+List of Travel::Status::DE::HAFAS::Message(3pm) instances related to this stop.
+These typically refer to delay reasons, platform changes, or changes in the
+line number / direction heading.
+
 =item $stop->rt_platform
 
 Actual platform.