implement -oq (qos_messages in Result.pm)

2 files changed, 47 insertions, 1 deletions

diff --git a/bin/db-iris b/bin/db-iris
index 1bbe5b2..d0e2662 100755
--- a/bin/db-iris
+++ b/bin/db-iris
@@ -151,6 +151,10 @@ sub display_result {
 		if ( $edata{delay} and $d->delay and $d->delay_messages ) {
 			printf( '  %s', ( $d->delay_messages )[-1]->[1] );
 		}
+		if ( $edata{qos} and $d->qos_messages ) {
+			printf( '  %s',
+				join( '  ', map { $_->[1] } ( reverse $d->qos_messages ) ) );
+		}
 		print "\n";
 
 		if ( $edata{times} ) {
diff --git a/lib/Travel/Status/DE/IRIS/Result.pm b/lib/Travel/Status/DE/IRIS/Result.pm
index d3fd0f5..0438722 100644
--- a/lib/Travel/Status/DE/IRIS/Result.pm
+++ b/lib/Travel/Status/DE/IRIS/Result.pm
@@ -11,7 +11,7 @@ use parent 'Class::Accessor';
 use Carp qw(cluck);
 use DateTime;
 use DateTime::Format::Strptime;
-use List::MoreUtils qw(uniq);
+use List::MoreUtils qw(none uniq);
 
 our $VERSION = '0.00';
 
@@ -192,6 +192,37 @@ sub delay_messages {
 	return @ret;
 }
 
+sub qos_messages {
+	my ($self) = @_;
+
+	my $strp = DateTime::Format::Strptime->new(
+		pattern   => '%y%m%d%H%M',
+		time_zone => 'Europe/Berlin',
+	);
+
+	my @keys = sort keys %{ $self->{messages} };
+	my @msgs = grep { $_->[1] eq 'q' } map { $self->{messages}{$_} } @keys;
+	my @ret;
+
+	for my $msg (@msgs) {
+		if ( my @superseded = $self->superseded_messages( $msg->[2] ) ) {
+			@ret = grep { not( $_->[2] ~~ \@superseded ) } @ret;
+		}
+
+		# 88 is "no qos shortcomings" and only required to filter previous
+		# qos messages
+		if ( $msg->[2] != 88 and ( none { $_->[2] == $msg->[2] } @ret ) ) {
+			push( @ret, $msg );
+		}
+	}
+
+	@ret = map {
+		[ $strp->parse_datetime( $_->[0] ), $self->translate_msg( $_->[2] ) ]
+	} @ret;
+
+	return @ret;
+}
+
 sub messages {
 	my ($self) = @_;
 
@@ -323,6 +354,17 @@ sub sched_route {
 		$self->sched_route_post );
 }
 
+sub superseded_messages {
+	my ( $self, $msg ) = @_;
+
+	my %superseded = (
+		84 => [ 80, 82, 83, 85 ],
+		88 => [ 80, 82, 83, 85, 86, 87, 90, 91, 92, 93, 96, 97, 98 ],
+	);
+
+	return @{ $superseded{$msg} // [] };
+}
+
 sub translate_msg {
 	my ( $self, $msg ) = @_;