Commit 10687196 authored by Birte Kristina Friesel's avatar Birte Kristina Friesel
Browse files

DeutscheBahn/Result: Return only useful text in info, add info_raw for the raw string

parent d463bbcd

Changelog

+7 −0
Changes for Changelog: 7 added lines, 0 removed lines.
Original line number Diff line number Diff line 
git HEAD



    [Travel::Status::DE::DeutscheBahn::Result]

    * 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



Travel::Status::DE::DeutscheBahn 0.03 - Wed Jul 13 2011



    * Clarify derl dependency (we actually need >= 5.10.1)

bin/db-ris

+1 −9
Changes for bin/db-ris: 1 added line, 9 removed lines.
Original line number Diff line number Diff line
@@ -84,14 +84,6 @@ sub display_result { 
	return;

}



sub filter_info {

	my ($info) = @_;



	$info =~ s{ (?: ^ | , ) (?: p.nktlich | k [.] A [.] ) }{}x;



	return $info;

}



sub filter_via {

	my (@via) = @_;
@@ -151,7 +143,7 @@ for my $d ( $status->results() ) { 
		[

			$d->time, $d->train,

			join( q{  }, filter_via(@via) ), $d->destination,

			$d->platform, filter_info( $d->info )

			$d->platform, $d->info,

		]

	);

}

lib/Travel/Status/DE/DeutscheBahn.pm

+1 −4
Changes for lib/Travel/Status/DE/DeutscheBahn.pm: 1 added line, 4 removed lines.
Original line number Diff line number Diff line
@@ -142,9 +142,6 @@ sub results { 
			$str =~ s/ +$//;

		}



		$info =~ s{ ,Grund }{}ox;

		$info =~ s{ ^ \s+ }{}ox;



		while ( $route =~ m{$re_via}g ) {

			if ($first) {

				$first = 0;
@@ -168,7 +165,7 @@ sub results { 
				route     => \@via,

				route_end => $dest,

				platform  => $platform,

				info      => $info,

				info_raw  => $info,

			)

		);

	}

lib/Travel/Status/DE/DeutscheBahn/Result.pm

+22 −3
Changes for lib/Travel/Status/DE/DeutscheBahn/Result.pm: 22 added lines, 3 removed lines.
Original line number Diff line number Diff line
@@ -9,7 +9,7 @@ use parent 'Class::Accessor'; 
our $VERSION = '0.03';



Travel::Status::DE::DeutscheBahn::Result->mk_ro_accessors(

	qw(time train route_end route_raw platform info));

	qw(time train route_end route_raw platform info_raw));



sub new {

	my ( $obj, %conf ) = @_;
@@ -25,6 +25,19 @@ sub destination { 
	return $self->{route_end};

}



sub info {

	my ($self) = @_;



	my $info = $self->info_raw;



	$info =~ s{ ,Grund }{}ox;

	$info =~ s{ ^ \s+ }{}ox;

	$info =~ s{ (?: ^ | , ) (?: p.nktlich | k [.] A [.] ) }{}ox;

	$info =~ s{ ^ , }{}ox;



	return $info;

}



sub origin {

	my ($self) = @_;
@@ -99,8 +112,14 @@ Convenience aliases for $result->route_end. 


=item $result->info



Returns additional information, usually wether the train is on time or

delayed.

Returns additional information, for instance in case the train is delayed. May

be an empty string if no (useful) information is available.



=item $result->info_raw



Returns the raw info string. B<info> only tells you about delays, platform

changes and such, B<info_raw> also explicitly states wether a train is on time

or no information is available.



=item $result->platform

t/20-db.t

+3 −2
Changes for t/20-db.t: 3 added lines, 2 removed lines.
Original line number Diff line number Diff line
@@ -4,7 +4,7 @@ use warnings; 
use 5.010;



use File::Slurp qw(slurp);

use Test::More tests => 89;

use Test::More tests => 90;



BEGIN {

	use_ok('Travel::Status::DE::DeutscheBahn');
@@ -37,7 +37,8 @@ is($departures[-1]->platform, '12', 'last result: platform ok'); 


is($departures[8]->time, '19:31', '9th result: time ok');

is($departures[8]->train, 'NWB75366', '9th result: train ok');

is($departures[8]->info, 'k.A.', '9th result: info ok');

is($departures[8]->info_raw, 'k.A.', '9th result: info_raw ok');

is($departures[8]->info, q{}, '9th result: info ok');



is_deeply([$departures[8]->route],

	['Essen-Borbeck', 'Bottrop Hbf', 'Gladbeck West', 'Gladbeck-Zweckel',