diff options
Diffstat (limited to 'lib/DBInfoscreen/Helper')
-rw-r--r-- | lib/DBInfoscreen/Helper/DBRIS.pm | 93 | ||||
-rw-r--r-- | lib/DBInfoscreen/Helper/EFA.pm | 55 | ||||
-rw-r--r-- | lib/DBInfoscreen/Helper/HAFAS.pm | 377 | ||||
-rw-r--r-- | lib/DBInfoscreen/Helper/MOTIS.pm | 82 | ||||
-rw-r--r-- | lib/DBInfoscreen/Helper/Wagonorder.pm | 207 |
5 files changed, 462 insertions, 352 deletions
diff --git a/lib/DBInfoscreen/Helper/DBRIS.pm b/lib/DBInfoscreen/Helper/DBRIS.pm new file mode 100644 index 0000000..e780213 --- /dev/null +++ b/lib/DBInfoscreen/Helper/DBRIS.pm @@ -0,0 +1,93 @@ +package DBInfoscreen::Helper::DBRIS; + +# Copyright (C) 2025 Birte Kristina Friesel +# +# SPDX-License-Identifier: AGPL-3.0-or-later + +use strict; +use warnings; +use 5.020; + +use DateTime; +use Encode qw(decode encode); +use Travel::Status::DE::DBRIS; +use Mojo::JSON qw(decode_json); +use Mojo::Promise; +use Mojo::UserAgent; + +sub new { + my ( $class, %opt ) = @_; + + my $version = $opt{version}; + + $opt{header} + = { 'User-Agent' => +"dbf/${version} on $opt{root_url} +https://finalrewind.org/projects/db-fakedisplay" + }; + + return bless( \%opt, $class ); + +} + +sub get_journey_p { + my ( $self, %opt ) = @_; + + my $agent = $self->{user_agent}; + + if ( my $proxy = $ENV{DBFAKEDISPLAY_DBRIS_PROXY} ) { + $agent = Mojo::UserAgent->new; + $agent->proxy->http($proxy); + $agent->proxy->https($proxy); + } + + return Travel::Status::DE::DBRIS->new_p( + journey => $opt{id}, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $agent->request_timeout(10) + ); +} + +# Input: TripID +# Output: Promise returning a Travel::Status::DE::DBRIS::Journey instance on success +sub get_polyline_p { + my ( $self, %opt ) = @_; + + my $trip_id = $opt{id}; + my $promise = Mojo::Promise->new; + + my $agent = $self->{user_agent}; + + if ( my $proxy = $ENV{DBFAKEDISPLAY_DBRIS_PROXY} ) { + $agent = Mojo::UserAgent->new; + $agent->proxy->http($proxy); + $agent->proxy->https($proxy); + } + + Travel::Status::DE::DBRIS->new_p( + journey => $trip_id, + with_polyline => 1, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $agent->request_timeout(10) + )->then( + sub { + my ($dbris) = @_; + my $journey = $dbris->result; + + $promise->resolve($journey); + return; + } + )->catch( + sub { + my ($err) = @_; + $self->{log}->debug("DBRIS->new_p($trip_id) error: $err"); + $promise->reject($err); + return; + } + )->wait; + + return $promise; +} + +1; diff --git a/lib/DBInfoscreen/Helper/EFA.pm b/lib/DBInfoscreen/Helper/EFA.pm index 2386ebb..0e7f7d7 100644 --- a/lib/DBInfoscreen/Helper/EFA.pm +++ b/lib/DBInfoscreen/Helper/EFA.pm @@ -1,6 +1,6 @@ package DBInfoscreen::Helper::EFA; -# Copyright (C) 2020-2022 Daniel Friesel +# Copyright (C) 2020-2022 Birte Kristina Friesel # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -13,7 +13,7 @@ use Encode qw(decode encode); use Mojo::JSON qw(decode_json); use Mojo::Promise; use Mojo::Util qw(url_escape); -use XML::LibXML; +use Travel::Status::DE::EFA; sub new { my ( $class, %opt ) = @_; @@ -29,6 +29,51 @@ sub new { } +sub get_polyline_p { + my ( $self, %opt ) = @_; + + my $stopseq = $opt{stopseq}; + my $service = $opt{service}; + my $promise = Mojo::Promise->new; + + Travel::Status::DE::EFA->new_p( + service => $service, + stopseq => $stopseq, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $self->{user_agent}->request_timeout(10) + )->then( + sub { + my ($efa) = @_; + my $journey = $efa->result; + + $promise->resolve($journey); + return; + } + )->catch( + sub { + my ($err) = @_; + $self->{log}->debug("EFA->new_p($stopseq) error: $err"); + $promise->reject($err); + return; + } + )->wait; + + return $promise; +} + +sub get_coverage { + my ( $self, $service ) = @_; + + my $service_definition = Travel::Status::DE::EFA::get_service($service); + + if ( not $service_definition ) { + return {}; + } + + return $service_definition->{coverage}{area} // {}; +} + sub get_json_p { my ( $self, $cache, $url ) = @_; @@ -49,8 +94,7 @@ sub get_json_p { if ( my $err = $tx->error ) { $self->{log}->debug( -"efa->get_json_p($url): HTTP $err->{code} $err->{message}" - ); + "efa->get_json_p($url): HTTP $err->{code} $err->{message}"); $cache->freeze( $url, { error => $err->{message} } ); $promise->reject( "GET $url returned HTTP $err->{code} $err->{message}"); @@ -60,8 +104,7 @@ sub get_json_p { my $res = $tx->res->json; if ( not $res ) { - $self->{log} - ->debug("efa->get_json_p($url): empty response"); + $self->{log}->debug("efa->get_json_p($url): empty response"); $promise->reject("GET $url returned empty response"); return; } diff --git a/lib/DBInfoscreen/Helper/HAFAS.pm b/lib/DBInfoscreen/Helper/HAFAS.pm index 6af47e3..e16bad8 100644 --- a/lib/DBInfoscreen/Helper/HAFAS.pm +++ b/lib/DBInfoscreen/Helper/HAFAS.pm @@ -1,19 +1,20 @@ package DBInfoscreen::Helper::HAFAS; -# Copyright (C) 2011-2022 Daniel Friesel +# Copyright (C) 2011-2022 Birte Kristina Friesel # # SPDX-License-Identifier: AGPL-3.0-or-later use strict; use warnings; use 5.020; +use utf8; use DateTime; use Encode qw(decode encode); use Travel::Status::DE::HAFAS; use Mojo::JSON qw(decode_json); use Mojo::Promise; -use XML::LibXML; +use Mojo::UserAgent; sub new { my ( $class, %opt ) = @_; @@ -29,224 +30,231 @@ sub new { } -sub get_json_p { - my ( $self, $cache, $url ) = @_; +sub get_coverage { + my ( $self, $service ) = @_; - my $promise = Mojo::Promise->new; + my $service_definition = Travel::Status::DE::HAFAS::get_service($service); - if ( my $content = $cache->thaw($url) ) { - return $promise->resolve($content); + if ( not $service_definition ) { + return {}; } - $self->{log}->debug("get_json_p($url)"); - - $self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} ) - ->then( - sub { - my ($tx) = @_; - - if ( my $err = $tx->error ) { - $self->{log}->warn( - "hafas->get_json_p($url): HTTP $err->{code} $err->{message}" - ); - $promise->reject( - "GET $url returned HTTP $err->{code} $err->{message}"); - return; - } - my $body - = encode( 'utf-8', decode( 'ISO-8859-15', $tx->res->body ) ); - - $body =~ s{^TSLs[.]sls = }{}; - $body =~ s{;$}{}; - $body =~ s{(}{(}g; - $body =~ s{)}{)}g; - - my $json = decode_json($body); - - if ( not $json ) { - $self->{log}->debug("hafas->get_json_p($url): empty response"); - $promise->reject("GET $url returned empty response"); - return; - } - - $cache->freeze( $url, $json ); - - $promise->resolve($json); - return; - } - )->catch( - sub { - my ($err) = @_; - $self->{log}->warn("hafas->get_json_p($url): $err"); - $promise->reject($err); - return; - } - )->wait; - - return $promise; + return $service_definition->{coverage}{area} // {}; } -sub trainsearch_p { +sub get_route_p { my ( $self, %opt ) = @_; - my $base - = 'https://reiseauskunft.bahn.de/bin/trainsearch.exe/dn?L=vs_json&start=yes&rt=1'; - - if ( not $opt{date_yy} ) { - my $now = DateTime->now( time_zone => 'Europe/Berlin' ); - $opt{date_yy} = $now->strftime('%d.%m.%y'); - $opt{date_yyyy} = $now->strftime('%d.%m.%Y'); - } - - # IRIS reports trains with unknown type as type "-". HAFAS thinks otherwise - # and prefers the type to be left out entirely in this case. - $opt{train_req} =~ s{^- }{}; - my $promise = Mojo::Promise->new; + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); - $self->get_json_p( $self->{realtime_cache}, - "${base}&date=$opt{date_yy}&trainname=$opt{train_req}" )->then( - sub { - my ($trainsearch) = @_; - - # Fallback: Take first result - my $result = $trainsearch->{suggestions}[0]; - - # Try finding a result for the current date - for my $suggestion ( @{ $trainsearch->{suggestions} // [] } ) { - - # Drunken API, sail with care. Both date formats are used interchangeably - if ( - exists $suggestion->{depDate} - and ( $suggestion->{depDate} eq $opt{date_yy} - or $suggestion->{depDate} eq $opt{date_yyyy} ) - ) - { - # Train numbers are not unique, e.g. IC 149 refers both to the - # InterCity service Amsterdam -> Berlin and to the InterCity service - # Koebenhavns Lufthavn st -> Aarhus. One workaround is making - # requests with the stationFilter=80 parameter. Checking the origin - # station seems to be the more generic solution, so we do that - # instead. - if ( $opt{train_origin} - and $suggestion->{dep} eq $opt{train_origin} ) - { - $result = $suggestion; - last; - } - } - } - - if ($result) { - - # The trip_id's date part doesn't seem to matter -- so far, HAFAS is - # happy as long as the date part starts with a number. HAFAS-internal - # tripIDs use this format (withouth leading zero for day of month < 10) - # though, so let's stick with it. - my $date_map = $opt{date_yyyy}; - $date_map =~ tr{.}{}d; - $result->{trip_id} = sprintf( '1|%d|%d|%d|%s', - $result->{id}, $result->{cycle}, - $result->{pool}, $date_map ); - $promise->resolve($result); - } - else { - $self->{log}->warn( - "hafas->trainsearch_p($opt{train_req}): train not found"); - $promise->reject("Zug $opt{train_req} nicht gefunden"); - } - - # do not propagate $promise->reject's return value to this promise. - # Perl implicitly returns the last statement, so we explicitly return - # nothing to avoid this. - return; - } - )->catch( - sub { - my ($err) = @_; - $self->{log}->warn("hafas->trainsearch_p($opt{train_req}): $err"); - $promise->reject($err); - - # do not propagate $promise->reject's return value to this promise - return; - } - )->wait; - - return $promise; -} + my $hafas_promise; -sub get_route_timestamps_p { - my ( $self, %opt ) = @_; + my $agent = $self->{user_agent}; + if ( $opt{service} and $opt{service} eq 'PKP' ) { - my $promise = Mojo::Promise->new; - my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + # PKP needs proxying + $agent = Mojo::UserAgent->new; + } - if ( $opt{train} ) { - $opt{date_yy} = $opt{train}->start->strftime('%d.%m.%y'); - $opt{date_yyyy} = $opt{train}->start->strftime('%d.%m.%Y'); + if ( $opt{trip_id} ) { + $hafas_promise = Travel::Status::DE::HAFAS->new_p( + service => $opt{service} // 'ÖBB', + journey => { + id => $opt{trip_id}, + }, + language => $opt{language}, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $agent->request_timeout(10) + ); + } + elsif ( $opt{train} ) { $opt{train_req} = $opt{train}->type . ' ' . $opt{train}->train_no; $opt{train_origin} = $opt{train}->origin; } else { $opt{train_req} = $opt{train_type} . ' ' . $opt{train_no}; - $opt{date_yy} = $now->strftime('%d.%m.%y'); - $opt{date_yyyy} = $now->strftime('%d.%m.%Y'); } - $self->trainsearch_p(%opt)->then( + $hafas_promise //= Travel::Status::DE::HAFAS->new_p( + service => $opt{service} // 'ÖBB', + journeyMatch => $opt{train_req} =~ s{^- }{}r, + datetime => ( $opt{train} ? $opt{train}->start : $opt{datetime} ), + language => $opt{language}, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $agent->request_timeout(10) + )->then( sub { - my ($trainsearch_result) = @_; - my $trip_id = $trainsearch_result->{trip_id}; + my ($hafas) = @_; + my @results = $hafas->results; + + if ( not @results ) { + return Mojo::Promise->reject( + "journeyMatch($opt{train_req}) found no results"); + } + + my $result = $results[0]; + if ( @results > 1 ) { + for my $journey (@results) { + if ( $opt{train_origin} + and ( $journey->route )[0]->loc->name eq + $opt{train_origin} ) + { + $result = $journey; + last; + } + } + } + return Travel::Status::DE::HAFAS->new_p( + service => $opt{service} // 'ÖBB', journey => { - id => $trip_id, - - # name => $opt{train_no}, + id => $result->id, }, + language => $opt{language}, cache => $self->{realtime_cache}, promise => 'Mojo::Promise', - user_agent => $self->{user_agent}->request_timeout(10) + user_agent => $agent->request_timeout(10) ); } - )->then( + ); + + $hafas_promise->then( sub { my ($hafas) = @_; my $journey = $hafas->result; - my $ret = {}; - + my @ret; my $station_is_past = 1; + + my $num_names = 0; + my $prev_name = q{}; + my $num_directions = 0; + my $prev_direction = q{}; + my $num_operators = 0; + my $prev_operator = q{}; + for my $stop ( $journey->route ) { - my $name = $stop->{name}; - $ret->{$name} = { - sched_arr => $stop->{sched_arr}, - sched_dep => $stop->{sched_dep}, - rt_arr => $stop->{rt_arr}, - rt_dep => $stop->{rt_dep}, - arr_delay => $stop->{arr_delay}, - dep_delay => $stop->{dep_delay}, - load => $stop->{load}, - isCancelled => ( - ( $stop->{arr_cancelled} or not $stop->{sched_arr} ) - and - ( $stop->{dep_cancelled} or not $stop->{sched_dep} ) - ), - }; + my $prod = $stop->prod_dep // $stop->prod_arr; + if ( $prod and $prod->name and $prod->name ne $prev_name ) { + $num_names++; + $prev_name = $prod->name; + } + if ( $prod + and $prod->operator + and $prod->operator ne $prev_operator ) + { + $num_operators++; + $prev_operator = $prod->operator; + } + if ( $stop->direction and $stop->direction ne $prev_direction ) + { + $num_directions++; + $prev_direction = $stop->direction; + } + } + + $prev_name = q{}; + $prev_direction = q{}; + $prev_operator = q{}; + + for my $stop ( $journey->route ) { + + my $prod = $stop->prod_dep // $stop->prod_arr; + my %annotation; + if ( $num_names > 1 + and $prod + and $prod->name + and $prod->name ne $prev_name ) + { + $prev_name = $annotation{prod_name} = $prod->name; + } + if ( $num_operators > 1 + and $prod + and $prod->operator + and $prod->operator ne $prev_operator ) + { + $prev_operator = $annotation{operator} = $prod->operator; + } + if ( $num_directions > 1 + and $stop->direction + and $stop->direction ne $prev_direction ) + { + $prev_direction = $annotation{direction} = $stop->direction; + } + + if (%annotation) { + $annotation{is_annotated} = 1; + } + + push( + @ret, + { + name => $stop->loc->name, + eva => $stop->loc->eva, + sched_arr => $stop->sched_arr, + sched_dep => $stop->sched_dep, + rt_arr => $stop->rt_arr, + rt_dep => $stop->rt_dep, + arr_delay => $stop->arr_delay, + dep_delay => $stop->dep_delay, + arr_cancelled => $stop->arr_cancelled, + dep_cancelled => $stop->dep_cancelled, + tz_offset => $stop->tz_offset, + platform => $stop->platform, + sched_platform => $stop->sched_platform, + load => $stop->load, + isAdditional => $stop->is_additional, + isCancelled => ( + ( $stop->arr_cancelled or not $stop->sched_arr ) + and + ( $stop->dep_cancelled or not $stop->sched_dep ) + ), + %annotation, + } + ); if ( $station_is_past - and not $ret->{$name}{isCancelled} + and not $ret[-1]{isCancelled} and $now->epoch < ( - $ret->{$name}{rt_arr} // $ret->{$name}{rt_dep} - // $ret->{$name}{sched_arr} - // $ret->{$name}{sched_dep} // $now + $ret[-1]{rt_arr} // $ret[-1]{rt_dep} + // $ret[-1]{sched_arr} // $ret[-1]{sched_dep} // $now )->epoch ) { $station_is_past = 0; } - $ret->{$name}{isPast} = $station_is_past; + $ret[-1]{isPast} = $station_is_past; + if ( $stop->tz_offset ) { + if ( $stop->sched_arr ) { + $ret[-1]{local_sched_arr} + = $stop->sched_arr->clone->add( + minutes => $stop->tz_offset ); + } + if ( $stop->sched_dep ) { + $ret[-1]{local_sched_dep} + = $stop->sched_dep->clone->add( + minutes => $stop->tz_offset ); + } + if ( $stop->rt_arr ) { + $ret[-1]{local_rt_arr} = $stop->rt_arr->clone->add( + minutes => $stop->tz_offset ); + } + if ( $stop->rt_dep ) { + $ret[-1]{local_rt_dep} = $stop->rt_dep->clone->add( + minutes => $stop->tz_offset ); + } + $ret[-1]{local_dt_ad} = $ret[-1]{local_rt_arr} + // $ret[-1]{local_sched_arr} // $ret[-1]{local_rt_dep} + // $ret[-1]{local_sched_dep}; + $ret[-1]{local_dt_da} = $ret[-1]{local_rt_dep} + // $ret[-1]{local_sched_dep} // $ret[-1]{local_rt_arr} + // $ret[-1]{local_sched_arr}; + } } - $promise->resolve( $ret, $journey ); + $promise->resolve( \@ret, $journey, $hafas ); return; } )->catch( @@ -263,11 +271,22 @@ sub get_route_timestamps_p { # Input: (HAFAS TripID, line number) # Output: Promise returning a Travel::Status::DE::HAFAS::Journey instance on success sub get_polyline_p { - my ( $self, $trip_id, $line ) = @_; + my ( $self, %opt ) = @_; + my $trip_id = $opt{id}; + my $line = $opt{line}; + my $service = $opt{service} // 'ÖBB'; my $promise = Mojo::Promise->new; + my $agent = $self->{user_agent}; + if ( $opt{service} and $opt{service} eq 'PKP' ) { + + # PKP needs proxying + $agent = Mojo::UserAgent->new; + } + Travel::Status::DE::HAFAS->new_p( + service => $service, journey => { id => $trip_id, name => $line, @@ -275,7 +294,7 @@ sub get_polyline_p { with_polyline => 1, cache => $self->{realtime_cache}, promise => 'Mojo::Promise', - user_agent => $self->{user_agent}->request_timeout(10) + user_agent => $agent->request_timeout(10) )->then( sub { my ($hafas) = @_; diff --git a/lib/DBInfoscreen/Helper/MOTIS.pm b/lib/DBInfoscreen/Helper/MOTIS.pm new file mode 100644 index 0000000..002a601 --- /dev/null +++ b/lib/DBInfoscreen/Helper/MOTIS.pm @@ -0,0 +1,82 @@ +package DBInfoscreen::Helper::MOTIS; + +# Copyright (C) 2025 networkException <git@nwex.de> +# +# SPDX-License-Identifier: AGPL-3.0-or-later + +use strict; +use warnings; +use 5.020; + +use DateTime; +use Encode qw(decode encode); +use Travel::Status::MOTIS; +use Mojo::JSON qw(decode_json); +use Mojo::Promise; + +sub new { + my ( $class, %opt ) = @_; + + my $version = $opt{version}; + + $opt{header} + = { 'User-Agent' => +"dbf/${version} on $opt{root_url} +https://finalrewind.org/projects/db-fakedisplay" + }; + + return bless( \%opt, $class ); + +} + +sub get_coverage { + my ( $self, $service ) = @_; + + my $service_definition = Travel::Status::MOTIS::get_service($service); + + if ( not $service_definition ) { + return {}; + } + + return $service_definition->{coverage}{area} // {}; +} + +# Input: TripID +# Output: Promise returning a Travel::Status::MOTIS::Trip instance on success +sub get_polyline_p { + my ( $self, %opt ) = @_; + + my $trip_id = $opt{id}; + my $service = $opt{service} // 'transitous'; + + my $promise = Mojo::Promise->new; + + my $agent = $self->{user_agent}; + + Travel::Status::MOTIS->new_p( + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $agent->request_timeout(10), + + service => $service, + trip_id => $trip_id, + )->then( + sub { + my ($motis) = @_; + my $trip = $motis->result; + + $promise->resolve($trip); + return; + } + )->catch( + sub { + my ($err) = @_; + $self->{log}->debug("MOTIS->new_p($trip_id) error: $err"); + $promise->reject($err); + return; + } + )->wait; + + return $promise; +} + +1; diff --git a/lib/DBInfoscreen/Helper/Wagonorder.pm b/lib/DBInfoscreen/Helper/Wagonorder.pm index 469eda6..9981244 100644 --- a/lib/DBInfoscreen/Helper/Wagonorder.pm +++ b/lib/DBInfoscreen/Helper/Wagonorder.pm @@ -1,6 +1,6 @@ package DBInfoscreen::Helper::Wagonorder; -# Copyright (C) 2011-2020 Daniel Friesel +# Copyright (C) 2011-2020 Birte Kristina Friesel # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -8,6 +8,7 @@ use strict; use warnings; use 5.020; +use DateTime; use Mojo::Promise; sub new { @@ -24,181 +25,51 @@ sub new { } -sub is_available_p { - my ( $self, $train, $wr_link ) = @_; - my $promise = Mojo::Promise->new; - - $self->check_wagonorder_p( $train->train_no, $wr_link )->then( - sub { - my ($body) = @_; - $promise->resolve($body); - return; - }, - sub { - if ( $train->is_wing ) { - my $wing = $train->wing_of; - return $self->check_wagonorder_p( $wing->train_no, $wr_link ); - } - else { - $promise->reject; - return; - } - } - )->then( - sub { - my ($body) = @_; - $promise->resolve($body); - return; - }, - sub { - $promise->reject; - return; - } - )->wait; - - return $promise; -} - -sub get_dbdb_p { - my ( $self, $url ) = @_; - - my $promise = Mojo::Promise->new; +sub get_p { + my ( $self, %opt ) = @_; - my $cache = $self->{main_cache}; + my %param; - if ( my $content = $cache->get($url) ) { - if ($content) { - return $promise->resolve($content); - } - else { - return $promise->reject; - } + if ( $opt{param} ) { + %param = %{ $opt{param} }; + delete $param{e}; } - - $self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} ) - ->then( - sub { - my ($tx) = @_; - if ( $tx->result->is_success ) { - my $body = $tx->result->body; - $cache->set( $url, $body ); - $promise->resolve($body); - } - else { - $cache->set( $url, q{} ); - $promise->reject; - } - return; - } - )->catch( - sub { - $cache->set( $url, q{} ); - $promise->reject; - return; - } - )->wait; - return $promise; -} - -sub head_dbdb_p { - my ( $self, $url ) = @_; - - my $promise = Mojo::Promise->new; - - my $cache = $self->{main_cache}; - - if ( my $content = $cache->get($url) ) { - $self->{log}->debug("wagonorder->head_dbdb_p($url): cached ($content)"); - if ( $content eq 'y' ) { - return $promise->resolve; - } - else { - return $promise->reject; - } + else { + my $datetime = $opt{datetime}->clone->set_time_zone('UTC'); + %param = ( + administrationId => 80, + category => $opt{train_type}, + date => $datetime->strftime('%Y-%m-%d'), + evaNumber => $opt{eva}, + number => $opt{train_number}, + time => $datetime->rfc3339 =~ s{(?=Z)}{.000}r + ); } - $self->{user_agent}->request_timeout(5)->head_p( $url => $self->{header} ) - ->then( - sub { - my ($tx) = @_; - if ( $tx->result->is_success ) { - $self->{log}->debug("wagonorder->head_dbdb_p($url): y"); - $cache->set( $url, 'y' ); - $promise->resolve; - } - else { - $self->{log}->debug("wagonorder->head_dbdb_p($url): n"); - $cache->set( $url, 'n' ); - $promise->reject; - } - return; - } - )->catch( - sub { - $self->{log}->debug("wagonorder->head_dbdb_p($url): n"); - $cache->set( $url, 'n' ); - $promise->reject; - return; - } - )->wait; - return $promise; -} - -sub has_cycle_p { - my ( $self, $train_no ) = @_; - - return $self->head_dbdb_p( - "https://lib.finalrewind.org/dbdb/db_umlauf/${train_no}.svg"); -} - -sub check_wagonorder_p { - my ( $self, $train_no, $wr_link ) = @_; + my $url = sprintf( '%s?%s', +'https://www.bahn.de/web/api/reisebegleitung/wagenreihung/vehicle-sequence', + join( '&', map { $_ . '=' . $param{$_} } sort keys %param ) ); my $promise = Mojo::Promise->new; - $self->head_dbdb_p( - "https://lib.finalrewind.org/dbdb/has_wagonorder/${train_no}/${wr_link}" - )->then( - sub { - $promise->resolve; - return; - } - )->catch( - sub { - $self->get_p( $train_no, $wr_link )->then( - sub { - $promise->resolve; - return; - } - )->catch( - sub { - $promise->reject; - return; - } - )->wait; - return; + if ( my $content = $self->{main_cache}->thaw($url) ) { + $self->{log}->debug("wagonorder->get_p($url): cached"); + if ( $content->{error} ) { + return $promise->reject( +"GET $url: HTTP $content->{error}{code} $content->{error}{message} (cachd)" + ); } - )->wait; - - return $promise; -} - -sub get_p { - my ( $self, $train_no, $api_ts ) = @_; - - my $url - = "https://www.apps-bahn.de/wr/wagenreihung/1.0/${train_no}/${api_ts}"; - - my $cache = $self->{realtime_cache}; - - my $promise = Mojo::Promise->new; + return $promise->resolve( $content, \%param ); + } - if ( my $content = $cache->thaw($url) ) { + if ( my $content = $self->{realtime_cache}->thaw($url) ) { $self->{log}->debug("wagonorder->get_p($url): cached"); if ( $content->{error} ) { - return $promise->reject($content); + return $promise->reject( +"GET $url: HTTP $content->{error}{code} $content->{error}{message} (cachd)" + ); } - return $promise->resolve($content); + return $promise->resolve( $content, \%param ); } $self->{user_agent}->request_timeout(10)->get_p( $url => $self->{header} ) @@ -216,16 +87,18 @@ sub get_p { $self->{log}->debug( "wagonorder->get_p($url): HTTP $err->{code} $err->{message}" ); - $cache->freeze( $url, $json ); - $promise->reject($json); + $self->{realtime_cache}->freeze( $url, $json ); + $promise->reject("GET $url: HTTP $err->{code} $err->{message}"); return; } $self->{log}->debug("wagonorder->get_p($url): OK"); my $json = $tx->res->json; + $json->{ts} = DateTime->now( time_zone => 'Europe/Berlin' ) + ->strftime('%d.%m.%Y %H:%M'); - $cache->freeze( $url, $json ); - $promise->resolve($json); + $self->{main_cache}->freeze( $url, $json ); + $promise->resolve( $json, \%param ); return; } )->catch( |