diff options
Diffstat (limited to 'lib/Travelynx/Helper/HAFAS.pm')
| -rw-r--r-- | lib/Travelynx/Helper/HAFAS.pm | 388 |
1 files changed, 207 insertions, 181 deletions
diff --git a/lib/Travelynx/Helper/HAFAS.pm b/lib/Travelynx/Helper/HAFAS.pm index 6fd5c71..7671d78 100644 --- a/lib/Travelynx/Helper/HAFAS.pm +++ b/lib/Travelynx/Helper/HAFAS.pm @@ -1,6 +1,6 @@ package Travelynx::Helper::HAFAS; -# Copyright (C) 2020 Daniel Friesel +# Copyright (C) 2020-2023 Birte Kristina Friesel # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -12,7 +12,13 @@ use DateTime; use Encode qw(decode); use JSON; use Mojo::Promise; -use XML::LibXML; +use Travel::Status::DE::HAFAS; + +sub _epoch { + my ($dt) = @_; + + return $dt ? $dt->epoch : 0; +} sub new { my ( $class, %opt ) = @_; @@ -27,15 +33,16 @@ sub new { return bless( \%opt, $class ); } -sub get_polyline_p { - my ( $self, $train, $trip_id ) = @_; +sub get_json_p { + my ( $self, $url, %opt ) = @_; - my $line = $train->line // 0; - my $url - = "https://v5.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 ( $opt{realtime} ) { + $cache = $self->{realtime_cache}; + } + $opt{encoding} //= 'ISO-8859-15'; if ( my $content = $cache->thaw($url) ) { return $promise->resolve($content); @@ -48,241 +55,260 @@ sub get_polyline_p { if ( my $err = $tx->error ) { $promise->reject( -"hafas->get_polyline_p($url) returned HTTP $err->{code} $err->{message}" +"hafas->get_json_p($url) returned HTTP $err->{code} $err->{message}" ); return; } - 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 $body = decode( $opt{encoding}, $tx->res->body ); - 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}->info( 'Ignoring polyline for ' - . $train->line - . ": IRIS route does not agree with HAFAS route: $iris_stations != $hafas_stations" - ); - $promise->reject( - "hafas->get_polyline_p($url): polyline route mismatch"); - } - else { - $promise->resolve($ret); - } + $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); return; } )->catch( sub { my ($err) = @_; - $promise->reject("hafas->get_polyline_p($url): $err"); + $self->{log}->info("hafas->get_json_p($url): $err"); + $promise->reject("hafas->get_json_p($url): $err"); return; } )->wait; - return $promise; } -sub get_json_p { - my ( $self, $url ) = @_; +sub get_departures_p { + my ( $self, %opt ) = @_; + + my $when = ( + $opt{timestamp} + ? $opt{timestamp}->clone + : DateTime->now( time_zone => 'Europe/Berlin' ) + )->subtract( minutes => $opt{lookbehind} ); + return Travel::Status::DE::HAFAS->new_p( + station => $opt{eva}, + datetime => $when, + lookahead => $opt{lookahead} + $opt{lookbehind}, + results => 300, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $self->{user_agent}->request_timeout(5), + ); +} - my $cache = $self->{main_cache}; - my $promise = Mojo::Promise->new; +sub search_location_p { + my ( $self, %opt ) = @_; - if ( my $content = $cache->thaw($url) ) { - return $promise->resolve($content); - } + return Travel::Status::DE::HAFAS->new_p( + locationSearch => $opt{query}, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $self->{user_agent}->request_timeout(5), + ); +} - $self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} ) - ->then( +sub get_tripid_p { + my ( $self, %opt ) = @_; + + my $promise = Mojo::Promise->new; + + my $train = $opt{train}; + my $train_desc = $train->type . ' ' . $train->train_no; + $train_desc =~ s{^- }{}; + + Travel::Status::DE::HAFAS->new_p( + journeyMatch => $train_desc, + datetime => $train->start, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $self->{user_agent}->request_timeout(10), + )->then( sub { - my ($tx) = @_; + my ($hafas) = @_; + my @results = $hafas->results; - if ( my $err = $tx->error ) { + if ( not @results ) { $promise->reject( -"hafas->get_json_p($url) returned HTTP $err->{code} $err->{message}" - ); + "journeyMatch($train_desc) returned no results"); return; } - my $body = decode( 'ISO-8859-15', $tx->res->body ); + my $result = $results[0]; + if ( @results > 1 ) { + for my $journey (@results) { + if ( ( $journey->route )[0]->loc->name eq $train->origin ) { + $result = $journey; + last; + } + } + } - $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); + $promise->resolve( $result->id ); return; } )->catch( sub { my ($err) = @_; - $self->{log}->info("hafas->get_json_p($url): $err"); - $promise->reject("hafas->get_json_p($url): $err"); + $promise->reject($err); return; } )->wait; + return $promise; } -sub get_xml_p { - my ( $self, $url ) = @_; +sub get_journey_p { + my ( $self, %opt ) = @_; - my $cache = $self->{realtime_cache}; my $promise = Mojo::Promise->new; - - if ( my $content = $cache->thaw($url) ) { - return $promise->resolve($content); - } - - $self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} ) - ->then( + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + + Travel::Status::DE::HAFAS->new_p( + journey => { + id => $opt{trip_id}, + }, + with_polyline => $opt{with_polyline}, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $self->{user_agent}->request_timeout(10), + )->then( sub { - my ($tx) = @_; + my ($hafas) = @_; + my $journey = $hafas->result; - if ( my $err = $tx->error ) { - $promise->reject( -"hafas->get_xml_p($url) returned HTTP $err->{code} $err->{message}" - ); + if ($journey) { + $promise->resolve($journey); return; } + $promise->reject('no journey'); + return; + } + )->catch( + sub { + my ($err) = @_; + $promise->reject($err); + return; + } + )->wait; - my $body = decode( 'ISO-8859-15', $tx->res->body ); - my $tree; - - my $traininfo = { - station => {}, - messages => [], - }; - - # <SDay text="... > ..."> is invalid XML, 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}; - $body =~ s{Wagen \d+ \K&}{&}; - $body =~ s{Wagen \d+, \d+ \K&}{&}; - - # <Attribute [...] text="[...]"[...]"" /> is invalid XML. - # Work around it. - $body - =~ s{<Attribute([^>]+)text="([^"]*)"([^"=>]*)""}{<Attribute$1text="$2*$3*"}s; - - # Same for <HIMMessage lead="[...]"[...]"[...]" /> - $body - =~ s{<HIMMessage([^>]+)lead="([^"]*)"([^"=>]*)"([^"]*)"}{<Attribute$1text="$2*$3*$4"}s; - - # ... and <HIMMessage [...] lead="[...]<>[...]"> - # (replace <> with t$t) - while ( $body - =~ s{<HIMMessage([^>]+)lead="([^"]*)<>([^"=]*)"}{<HIMMessage$1lead="$2⬌$3"}gis - ) - { - } - - # Dito for <HIMMessage [...] lead="[...]<br>[...]">. - while ( $body - =~ s{<HIMMessage([^>]+)lead="([^"]*)<br/?>([^"=]*)"}{<HIMMessage$1lead="$2 $3"}is - ) - { - } - - # ... and any other HTML tag inside an XML attribute - while ( $body - =~ s{<HIMMessage([^>]+)lead="([^"]*)<[^>]+>([^"=]*)"}{<HIMMessage$1lead="$2$3"}is - ) - { - } + return $promise; +} - eval { $tree = XML::LibXML->load_xml( string => $body ) }; - if ( my $err = $@ ) { - if ( $err =~ m{extra content at the end}i ) { +sub get_route_timestamps_p { + my ( $self, %opt ) = @_; - # We requested XML, but received an HTML error page - # (which was returned with HTTP 200 OK). - $self->{log}->debug("load_xml($url): $err"); + my $promise = Mojo::Promise->new; + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); + + Travel::Status::DE::HAFAS->new_p( + journey => { + id => $opt{trip_id}, + + # name => $opt{train_no}, + }, + with_polyline => $opt{with_polyline}, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $self->{user_agent}->request_timeout(10), + )->then( + sub { + my ($hafas) = @_; + my $journey = $hafas->result; + my $ret = {}; + my $polyline; + + my $station_is_past = 1; + for my $stop ( $journey->route ) { + my $name = $stop->loc->name; + $ret->{$name} = $ret->{ $stop->loc->eva } = { + name => $stop->loc->name, + eva => $stop->loc->eva, + sched_arr => _epoch( $stop->sched_arr ), + sched_dep => _epoch( $stop->sched_dep ), + rt_arr => _epoch( $stop->rt_arr ), + rt_dep => _epoch( $stop->rt_dep ), + arr_delay => $stop->arr_delay, + dep_delay => $stop->dep_delay, + load => $stop->load + }; + if ( $stop->tz_offset ) { + $ret->{$name}{tz_offset} = $stop->tz_offset; } - else { - # There is invalid XML which we might be able to fix via - # regular expressions, so dump it into the production log. - $self->{log}->info("load_xml($url): $err"); + if ( ( $stop->arr_cancelled or not $stop->sched_arr ) + and ( $stop->dep_cancelled or not $stop->sched_dep ) ) + { + $ret->{$name}{isCancelled} = 1; } - $cache->freeze( $url, $traininfo ); - $promise->reject("hafas->get_xml_p($url): $err"); - return; + if ( + $station_is_past + and not $ret->{$name}{isCancelled} + and $now->epoch < ( + $ret->{$name}{rt_arr} // $ret->{$name}{rt_dep} + // $ret->{$name}{sched_arr} + // $ret->{$name}{sched_dep} // $now->epoch + ) + ) + { + $station_is_past = 0; + } + $ret->{$name}{isPast} = $station_is_past; } - 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, - }; - } + if ( $journey->polyline ) { + my @station_list; + my @coordinate_list; - 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 + for my $coord ( $journey->polyline ) { + if ( $coord->{name} ) { + push( @coordinate_list, + [ $coord->{lon}, $coord->{lat}, $coord->{eva} ] ); + push( @station_list, $coord->{name} ); } - ); + else { + push( @coordinate_list, + [ $coord->{lon}, $coord->{lat} ] ); + } + } + my $iris_stations = join( '|', $opt{train}->route ); + + # borders (Gr" as in "Grenze") are only returned by HAFAS. + # They are not stations. + my $hafas_stations + = join( '|', grep { $_ !~ m{(\(Gr\)|\)Gr)$} } @station_list ); + + if ( $iris_stations eq $hafas_stations + or index( $hafas_stations, $iris_stations ) != -1 ) + { + $polyline = { + from_eva => ( $journey->route )[0]->loc->eva, + to_eva => ( $journey->route )[-1]->loc->eva, + coords => \@coordinate_list, + }; + } + else { + $self->{log}->debug( 'Ignoring polyline for ' + . $opt{train}->line + . ": IRIS route does not agree with HAFAS route: $iris_stations != $hafas_stations" + ); + } } - $cache->freeze( $url, $traininfo ); - $promise->resolve($traininfo); + $promise->resolve( $ret, $journey, $polyline ); return; } )->catch( sub { my ($err) = @_; - $self->{log}->info("hafas->get_xml_p($url): $err"); - $promise->reject("hafas->get_xml_p($url): $err"); + $promise->reject($err); return; } )->wait; + return $promise; } |