From 5e436d356b026e06ed29163791a04b3820cf6c05 Mon Sep 17 00:00:00 2001
From: Daniel Friesel <derf@finalrewind.org>
Date: Sat, 3 Dec 2011 02:12:00 +0100
Subject: Result: Add ->date accessor

---
 lib/Travel/Status/DE/DeutscheBahn.pm        | 16 +++++++++++++++-
 lib/Travel/Status/DE/DeutscheBahn/Result.pm |  2 +-
 t/20-db.t                                   |  5 +++--
 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');
-- 
cgit v1.2.3