preparations for optional emma message support

2 files changed, 41 insertions, 0 deletions

diff --git a/lib/Travel/Status/DE/IRIS.pm b/lib/Travel/Status/DE/IRIS.pm
index 937bb65..3519952 100644
--- a/lib/Travel/Status/DE/IRIS.pm
+++ b/lib/Travel/Status/DE/IRIS.pm
@@ -330,9 +330,11 @@ sub get_realtime {
 		my $e_ar   = ( $s->findnodes('./ar') )[0];
 		my $e_dp   = ( $s->findnodes('./dp') )[0];
 		my @e_refs = $s->findnodes('./ref/tl');
+		my @e_tms  = $s->findnodes('./m');
 		my @e_ms   = $s->findnodes('.//m');
 
 		my %messages;
+		my %track_messages;
 
 		my $result = first { $_->raw_id eq $id } $self->results;
 
@@ -362,8 +364,17 @@ sub get_realtime {
 				$messages{$msgid} = [ $ts, $type, $value ];
 			}
 		}
+		for my $e_tm (@e_tms) {
+			my $type  = $e_tm->getAttribute('t');
+			my $msgid = $e_tm->getAttribute('id');
+			my $ts    = $e_tm->getAttribute('ts');
+			my $from  = $e_tm->getAttribute('from');
+			my $to    = $e_tm->getAttribute('to');
+			$track_messages{$msgid} = [ $ts, $from, $to, $type, $msgid ];
+		}
 
 		$result->set_messages(%messages);
+		$result->set_track_messages(%track_messages);
 
 		# note: A departure may also have a ./tl attribute. However, we do
 		# not need to process it because it only matters for departures which
diff --git a/lib/Travel/Status/DE/IRIS/Result.pm b/lib/Travel/Status/DE/IRIS/Result.pm
index 63e0c40..153db87 100644
--- a/lib/Travel/Status/DE/IRIS/Result.pm
+++ b/lib/Travel/Status/DE/IRIS/Result.pm
@@ -305,6 +305,14 @@ sub set_messages {
 	return $self;
 }
 
+sub set_track_messages {
+	my ( $self, %track_messages ) = @_;
+
+	$self->{track_messages} = \%track_messages;
+
+	return $self;
+}
+
 sub set_realtime {
 	my ( $self, $xmlobj ) = @_;
 
@@ -469,6 +477,28 @@ sub delay_messages {
 	return @ret;
 }
 
+sub track_messages {
+	my ($self) = @_;
+
+	my @keys = reverse sort keys %{ $self->{track_messages} };
+	my @msgs = map { $self->{track_messages}{$_} } @keys;
+	my @ret;
+
+	for my $msg (@msgs) {
+		push(
+			@ret,
+			[
+				$self->parse_ts( $msg->[0] ),
+				$self->parse_ts( $msg->[1] ),
+				$self->parse_ts( $msg->[2] ),
+				$msg->[4]
+			]
+		);
+	}
+
+	return @ret;
+}
+
 sub arrival_wings {
 	my ($self) = @_;