diff options
| -rw-r--r-- | Changelog | 1 | ||||
| -rwxr-xr-x | bin/db-ris | 42 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/DeutscheBahn/Result.pm | 57 |
3 files changed, 60 insertions, 40 deletions
@@ -4,6 +4,7 @@ git HEAD * The info accessor now strips the mostly useless "k.A." / "pünktlich" (train on time) text parts * Use the new info_raw accessor to get the old info results + * Add (slightly experimental) route_interesting accessor Travel::Status::DE::DeutscheBahn 0.03 - Wed Jul 13 2011 @@ -84,47 +84,9 @@ sub display_result { return; } -sub filter_via { - my (@via) = @_; - - my ( @via_main, @via_show, $last_stop ); - - for my $stop (@via) { - if ( $stop =~ m{ ?Hbf} ) { - push( @via_main, $stop ); - } - } - $last_stop = pop(@via); - - if ( @via_main and @via and $via[0] eq $via_main[0] ) { - shift(@via_main); - } - - if ( @via < 3 ) { - @via_show = @via; - } - else { - @via_show = splice( @via, 0, ( @via_main > 2 ? 1 : 3 - @via_main ) ); - - while ( @via_show < 3 and @via_main ) { - my $stop = shift(@via_main); - if ( $stop ~~ \@via_show or $stop eq $last_stop ) { - next; - } - push( @via_show, $stop ); - } - } - - for my $stop (@via_show) { - $stop =~ s{ ?Hbf}{}; - } - - return @via_show; -} - for my $d ( $status->results() ) { - my ( @via, @via_main, @via_show ); + my @via; my $re_late = qr{ (?: ^ | , ) ca[.] \s \d+ \s Minuten \s sp.ter}ox; @@ -142,7 +104,7 @@ for my $d ( $status->results() ) { @output, [ $d->time, $d->train, - join( q{ }, filter_via(@via) ), $d->destination, + join( q{ }, $d->route_interesting ), $d->destination, $d->platform, $d->info, ] ); diff --git a/lib/Travel/Status/DE/DeutscheBahn/Result.pm b/lib/Travel/Status/DE/DeutscheBahn/Result.pm index 660abc5..5c2e9e1 100644 --- a/lib/Travel/Status/DE/DeutscheBahn/Result.pm +++ b/lib/Travel/Status/DE/DeutscheBahn/Result.pm @@ -50,6 +50,52 @@ sub route { return @{ $self->{route} }; } +sub route_interesting { + my ( $self, $max_parts ) = @_; + + my @via = $self->route; + my ( @via_main, @via_show, $last_stop ); + $max_parts //= 3; + + for my $stop (@via) { + if ( $stop =~ m{ ?Hbf}o ) { + push( @via_main, $stop ); + } + } + $last_stop = pop(@via); + + if ( @via_main and @via and $via[0] eq $via_main[0] ) { + shift(@via_main); + } + + if ( @via < $max_parts ) { + @via_show = @via; + } + else { + if ( @via_main >= $max_parts ) { + @via_show = ( $via[0] ); + } + else { + @via_show = splice( @via, 0, $max_parts - @via_main ); + } + + while ( @via_show < $max_parts and @via_main ) { + my $stop = shift(@via_main); + if ( $stop ~~ \@via_show or $stop eq $last_stop ) { + next; + } + push( @via_show, $stop ); + } + } + + for (@via_show) { + s{ ?Hbf}{}; + } + + return @via_show; + +} + 1; __END__ @@ -131,6 +177,17 @@ arrive. Returns a list of station names the train will pass between the selected station and its origin/destination. +=item $result->route_interesting([I<max>]) + +Returns a list of (at most I<max>) interesting stations the train will pass on +its journey. This is somewhat tricky (and therefore experimental). + +The first element of the list is always the train's next stop. The following +elements contain as many main stations as possible, but there may also be +smaller stations if not enough main stations are available. + +Note that all main stations will be stripped of their "Hbf" suffix. + =item $result->route_raw Returns the raw string used to create the route array. |