diff options
author | Daniel Friesel <derf@finalrewind.org> | 2023-01-23 20:03:09 +0100 |
---|---|---|
committer | Daniel Friesel <derf@finalrewind.org> | 2023-01-23 20:03:09 +0100 |
commit | b0002a4c9a75a573996c0f4c5544111f3e018077 (patch) | |
tree | 65272c112807ceeea235efb964d2b2e3286b0505 /lib/Travel/Status/DE | |
parent | 90ceeffc8f4dc0aaaa1ced04328f7653e35a1b6e (diff) |
Add preliminary route_interesting implementation
Diffstat (limited to 'lib/Travel/Status/DE')
-rw-r--r-- | lib/Travel/Status/DE/HAFAS/Journey.pm | 59 |
1 files changed, 59 insertions, 0 deletions
diff --git a/lib/Travel/Status/DE/HAFAS/Journey.pm b/lib/Travel/Status/DE/HAFAS/Journey.pm index 0fbec9e..480ff89 100644 --- a/lib/Travel/Status/DE/HAFAS/Journey.pm +++ b/lib/Travel/Status/DE/HAFAS/Journey.pm @@ -293,6 +293,65 @@ sub route { return; } +sub route_interesting { + my ( $self, $max_parts ) = @_; + + my @via = $self->route; + my ( @via_main, @via_show, $last_stop ); + $max_parts //= 3; + + # Centraal: dutch main station (Hbf in .nl) + # HB: swiss main station (Hbf in .ch) + # hl.n.: czech main station (Hbf in .cz) + for my $stop (@via) { + if ( $stop->{name} + =~ m{ HB $ | hl\.n\. $ | Hbf | Hauptbahnhof | Bf | Bahnhof | Centraal | Flughafen }x + ) + { + push( @via_main, $stop ); + } + } + $last_stop = pop(@via); + + if ( @via_main and $via_main[-1]{name} eq $last_stop->{name} ) { + pop(@via_main); + } + if ( @via and $via[-1]{name} eq $last_stop->{name} ) { + pop(@via); + } + + if ( @via_main and @via and $via[0]{name} eq $via_main[0]{name} ) { + 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->{name} eq $last_stop->{name} ) { + next; + } + push( @via_show, $stop ); + } + } + + for my $stop (@via_show) { + $stop->{name} =~ s{ \s? Hbf .* }{}x; + } + + return @via_show; + +} + sub TO_JSON { my ($self) = @_; |