diff options
Diffstat (limited to 'lib/Travel/Status/DE/IRIS.pm')
| -rw-r--r-- | lib/Travel/Status/DE/IRIS.pm | 607 |
1 files changed, 527 insertions, 80 deletions
diff --git a/lib/Travel/Status/DE/IRIS.pm b/lib/Travel/Status/DE/IRIS.pm index c4bbeda..60f5d49 100644 --- a/lib/Travel/Status/DE/IRIS.pm +++ b/lib/Travel/Status/DE/IRIS.pm @@ -4,16 +4,14 @@ use strict; use warnings; use 5.014; -no if $] >= 5.018, warnings => 'experimental::smartmatch'; - -our $VERSION = '1.28'; +our $VERSION = '1.96'; use Carp qw(confess cluck); use DateTime; use DateTime::Format::Strptime; -use List::Util qw(first); +use List::Util qw(none first); use List::MoreUtils qw(uniq); -use List::UtilsBy qw(uniq_by); +use List::UtilsBy qw(uniq_by); use LWP::UserAgent; use Travel::Status::DE::IRIS::Result; use XML::LibXML; @@ -31,6 +29,153 @@ sub try_load_xml { return ( $tree, undef ); } +# "station" parameter must be an EVA or DS100 ID. +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++; + } + + my @candidates = $opt{get_station}( $opt{station} ); + + if ( @candidates != 1 and $opt{station} =~ m{^\d+$} ) { + @candidates = ( + [ + "D$opt{station}", "Betriebsstelle nicht bekannt $opt{station}", + $opt{station} + ] + ); + } + + if ( @candidates == 0 ) { + return $promise->reject('station not found'); + } + if ( @candidates >= 2 ) { + return $promise->reject('station identifier is ambiguous'); + } + + # "uic" is deprecated + $self->{station} = { + ds100 => $candidates[0][0], + eva => $candidates[0][2], + name => $candidates[0][1], + uic => $candidates[0][2], + }; + $self->{related_stations} = []; + + my @queue = ( $self->{station}{eva} ); + my @related_reqs; + my @related_stations; + my %seen = ( $self->{station}{eva} => 1 ); + my $iter_depth = 0; + + while ( @queue and $iter_depth < 12 and $opt{with_related} ) { + my $eva = shift(@queue); + $iter_depth++; + for my $ref ( @{ $opt{meta}{$eva} // [] } ) { + if ( not $seen{$ref} ) { + push( @related_stations, $ref ); + $seen{$ref} = 1; + push( @queue, $ref ); + } + } + } + + for my $eva (@related_stations) { + @candidates = $opt{get_station}($eva); + + if ( @candidates == 1 ) { + + # "uic" is deprecated + push( + @{ $self->{related_stations} }, + { + ds100 => $candidates[0][0], + eva => $candidates[0][2], + name => $candidates[0][1], + uic => $candidates[0][2], + } + ); + } + } + + my $dt_req = $self->{datetime}->clone; + my @timetable_reqs + = ( $self->get_timetable_p( $self->{station}{eva}, $dt_req ) ); + + for my $eva (@related_stations) { + push( @timetable_reqs, $self->get_timetable_p( $eva, $dt_req ) ); + } + + for ( 1 .. $lookahead_steps ) { + $dt_req->add( hours => 1 ); + push( @timetable_reqs, + $self->get_timetable_p( $self->{station}{eva}, $dt_req ) ); + for my $eva (@related_stations) { + push( @timetable_reqs, $self->get_timetable_p( $eva, $dt_req ) ); + } + } + + $dt_req = $self->{datetime}->clone; + for ( 1 .. $lookbehind_steps ) { + $dt_req->subtract( hours => 1 ); + push( @timetable_reqs, + $self->get_timetable_p( $self->{station}{eva}, $dt_req ) ); + for my $eva (@related_stations) { + push( @timetable_reqs, $self->get_timetable_p( $eva, $dt_req ) ); + } + } + + $self->{promise}->all(@timetable_reqs)->then( + sub { + my @realtime_reqs + = ( $self->get_realtime_p( $self->{station}{eva} ) ); + for my $eva (@related_stations) { + push( @realtime_reqs, $self->get_realtime_p( $eva, $dt_req ) ); + } + return $self->{promise}->all_settled(@realtime_reqs); + } + )->then( + sub { + my @realtime_results = @_; + + for my $realtime_result (@realtime_results) { + if ( $realtime_result->{status} eq 'rejected' ) { + $self->{warnstr} //= q{}; + $self->{warnstr} + .= "Realtime data request failed: $realtime_result->{reason}. "; + } + } + + $self->postprocess_results; + $promise->resolve($self); + return; + } + )->catch( + sub { + my ($err) = @_; + $promise->reject($err); + return; + } + )->wait; + + return $promise; +} + sub new { my ( $class, %opt ) = @_; @@ -43,11 +188,12 @@ sub new { // DateTime->now( time_zone => 'Europe/Berlin' ), developer_mode => $opt{developer_mode}, iris_base => $opt{iris_base} - // 'http://iris.noncd.db.de/iris-tts/timetable', - lookahead => $opt{lookahead} // ( 2 * 60 ), - lookbehind => $opt{lookbehind} // ( 0 * 60 ), - main_cache => $opt{main_cache}, - rt_cache => $opt{realtime_cache}, + // 'https://iris.noncd.db.de/iris-tts/timetable', + keep_transfers => $opt{keep_transfers}, + lookahead => $opt{lookahead} // ( 2 * 60 ), + lookbehind => $opt{lookbehind} // ( 0 * 60 ), + main_cache => $opt{main_cache}, + rt_cache => $opt{realtime_cache}, serializable => $opt{serializable}, user_agent => $opt{user_agent}, with_related => $opt{with_related}, @@ -64,6 +210,19 @@ sub new { bless( $self, $class ); + 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++; + } + + 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); @@ -80,16 +239,24 @@ sub new { $self->{related_stations} = \@related_stations; for my $ref (@related_stations) { + + # We (the parent) perform transfer processing, so child requests must not + # do it themselves. Otherwise, trains from child requests will be + # processed twice and may be lost. + # Similarly, child requests must not perform requests to related + # stations -- we're already doing that right now. my $ref_status = Travel::Status::DE::IRIS->new( datetime => $self->{datetime}, developer_mode => $self->{developer_mode}, + iris_base => $self->{iris_base}, lookahead => $self->{lookahead}, lookbehind => $self->{lookbehind}, - station => $ref->{uic}, + station => $ref->{eva}, main_cache => $self->{main_cache}, realtime_cache => $self->{rt_cache}, strptime_obj => $self->{strptime_obj}, user_agent => $self->{user_agent}, + keep_transfers => 1, with_related => 0, ); if ( not $ref_status->errstr ) { @@ -101,50 +268,52 @@ sub new { return $self; } - 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++; - } - my $dt_req = $self->{datetime}->clone; - $self->get_timetable( $self->{station}{uic}, $dt_req ); + $self->get_timetable( $self->{station}{eva}, $dt_req ); for ( 1 .. $lookahead_steps ) { $dt_req->add( hours => 1 ); - $self->get_timetable( $self->{station}{uic}, $dt_req ); + $self->get_timetable( $self->{station}{eva}, $dt_req ); } $dt_req = $self->{datetime}->clone; for ( 1 .. $lookbehind_steps ) { $dt_req->subtract( hours => 1 ); - $self->get_timetable( $self->{station}{uic}, $dt_req ); + $self->get_timetable( $self->{station}{eva}, $dt_req ); } $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 counterpart. - # 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} }; + $self->postprocess_results; + + return $self; +} - for my $transfer (@merge_candidates) { - my $result - = first { $_->transfer and $_->transfer eq $transfer->train_id } - @{ $self->{results} }; - if ($result) { - $result->merge_with_departure($transfer); +sub postprocess_results { + my ($self) = @_; + if ( not $self->{keep_transfers} ) { + + # 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 counterpart. + # 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; + my $d = $_->departure // $_->arrival; my $s = $_->sched_arrival // $_->sched_departure // $_->arrival // $d; $d = $d->subtract_datetime( $self->{datetime} ); $s = $s->subtract_datetime( $self->{datetime} ); @@ -160,8 +329,55 @@ sub new { # same goes for replacement refs (the <ref> tag in the fchg document) $self->create_replacement_refs; +} - return $self; +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->{message}"); + 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 { @@ -200,17 +416,67 @@ 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( + { + ds100 => $station_node->getAttribute('ds100'), + eva => $station_node->getAttribute('eva'), + name => $station_node->getAttribute('name'), + uic => $station_node->getAttribute('eva'), + } + ); + return; + } + )->catch( + sub { + my ($err) = @_; + $promise->reject($err); + return; + } + )->wait; + + return $promise; +} + sub get_station { my ( $self, %opt ) = @_; my $iter_depth = 0; my @ret; my @queue = ( $opt{name} ); - my @seen; + + # @seen holds station IDs which were already seen during recursive + # 'meta' descent. This avoids infinite loops of 'meta' references. + # Additionally, we use it to skip stations shat should not be referenced. + # This includes Norddeich / Norddeich Mole (different stations commonly used + # by identical trains with different departure times), and Essen-Dellwig / + # Essen-Dellwig Ost (different stations used by different trains, but with + # identical platform numbers). + my @seen = ( 8007768, 8004449, 8001903, 8001904 ); while ( @queue and $iter_depth < 12 ) { my $station = shift(@queue); - push( @seen, $station ); $iter_depth++; my ( $raw, $err ) @@ -237,6 +503,9 @@ sub get_station { my $station_node = ( $xml_st->findnodes('//station') )[0]; if ( not $station_node ) { + if ( $self->{developer_mode} ) { + say ' no timetable'; + } if ( $opt{root} ) { $self->{errstr} = "Station '$station' has no associated timetable"; @@ -259,24 +528,42 @@ sub get_station { next; } + if ( $station_node->getAttribute('ds100') =~ m{ ^ D \d+ $ }x ) { + + # This used to indicate an invalid DS100 code, at least from DB + # perspective. It typically referred to subway stations which do not + # have IRIS departures. + # However, since Fahrplanwechsel 2022 / 2023, this does not seem + # to be the case anymore. There are some stations whose DS100 code + # IRIS does not know, for whatever reason. So for now, accept these + # stations as well. + + #next; + } + push( @ret, { - uic => $station_node->getAttribute('eva'), - name => $station_node->getAttribute('name'), ds100 => $station_node->getAttribute('ds100'), + eva => $station_node->getAttribute('eva'), + name => $station_node->getAttribute('name'), + uic => $station_node->getAttribute('eva'), } ); if ( $self->{developer_mode} ) { - printf( " -> %s (%s / %s)\n", @{ $ret[-1] }{qw{name uic ds100}} ); + printf( " -> %s (%s / %s)\n", @{ $ret[-1] }{qw{name eva ds100}} ); } if ( $opt{recursive} and defined $station_node->getAttribute('meta') ) { my @refs = uniq( split( m{ \| }x, $station_node->getAttribute('meta') ) ); - @refs = grep { not( $_ ~~ \@seen or $_ ~~ \@queue ) } @refs; - push( @queue, @refs ); + for my $ref (@refs) { + if ( none { $_ == $ref } @seen and none { $_ == $ref } @queue ) + { + push( @queue, $ref ); + } + } $opt{root} = 0; } } @@ -286,13 +573,13 @@ sub get_station { . "This is probably a bug" ); } - @ret = uniq_by { $_->{uic} } @ret; + @ret = uniq_by { $_->{eva} } @ret; return @ret; } sub add_result { - my ( $self, $station, $s ) = @_; + my ( $self, $station_name, $station_eva, $s ) = @_; my $id = $s->getAttribute('id'); my $e_tl = ( $s->findnodes( $self->{xp_tl} ) )[0]; @@ -305,13 +592,15 @@ sub add_result { my %data = ( raw_id => $id, - classes => $e_tl->getAttribute('f'), # D N S F - train_no => $e_tl->getAttribute('n'), # dep number - type => $e_tl->getAttribute('c'), # S/ICE/ERB/... - station => $station, + classes => $e_tl->getAttribute('f'), # D N S F + operator => $e_tl->getAttribute('o'), # coded operator: 03/80/R2/... + train_no => $e_tl->getAttribute('n'), # dep number + type => $e_tl->getAttribute('c'), # S/ICE/ERB/... + station => $station_name, + station_eva => $station_eva + 0, # EVA IDs are numbers + station_uic => $station_eva + 0, # deprecated strptime_obj => $self->{strptime_obj}, - #unknown_o => $e_tl->getAttribute('o'), # owner: 03/80/R2/... #unknown_t => $e_tl->getAttribute('t'), # p ); @@ -322,9 +611,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_hidden} = $e_ar->getAttribute('hi'); $data{arrival_wing_ids} = $e_ar->getAttribute('wings'); - - #$data{unk_ar_hi} = $e_ar->getAttribute('hi'); } if ($e_dp) { @@ -334,9 +622,8 @@ 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_hidden} = $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} ) { @@ -360,6 +647,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 ) = @_; @@ -383,16 +705,51 @@ sub get_timetable { for my $s ( $xml->findnodes('/timetable/s') ) { - $self->add_result( $station, $s ); + $self->add_result( $station, $eva, $s ); + } + + if ( $self->{developer_mode} + and not scalar $xml->findnodes('/timetable/s') ) + { + say ' no scheduled trains'; } return $self; } +sub get_realtime_p { + my ( $self, $eva ) = @_; + + my $promise = $self->{promise}->new; + + $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) = @_; - my $eva = $self->{station}{uic}; + my $eva = $self->{station}{eva}; my ( $raw, $err ) = $self->get_with_cache( $self->{rt_cache}, @@ -410,6 +767,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') ) { @@ -426,7 +788,7 @@ sub get_realtime { # add_result will return nothing if no ./tl node is present. The ./tl # check here is for optimization purposes. if ( not $result and ( $s->findnodes( $self->{xp_tl} ) )[0] ) { - $result = $self->add_result( $station, $s ); + $result = $self->add_result( $station, $eva, $s ); if ($result) { $result->set_unscheduled(1); } @@ -445,12 +807,14 @@ sub get_realtime { my $msgid = $e_m->getAttribute('id'); my $ts = $e_m->getAttribute('ts'); - # 0 and 1 (with key "f") are related to canceled trains and - # do not appear to hold information (or at least none we can access). - # All observed cases of message ID 900 were related to bus - # connections ("Anschlussbus wartet"). We can't access which bus - # it refers to, so we don't show that either. - if ( defined $value and $value > 1 and $value != 900 ) { + # 0 and 1 (with key "f") are related to canceled trains and + # do not appear to hold information (or at least none we can access). + # All observed cases of message ID 900 were related to bus + # connections ("Anschlussbus wartet"). We can't access which bus + # it refers to, so we don't show that either. + # ID 1000 is a generic free text message, which (as we lack access + # to the text itself) is not helpful either. + if ( defined $value and $value > 1 and $value < 100 ) { $messages{$msgid} = [ $ts, $type, $value ]; } } @@ -469,9 +833,9 @@ sub get_realtime { type => $e_ref->getAttribute('c'), # S/ICE/ERB/... line_no => $e_ref->getAttribute('l'), # 1 -> S1, ... - #unknown_t => $e_ref->getAttribute('t'), # p - #unknown_o => $e_ref->getAttribute('o'), # owner: 03/80/R2/... - # TODO ps='a' -> rerouted and normally unscheduled train? + #unknown_t => $e_ref->getAttribute('t'), # p + #unknown_o => $e_ref->getAttribute('o'), # owner: 03/80/R2/... + # TODO ps='a' -> rerouted and normally unscheduled train? ); } if ($e_ar) { @@ -483,6 +847,7 @@ sub get_realtime { sched_route_pre => $e_ar->getAttribute('ppth'), status => $e_ar->getAttribute('cs'), status_since => $e_ar->getAttribute('clt'), + arrival_hidden => $e_ar->getAttribute('hi'), # TODO ps='a' -> rerouted and normally unscheduled train? ); @@ -495,6 +860,7 @@ sub get_realtime { route_post => $e_dp->getAttribute('cpth'), sched_route_post => $e_dp->getAttribute('ppth'), status => $e_dp->getAttribute('cs'), + departure_hidden => $e_dp->getAttribute('hi'), ); } @@ -514,7 +880,7 @@ sub get_result_by_train { my ( $self, $type, $train_no ) = @_; my $res = first { $_->type eq $type and $_->train_no eq $train_no } - @{ $self->{results} }; + @{ $self->{results} }; return $res; } @@ -596,14 +962,11 @@ Travel::Status::DE::IRIS - Interface to IRIS based web departure monitors. =head1 SYNOPSIS - use Travel::Status::DE::IRIS; - use Travel::Status::DE::IRIS::Stations; +Blocking variant: - # Get station code for "Essen Hbf" (-> "EE") - my $station = (Travel::Status::DE::IRIS::Stations::get_station_by_name( - 'Essen Hbf'))[0][0]; + use Travel::Status::DE::IRIS; - my $status = Travel::Status::DE::IRIS->new(station => $station); + my $status = Travel::Status::DE::IRIS->new(station => "Essen Hbf"); for my $r ($status->results) { printf( "%s %s +%-3d %10s -> %s\n", @@ -611,9 +974,29 @@ Travel::Status::DE::IRIS - Interface to IRIS based web departure monitors. ); } +Non-blocking variant (EXPERIMENTAL): + + use Mojo::Promise; + use Mojo::UserAgent; + use Travel::Status::DE::IRIS; + use Travel::Status::DE::IRIS::Stations; + + Travel::Status::DE::IRIS->new_p(station => "Essen Hbf", + promise => 'Mojo::Promise', user_agent => Mojo::UserAgent->new, + get_station => \&Travel::Status::DE::IRIS::Stations::get_station, + meta => Travel::Status::DE::IRIS::Stations::get_meta())->then(sub { + my ($status) = @_; + for my $r ($status->results) { + printf( + "%s %s +%-3d %10s -> %s\n", + $r->date, $r->time, $r->delay || 0, $r->line, $r->destination + ); + } + })->wait; + =head1 VERSION -version 1.28 +version 1.96 =head1 DESCRIPTION @@ -643,11 +1026,32 @@ current date and time. IRIS base url, defaults to C<< http://iris.noncd.db.de/iris-tts/timetable >>. +=item B<keep_transfers> => I<bool> + +A train may change its ID and number at a station, indicating that although the +previous logical train ends here, the physical train will continue its journey +under a new number to a new destination. A notable example is the Berlin +Ringbahn, which travels round and round from Berlin SE<uuml>dkreuz to Berlin +SE<uuml>dkreuz. Each train number corresponds to a single revolution, but the +actual trains just keep going. + +The IRIS backend returns two results for each transfer train: An arrival-only +result using the old ID (linked to the new one) and a departure-only result +using the new ID (linked to the old one). By default, this library merges these +into a single result with both arrival and departure time. Train number, ID, +and route are taken from the departure only. The original train ID and number +are available using the B<old_train_id> and B<old_train_no> accessors. + +In case this is not desirable (e.g. because you intend to track a single +train to its destination station and do not want to implement special cases +for transfer trains), set B<keep_transfers> to a true value. In this case, +backend data will be reported as-is and transfer trains will not be merged. + =item B<lookahead> => I<int> Compute only results which are scheduled less than I<int> minutes in the future. -Default: 180 (3 hours). +Default: 120 (2 hours). Note that the DeutscheBahn IRIS backend only provides schedules up to four to five hours into the future. So in most cases, setting this to a value above 240 @@ -702,11 +1106,54 @@ departures for all related stations. =back +=item my $promise = Travel::Status::DE::IRIS->new_p(I<%opt>) (B<EXPERIMENTAL>) + +Return a promise yielding a Travel::Status::DE::IRIS instance (C<< $status >>) +on success, or an error message (same as C<< $status->errstr >>) on failure. +This function is experimental and may be changed or remove without warning. + +In addition to the arguments of B<new>, the following mandatory arguments must +be set: + +=over + +=item B<promise> => I<promises module> + +Promises implementation to use for internal promises as well as B<new_p> return +value. Recommended: Mojo::Promise(3pm). + +=item B<get_station> => I<get_station ref> + +Reference to Travel::Status::DE::IRIS::Stations::get_station(). + +=item B<meta> => I<meta dict> + +The dictionary returned by Travel::Status::DE::IRIS::Stations::get_meta(). + +=item B<user_agent> => I<user agent> + +User agent instance to use for asynchronous requests. The object must support +promises (i.e., it must implement a C<< get_p >> function). Recommended: +Mojo::UserAgent(3pm). + +=back + =item $status->errstr In case of a fatal HTTP request or IRIS error, returns a string describing it. Returns undef otherwise. +=item $status->related_stations + +Returns a list of hashes describing related stations whose +arrivals/departures are included in B<results>. Only useful when setting +B<with_related> to a true value, see its documentation above for details. + +Each hash contains the keys B<eva> (EVA number; often same as UIC station ID), +B<name> (station name), and B<ds100> (station code). Note that stations +returned by B<related_stations> are not necessarily known to +Travel::Status::DE::IRIS::Stations(3pm). + =item $status->results Returns a list of Travel::Status::DE::IRIS::Result(3pm) objects, each one describing @@ -752,7 +1199,7 @@ L<https://github.com/derf/Travel-Status-DE-IRIS> =head1 AUTHOR -Copyright (C) 2013-2019 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> +Copyright (C) 2013-2024 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> =head1 LICENSE |