diff options
author | Daniel Friesel <derf@finalrewind.org> | 2015-04-18 20:28:49 +0200 |
---|---|---|
committer | Daniel Friesel <derf@finalrewind.org> | 2015-04-18 20:28:49 +0200 |
commit | ef40feb961f363029d98524b62a38a977823bb2b (patch) | |
tree | 645534359fe155d0991bba458b8f6f491064ce5b /lib/Travel/Status/DE | |
parent | 70033e0073c04903e228f0535bf68d55106779e0 (diff) |
Start work on wings support
Diffstat (limited to 'lib/Travel/Status/DE')
-rw-r--r-- | lib/Travel/Status/DE/IRIS.pm | 52 | ||||
-rw-r--r-- | lib/Travel/Status/DE/IRIS/Result.pm | 32 |
2 files changed, 80 insertions, 4 deletions
diff --git a/lib/Travel/Status/DE/IRIS.pm b/lib/Travel/Status/DE/IRIS.pm index ae614dc..da39a7c 100644 --- a/lib/Travel/Status/DE/IRIS.pm +++ b/lib/Travel/Status/DE/IRIS.pm @@ -13,6 +13,7 @@ use DateTime; use Encode qw(encode decode); use List::Util qw(first); use LWP::UserAgent; +use Scalar::Util qw(weaken); use Travel::Status::DE::IRIS::Result; use XML::LibXML; @@ -96,6 +97,10 @@ sub new { @{ $self->{results} } = sort { $a->{datetime} <=> $b->{datetime} } @{ $self->{results} }; + # wings (different departures which are coupled as one train) contain + # references to each other. therefore, they must be processed last. + $self->create_wing_refs; + return $self; } @@ -128,8 +133,8 @@ sub add_result { $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'); - $data{unk_ar_hi} = $e_ar->getAttribute('hi'); + $data{arrival_wing_ids} = $e_ar->getAttribute('wings'); + $data{unk_ar_hi} = $e_ar->getAttribute('hi'); } if ($e_dp) { @@ -138,8 +143,16 @@ sub add_result { $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'); - $data{unk_dp_hi} = $e_dp->getAttribute('hi'); + $data{departure_wing_ids} = $e_dp->getAttribute('wings'); + $data{unk_dp_hi} = $e_dp->getAttribute('hi'); + } + + if ( $data{arrival_wing_ids} ) { + $data{arrival_wing_ids} = [ split( /\|/, $data{arrival_wing_ids} ) ]; + } + if ( $data{departure_wing_ids} ) { + $data{departure_wing_ids} + = [ split( /\|/, $data{departure_wing_ids} ) ]; } my $result = Travel::Status::DE::IRIS::Result->new(%data); @@ -282,6 +295,37 @@ sub get_realtime { return $self; } +sub get_result_by_id { + my ( $self, $id ) = @_; + + my $res = first { $_->{raw_id} eq $id } $self->results; + return $res; +} + +sub create_wing_refs { + my ($self) = @_; + + for my $r ( $self->results ) { + if ( $r->{departure_wing_ids} ) { + for my $wing_id ( @{ $r->{departure_wing_ids} } ) { + my $wingref = $self->get_result_by_id($wing_id); + if ($wingref) { + $r->add_departure_wingref($wingref); + } + } + } + if ( $r->{arrival_wing_ids} ) { + for my $wing_id ( @{ $r->{arrival_wing_ids} } ) { + my $wingref = $self->get_result_by_id($wing_id); + if ($wingref) { + $r->add_departure_wingref($wingref); + } + } + } + } + +} + sub errstr { my ($self) = @_; diff --git a/lib/Travel/Status/DE/IRIS/Result.pm b/lib/Travel/Status/DE/IRIS/Result.pm index d4e3821..e49750f 100644 --- a/lib/Travel/Status/DE/IRIS/Result.pm +++ b/lib/Travel/Status/DE/IRIS/Result.pm @@ -323,6 +323,20 @@ sub set_tl { return $self; } +sub add_arrival_wingref { + my ( $self, $ref ) = @_; + + weaken($ref); + push( @{ $self->{arrival_wings} }, $ref ); +} + +sub add_departure_wingref { + my ( $self, $ref ) = @_; + + weaken($ref); + push( @{ $self->{departure_wings} }, $ref ); +} + # List::Compare does not keep the order of its arguments (even with unsorted). # So we need to re-sort all stops to maintain their original order. sub sorted_sublist { @@ -434,6 +448,24 @@ sub delay_messages { return @ret; } +sub arrival_wings { + my ($self) = @_; + + if ( $self->{arrival_wings} ) { + return @{ $self->{arrival_wings} }; + } + return; +} + +sub departure_wings { + my ($self) = @_; + + if ( $self->{departure_wings} ) { + return @{ $self->{departure_wings} }; + } + return; +} + sub dump_message_codes { my ($self) = @_; |