DeutscheBahn/Result: Add route_interesting accessor (d0f1eccd) · Commits · derf / Travel-Status-DE-HAFAS

Changelog

+1 −0

Original line number	Diff line number	Diff line
		@@ -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

+2 −40

Original line number	Diff line number	Diff line
		@@ -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,
		]
		);

+57 −0

Original line number	Diff line number	Diff line
		@@ -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.