diff options
Diffstat (limited to 'lib/Travel/Status')
-rw-r--r-- | lib/Travel/Status/DE/IRIS.pm | 21 | ||||
-rw-r--r-- | lib/Travel/Status/DE/IRIS/Result.pm | 31 |
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) = @_; |