diff options
author | Daniel Friesel <derf@finalrewind.org> | 2020-09-15 18:52:12 +0200 |
---|---|---|
committer | Daniel Friesel <derf@finalrewind.org> | 2020-09-15 18:52:12 +0200 |
commit | 65aab8c7f827d0c0edf1249ea30c287c5f91ace8 (patch) | |
tree | a2b05be549f9d4609ffb9ff0d8764cc91921ffad /lib/DBInfoscreen/Helper | |
parent | 3c7f39d00ae23731e8e2f0ccaaf1d37e7f4ba1dc (diff) |
use non-blocking requests for train details
Diffstat (limited to 'lib/DBInfoscreen/Helper')
-rw-r--r-- | lib/DBInfoscreen/Helper/HAFAS.pm | 322 |
1 files changed, 128 insertions, 194 deletions
diff --git a/lib/DBInfoscreen/Helper/HAFAS.pm b/lib/DBInfoscreen/Helper/HAFAS.pm index 6c54a51..0206bed 100644 --- a/lib/DBInfoscreen/Helper/HAFAS.pm +++ b/lib/DBInfoscreen/Helper/HAFAS.pm @@ -24,46 +24,13 @@ sub new { } -sub hafas_json_req { - my ( $self, $cache, $url ) = @_; - - if ( my $content = $cache->thaw($url) ) { - return $content; - } - - my $res - = eval { $self->{user_agent}->get( $url => $self->{header} )->result }; - - if ($@) { - $self->{log}->debug("hafas_json_req($url): $@"); - return; - } - if ( $res->is_error ) { - return; - } - - my $body = encode( 'utf-8', decode( 'ISO-8859-15', $res->body ) ); - - $body =~ s{^TSLs[.]sls = }{}; - $body =~ s{;$}{}; - $body =~ s{(}{(}g; - $body =~ s{)}{)}g; - - my $json = decode_json($body); - - $cache->freeze( $url, $json ); - - return $json; -} - sub get_json_p { my ( $self, $cache, $url ) = @_; my $promise = Mojo::Promise->new; if ( my $content = $cache->thaw($url) ) { - $promise->resolve($content); - return $promise; + return $promise->resolve($content); } $self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} ) @@ -106,136 +73,86 @@ sub get_json_p { return $promise; } -sub hafas_xml_req { +sub get_xml_p { my ( $self, $cache, $url ) = @_; - if ( my $content = $cache->thaw($url) ) { - return $content; - } - - my $res - = eval { $self->{user_agent}->get( $url => $self->{header} )->result }; - - if ($@) { - $self->{log}->debug("hafas_xml_req($url): $@"); - return; - } - if ( $res->is_error ) { - $cache->freeze( $url, {} ); - return; - } - - my $body = decode( 'ISO-8859-15', $res->body ); - - # <SDay text="... > ..."> is invalid HTML, but present - # regardless. As it is the last tag, we just throw it away. - $body =~ s{<SDay [^>]*/>}{}s; - - my $tree; - - eval { $tree = XML::LibXML->load_xml( string => $body ) }; + my $promise = Mojo::Promise->new; - if ($@) { - $cache->freeze( $url, {} ); - return; + if ( my $content = $cache->thaw($url) ) { + return $promise->resolve($content); } - my $ret = { - station => {}, - stations => [], - messages => [], - }; - - for my $station ( $tree->findnodes('/Journey/St') ) { - my $name = $station->getAttribute('name'); - my $adelay = $station->getAttribute('adelay'); - my $ddelay = $station->getAttribute('ddelay'); - push( @{ $ret->{stations} }, $name ); - $ret->{station}{$name} = { - adelay => $adelay, - ddelay => $ddelay, - }; - } + $self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} ) + ->then( + sub { + my ($tx) = @_; - for my $message ( $tree->findnodes('/Journey/HIMMessage') ) { - my $header = $message->getAttribute('header'); - my $lead = $message->getAttribute('lead'); - my $display = $message->getAttribute('display'); - push( - @{ $ret->{messages} }, - { - header => $header, - lead => $lead, - display => $display + if ( my $err = $tx->error ) { + $cache->freeze( $url, {} ); + $self->{log}->warn( + "hafas->get_xml_p($url): HTTP $err->{code} $err->{message}" + ); + $promise->reject( + "GET $url returned HTTP $err->{code} $err->{message}"); + return; } - ); - } - $cache->freeze( $url, $ret ); - - return $ret; -} + my $body = decode( 'ISO-8859-15', $tx->res->body ); -sub trainsearch { - 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'); - } + # <SDay text="... > ..."> is invalid HTML, but present + # regardless. As it is the last tag, we just throw it away. + $body =~ s{<SDay [^>]*/>}{}s; - my $trainsearch = $self->hafas_json_req( $self->{realtime_cache}, - "${base}&date=$opt{date_yy}&trainname=$opt{train_no}" ); + my $tree; - if ( not $trainsearch ) { - return; - } + eval { $tree = XML::LibXML->load_xml( string => $body ) }; - # Fallback: Take first result - my $result = $trainsearch->{suggestions}[0]; + if ($@) { + $cache->freeze( $url, {} ); + $promise->reject; + return; + } - # Try finding a result for the current date - for my $suggestion ( @{ $trainsearch->{suggestions} // [] } ) { + my $ret = { + station => {}, + stations => [], + messages => [], + }; - # 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} ) - { - $result = $suggestion; - last; + for my $station ( $tree->findnodes('/Journey/St') ) { + my $name = $station->getAttribute('name'); + my $adelay = $station->getAttribute('adelay'); + my $ddelay = $station->getAttribute('ddelay'); + push( @{ $ret->{stations} }, $name ); + $ret->{station}{$name} = { + adelay => $adelay, + ddelay => $ddelay, + }; } - } - } - if ($result) { + for my $message ( $tree->findnodes('/Journey/HIMMessage') ) { + my $header = $message->getAttribute('header'); + my $lead = $message->getAttribute('lead'); + my $display = $message->getAttribute('display'); + push( + @{ $ret->{messages} }, + { + header => $header, + lead => $lead, + display => $display + } + ); + } - # 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 ); - } + $cache->freeze( $url, $ret ); + $promise->resolve($ret); - return $result; + return; + } + )->catch( + sub { + } + )->wait; } sub trainsearch_p { @@ -320,9 +237,11 @@ sub trainsearch_p { return $promise; } -sub get_route_timestamps { +sub get_route_timestamps_p { my ( $self, %opt ) = @_; + my $promise = Mojo::Promise->new; + if ( $opt{train} ) { $opt{date_yy} = $opt{train}->start->strftime('%d.%m.%y'); $opt{date_yyyy} = $opt{train}->start->strftime('%d.%m.%Y'); @@ -335,61 +254,76 @@ sub get_route_timestamps { $opt{date_yyyy} = $now->strftime('%d.%m.%Y'); } - my $trainsearch_result = $self->trainsearch(%opt); - - if ( not $trainsearch_result ) { - return; - } - - my $trainlink = $trainsearch_result->{trainLink}; - my $base = 'https://reiseauskunft.bahn.de/bin/traininfo.exe/dn'; + my ( $trainsearch_result, $trainlink, $traininfo ); - my $traininfo = $self->hafas_json_req( $self->{realtime_cache}, - "${base}/${trainlink}?rt=1&date=$opt{date_yy}&L=vs_json" ); + $self->trainsearch_p(%opt)->then( + sub { + ($trainsearch_result) = @_; + $trainlink = $trainsearch_result->{trainLink}; + return $self->get_json_p( $self->{realtime_cache}, + "${base}/${trainlink}?rt=1&date=$opt{date_yy}&L=vs_json" ); + } + )->then( + sub { + ($traininfo) = @_; + if ( not $traininfo or $traininfo->{error} ) { + $promise->reject; + return; + } + return $self->get_xml_p( $self->{realtime_cache}, + "${base}/${trainlink}?rt=1&date=$opt{date_yy}&L=vs_java3" ); + } + )->then( + sub { + my ($traindelay) = @_; + my $ret = {}; - if ( not $traininfo or $traininfo->{error} ) { - return; - } + my $strp = DateTime::Format::Strptime->new( + pattern => '%d.%m.%y %H:%M', + time_zone => 'Europe/Berlin', + ); - my $traindelay = $self->hafas_xml_req( $self->{realtime_cache}, - "${base}/${trainlink}?rt=1&date=$opt{date_yy}&L=vs_java3" ); - - my $ret = {}; - - my $strp = DateTime::Format::Strptime->new( - pattern => '%d.%m.%y %H:%M', - time_zone => 'Europe/Berlin', - ); - - for my $station ( @{ $traininfo->{suggestions}[0]{locations} // [] } ) { - my $name = $station->{name}; - my $arr = $station->{arrDate} . ' ' . $station->{arrTime}; - my $dep = $station->{depDate} . ' ' . $station->{depTime}; - $ret->{$name} = { - sched_arr => scalar $strp->parse_datetime($arr), - sched_dep => scalar $strp->parse_datetime($dep), - }; - if ( exists $traindelay->{station}{$name} ) { - my $delay = $traindelay->{station}{$name}; - if ( $ret->{$name}{sched_arr} - and $delay->{adelay} - and $delay->{adelay} =~ m{^\d+$} ) + for + my $station ( @{ $traininfo->{suggestions}[0]{locations} // [] } ) { - $ret->{$name}{rt_arr} = $ret->{$name}{sched_arr} - ->clone->add( minutes => $delay->{adelay} ); - } - if ( $ret->{$name}{sched_dep} - and $delay->{ddelay} - and $delay->{ddelay} =~ m{^\d+$} ) - { - $ret->{$name}{rt_dep} = $ret->{$name}{sched_dep} - ->clone->add( minutes => $delay->{ddelay} ); + my $name = $station->{name}; + my $arr = $station->{arrDate} . ' ' . $station->{arrTime}; + my $dep = $station->{depDate} . ' ' . $station->{depTime}; + $ret->{$name} = { + sched_arr => scalar $strp->parse_datetime($arr), + sched_dep => scalar $strp->parse_datetime($dep), + }; + if ( exists $traindelay->{station}{$name} ) { + my $delay = $traindelay->{station}{$name}; + if ( $ret->{$name}{sched_arr} + and $delay->{adelay} + and $delay->{adelay} =~ m{^\d+$} ) + { + $ret->{$name}{rt_arr} = $ret->{$name}{sched_arr} + ->clone->add( minutes => $delay->{adelay} ); + } + if ( $ret->{$name}{sched_dep} + and $delay->{ddelay} + and $delay->{ddelay} =~ m{^\d+$} ) + { + $ret->{$name}{rt_dep} = $ret->{$name}{sched_dep} + ->clone->add( minutes => $delay->{ddelay} ); + } + } } + + $promise->resolve( $ret, $traindelay // {}, $trainsearch_result ); + return; } - } + )->catch( + sub { + $promise->reject; + return; + } + )->wait; - return ( $ret, $traindelay // {}, $trainsearch_result ); + return $promise; } # Input: (HAFAS TripID, line number) |