From 56c275875c165af839859d61b1a2eb6e6be5a32c Mon Sep 17 00:00:00 2001 From: Daniel Friesel Date: Tue, 28 Jul 2020 13:01:44 +0200 Subject: Move HAFAS helpers to a separate Helper module --- lib/Travelynx/Helper/HAFAS.pm | 289 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 289 insertions(+) create mode 100644 lib/Travelynx/Helper/HAFAS.pm (limited to 'lib/Travelynx/Helper') diff --git a/lib/Travelynx/Helper/HAFAS.pm b/lib/Travelynx/Helper/HAFAS.pm new file mode 100644 index 0000000..2adcf02 --- /dev/null +++ b/lib/Travelynx/Helper/HAFAS.pm @@ -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 => [], + }; + + # is invalid HTML, but present in + # regardless. As it is the last tag, we just throw it away. + $body =~ s{]*/>}{}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; -- cgit v1.2.3