summaryrefslogtreecommitdiff
path: root/lib/Travel/Status/DE/IRIS/Result.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Travel/Status/DE/IRIS/Result.pm')
-rw-r--r--lib/Travel/Status/DE/IRIS/Result.pm31
1 files changed, 30 insertions, 1 deletions
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) = @_;