summaryrefslogtreecommitdiff
path: root/lib/Travel/Status
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Travel/Status')
-rw-r--r--lib/Travel/Status/DE/IRIS.pm21
-rw-r--r--lib/Travel/Status/DE/IRIS/Result.pm31
2 files changed, 51 insertions, 1 deletions
diff --git a/lib/Travel/Status/DE/IRIS.pm b/lib/Travel/Status/DE/IRIS.pm
index 03aa89c..002f354 100644
--- a/lib/Travel/Status/DE/IRIS.pm
+++ b/lib/Travel/Status/DE/IRIS.pm
@@ -65,6 +65,25 @@ sub new {
$self->get_realtime;
+ # tra (transfer?) indicates a train changing its ID, so there are two
+ # results for the same train. Remove the departure-only trains from the
+ # result set and merge them with their arrival-only counterpairt.
+ # This way, in case the arrival is available but the departure isn't,
+ # nothing gets lost.
+ my @merge_candidates
+ = grep { $_->transfer and $_->departure } @{ $self->{results} };
+ @{ $self->{results} }
+ = grep { not( $_->transfer and $_->departure ) } @{ $self->{results} };
+
+ for my $transfer (@merge_candidates) {
+ my $result
+ = first { $_->transfer and $_->transfer eq $transfer->train_id }
+ @{ $self->{results} };
+ if ($result) {
+ $result->merge_with_departure($transfer);
+ }
+ }
+
@{ $self->{results} } = grep {
my $d
= ( $_->departure // $_->arrival )
@@ -106,6 +125,7 @@ sub add_result {
$data{platform} = $e_ar->getAttribute('pp'); # string, not number!
$data{route_pre} = $e_ar->getAttribute('ppth');
$data{route_start} = $e_ar->getAttribute('pde');
+ $data{transfer} = $e_ar->getAttribute('tra');
$data{arrival_wings} = $e_ar->getAttribute('wings');
}
@@ -114,6 +134,7 @@ sub add_result {
$data{platform} = $e_dp->getAttribute('pp'); # string, not number!
$data{route_post} = $e_dp->getAttribute('ppth');
$data{route_end} = $e_dp->getAttribute('pde');
+ $data{transfer} = $e_dp->getAttribute('tra');
$data{departure_wings} = $e_dp->getAttribute('wings');
}
diff --git a/lib/Travel/Status/DE/IRIS/Result.pm b/lib/Travel/Status/DE/IRIS/Result.pm
index d1993f4..a9a8a14 100644
--- a/lib/Travel/Status/DE/IRIS/Result.pm
+++ b/lib/Travel/Status/DE/IRIS/Result.pm
@@ -19,7 +19,7 @@ Travel::Status::DE::IRIS::Result->mk_ro_accessors(
qw(arrival classes date datetime delay departure is_cancelled line_no
platform raw_id realtime_xml route_start route_end sched_arrival
sched_departure sched_route_start sched_route_end start stop_no time
- train_id train_no type unknown_t unknown_o)
+ train_id train_no transfer type unknown_t unknown_o)
);
sub new {
@@ -39,6 +39,11 @@ sub new {
$ref->{train_id} = $train_id;
$ref->{stop_no} = $stop_no;
+ if ( $opt{transfer} ) {
+ my ($transfer) = split( /.\K-/, $opt{transfer} );
+ $ref->{transfer} = $transfer;
+ }
+
my $ar = $ref->{arrival} = $ref->{sched_arrival}
= $strp->parse_datetime( $opt{arrival_ts} );
my $dp = $ref->{departure} = $ref->{sched_departure}
@@ -161,6 +166,30 @@ sub add_tl {
return $self;
}
+sub merge_with_departure {
+ my ( $self, $result ) = @_;
+
+ # result must be departure-only
+
+ # departure is preferred over arrival, so overwrite default values
+ $self->{date} = $result->{date};
+ $self->{time} = $result->{time};
+ $self->{datetime} = $result->{datetime};
+ $self->{train_id} = $result->{train_id}; # TODO save old value
+ $self->{train_no} = $result->{train_no}; # TODO save old value
+
+ $self->{departure} = $result->{departure};
+ $self->{departure_wings} = $result->{departure_wings};
+ $self->{route_post} = $result->{route_post};
+ $self->{sched_departure} = $result->{sched_departure};
+ $self->{sched_route_post} = $result->{sched_route_post};
+
+ # update realtime info only if applicable
+ $self->{is_cancelled} ||= $result->{is_cancelled};
+
+ return $self;
+}
+
sub origin {
my ($self) = @_;