summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/Travel/Status/DE/DeutscheBahn.pm16
-rw-r--r--lib/Travel/Status/DE/DeutscheBahn/Result.pm2
-rw-r--r--t/20-db.t5
3 files changed, 19 insertions, 4 deletions
diff --git a/lib/Travel/Status/DE/DeutscheBahn.pm b/lib/Travel/Status/DE/DeutscheBahn.pm
index 4e9004d..8d98138 100644
--- a/lib/Travel/Status/DE/DeutscheBahn.pm
+++ b/lib/Travel/Status/DE/DeutscheBahn.pm
@@ -43,8 +43,10 @@ sub new {
date => $conf{date} || $date,
time => $conf{time} || $time,
REQTrain_name => q{},
- start => 'Suchen',
+ start => 'yes',
boardType => $conf{mode} // 'dep',
+ maxJourneys => 20,
+# L => 'vs_java3',
},
};
@@ -153,6 +155,10 @@ sub results {
my $xp_element = XML::LibXML::XPathExpression->new(
"//table[\@class = \"result stboard ${mode}\"]/tr");
+ my $xp_train_more = XML::LibXML::XPathExpression->new('./td[3]/a');
+
+ # bhftafel.exe is not y2k1-safe
+ my $re_morelink = qr{ date = (?<date> .. [.] .. [.] .. ) }x;
my @parts = (
[ 'time', './td[@class="time"]' ],
@@ -186,11 +192,18 @@ sub results {
my $first = 1;
my ( $time, $train, $route, $dest, $platform, $info )
= map { get_node( $tr, @{$_} ) } @parts;
+ my $e_train_more = ($tr->findnodes($xp_train_more))[0];
if ( not( $time and $dest ) ) {
next;
}
+ $e_train_more->getAttribute('href') =~ $re_morelink;
+
+ my $date = $+{date};
+
+ substr($date, 6, 0) = '20';
+
$platform //= q{};
$info //= q{};
@@ -217,6 +230,7 @@ sub results {
push(
@{ $self->{results} },
Travel::Status::DE::DeutscheBahn::Result->new(
+ date => $date,
time => $time,
train => $train,
route_raw => $route,
diff --git a/lib/Travel/Status/DE/DeutscheBahn/Result.pm b/lib/Travel/Status/DE/DeutscheBahn/Result.pm
index 0175e03..87cd84b 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 = '1.00';
Travel::Status::DE::DeutscheBahn::Result->mk_ro_accessors(
- qw(time train route_end route_raw platform info_raw));
+ qw(date time train route_end route_raw platform info_raw));
sub new {
my ( $obj, %conf ) = @_;
diff --git a/t/20-db.t b/t/20-db.t
index 03c25ef..e90f853 100644
--- a/t/20-db.t
+++ b/t/20-db.t
@@ -4,7 +4,7 @@ use warnings;
use 5.010;
use File::Slurp qw(slurp);
-use Test::More tests => 97;
+use Test::More tests => 98;
BEGIN {
use_ok('Travel::Status::DE::DeutscheBahn');
@@ -22,10 +22,11 @@ my @departures = $status->results;
for my $departure (@departures) {
isa_ok($departure, 'Travel::Status::DE::DeutscheBahn::Result');
- can_ok($departure, qw(route_end destination origin info platform route
+ can_ok($departure, qw(date route_end destination origin info platform route
route_raw time train));
}
+is($departures[0]->date, '06.07.2011', 'first result: date ok');
is($departures[0]->time, '19:21', 'first result: time ok');
is($departures[0]->train, 'RE 10228', 'first result: train ok');
is($departures[0]->destination, 'Duisburg Hbf', 'first result: destination ok');