diff options
| -rw-r--r-- | Changelog | 7 | ||||
| -rwxr-xr-x | bin/db-ris | 10 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/DeutscheBahn.pm | 5 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/DeutscheBahn/Result.pm | 25 | ||||
| -rw-r--r-- | t/20-db.t | 5 |
5 files changed, 34 insertions, 18 deletions
@@ -1,3 +1,10 @@ +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) @@ -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, ] ); } diff --git a/lib/Travel/Status/DE/DeutscheBahn.pm b/lib/Travel/Status/DE/DeutscheBahn.pm index 8919dfc..9f71eb0 100644 --- a/lib/Travel/Status/DE/DeutscheBahn.pm +++ b/lib/Travel/Status/DE/DeutscheBahn.pm @@ -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, ) ); } diff --git a/lib/Travel/Status/DE/DeutscheBahn/Result.pm b/lib/Travel/Status/DE/DeutscheBahn/Result.pm index 969658d..660abc5 100644 --- a/lib/Travel/Status/DE/DeutscheBahn/Result.pm +++ b/lib/Travel/Status/DE/DeutscheBahn/Result.pm @@ -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 @@ -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', |