diff options
Diffstat (limited to 'lib/Travel')
| -rw-r--r-- | lib/Travel/Status/DE/IRIS.pm | 231 |
1 files changed, 231 insertions, 0 deletions
diff --git a/lib/Travel/Status/DE/IRIS.pm b/lib/Travel/Status/DE/IRIS.pm index f46cb2b..1c21339 100644 --- a/lib/Travel/Status/DE/IRIS.pm +++ b/lib/Travel/Status/DE/IRIS.pm @@ -31,6 +31,72 @@ sub try_load_xml { return ( $tree, undef ); } +sub new_p { + my ( $class, %opt ) = @_; + my $promise = $opt{promise}->new; + + if ( not $opt{station} ) { + return $promise->reject('station flag must be passed'); + } + + my $self = $class->new( %opt, async => 1 ); + $self->{promise} = $opt{promise}; + + my $lookahead_steps = int( $self->{lookahead} / 60 ); + if ( ( 60 - $self->{datetime}->minute ) < ( $self->{lookahead} % 60 ) ) { + $lookahead_steps++; + } + my $lookbehind_steps = int( $self->{lookbehind} / 60 ); + if ( $self->{datetime}->minute < ( $self->{lookbehind} % 60 ) ) { + $lookbehind_steps++; + } + + $self->get_station_p( + name => $opt{station}, + )->then( + sub { + my ($station) = @_; + $self->{station} = $station; + $self->{related_stations} = []; + + my $dt_req = $self->{datetime}->clone; + my @subreq + = ( $self->get_timetable_p( $self->{station}{uic}, $dt_req ) ); + for ( 1 .. $lookahead_steps ) { + $dt_req->add( hours => 1 ); + push( @subreq, + $self->get_timetable_p( $self->{station}{uic}, $dt_req ) ); + } + $dt_req = $self->{datetime}->clone; + for ( 1 .. $lookbehind_steps ) { + $dt_req->subtract( hours => 1 ); + push( @subreq, + $self->get_timetable_p( $self->{station}{uic}, $dt_req ) ); + } + + return $self->{promise}->all(@subreq); + } + )->then( + sub { + return $self->get_realtime_p; + } + )->then( + sub { + $self->postprocess_results; + $promise->resolve($self); + return; + } + )->catch( + sub { + my ($err) = @_; + $promise->reject($err); + return; + } + )->wait; + + return $promise; +} + sub new { my ( $class, %opt ) = @_; @@ -74,6 +140,10 @@ sub new { $lookbehind_steps++; } + if ( $opt{async} ) { + return $self; + } + if ( not $self->{user_agent} ) { my %lwp_options = %{ $opt{lwp_options} // { timeout => 10 } }; $self->{user_agent} = LWP::UserAgent->new(%lwp_options); @@ -182,6 +252,55 @@ sub postprocess_results { $self->create_replacement_refs; } +sub get_with_cache_p { + my ( $self, $cache, $url ) = @_; + + if ( $self->{developer_mode} ) { + say "GET $url"; + } + + my $promise = $self->{promise}->new; + + if ($cache) { + my $content = $cache->thaw($url); + if ($content) { + if ( $self->{developer_mode} ) { + say ' cache hit'; + } + return $promise->resolve($content); + } + } + + if ( $self->{developer_mode} ) { + say ' cache miss'; + } + + my $res = $self->{user_agent}->get_p($url)->then( + sub { + my ($tx) = @_; + if ( my $err = $tx->error ) { + $promise->reject( + "GET $url returned HTTP $err->{code} $err->{messag}"); + return; + } + my $content = $tx->res->body; + if ($cache) { + $cache->freeze( $url, \$content ); + } + $promise->resolve($content); + return; + } + )->catch( + sub { + my ($err) = @_; + $promise->reject($err); + return; + } + )->wait; + + return $promise; +} + sub get_with_cache { my ( $self, $cache, $url ) = @_; @@ -218,6 +337,48 @@ sub get_with_cache { return ( $content, undef ); } +sub get_station_p { + my ( $self, %opt ) = @_; + + my $promise = $self->{promise}->new; + my $station = $opt{name}; + + $self->get_with_cache_p( $self->{main_cache}, + $self->{iris_base} . '/station/' . $station )->then( + sub { + my ($raw) = @_; + my ( $xml_st, $xml_err ) = try_load_xml($raw); + if ($xml_err) { + $promise->reject('Failed to parse station data: Invalid XML'); + return; + } + my $station_node = ( $xml_st->findnodes('//station') )[0]; + + if ( not $station_node ) { + $promise->reject( + "Station '$station' has no associated timetable"); + return; + } + $promise->resolve( + { + uic => $station_node->getAttribute('eva'), + name => $station_node->getAttribute('name'), + ds100 => $station_node->getAttribute('ds100'), + } + ); + return; + } + )->catch( + sub { + my ($err) = @_; + $promise->reject($err); + return; + } + )->wait; + + return $promise; +} + sub get_station { my ( $self, %opt ) = @_; @@ -393,6 +554,41 @@ sub add_result { return $result; } +sub get_timetable_p { + my ( $self, $eva, $dt ) = @_; + + my $promise = $self->{promise}->new; + + $self->get_with_cache_p( $self->{main_cache}, + $dt->strftime( $self->{iris_base} . "/plan/${eva}/%y%m%d/%H" ) )->then( + sub { + my ($raw) = @_; + my ( $xml, $xml_err ) = try_load_xml($raw); + if ($xml_err) { + $promise->reject( + 'Failed to parse a schedule part: Invalid XML'); + return; + } + my $station + = ( $xml->findnodes('/timetable') )[0]->getAttribute('station'); + + for my $s ( $xml->findnodes('/timetable/s') ) { + + $self->add_result( $station, $eva, $s ); + } + $promise->resolve; + return; + } + )->catch( + sub { + my ($err) = @_; + $promise->reject($err); + return; + } + )->wait; + return $promise; +} + sub get_timetable { my ( $self, $eva, $dt ) = @_; @@ -422,6 +618,36 @@ sub get_timetable { return $self; } +sub get_realtime_p { + my ($self) = @_; + + my $promise = $self->{promise}->new; + + my $eva = $self->{station}{uic}; + $self->get_with_cache_p( $self->{rt_cache}, + $self->{iris_base} . "/fchg/${eva}" )->then( + sub { + my ($raw) = @_; + my ( $xml, $xml_err ) = try_load_xml($raw); + if ($xml_err) { + $promise->reject( + 'Failed to parse a schedule part: Invalid XML'); + return; + } + $self->parse_realtime( $eva, $xml ); + $promise->resolve; + return; + } + )->catch( + sub { + my ($err) = @_; + $promise->reject("Failed to fetch realtime data: $err"); + return; + } + )->wait; + return $promise; +} + sub get_realtime { my ($self) = @_; @@ -443,6 +669,11 @@ sub get_realtime { return $self; } + $self->parse_realtime( $eva, $xml ); +} + +sub parse_realtime { + my ( $self, $eva, $xml ) = @_; my $station = ( $xml->findnodes('/timetable') )[0]->getAttribute('station'); for my $s ( $xml->findnodes('/timetable/s') ) { |