Build.PL

@@ -20,6 +20,7 @@ Module::Build->new(
 		'perl' => '5.10.1',
 		'Carp' => 0,
 		'Class::Accessor' => 0,
+		'DateTime' => 0,
 		'Getopt::Long' => 0,
 		'List::Util' => 0,
 		'LWP::UserAgent' => 0,

bin/efa-m

@@ -164,23 +164,35 @@ sub format_route {
 			say 'BUG';
 			next;
 		}
-		if ( not defined $stop->arr_time ) {
-			$output .= sprintf( "        %5s  %40s %s\n",
-				$stop->dep_time, $stop->name, $stop->platform, );
-		}
-		elsif ( not defined $stop->dep_time ) {
-			$output .= sprintf( "%5s          %40s %s\n",
-				$stop->arr_time, $stop->name, $stop->platform, );
+		if ( defined $stop->arr and defined $stop->dep ) {
+			if ( $stop->arr->epoch == $stop->dep->epoch ) {
+				$output .= sprintf(
+					"    %5s      %40s %s\n",
+					$stop->arr->strftime('%H:%M'),
+					$stop->name, $stop->platform,
+				);
+			}
+			else {
+				$output .= sprintf(
+					"%5s → %5s  %40s %s\n",
+					$stop->arr->strftime('%H:%M'),
+					$stop->dep->strftime('%H:%M'),
+					$stop->name, $stop->platform,
+				);
+			}
 		}
-		elsif ( $stop->arr_time eq $stop->dep_time ) {
-			$output .= sprintf( "    %5s      %40s %s\n",
-				$stop->dep_time, $stop->name, $stop->platform, );
+		elsif ( defined $stop->arr ) {
+			$output .= sprintf(
+				"%5s          %40s %s\n",
+				$stop->arr->strftime('%H:%M'),
+				$stop->name, $stop->platform,
+			);
 		}
-		else {
+		elsif ( defined $stop->dep ) {
 			$output .= sprintf(
-				"%5s → %5s  %40s %s\n",
-				$stop->arr_time, $stop->dep_time,
-				$stop->name,     $stop->platform,
+				"        %5s  %40s %s\n",
+				$stop->dep->strftime('%H:%M'),
+				$stop->name, $stop->platform,
 			);
 		}
 	}
@@ -270,7 +282,7 @@ sub show_results {
 		my $dtime    = (
 			$relative_times
 			? sprintf( '%2d min', $d->countdown )
-			: $d->time
+			: $d->datetime->strftime('%H:%M')
 		);
 
 		if ( $d->platform_db ) {
@@ -301,7 +313,7 @@ sub show_results {
 		}
 		elsif ($track_via) {
 			my $via = first { $_->name =~ m{$filter_via}io } $d->route_post;
-			$dtime .= ' → ' . $via->arr_time;
+			$dtime .= ' → ' . $via->arr->strftime('%H:%M');
 		}
 		if ( $d->delay ) {
 			$dtime .= ' ' . format_delay( $d->delay, $delay_len );

cpanfile

+requires 'Carp';
+requires 'Class::Accessor';
+requires 'DateTime';
+requires 'Getopt::Long';
+requires 'List::Util';
+requires 'LWP::UserAgent';
+requires 'LWP::Protocol::https';
+requires 'XML::LibXML';
+
+on test => sub {
+	requires 'File::Slurp';
+	requires 'Test::More';
+};

lib/Travel/Status/DE/EFA.pm

@@ -7,7 +7,8 @@ use utf8;
 
 our $VERSION = '1.24';
 
-use Carp   qw(confess cluck);
+use Carp qw(confess cluck);
+use DateTime;
 use Encode qw(encode);
 use Travel::Status::DE::EFA::Line;
 use Travel::Status::DE::EFA::Result;
@@ -194,33 +195,6 @@ sub place_candidates {
 	return;
 }
 
-sub sprintf_date {
-	my ($e) = @_;
-
-	if ( $e->getAttribute('day') == -1 ) {
-		return;
-	}
-
-	return sprintf( '%02d.%02d.%d',
-		$e->getAttribute('day'),
-		$e->getAttribute('month'),
-		$e->getAttribute('year'),
-	);
-}
-
-sub sprintf_time {
-	my ($e) = @_;
-
-	if ( $e->getAttribute('minute') == -1 ) {
-		return;
-	}
-
-	return sprintf( '%02d:%02d',
-		$e->getAttribute('hour'),
-		$e->getAttribute('minute'),
-	);
-}
-
 sub check_for_ambiguous {
 	my ($self) = @_;
 
@@ -368,17 +342,45 @@ sub parse_route {
 		my @dates = $e->findnodes($xp_routepoint_date);
 		my @times = $e->findnodes($xp_routepoint_time);
 
+		my ( $arr, $dep );
+
 		# note that the first stop has an arrival node with an invalid
 		# timestamp and the terminal stop has a departure node with an
-		# invalid timestamp.  sprintf_{date,time} return undef in these
-		# cases.
+		# invalid timestamp.
+
+		if ( $dates[0] and $times[0] and $dates[0]->getAttribute('day') != -1 )
+		{
+			$arr = DateTime->new(
+				year      => $dates[0]->getAttribute('year'),
+				month     => $dates[0]->getAttribute('month'),
+				day       => $dates[0]->getAttribute('day'),
+				hour      => $times[0]->getAttribute('hour'),
+				minute    => $times[0]->getAttribute('minute'),
+				second    => $times[0]->getAttribute('second') // 0,
+				time_zone => 'Europe/Berlin'
+			);
+		}
+
+		if (    $dates[-1]
+			and $times[-1]
+			and $dates[-1]->getAttribute('day') != -1 )
+		{
+			$dep = DateTime->new(
+				year      => $dates[-1]->getAttribute('year'),
+				month     => $dates[-1]->getAttribute('month'),
+				day       => $dates[-1]->getAttribute('day'),
+				hour      => $times[-1]->getAttribute('hour'),
+				minute    => $times[-1]->getAttribute('minute'),
+				second    => $times[-1]->getAttribute('second') // 0,
+				time_zone => 'Europe/Berlin'
+			);
+		}
+
 		push(
 			@ret,
 			Travel::Status::DE::EFA::Stop->new(
-				arr_date => scalar sprintf_date( $dates[0] ),
-				arr_time => scalar sprintf_time( $times[0] ),
-				dep_date => scalar sprintf_date( $dates[-1] ),
-				dep_time => scalar sprintf_time( $times[-1] ),
+				arr      => $arr,
+				dep      => $dep,
 				name     => $e->getAttribute('name'),
 				name_suf => $e->getAttribute('nameWO'),
 				platform => $e->getAttribute('platformName'),
@@ -432,11 +434,31 @@ sub results {
 			next;
 		}
 
-		my $date = sprintf_date($e_date);
-		my $time = sprintf_time($e_time);
+		my ( $sched_dt, $real_dt );
+
+		if ( $e_date and $e_time and $e_date->getAttribute('day') != -1 ) {
+			$sched_dt = DateTime->new(
+				year      => $e_date->getAttribute('year'),
+				month     => $e_date->getAttribute('month'),
+				day       => $e_date->getAttribute('day'),
+				hour      => $e_time->getAttribute('hour'),
+				minute    => $e_time->getAttribute('minute'),
+				second    => $e_time->getAttribute('second') // 0,
+				time_zone => 'Europe/Berlin'
+			);
+		}
 
-		my $rdate = $e_rdate ? sprintf_date($e_rdate) : $date;
-		my $rtime = $e_rtime ? sprintf_time($e_rtime) : $time;
+		if ( $e_rdate and $e_rtime and $e_rdate->getAttribute('day') != -1 ) {
+			$real_dt = DateTime->new(
+				year      => $e_rdate->getAttribute('year'),
+				month     => $e_rdate->getAttribute('month'),
+				day       => $e_rdate->getAttribute('day'),
+				hour      => $e_rtime->getAttribute('hour'),
+				minute    => $e_rtime->getAttribute('minute'),
+				second    => $e_rtime->getAttribute('second') // 0,
+				time_zone => 'Europe/Berlin'
+			);
+		}
 
 		my $platform      = $e->getAttribute('platform');
 		my $platform_name = $e->getAttribute('platformName');
@@ -496,28 +518,26 @@ sub results {
 		push(
 			@results,
 			Travel::Status::DE::EFA::Result->new(
-				date          => $rdate,
-				time          => $rtime,
-				platform      => $platform,
-				platform_db   => $platform_is_db,
-				platform_name => $platform_name,
-				key           => $key,
-				lineref       => $line_obj[0] // undef,
-				line          => $line,
-				train_type    => $train_type,
-				train_name    => $train_name,
-				train_no      => $train_no,
-				destination   => $dest,
-				occupancy     => $occupancy,
-				countdown     => $countdown,
-				info          => $info,
-				delay         => $delay,
-				sched_date    => $date,
-				sched_time    => $time,
-				type          => $type,
-				mot           => $mot,
-				prev_route    => \@prev_route,
-				next_route    => \@next_route,
+				rt_datetime    => $real_dt,
+				platform       => $platform,
+				platform_db    => $platform_is_db,
+				platform_name  => $platform_name,
+				key            => $key,
+				lineref        => $line_obj[0] // undef,
+				line           => $line,
+				train_type     => $train_type,
+				train_name     => $train_name,
+				train_no       => $train_no,
+				destination    => $dest,
+				occupancy      => $occupancy,
+				countdown      => $countdown,
+				info           => $info,
+				delay          => $delay,
+				sched_datetime => $sched_dt,
+				type           => $type,
+				mot            => $mot,
+				prev_route     => \@prev_route,
+				next_route     => \@next_route,
 			)
 		);
 	}
@@ -770,6 +790,8 @@ None.
 
 =item * Class::Accessor(3pm)
 
+=item * DateTime(3pm)
+
 =item * LWP::UserAgent(3pm)
 
 =item * XML::LibXML(3pm)

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

@@ -9,8 +9,9 @@ use parent 'Class::Accessor';
 our $VERSION = '1.24';
 
 Travel::Status::DE::EFA::Result->mk_ro_accessors(
-	qw(countdown date delay destination is_cancelled info key line lineref
-	  mot occupancy operator platform platform_db platform_name sched_date sched_time time train_type train_name train_no type)
+	qw(countdown datetime delay destination is_cancelled info key line lineref
+	  mot occupancy operator platform platform_db platform_name rt_datetime
+	  sched_datetime train_type train_name train_no type)
 );
 
 my @mot_mapping = qw{
@@ -31,6 +32,8 @@ sub new {
 		$ref->{is_cancelled} = 0;
 	}
 
+	$ref->{datetime} = $ref->{rt_datetime} // $ref->{sched_datetime};
+
 	return bless( $ref, $obj );
 }
 
@@ -126,8 +129,8 @@ departure received by Travel::Status::DE::EFA
     for my $departure ($status->results) {
         printf(
             "At %s: %s to %s from platform %d\n",
-            $departure->time, $departure->line, $departure->destination,
-            $departure->platform
+            $departure->datetime->strftime('%H:%M'), $departure->line,
+            $departure->destination, $departure->platform
         );
     }
 
@@ -145,20 +148,19 @@ line number and destination.
 
 =head2 ACCESSORS
 
-"Actual" in the description means that the delay (if available) is already
-included in the calculation, "Scheduled" means it isn't.
-
 =over
 
 =item $departure->countdown
 
-Actual time in minutes from now until the tram/bus/train will depart.
+Time in minutes from now until the tram/bus/train will depart, including
+realtime data if available.
 
 If delay information is available, it is already included.
 
-=item $departure->date
+=item $departure->datetime
 
-Actual departure date (DD.MM.YYYY).
+DateTime(3pm) object for departure date and time.  Realtime data if available,
+schedule data otherwise.
 
 =item $departure->delay
 
@@ -242,17 +244,14 @@ Each station is a Travel::Status::DE::EFA::Stop(3pm) object.
 List of stations the vehicle will pass after this stop.
 Each station is a Travel::Status::DE::EFA::Stop(3pm) object.
 
-=item $departure->sched_date
-
-Scheduled departure date (DD.MM.YYYY).
-
-=item $departure->sched_time
+=item $departure->rt_datetime
 
-Scheduled departure time (HH:MM).
+DateTime(3pm) object holding the departure date and time according to
+realtime data. Undef if unknown / unavailable.
 
-=item $departure->time
+=item $departure->sched_datetime
 
-Actual departure time (HH:MM).
+DateTime(3pm) object holding the scheduled departure date and time.
 
 =item $departure->train_type
 

lib/Travel/Status/DE/EFA/Stop.pm

@@ -9,7 +9,7 @@ use parent 'Class::Accessor';
 our $VERSION = '1.24';
 
 Travel::Status::DE::EFA::Stop->mk_ro_accessors(
-	qw(arr_date arr_time dep_date dep_time name name_suf platform));
+	qw(arr dep name name_suf platform));
 
 sub new {
 	my ( $obj, %conf ) = @_;
@@ -39,7 +39,8 @@ in a Travel::Status::DE::EFA::Result's route
     for my $stop ($departure->route_post) {
         printf(
             "%s -> %s : %40s %s\n",
-            $stop->arr_time // q{     }, $stop->dep_time // q{     },
+            $stop->arr ? $stop->arr->strftime('%H:%M') : q{--:--},
+            $stop->dep ? $stop->dep->strftime('%H:%M') : q{--:--},
             $stop->name, $stop->platform
         );
     }
@@ -60,21 +61,15 @@ delays or changed platforms are not taken into account.
 
 =over
 
-=item $stop->arr_date
+=item $stop->arr
 
-arrival date (DD.MM.YYYY). undef if this is the first scheduled stop.
+DateTime(3pm) object holding arrival date and time. undef if this is the
+first scheduled stop.
 
-=item $stop->arr_time
+=item $stop->dep
 
-arrival time (HH:MM). undef if this is the first scheduled stop.
-
-=item $stop->dep_date
-
-departure date (DD.MM.YYYY). undef if this is the final scehduled stop.
-
-=item $stop->dep_time
-
-departure time (HH:MM). undef if this is the final scehduled stop.
+DateTime(3pm) object holding departure date and time. undef if this is the
+final scheduled stop.
 
 =item $stop->name
 

t/20-vrr.t

@@ -4,7 +4,7 @@ use warnings;
 use 5.010;
 use utf8;
 
-use Encode qw(decode);
+use Encode      qw(decode);
 use File::Slurp qw(slurp);
 use Test::More tests => 113;
 
@@ -15,53 +15,83 @@ require_ok('Travel::Status::DE::VRR');
 
 my $xml = slurp('t/in/essen_hb.xml');
 
-my $status = Travel::Status::DE::VRR->new_from_xml(xml => $xml);
+my $status = Travel::Status::DE::VRR->new_from_xml( xml => $xml );
 
-isa_ok($status, 'Travel::Status::DE::EFA');
-can_ok($status, qw(errstr results));
+isa_ok( $status, 'Travel::Status::DE::EFA' );
+can_ok( $status, qw(errstr results) );
 
-is($status->errstr, undef, 'no error');
-is_deeply([$status->identified_data], [qw[Essen Hauptbahnhof]], 'identified_data');
+is( $status->errstr, undef, 'no error' );
+is_deeply( [ $status->identified_data ],
+	[qw[Essen Hauptbahnhof]], 'identified_data' );
 
 my @results = $status->results;
 
 for my $result (@results) {
-	isa_ok($result, 'Travel::Status::DE::EFA::Result');
-	can_ok($result, qw(date destination info line time type platform));
+	isa_ok( $result, 'Travel::Status::DE::EFA::Result' );
+	can_ok( $result,
+		qw(datetime destination info line type platform sched_datetime) );
 }
 
-is($results[0]->destination, 'Düsseldorf Hbf', 'first result: destination ok');
-is($results[0]->info, 'Bordrestaurant', 'first result: no info');
-is($results[0]->line, 'ICE 946 Intercity-Express', 'first result: line ok');
-is($results[0]->date, '16.11.2011', 'first result: real date ok');
-is($results[0]->time, '09:40', 'first result: real time ok');
-is($results[0]->delay, 4, 'first result: delay 4');
-is($results[0]->sched_date, '16.11.2011', 'first result: scheduled date ok');
-is($results[0]->sched_time, '09:36', 'first result: scheduled time ok');
-is($results[0]->mot_name, 'zug', 'first result: mot_name ok');
+is( $results[0]->destination, 'Düsseldorf Hbf',
+	'first result: destination ok' );
+is( $results[0]->info, 'Bordrestaurant',            'first result: no info' );
+is( $results[0]->line, 'ICE 946 Intercity-Express', 'first result: line ok' );
+is( $results[0]->datetime->strftime('%d.%m.%Y'),
+	'16.11.2011', 'first result: real date ok' );
+is( $results[0]->datetime->strftime('%H:%M'),
+	'09:40', 'first result: real time ok' );
+is( $results[0]->delay, 4, 'first result: delay 4' );
+is( $results[0]->sched_datetime->strftime('%d.%m.%Y'),
+	'16.11.2011', 'first result: scheduled date ok' );
+is( $results[0]->sched_datetime->strftime('%H:%M'),
+	'09:36', 'first result: scheduled time ok' );
+is( $results[0]->mot_name, 'zug', 'first result: mot_name ok' );
+
 #is($results[0]->platform, '1', 'first result: platform ok');
 #is($results[0]->platform_db, 1, 'first result: platform_db ok');
 
-is($results[3]->destination, 'Mülheim Heißen Kirche', 'fourth result: destination ok');
-is($results[3]->info, 'Ab (H) Heißen Kirche, Umstieg in den SEV Ri. Mülheim Hbf.', 'fourth result: no info');
-is($results[3]->line, '18', 'fourth result: line ok');
-is($results[3]->date, '16.11.2011', 'fourth result: real date ok');
-is($results[3]->time, '09:39', 'fourth result: real time ok');
-is($results[3]->delay, undef, 'fourth result: delay undef');
-is($results[3]->sched_date, '16.11.2011', 'fourth result: scheduled date ok');
-is($results[3]->sched_time, '09:39', 'fourth result: scheduled time ok');
-is($results[3]->mot_name, 'u-bahn', 'fourth result: mot_name ok');
+is(
+	$results[3]->destination,
+	'Mülheim Heißen Kirche',
+	'fourth result: destination ok'
+);
+is(
+	$results[3]->info,
+	'Ab (H) Heißen Kirche, Umstieg in den SEV Ri. Mülheim Hbf.',
+	'fourth result: no info'
+);
+is( $results[3]->line, '18', 'fourth result: line ok' );
+is( $results[3]->datetime->strftime('%d.%m.%Y'),
+	'16.11.2011', 'fourth result: real date ok' );
+is( $results[3]->datetime->strftime('%H:%M'),
+	'09:39', 'fourth result: real time ok' );
+is( $results[3]->delay, undef, 'fourth result: delay undef' );
+is( $results[3]->sched_datetime->strftime('%d.%m.%Y'),
+	'16.11.2011', 'fourth result: scheduled date ok' );
+is( $results[3]->sched_datetime->strftime('%H:%M'),
+	'09:39', 'fourth result: scheduled time ok' );
+is( $results[3]->mot_name, 'u-bahn', 'fourth result: mot_name ok' );
+
 #is($results[3]->platform, '2', 'fourth result: platform ok');
 #is($results[3]->platform_db, 0, 'fourth result: platform_db ok');
 
-is($results[-1]->destination, 'Hamm (Westf)', 'last result: destination ok');
-is($results[-1]->info, 'Fahrradmitnahme begrenzt möglich', 'last result: info ok');
-is($results[-1]->delay, 12, 'last result: delay 12');
-is($results[-1]->line, 'RE1', 'last result: line ok');
-is($results[-1]->date, '16.11.2011', 'last result: date ok');
-is($results[-1]->time, '10:05', 'last result: time ok');
-is($results[-1]->sched_date, '16.11.2011', 'first result: scheduled date ok');
-is($results[-1]->sched_time, '09:53', 'last result: scheduled time ok');
-is($results[-1]->mot_name, 'zug', 'last result: mot_name ok');
+is( $results[-1]->destination, 'Hamm (Westf)', 'last result: destination ok' );
+is(
+	$results[-1]->info,
+	'Fahrradmitnahme begrenzt möglich',
+	'last result: info ok'
+);
+is( $results[-1]->delay, 12,    'last result: delay 12' );
+is( $results[-1]->line,  'RE1', 'last result: line ok' );
+is( $results[-1]->datetime->strftime('%d.%m.%Y'),
+	'16.11.2011', 'last result: date ok' );
+is( $results[-1]->datetime->strftime('%H:%M'), '10:05',
+	'last result: time ok' );
+is( $results[-1]->sched_datetime->strftime('%d.%m.%Y'),
+	'16.11.2011', 'first result: scheduled date ok' );
+is( $results[-1]->sched_datetime->strftime('%H:%M'),
+	'09:53', 'last result: scheduled time ok' );
+is( $results[-1]->mot_name, 'zug', 'last result: mot_name ok' );
+
 #is($results[-1]->platform, '6', 'last result: platform ok');
 #is($results[-1]->platform_db, 1, 'last result: platform ok');