diff options
Diffstat (limited to 'lib/DBInfoscreen/Helper/HAFAS.pm')
-rw-r--r-- | lib/DBInfoscreen/Helper/HAFAS.pm | 354 |
1 files changed, 172 insertions, 182 deletions
diff --git a/lib/DBInfoscreen/Helper/HAFAS.pm b/lib/DBInfoscreen/Helper/HAFAS.pm index 6af47e3..cdb84f0 100644 --- a/lib/DBInfoscreen/Helper/HAFAS.pm +++ b/lib/DBInfoscreen/Helper/HAFAS.pm @@ -1,6 +1,6 @@ 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 @@ -29,224 +29,210 @@ sub new { } -sub get_json_p { - my ( $self, $cache, $url ) = @_; +sub get_route_p { + my ( $self, %opt ) = @_; my $promise = Mojo::Promise->new; + my $now = DateTime->now( time_zone => 'Europe/Berlin' ); - if ( my $content = $cache->thaw($url) ) { - return $promise->resolve($content); + my $hafas_promise; + + if ( $opt{trip_id} ) { + $hafas_promise = Travel::Status::DE::HAFAS->new_p( + service => $opt{service}, + journey => { + id => $opt{trip_id}, + }, + language => $opt{language}, + cache => $self->{realtime_cache}, + promise => 'Mojo::Promise', + user_agent => $self->{user_agent}->request_timeout(10) + ); } - - $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; -} - -sub trainsearch_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'); + 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}; } - # 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; - - $self->get_json_p( $self->{realtime_cache}, - "${base}&date=$opt{date_yy}&trainname=$opt{train_req}" )->then( + $hafas_promise //= Travel::Status::DE::HAFAS->new_p( + 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 => $self->{user_agent}->request_timeout(10) + )->then( sub { - my ($trainsearch) = @_; - - # Fallback: Take first result - my $result = $trainsearch->{suggestions}[0]; + my ($hafas) = @_; + my @results = $hafas->results; - # Try finding a result for the current date - for my $suggestion ( @{ $trainsearch->{suggestions} // [] } ) { + if ( not @results ) { + return Mojo::Promise->reject( + "journeyMatch($opt{train_req}) found no results"); + } - # 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} ) + 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 = $suggestion; + $result = $journey; 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; -} - -sub get_route_timestamps_p { - my ( $self, %opt ) = @_; - - my $promise = Mojo::Promise->new; - my $now = DateTime->now( time_zone => 'Europe/Berlin' ); - - if ( $opt{train} ) { - $opt{date_yy} = $opt{train}->start->strftime('%d.%m.%y'); - $opt{date_yyyy} = $opt{train}->start->strftime('%d.%m.%Y'); - $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( - sub { - my ($trainsearch_result) = @_; - my $trip_id = $trainsearch_result->{trip_id}; return Travel::Status::DE::HAFAS->new_p( 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) ); } - )->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 $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 $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; + 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 +249,15 @@ 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}; my $promise = Mojo::Promise->new; Travel::Status::DE::HAFAS->new_p( + service => $service, journey => { id => $trip_id, name => $line, |