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.pm | 336 +++++------------------------------------- lib/Travelynx/Helper/HAFAS.pm | 289 ++++++++++++++++++++++++++++++++++++ 2 files changed, 328 insertions(+), 297 deletions(-) create mode 100644 lib/Travelynx/Helper/HAFAS.pm (limited to 'lib') diff --git a/lib/Travelynx.pm b/lib/Travelynx.pm index 378a2ca..ea53742 100755 --- a/lib/Travelynx.pm +++ b/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::IRIS; use Travel::Status::DE::IRIS::Stations; +use Travelynx::Helper::HAFAS; use Travelynx::Helper::Sendmail; use Travelynx::Model::Users; use XML::LibXML; @@ -264,18 +265,15 @@ sub startup { ); $self->helper( - sendmail => sub { - state $sendmail = Travelynx::Helper::Sendmail->new( - config => ( $self->config->{mail} // {} ), - log => $self->log - ); - } - ); - - $self->helper( - users => sub { + hafas => sub { 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( 'now' => sub { return DateTime->now( time_zone => 'Europe/Berlin' ); @@ -1564,16 +1578,20 @@ sub startup { $self->ua->request_timeout(5)->get_p($url)->then( sub { 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 ); - $promise->resolve($json); + return $promise->resolve($json); } )->catch( sub { my ($err) = @_; - $promise->reject($err); + return $promise->reject($err); } )->wait; 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 => [], - }; - - # 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->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( 'add_route_timestamps' => sub { my ( $self, $uid, $train, $is_departure ) = @_; @@ -1952,7 +1694,7 @@ sub startup { if ( not $journey->{data}{trip_id} ) { my ( $origin_eva, $destination_eva, $polyline_str ); - $self->get_hafas_tripid_p($train)->then( + $self->hafas->get_tripid_p($train)->then( sub { my ($trip_id) = @_; @@ -1968,7 +1710,7 @@ sub startup { { data => JSON->new->encode($data) }, { user_id => $uid } ); - return $self->get_hafas_polyline_p( $train, $trip_id ); + return $self->hafas->get_polyline_p( $train, $trip_id ); } )->then( sub { @@ -2043,7 +1785,7 @@ sub startup { my ( $trainlink, $route_data ); - $self->get_hafas_json_p( + $self->hafas->get_json_p( "${base}&date=${date_yy}&trainname=${train_no}")->then( sub { my ($trainsearch) = @_; @@ -2082,7 +1824,7 @@ sub startup { } my $base2 = '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" ); } @@ -2118,7 +1860,7 @@ sub startup { my $base2 = '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" ); } @@ -2400,7 +2142,7 @@ sub startup { my ( $self, %opt ) = @_; 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 $now = $self->now->epoch; 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