filter duplicate timetable entries, parse some realtime data

2 files changed, 127 insertions, 14 deletions

diff --git a/lib/Travel/Status/DE/IRIS.pm b/lib/Travel/Status/DE/IRIS.pm
index 16883a4..223a3c9 100644
--- a/lib/Travel/Status/DE/IRIS.pm
+++ b/lib/Travel/Status/DE/IRIS.pm
@@ -11,6 +11,7 @@ our $VERSION = '0.00';
 use Carp qw(confess cluck);
 use DateTime;
 use Encode qw(encode decode);
+use List::Util qw(first);
 use LWP::UserAgent;
 use Travel::Status::DE::IRIS::Result;
 use XML::LibXML;
@@ -56,6 +57,8 @@ sub new {
 	@{ $self->{results} }
 	  = sort { $a->{datetime} <=> $b->{datetime} } @{ $self->{results} };
 
+	$self->get_realtime;
+
 	return $self;
 }
 
@@ -75,6 +78,8 @@ sub get_timetable {
 
 	my $xml = XML::LibXML->load_xml( string => $res->decoded_content );
 
+	#say $xml->toString(1);
+
 	my $station = ( $xml->findnodes('/timetable') )[0]->getAttribute('station');
 
 	for my $s ( $xml->findnodes('/timetable/s') ) {
@@ -112,10 +117,71 @@ sub get_timetable {
 			$data{departure_wings} = $e_dp->getAttribute('wings');
 		}
 
-		push(
-			@{ $self->{results} },
-			Travel::Status::DE::IRIS::Result->new(%data)
-		);
+		# if scheduled departure and current departure are not within the
+		# same hour, trains are reported twice. Don't add duplicates in
+		# that case.
+		if ( not first { $_->raw_id eq $id } @{ $self->{results} } ) {
+			push(
+				@{ $self->{results} },
+				Travel::Status::DE::IRIS::Result->new(%data)
+			);
+		}
+	}
+
+	return $self;
+}
+
+sub get_realtime {
+	my ($self) = @_;
+
+	my $eva = $self->{nodes}{station}->getAttribute('eva');
+	my $res = $self->{user_agent}
+	  ->get("http://iris.noncd.db.de/iris-tts/timetable/fchg/${eva}");
+
+	if ( $res->is_error ) {
+		$self->{errstr} = $res->status_line;
+		return $self;
+	}
+
+	my $xml = XML::LibXML->load_xml( string => $res->decoded_content );
+
+	for my $s ( $xml->findnodes('/timetable/s') ) {
+		my $id   = $s->getAttribute('id');
+		my $e_tl = ( $s->findnodes('./tl') )[0];
+		my $e_ar = ( $s->findnodes('./ar') )[0];
+		my $e_dp = ( $s->findnodes('./dp') )[0];
+
+		my $result = first { $_->raw_id eq $id } $self->results;
+
+		if ( not $result ) {
+			next;
+		}
+
+		if ($e_tl) {
+			$result->add_tl(
+				class     => $e_tl->getAttribute('f'),    # D N S F
+				unknown_t => $e_tl->getAttribute('t'),    # p
+				train_no  => $e_tl->getAttribute('n'),    # dep number
+				type      => $e_tl->getAttribute('c'),    # S/ICE/ERB/...
+				line_no   => $e_tl->getAttribute('l'),    # 1 -> S1, ...
+				unknown_o => $e_tl->getAttribute('o'),    # owner: 03/80/R2/...
+			);
+		}
+		if ($e_ar) {
+			$result->add_ar(
+				arrival_ts => $e_ar->getAttribute('ct'),
+				platform   => $e_ar->getAttribute('cp'),
+				route_pre  => $e_ar->getAttribute('cpth'),
+			);
+		}
+		if ($e_dp) {
+			$result->add_dp(
+				departure_ts => $e_dp->getAttribute('ct'),
+				platform     => $e_dp->getAttribute('cp'),
+				route_pre    => $e_dp->getAttribute('cpth'),
+			);
+		}
+
 	}
 
 	return $self;
diff --git a/lib/Travel/Status/DE/IRIS/Result.pm b/lib/Travel/Status/DE/IRIS/Result.pm
index fbb519a..b87cdf5 100644
--- a/lib/Travel/Status/DE/IRIS/Result.pm
+++ b/lib/Travel/Status/DE/IRIS/Result.pm
@@ -14,8 +14,9 @@ use DateTime::Format::Strptime;
 our $VERSION = '0.00';
 
 Travel::Status::DE::IRIS::Result->mk_ro_accessors(
-	qw(arrival date datetime departure line_no raw_id
+	qw(arrival date datetime delay departure line_no raw_id
 	  route_start route_end
+	  sched_arrival sched_departure
 	  start stop_no time train_id train_no type unknown_t unknown_o)
 );
 
@@ -36,8 +37,10 @@ sub new {
 	$ref->{train_id} = $train_id;
 	$ref->{stop_no}  = $stop_no;
 
-	my $ar = $ref->{arrival}   = $strp->parse_datetime( $opt{arrival_ts} );
-	my $dp = $ref->{departure} = $strp->parse_datetime( $opt{departure_ts} );
+	my $ar = $ref->{arrival} = $ref->{sched_arrival}
+	  = $strp->parse_datetime( $opt{arrival_ts} );
+	my $dp = $ref->{departure} = $ref->{sched_departure}
+	  = $strp->parse_datetime( $opt{departure_ts} );
 
 	if ( not( $ar or $dp ) ) {
 		cluck(
@@ -54,15 +57,59 @@ sub new {
 	$ref->{date} = $dt->strftime('%d.%m.%Y');
 	$ref->{time} = $dt->strftime('%H:%M');
 
-	$ref->{route_pre}  = [ split( qr{\|}, $ref->{route_pre}  // q{} ) ];
-	$ref->{route_post} = [ split( qr{\|}, $ref->{route_post} // q{} ) ];
+	$ref->{route_pre} = $ref->{sched_route_pre}
+	  = [ split( qr{\|}, $ref->{route_pre} // q{} ) ];
+	$ref->{route_post} = $ref->{sched_route_post}
+	  = [ split( qr{\|}, $ref->{route_post} // q{} ) ];
 
-	$ref->{route_end}   = $ref->{route_post}[-1] || $ref->{station};
-	$ref->{route_start} = $ref->{route_pre}[0]   || $ref->{station};
+	$ref->{route_end} = $ref->{sched_route_end} = $ref->{route_post}[-1]
+	  || $ref->{station};
+	$ref->{route_start} = $ref->{sched_route_start} = $ref->{route_pre}[0]
+	  || $ref->{station};
 
 	return bless( $ref, $obj );
 }
 
+sub add_ar {
+	my ( $self, %attrib ) = @_;
+
+	my $strp = DateTime::Format::Strptime->new(
+		pattern   => '%y%m%d%H%M',
+		time_zone => 'Europe/Berlin',
+	);
+
+	if ( $attrib{arrival_ts} ) {
+		$self->{arrival} = $strp->parse_datetime( $attrib{arrival_ts} );
+		$self->{delay}
+		  = $self->arrival->subtract_datetime( $self->sched_arrival )
+		  ->in_units('minutes');
+	}
+}
+
+sub add_dp {
+	my ( $self, %attrib ) = @_;
+
+	my $strp = DateTime::Format::Strptime->new(
+		pattern   => '%y%m%d%H%M',
+		time_zone => 'Europe/Berlin',
+	);
+
+	if ( $attrib{departure_ts} ) {
+		$self->{departure} = $strp->parse_datetime( $attrib{departure_ts} );
+		$self->{delay}
+		  = $self->departure->subtract_datetime( $self->sched_departure )
+		  ->in_units('minutes');
+	}
+}
+
+sub add_tl {
+	my ( $self, %attrib ) = @_;
+
+	# TODO
+
+	return $self;
+}
+
 sub origin {
 	my ($self) = @_;
 
@@ -85,19 +132,19 @@ sub line {
 sub route_pre {
 	my ($self) = @_;
 
-	return @{$self->{route_pre}};
+	return @{ $self->{route_pre} };
 }
 
 sub route_post {
 	my ($self) = @_;
 
-	return @{$self->{route_post}};
+	return @{ $self->{route_post} };
 }
 
 sub route {
 	my ($self) = @_;
 
-	return ($self->route_pre, $self->{station}, $self->route_post);
+	return ( $self->route_pre, $self->{station}, $self->route_post );
 }
 
 sub train {