Move HAFAS helpers to a separate Helper module
This commit is contained in:
Daniel Friesel
parent
f08bdaca5c
commit
56c275875c
2 changed files with 328 additions and 297 deletions
336
lib/Travelynx.pm
336
lib/Travelynx.pm
|
|
@ -18,6 +18,7 @@ use List::MoreUtils qw(after_incl before_incl first_index);
|
||||||
use Travel::Status::DE::DBWagenreihung;
|
use Travel::Status::DE::DBWagenreihung;
|
||||||
use Travel::Status::DE::IRIS;
|
use Travel::Status::DE::IRIS;
|
||||||
use Travel::Status::DE::IRIS::Stations;
|
use Travel::Status::DE::IRIS::Stations;
|
||||||
|
use Travelynx::Helper::HAFAS;
|
||||||
use Travelynx::Helper::Sendmail;
|
use Travelynx::Helper::Sendmail;
|
||||||
use Travelynx::Model::Users;
|
use Travelynx::Model::Users;
|
||||||
use XML::LibXML;
|
use XML::LibXML;
|
||||||
|
|
@ -264,18 +265,15 @@ sub startup {
|
||||||
);
|
);
|
||||||
|
|
||||||
$self->helper(
|
$self->helper(
|
||||||
sendmail => sub {
|
hafas => sub {
|
||||||
state $sendmail = Travelynx::Helper::Sendmail->new(
|
|
||||||
config => ( $self->config->{mail} // {} ),
|
|
||||||
log => $self->log
|
|
||||||
);
|
|
||||||
}
|
|
||||||
);
|
|
||||||
|
|
||||||
$self->helper(
|
|
||||||
users => sub {
|
|
||||||
my ($self) = @_;
|
my ($self) = @_;
|
||||||
state $users = Travelynx::Model::Users->new( pg => $self->pg );
|
state $hafas = Travelynx::Helper::HAFAS->new(
|
||||||
|
log => $self->app->log,
|
||||||
|
main_cache => $self->app->cache_iris_main,
|
||||||
|
realtime_cache => $self->app->cache_iris_rt,
|
||||||
|
user_agent => $self->ua,
|
||||||
|
version => $self->app->config->{version},
|
||||||
|
);
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
|
||||||
|
|
@ -296,6 +294,22 @@ sub startup {
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
|
||||||
|
$self->helper(
|
||||||
|
sendmail => sub {
|
||||||
|
state $sendmail = Travelynx::Helper::Sendmail->new(
|
||||||
|
config => ( $self->config->{mail} // {} ),
|
||||||
|
log => $self->log
|
||||||
|
);
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
|
$self->helper(
|
||||||
|
users => sub {
|
||||||
|
my ($self) = @_;
|
||||||
|
state $users = Travelynx::Model::Users->new( pg => $self->pg );
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
$self->helper(
|
$self->helper(
|
||||||
'now' => sub {
|
'now' => sub {
|
||||||
return DateTime->now( time_zone => 'Europe/Berlin' );
|
return DateTime->now( time_zone => 'Europe/Berlin' );
|
||||||
|
|
@ -1564,16 +1578,20 @@ sub startup {
|
||||||
$self->ua->request_timeout(5)->get_p($url)->then(
|
$self->ua->request_timeout(5)->get_p($url)->then(
|
||||||
sub {
|
sub {
|
||||||
my ($tx) = @_;
|
my ($tx) = @_;
|
||||||
my $body = decode( 'utf-8', $tx->res->body );
|
|
||||||
|
|
||||||
my $json = JSON->new->decode($body);
|
if ( my $err = $tx->error ) {
|
||||||
|
return $promise->reject(
|
||||||
|
"HTTP $err->{code} $err->{message}");
|
||||||
|
}
|
||||||
|
|
||||||
|
my $json = $tx->result->json;
|
||||||
$cache->freeze( $url, $json );
|
$cache->freeze( $url, $json );
|
||||||
$promise->resolve($json);
|
return $promise->resolve($json);
|
||||||
}
|
}
|
||||||
)->catch(
|
)->catch(
|
||||||
sub {
|
sub {
|
||||||
my ($err) = @_;
|
my ($err) = @_;
|
||||||
$promise->reject($err);
|
return $promise->reject($err);
|
||||||
}
|
}
|
||||||
)->wait;
|
)->wait;
|
||||||
return $promise;
|
return $promise;
|
||||||
|
|
@ -1656,282 +1674,6 @@ sub startup {
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
|
||||||
$self->helper(
|
|
||||||
'get_hafas_polyline_p' => sub {
|
|
||||||
my ( $self, $train, $trip_id ) = @_;
|
|
||||||
|
|
||||||
my $line = $train->line // 0;
|
|
||||||
my $url
|
|
||||||
= "https://2.db.transport.rest/trips/${trip_id}?lineName=${line}&polyline=true";
|
|
||||||
my $cache = $self->app->cache_iris_main;
|
|
||||||
my $promise = Mojo::Promise->new;
|
|
||||||
my $version = $self->app->config->{version};
|
|
||||||
|
|
||||||
if ( my $content = $cache->thaw($url) ) {
|
|
||||||
$promise->resolve($content);
|
|
||||||
return $promise;
|
|
||||||
}
|
|
||||||
|
|
||||||
$self->ua->request_timeout(5)->get_p(
|
|
||||||
$url => {
|
|
||||||
'User-Agent' =>
|
|
||||||
"travelynx/${version} +https://finalrewind.org/projects/travelynx"
|
|
||||||
}
|
|
||||||
)->then(
|
|
||||||
sub {
|
|
||||||
my ($tx) = @_;
|
|
||||||
my $body = decode( 'utf-8', $tx->res->body );
|
|
||||||
my $json = JSON->new->decode($body);
|
|
||||||
my @station_list;
|
|
||||||
my @coordinate_list;
|
|
||||||
|
|
||||||
for my $feature ( @{ $json->{polyline}{features} } ) {
|
|
||||||
if ( exists $feature->{geometry}{coordinates} ) {
|
|
||||||
my $coord = $feature->{geometry}{coordinates};
|
|
||||||
if ( exists $feature->{properties}{type}
|
|
||||||
and $feature->{properties}{type} eq 'stop' )
|
|
||||||
{
|
|
||||||
push( @{$coord}, $feature->{properties}{id} );
|
|
||||||
push( @station_list,
|
|
||||||
$feature->{properties}{name} );
|
|
||||||
}
|
|
||||||
push( @coordinate_list, $coord );
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
my $ret = {
|
|
||||||
name => $json->{line}{name} // '?',
|
|
||||||
polyline => [@coordinate_list],
|
|
||||||
raw => $json,
|
|
||||||
};
|
|
||||||
|
|
||||||
$cache->freeze( $url, $ret );
|
|
||||||
|
|
||||||
# borders ("(Gr)" as in "Grenze") are only returned by HAFAS.
|
|
||||||
# They are not stations.
|
|
||||||
my $iris_stations = join( '|', $train->route );
|
|
||||||
my $hafas_stations
|
|
||||||
= join( '|', grep { $_ !~ m{\(Gr\)$} } @station_list );
|
|
||||||
|
|
||||||
# Do not return polyline if it belongs to an entirely different
|
|
||||||
# train. Trains with longer routes (e.g. due to train number
|
|
||||||
# changes, which are handled by HAFAS but left out in IRIS)
|
|
||||||
# are okay though.
|
|
||||||
if ( $iris_stations ne $hafas_stations
|
|
||||||
and index( $hafas_stations, $iris_stations ) == -1 )
|
|
||||||
{
|
|
||||||
$self->app->log->warn( 'Ignoring polyline for '
|
|
||||||
. $train->line
|
|
||||||
. ": IRIS route does not agree with HAFAS route: $iris_stations != $hafas_stations"
|
|
||||||
);
|
|
||||||
$promise->reject('polyline route mismatch');
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
$promise->resolve($ret);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
)->catch(
|
|
||||||
sub {
|
|
||||||
my ($err) = @_;
|
|
||||||
$promise->reject($err);
|
|
||||||
}
|
|
||||||
)->wait;
|
|
||||||
|
|
||||||
return $promise;
|
|
||||||
}
|
|
||||||
);
|
|
||||||
|
|
||||||
$self->helper(
|
|
||||||
'get_hafas_tripid_p' => sub {
|
|
||||||
my ( $self, $train ) = @_;
|
|
||||||
|
|
||||||
my $promise = Mojo::Promise->new;
|
|
||||||
my $cache = $self->app->cache_iris_main;
|
|
||||||
my $eva = $train->station_uic;
|
|
||||||
|
|
||||||
my $dep_ts = DateTime->now( time_zone => 'Europe/Berlin' );
|
|
||||||
my $url
|
|
||||||
= "https://2.db.transport.rest/stations/${eva}/departures?duration=5&when=$dep_ts";
|
|
||||||
|
|
||||||
if ( $train->sched_departure ) {
|
|
||||||
$dep_ts = $train->sched_departure->epoch;
|
|
||||||
$url
|
|
||||||
= "https://2.db.transport.rest/stations/${eva}/departures?duration=5&when=$dep_ts";
|
|
||||||
}
|
|
||||||
elsif ( $train->sched_arrival ) {
|
|
||||||
$dep_ts = $train->sched_arrival->epoch;
|
|
||||||
$url
|
|
||||||
= "https://2.db.transport.rest/stations/${eva}/arrivals?duration=5&when=$dep_ts";
|
|
||||||
}
|
|
||||||
|
|
||||||
$self->get_hafas_rest_p($url)->then(
|
|
||||||
sub {
|
|
||||||
my ($json) = @_;
|
|
||||||
|
|
||||||
for my $result ( @{$json} ) {
|
|
||||||
if ( $result->{line}
|
|
||||||
and $result->{line}{fahrtNr} == $train->train_no )
|
|
||||||
{
|
|
||||||
my $trip_id = $result->{tripId};
|
|
||||||
$promise->resolve($trip_id);
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
$promise->reject;
|
|
||||||
}
|
|
||||||
)->catch(
|
|
||||||
sub {
|
|
||||||
my ($err) = @_;
|
|
||||||
$promise->reject($err);
|
|
||||||
}
|
|
||||||
)->wait;
|
|
||||||
|
|
||||||
return $promise;
|
|
||||||
}
|
|
||||||
);
|
|
||||||
|
|
||||||
$self->helper(
|
|
||||||
'get_hafas_rest_p' => sub {
|
|
||||||
my ( $self, $url ) = @_;
|
|
||||||
|
|
||||||
my $cache = $self->app->cache_iris_main;
|
|
||||||
my $promise = Mojo::Promise->new;
|
|
||||||
|
|
||||||
if ( my $content = $cache->thaw($url) ) {
|
|
||||||
$promise->resolve($content);
|
|
||||||
return $promise;
|
|
||||||
}
|
|
||||||
|
|
||||||
$self->ua->request_timeout(5)->get_p($url)->then(
|
|
||||||
sub {
|
|
||||||
my ($tx) = @_;
|
|
||||||
my $json = JSON->new->decode( $tx->res->body );
|
|
||||||
$cache->freeze( $url, $json );
|
|
||||||
$promise->resolve($json);
|
|
||||||
}
|
|
||||||
)->catch(
|
|
||||||
sub {
|
|
||||||
my ($err) = @_;
|
|
||||||
$self->app->log->warn("get($url): $err");
|
|
||||||
$promise->reject($err);
|
|
||||||
}
|
|
||||||
)->wait;
|
|
||||||
return $promise;
|
|
||||||
}
|
|
||||||
);
|
|
||||||
|
|
||||||
$self->helper(
|
|
||||||
'get_hafas_json_p' => sub {
|
|
||||||
my ( $self, $url ) = @_;
|
|
||||||
|
|
||||||
my $cache = $self->app->cache_iris_main;
|
|
||||||
my $promise = Mojo::Promise->new;
|
|
||||||
|
|
||||||
if ( my $content = $cache->thaw($url) ) {
|
|
||||||
$promise->resolve($content);
|
|
||||||
return $promise;
|
|
||||||
}
|
|
||||||
|
|
||||||
$self->ua->request_timeout(5)->get_p($url)->then(
|
|
||||||
sub {
|
|
||||||
my ($tx) = @_;
|
|
||||||
my $body = decode( 'ISO-8859-15', $tx->res->body );
|
|
||||||
|
|
||||||
$body =~ s{^TSLs[.]sls = }{};
|
|
||||||
$body =~ s{;$}{};
|
|
||||||
$body =~ s{(}{(}g;
|
|
||||||
$body =~ s{)}{)}g;
|
|
||||||
my $json = JSON->new->decode($body);
|
|
||||||
$cache->freeze( $url, $json );
|
|
||||||
$promise->resolve($json);
|
|
||||||
}
|
|
||||||
)->catch(
|
|
||||||
sub {
|
|
||||||
my ($err) = @_;
|
|
||||||
$self->app->log->warn("get($url): $err");
|
|
||||||
$promise->reject($err);
|
|
||||||
}
|
|
||||||
)->wait;
|
|
||||||
return $promise;
|
|
||||||
}
|
|
||||||
);
|
|
||||||
|
|
||||||
$self->helper(
|
|
||||||
'get_hafas_xml_p' => sub {
|
|
||||||
my ( $self, $url ) = @_;
|
|
||||||
|
|
||||||
my $cache = $self->app->cache_iris_rt;
|
|
||||||
my $promise = Mojo::Promise->new;
|
|
||||||
|
|
||||||
if ( my $content = $cache->thaw($url) ) {
|
|
||||||
$promise->resolve($content);
|
|
||||||
return $promise;
|
|
||||||
}
|
|
||||||
|
|
||||||
$self->ua->request_timeout(5)->get_p($url)->then(
|
|
||||||
sub {
|
|
||||||
my ($tx) = @_;
|
|
||||||
my $body = decode( 'ISO-8859-15', $tx->res->body );
|
|
||||||
my $tree;
|
|
||||||
|
|
||||||
my $traininfo = {
|
|
||||||
station => {},
|
|
||||||
messages => [],
|
|
||||||
};
|
|
||||||
|
|
||||||
# <SDay text="... > ..."> is invalid HTML, but present in
|
|
||||||
# regardless. As it is the last tag, we just throw it away.
|
|
||||||
$body =~ s{<SDay [^>]*/>}{}s;
|
|
||||||
|
|
||||||
# More fixes for invalid XML
|
|
||||||
$body =~ s{P&R}{P&R};
|
|
||||||
eval { $tree = XML::LibXML->load_xml( string => $body ) };
|
|
||||||
if ($@) {
|
|
||||||
$self->app->log->warn("load_xml($url): $@");
|
|
||||||
$cache->freeze( $url, $traininfo );
|
|
||||||
$promise->resolve($traininfo);
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
for my $station ( $tree->findnodes('/Journey/St') ) {
|
|
||||||
my $name = $station->getAttribute('name');
|
|
||||||
my $adelay = $station->getAttribute('adelay');
|
|
||||||
my $ddelay = $station->getAttribute('ddelay');
|
|
||||||
$traininfo->{station}{$name} = {
|
|
||||||
adelay => $adelay,
|
|
||||||
ddelay => $ddelay,
|
|
||||||
};
|
|
||||||
}
|
|
||||||
|
|
||||||
for my $message ( $tree->findnodes('/Journey/HIMMessage') )
|
|
||||||
{
|
|
||||||
my $header = $message->getAttribute('header');
|
|
||||||
my $lead = $message->getAttribute('lead');
|
|
||||||
my $display = $message->getAttribute('display');
|
|
||||||
push(
|
|
||||||
@{ $traininfo->{messages} },
|
|
||||||
{
|
|
||||||
header => $header,
|
|
||||||
lead => $lead,
|
|
||||||
display => $display
|
|
||||||
}
|
|
||||||
);
|
|
||||||
}
|
|
||||||
|
|
||||||
$cache->freeze( $url, $traininfo );
|
|
||||||
$promise->resolve($traininfo);
|
|
||||||
}
|
|
||||||
)->catch(
|
|
||||||
sub {
|
|
||||||
my ($err) = @_;
|
|
||||||
$self->app->log->warn("get($url): $err");
|
|
||||||
$promise->reject($err);
|
|
||||||
}
|
|
||||||
)->wait;
|
|
||||||
return $promise;
|
|
||||||
}
|
|
||||||
);
|
|
||||||
|
|
||||||
$self->helper(
|
$self->helper(
|
||||||
'add_route_timestamps' => sub {
|
'add_route_timestamps' => sub {
|
||||||
my ( $self, $uid, $train, $is_departure ) = @_;
|
my ( $self, $uid, $train, $is_departure ) = @_;
|
||||||
|
|
@ -1952,7 +1694,7 @@ sub startup {
|
||||||
|
|
||||||
if ( not $journey->{data}{trip_id} ) {
|
if ( not $journey->{data}{trip_id} ) {
|
||||||
my ( $origin_eva, $destination_eva, $polyline_str );
|
my ( $origin_eva, $destination_eva, $polyline_str );
|
||||||
$self->get_hafas_tripid_p($train)->then(
|
$self->hafas->get_tripid_p($train)->then(
|
||||||
sub {
|
sub {
|
||||||
my ($trip_id) = @_;
|
my ($trip_id) = @_;
|
||||||
|
|
||||||
|
|
@ -1968,7 +1710,7 @@ sub startup {
|
||||||
{ data => JSON->new->encode($data) },
|
{ data => JSON->new->encode($data) },
|
||||||
{ user_id => $uid }
|
{ user_id => $uid }
|
||||||
);
|
);
|
||||||
return $self->get_hafas_polyline_p( $train, $trip_id );
|
return $self->hafas->get_polyline_p( $train, $trip_id );
|
||||||
}
|
}
|
||||||
)->then(
|
)->then(
|
||||||
sub {
|
sub {
|
||||||
|
|
@ -2043,7 +1785,7 @@ sub startup {
|
||||||
|
|
||||||
my ( $trainlink, $route_data );
|
my ( $trainlink, $route_data );
|
||||||
|
|
||||||
$self->get_hafas_json_p(
|
$self->hafas->get_json_p(
|
||||||
"${base}&date=${date_yy}&trainname=${train_no}")->then(
|
"${base}&date=${date_yy}&trainname=${train_no}")->then(
|
||||||
sub {
|
sub {
|
||||||
my ($trainsearch) = @_;
|
my ($trainsearch) = @_;
|
||||||
|
|
@ -2082,7 +1824,7 @@ sub startup {
|
||||||
}
|
}
|
||||||
my $base2
|
my $base2
|
||||||
= 'https://reiseauskunft.bahn.de/bin/traininfo.exe/dn';
|
= 'https://reiseauskunft.bahn.de/bin/traininfo.exe/dn';
|
||||||
return $self->get_hafas_json_p(
|
return $self->hafas->get_json_p(
|
||||||
"${base2}/${trainlink}?rt=1&date=${date_yy}&L=vs_json.vs_hap"
|
"${base2}/${trainlink}?rt=1&date=${date_yy}&L=vs_json.vs_hap"
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
|
|
@ -2118,7 +1860,7 @@ sub startup {
|
||||||
|
|
||||||
my $base2
|
my $base2
|
||||||
= 'https://reiseauskunft.bahn.de/bin/traininfo.exe/dn';
|
= 'https://reiseauskunft.bahn.de/bin/traininfo.exe/dn';
|
||||||
return $self->get_hafas_xml_p(
|
return $self->hafas->get_xml_p(
|
||||||
"${base2}/${trainlink}?rt=1&date=${date_yy}&L=vs_java3"
|
"${base2}/${trainlink}?rt=1&date=${date_yy}&L=vs_java3"
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
|
|
@ -2400,7 +2142,7 @@ sub startup {
|
||||||
my ( $self, %opt ) = @_;
|
my ( $self, %opt ) = @_;
|
||||||
|
|
||||||
my $uid = $opt{uid} //= $self->current_user->{id};
|
my $uid = $opt{uid} //= $self->current_user->{id};
|
||||||
my $use_history = $self->account_use_history($uid);
|
my $use_history = $self->users->use_history( uid => $uid );
|
||||||
|
|
||||||
my ( $eva, $exclude_via, $exclude_train_id, $exclude_before );
|
my ( $eva, $exclude_via, $exclude_train_id, $exclude_before );
|
||||||
my $now = $self->now->epoch;
|
my $now = $self->now->epoch;
|
||||||
|
|
|
||||||
289
lib/Travelynx/Helper/HAFAS.pm
Normal file
289
lib/Travelynx/Helper/HAFAS.pm
Normal file
|
|
@ -0,0 +1,289 @@
|
||||||
|
package Travelynx::Helper::HAFAS;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use 5.020;
|
||||||
|
|
||||||
|
use DateTime;
|
||||||
|
use Encode qw(decode);
|
||||||
|
use JSON;
|
||||||
|
use Mojo::Promise;
|
||||||
|
use XML::LibXML;
|
||||||
|
|
||||||
|
sub new {
|
||||||
|
my ( $class, %opt ) = @_;
|
||||||
|
|
||||||
|
my $version = $opt{version};
|
||||||
|
|
||||||
|
$opt{header} = {
|
||||||
|
'User-Agent' =>
|
||||||
|
"travelynx/${version} +https://finalrewind.org/projects/travelynx"
|
||||||
|
};
|
||||||
|
|
||||||
|
return bless( \%opt, $class );
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_polyline_p {
|
||||||
|
my ( $self, $train, $trip_id ) = @_;
|
||||||
|
|
||||||
|
my $line = $train->line // 0;
|
||||||
|
my $url
|
||||||
|
= "https://2.db.transport.rest/trips/${trip_id}?lineName=${line}&polyline=true";
|
||||||
|
my $cache = $self->{main_cache};
|
||||||
|
my $promise = Mojo::Promise->new;
|
||||||
|
my $version = $self->{version};
|
||||||
|
|
||||||
|
if ( my $content = $cache->thaw($url) ) {
|
||||||
|
$promise->resolve($content);
|
||||||
|
return $promise;
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->{user_agent}->request_timeout(5)->get_p(
|
||||||
|
$url => $self->{header}
|
||||||
|
)->then(
|
||||||
|
sub {
|
||||||
|
my ($tx) = @_;
|
||||||
|
my $body = decode( 'utf-8', $tx->res->body );
|
||||||
|
my $json = JSON->new->decode($body);
|
||||||
|
my @station_list;
|
||||||
|
my @coordinate_list;
|
||||||
|
|
||||||
|
for my $feature ( @{ $json->{polyline}{features} } ) {
|
||||||
|
if ( exists $feature->{geometry}{coordinates} ) {
|
||||||
|
my $coord = $feature->{geometry}{coordinates};
|
||||||
|
if ( exists $feature->{properties}{type}
|
||||||
|
and $feature->{properties}{type} eq 'stop' )
|
||||||
|
{
|
||||||
|
push( @{$coord}, $feature->{properties}{id} );
|
||||||
|
push( @station_list,
|
||||||
|
$feature->{properties}{name} );
|
||||||
|
}
|
||||||
|
push( @coordinate_list, $coord );
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
my $ret = {
|
||||||
|
name => $json->{line}{name} // '?',
|
||||||
|
polyline => [@coordinate_list],
|
||||||
|
raw => $json,
|
||||||
|
};
|
||||||
|
|
||||||
|
$cache->freeze( $url, $ret );
|
||||||
|
|
||||||
|
# borders ("(Gr)" as in "Grenze") are only returned by HAFAS.
|
||||||
|
# They are not stations.
|
||||||
|
my $iris_stations = join( '|', $train->route );
|
||||||
|
my $hafas_stations
|
||||||
|
= join( '|', grep { $_ !~ m{\(Gr\)$} } @station_list );
|
||||||
|
|
||||||
|
# Do not return polyline if it belongs to an entirely different
|
||||||
|
# train. Trains with longer routes (e.g. due to train number
|
||||||
|
# changes, which are handled by HAFAS but left out in IRIS)
|
||||||
|
# are okay though.
|
||||||
|
if ( $iris_stations ne $hafas_stations
|
||||||
|
and index( $hafas_stations, $iris_stations ) == -1 )
|
||||||
|
{
|
||||||
|
$self->{log}->warn( 'Ignoring polyline for '
|
||||||
|
. $train->line
|
||||||
|
. ": IRIS route does not agree with HAFAS route: $iris_stations != $hafas_stations"
|
||||||
|
);
|
||||||
|
$promise->reject('polyline route mismatch');
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$promise->resolve($ret);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
)->catch(
|
||||||
|
sub {
|
||||||
|
my ($err) = @_;
|
||||||
|
$promise->reject($err);
|
||||||
|
}
|
||||||
|
)->wait;
|
||||||
|
|
||||||
|
return $promise;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_tripid_p {
|
||||||
|
my ( $self, $train ) = @_;
|
||||||
|
|
||||||
|
my $promise = Mojo::Promise->new;
|
||||||
|
my $cache = $self->{main_cache};
|
||||||
|
my $eva = $train->station_uic;
|
||||||
|
|
||||||
|
my $dep_ts = DateTime->now( time_zone => 'Europe/Berlin' );
|
||||||
|
my $url
|
||||||
|
= "https://2.db.transport.rest/stations/${eva}/departures?duration=5&when=$dep_ts";
|
||||||
|
|
||||||
|
if ( $train->sched_departure ) {
|
||||||
|
$dep_ts = $train->sched_departure->epoch;
|
||||||
|
$url
|
||||||
|
= "https://2.db.transport.rest/stations/${eva}/departures?duration=5&when=$dep_ts";
|
||||||
|
}
|
||||||
|
elsif ( $train->sched_arrival ) {
|
||||||
|
$dep_ts = $train->sched_arrival->epoch;
|
||||||
|
$url
|
||||||
|
= "https://2.db.transport.rest/stations/${eva}/arrivals?duration=5&when=$dep_ts";
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->get_rest_p($url)->then(
|
||||||
|
sub {
|
||||||
|
my ($json) = @_;
|
||||||
|
|
||||||
|
for my $result ( @{$json} ) {
|
||||||
|
if ( $result->{line}
|
||||||
|
and $result->{line}{fahrtNr} == $train->train_no )
|
||||||
|
{
|
||||||
|
my $trip_id = $result->{tripId};
|
||||||
|
$promise->resolve($trip_id);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$promise->reject;
|
||||||
|
}
|
||||||
|
)->catch(
|
||||||
|
sub {
|
||||||
|
my ($err) = @_;
|
||||||
|
$promise->reject($err);
|
||||||
|
}
|
||||||
|
)->wait;
|
||||||
|
|
||||||
|
return $promise;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_rest_p {
|
||||||
|
my ( $self, $url ) = @_;
|
||||||
|
|
||||||
|
my $cache = $self->{main_cache};
|
||||||
|
my $promise = Mojo::Promise->new;
|
||||||
|
|
||||||
|
if ( my $content = $cache->thaw($url) ) {
|
||||||
|
$promise->resolve($content);
|
||||||
|
return $promise;
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->{user_agent}->request_timeout(5)->get_p($url => $self->{header})->then(
|
||||||
|
sub {
|
||||||
|
my ($tx) = @_;
|
||||||
|
my $json = JSON->new->decode( $tx->res->body );
|
||||||
|
$cache->freeze( $url, $json );
|
||||||
|
$promise->resolve($json);
|
||||||
|
}
|
||||||
|
)->catch(
|
||||||
|
sub {
|
||||||
|
my ($err) = @_;
|
||||||
|
$self->{log}->warn("get($url): $err");
|
||||||
|
$promise->reject($err);
|
||||||
|
}
|
||||||
|
)->wait;
|
||||||
|
return $promise;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_json_p {
|
||||||
|
my ( $self, $url ) = @_;
|
||||||
|
|
||||||
|
my $cache = $self->{main_cache};
|
||||||
|
my $promise = Mojo::Promise->new;
|
||||||
|
|
||||||
|
if ( my $content = $cache->thaw($url) ) {
|
||||||
|
$promise->resolve($content);
|
||||||
|
return $promise;
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->{user_agent}->request_timeout(5)->get_p($url => $self->{header})->then(
|
||||||
|
sub {
|
||||||
|
my ($tx) = @_;
|
||||||
|
my $body = decode( 'ISO-8859-15', $tx->res->body );
|
||||||
|
|
||||||
|
$body =~ s{^TSLs[.]sls = }{};
|
||||||
|
$body =~ s{;$}{};
|
||||||
|
$body =~ s{(}{(}g;
|
||||||
|
$body =~ s{)}{)}g;
|
||||||
|
my $json = JSON->new->decode($body);
|
||||||
|
$cache->freeze( $url, $json );
|
||||||
|
$promise->resolve($json);
|
||||||
|
}
|
||||||
|
)->catch(
|
||||||
|
sub {
|
||||||
|
my ($err) = @_;
|
||||||
|
$self->{log}->warn("get($url): $err");
|
||||||
|
$promise->reject($err);
|
||||||
|
}
|
||||||
|
)->wait;
|
||||||
|
return $promise;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_xml_p {
|
||||||
|
my ( $self, $url ) = @_;
|
||||||
|
|
||||||
|
my $cache = $self->{realtime_cache};
|
||||||
|
my $promise = Mojo::Promise->new;
|
||||||
|
|
||||||
|
if ( my $content = $cache->thaw($url) ) {
|
||||||
|
$promise->resolve($content);
|
||||||
|
return $promise;
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->{user_agent}->request_timeout(5)->get_p($url => $self->{header})->then(
|
||||||
|
sub {
|
||||||
|
my ($tx) = @_;
|
||||||
|
my $body = decode( 'ISO-8859-15', $tx->res->body );
|
||||||
|
my $tree;
|
||||||
|
|
||||||
|
my $traininfo = {
|
||||||
|
station => {},
|
||||||
|
messages => [],
|
||||||
|
};
|
||||||
|
|
||||||
|
# <SDay text="... > ..."> is invalid HTML, but present in
|
||||||
|
# regardless. As it is the last tag, we just throw it away.
|
||||||
|
$body =~ s{<SDay [^>]*/>}{}s;
|
||||||
|
|
||||||
|
# More fixes for invalid XML
|
||||||
|
$body =~ s{P&R}{P&R};
|
||||||
|
eval { $tree = XML::LibXML->load_xml( string => $body ) };
|
||||||
|
if ($@) {
|
||||||
|
$self->{log}->warn("load_xml($url): $@");
|
||||||
|
$cache->freeze( $url, $traininfo );
|
||||||
|
$promise->resolve($traininfo);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
for my $station ( $tree->findnodes('/Journey/St') ) {
|
||||||
|
my $name = $station->getAttribute('name');
|
||||||
|
my $adelay = $station->getAttribute('adelay');
|
||||||
|
my $ddelay = $station->getAttribute('ddelay');
|
||||||
|
$traininfo->{station}{$name} = {
|
||||||
|
adelay => $adelay,
|
||||||
|
ddelay => $ddelay,
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
for my $message ( $tree->findnodes('/Journey/HIMMessage') )
|
||||||
|
{
|
||||||
|
my $header = $message->getAttribute('header');
|
||||||
|
my $lead = $message->getAttribute('lead');
|
||||||
|
my $display = $message->getAttribute('display');
|
||||||
|
push(
|
||||||
|
@{ $traininfo->{messages} },
|
||||||
|
{
|
||||||
|
header => $header,
|
||||||
|
lead => $lead,
|
||||||
|
display => $display
|
||||||
|
}
|
||||||
|
);
|
||||||
|
}
|
||||||
|
|
||||||
|
$cache->freeze( $url, $traininfo );
|
||||||
|
$promise->resolve($traininfo);
|
||||||
|
}
|
||||||
|
)->catch(
|
||||||
|
sub {
|
||||||
|
my ($err) = @_;
|
||||||
|
$self->{log}->warn("get($url): $err");
|
||||||
|
$promise->reject($err);
|
||||||
|
}
|
||||||
|
)->wait;
|
||||||
|
return $promise;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
Loading…
Reference in a new issue