diff options
| -rw-r--r-- | Changelog | 2 | ||||
| -rwxr-xr-x | bin/db-iris | 10 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/IRIS/Result.pm | 56 | ||||
| -rw-r--r-- | t/32-result-messages.t | 68 |
4 files changed, 76 insertions, 60 deletions
@@ -6,6 +6,8 @@ git HEAD and expected arrival at a destination station * db-iris: Add -r / --realtime option to compute times using delay data + * Result: Remove duplicates in qos_messages and delay_messages, + return all messages in reverse order (newest first) Travel::Status::DE::IRIS 0.01 - Fri Jan 24 2014 diff --git a/bin/db-iris b/bin/db-iris index 2ac75e1..1dd6ede 100755 --- a/bin/db-iris +++ b/bin/db-iris @@ -200,8 +200,7 @@ sub display_result { if ( $edata{delays} and $d->delay_messages ) { - printf( ' %s', - join( q{ }, map { $_->[1] } ( reverse $d->delay_messages ) ) ); + printf( ' %s', join( q{ }, map { $_->[1] } $d->delay_messages ) ); } if ( $edata{delay} and ( $d->delay or $d->is_cancelled ) @@ -210,8 +209,7 @@ sub display_result { printf( ' %s', ( $d->delay_messages )[-1]->[1] ); } if ( $edata{qos} and $d->qos_messages ) { - printf( ' %s', - join( q{ }, map { $_->[1] } ( reverse $d->qos_messages ) ) ); + printf( ' %s', join( q{ }, map { $_->[1] } $d->qos_messages ) ); } print "\n"; @@ -233,7 +231,7 @@ sub display_result { } if ( $edata{messages} ) { - for my $message ( reverse $d->messages ) { + for my $message ( $d->messages ) { # leading spaces to align with regular output printf( " %s %s\n", @@ -520,7 +518,7 @@ None. =head1 BUGS AND LIMITATIONS -B<-oD> and B<-oq> contain duplicate entries. +Unknown. =head1 AUTHOR diff --git a/lib/Travel/Status/DE/IRIS/Result.pm b/lib/Travel/Status/DE/IRIS/Result.pm index 02dfaba..623880e 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(none uniq); +use List::MoreUtils qw(none uniq firstval); our $VERSION = '0.01'; @@ -181,13 +181,16 @@ sub delay_messages { time_zone => 'Europe/Berlin', ); - my @keys = sort keys %{ $self->{messages} }; - my @msgs - = uniq( grep { $_->[1] eq 'd' } map { $self->{messages}{$_} } @keys ); + my @keys = reverse sort keys %{ $self->{messages} }; + my @msgs = grep { $_->[1] eq 'd' } map { $self->{messages}{$_} } @keys; + my @msgids = uniq( map { $_->[2] } @msgs ); + my @ret; - my @ret = map { - [ $strp->parse_datetime( $_->[0] ), $self->translate_msg( $_->[2] ) ] - } @msgs; + for my $id (@msgids) { + my $msg = firstval { $_->[2] == $id } @msgs; + push( @ret, + [ $strp->parse_datetime( $msg->[0] ), $self->translate_msg($id) ] ); + } return @ret; } @@ -208,17 +211,18 @@ sub qos_messages { if ( my @superseded = $self->superseded_messages( $msg->[2] ) ) { @ret = grep { not( $_->[2] ~~ \@superseded ) } @ret; } + @ret = grep { $_->[2] != $msg->[2] } @ret; # 88 is "no qos shortcomings" and only required to filter previous # qos messages - if ( $msg->[2] != 88 and ( none { $_->[2] == $msg->[2] } @ret ) ) { + if ( $msg->[2] != 88 ) { push( @ret, $msg ); } } @ret = map { [ $strp->parse_datetime( $_->[0] ), $self->translate_msg( $_->[2] ) ] - } @ret; + } reverse @ret; return @ret; } @@ -231,7 +235,7 @@ sub messages { time_zone => 'Europe/Berlin', ); - my @messages = sort keys %{ $self->{messages} }; + my @messages = reverse sort keys %{ $self->{messages} }; my @ret = map { [ $strp->parse_datetime( $self->{messages}->{$_}->[0] ), @@ -511,11 +515,11 @@ arrived early. =item $result->delay_messages -Get all delay messages entered for this train. Returns a list -of [datetime, string] listrefs. The datetime part is a DateTime(3pm) object -corresponding to the point in time when the message was entered, the string -is the message. If a delay reason was entered more than once, only its oldest -record will be returned. +Get all delay messages entered for this train. Returns a list of [datetime, +string] listrefs sorted by newest first. The datetime part is a DateTime(3pm) +object corresponding to the point in time when the message was entered, the +string is the message. If a delay reason was entered more than once, only its +most recent record will be returned. =item $result->departure @@ -553,11 +557,11 @@ Example: For the line C<< S 1 >>, line_no will return C<< 1 >>. =item $result->messages -Get all qos and delay messages ever entered for this train. Returns a list -of [datetime, string] listrefs. The datetime part is a DateTime(3pm) object -corresponding to the point in time when the message was entered, the string -is the message. Note that neither duplicates nor superseded messages are -filtered from this list. +Get all qos and delay messages ever entered for this train. Returns a list of +[datetime, string] listrefs sorted by newest first. The datetime part is a +DateTime(3pm) object corresponding to the point in time when the message was +entered, the string is the message. Note that neither duplicates nor superseded +messages are filtered from this list. =item $result->origin @@ -565,10 +569,11 @@ Alias for route_start. =item $result->qos_messages -Get all current qos messages for this train. Returns a list -of [datetime, string] listrefs. The datetime part is a DateTime(3pm) object -corresponding to the point in time when the message was entered, the string -is the message. Contains neither superseded messages nor duplicates. +Get all current qos messages for this train. Returns a list of [datetime, +string] listrefs sorted by newest first. The datetime part is a DateTime(3pm) +object corresponding to the point in time when the message was entered, the +string is the message. Contains neither superseded messages nor duplicates (in +case of a duplicate, only the most recent message is present) =item $result->platform @@ -882,8 +887,7 @@ None. =head1 BUGS AND LIMITATIONS -The messages returned by B<delay_messages> and B<qos_messages> contain -duplicates. +Unknown. =head1 SEE ALSO diff --git a/t/32-result-messages.t b/t/32-result-messages.t index 4e30355..355162a 100644 --- a/t/32-result-messages.t +++ b/t/32-result-messages.t @@ -26,31 +26,43 @@ my $status = Travel::Status::DE::IRIS->new( my @results = $status->results; my $ice645 = $results[0]; -my $s1 = $results[1]; -my $s9 = $results[8]; -my $hkx = $results[10]; -my $abr = $results[13]; - -is_deeply([$ice645->info], -['Witterungsbedingte Störung', 'Unwetter', 'Abweichende Wagenreihung'], -'info: no dups, sorted, msg+qos'); - -is_deeply([$ice645->messages], [ -['2014-01-03T19:03:00', 'Witterungsbedingte Störung'], -['2014-01-03T19:15:00', 'Witterungsbedingte Störung'], -['2014-01-03T19:48:00', 'Witterungsbedingte Störung'], -['2014-01-03T19:58:00', 'Witterungsbedingte Störung'], -['2014-01-03T19:59:00', 'Witterungsbedingte Störung'], -['2014-01-03T20:00:00', 'Witterungsbedingte Störung'], -['2014-01-03T20:01:00', 'Unwetter'], -['2014-01-03T20:02:00', 'Abweichende Wagenreihung']], 'messages: with dups'); - -is_deeply([$ice645->qos_messages], [ -['2014-01-03T20:02:00', 'Abweichende Wagenreihung']], 'qos_messages'); - -TODO: { - local $TODO = 'no duplicate finding yet'; - is_deeply([$ice645->delay_messages], [ -['2014-01-03T19:03:00', 'Witterungsbedingte Störung'], -['2014-01-03T20:01:00', 'Unwetter']], 'delay_messages: no dups'); -} +my $s1 = $results[1]; +my $s9 = $results[8]; +my $hkx = $results[10]; +my $abr = $results[13]; + +is_deeply( + [ $ice645->info ], + [ 'Witterungsbedingte Störung', 'Unwetter', 'Abweichende Wagenreihung' ], + 'info: no dups, sorted, msg+qos' +); + +is_deeply( + [ $ice645->messages ], + [ + [ '2014-01-03T20:02:00', 'Abweichende Wagenreihung' ], + [ '2014-01-03T20:01:00', 'Unwetter' ], + [ '2014-01-03T20:00:00', 'Witterungsbedingte Störung' ], + [ '2014-01-03T19:59:00', 'Witterungsbedingte Störung' ], + [ '2014-01-03T19:58:00', 'Witterungsbedingte Störung' ], + [ '2014-01-03T19:48:00', 'Witterungsbedingte Störung' ], + [ '2014-01-03T19:15:00', 'Witterungsbedingte Störung' ], + [ '2014-01-03T19:03:00', 'Witterungsbedingte Störung' ] + ], + 'messages: with dups' +); + +is_deeply( + [ $ice645->qos_messages ], + [ [ '2014-01-03T20:02:00', 'Abweichende Wagenreihung' ] ], + 'qos_messages' +); + +is_deeply( + [ $ice645->delay_messages ], + [ + [ '2014-01-03T20:01:00', 'Unwetter' ], + [ '2014-01-03T20:00:00', 'Witterungsbedingte Störung' ] + ], + 'delay_messages: no dups' +); |