From b19328aecd79a91ea4535edd8dddc2e4908d615f Mon Sep 17 00:00:00 2001 From: Daniel Friesel Date: Fri, 17 Jan 2014 09:19:35 +0100 Subject: implement -oq (qos_messages in Result.pm) --- bin/db-iris | 4 ++++ lib/Travel/Status/DE/IRIS/Result.pm | 44 ++++++++++++++++++++++++++++++++++++- 2 files changed, 47 insertions(+), 1 deletion(-) 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 ) = @_; -- cgit v1.2.3