diff options
| -rw-r--r-- | lib/DBInfoscreen/Helper/HAFAS.pm | 138 |
1 files changed, 0 insertions, 138 deletions
diff --git a/lib/DBInfoscreen/Helper/HAFAS.pm b/lib/DBInfoscreen/Helper/HAFAS.pm index 28f5f02..6af47e3 100644 --- a/lib/DBInfoscreen/Helper/HAFAS.pm +++ b/lib/DBInfoscreen/Helper/HAFAS.pm @@ -86,144 +86,6 @@ sub get_json_p { return $promise; } -sub get_xml_p { - my ( $self, $cache, $url ) = @_; - - my $promise = Mojo::Promise->new; - - if ( my $content = $cache->thaw($url) ) { - return $promise->resolve($content); - } - - $self->{log}->debug("get_xml_p($url)"); - - $self->{user_agent}->request_timeout(5)->get_p( $url => $self->{header} ) - ->then( - sub { - my ($tx) = @_; - - 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; - } - - my $body = decode( 'ISO-8859-15', $tx->res->body ); - - # <SDay text="... > ..."> is invalid XML, but present - # 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{& }{& }g; - - # <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; - - # Dito for <HIMMessage [...] lead="[...]<br>[...]"> - # (replace line breaks with space) - while ( $body - =~ s{<HIMMessage([^>]+)lead="([^"]*)<br/?>([^"=]*)"}{<HIMMessage$1lead="$2 $3"}gis - ) - { - } - - # ... and <HIMMessage [...] lead="[...]<>[...]"> - # (replace <> with t$t) - while ( $body - =~ s{<HIMMessage([^>]+)lead="([^"]*)<>([^"=]*)"}{<HIMMessage$1lead="$2⬌$3"}gis - ) - { - } - - # ... and any other HTML tag inside an XML attribute - # (remove them entirely) - while ( $body - =~ s{<HIMMessage([^>]+)lead="([^"]*)<[^>]+>([^"=]*)"}{<HIMMessage$1lead="$2$3"}gis - ) - { - } - - my $tree; - - eval { $tree = XML::LibXML->load_xml( string => $body ) }; - - if ($@) { - $self->{log}->debug("hafas->get_xml_p($url): $@"); - $cache->freeze( $url, {} ); - $promise->reject; - return; - } - - 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, - }; - } - - for my $message ( $tree->findnodes('/Journey/HIMMessage') ) { - my $header = $message->getAttribute('header'); - my $lead = $message->getAttribute('lead'); - my $display = $message->getAttribute('display'); - - # "something is wrong, but we're not telling what" is not helpful. - # Observed on RRX lines in NRW - if ( $header - =~ m{ : \s St..?rung. \s \(Quelle: \s zuginfo.nrw \) $ }x - and not $lead ) - { - next; - } - - push( - @{ $ret->{messages} }, - { - header => $header, - lead => $lead, - display => $display - } - ); - } - - $cache->freeze( $url, $ret ); - $promise->resolve($ret); - - return; - } - )->catch( - sub { - my ($err) = @_; - $self->{log}->warn("hafas->get_xml_p($url): $err"); - $promise->reject($err); - return; - } - )->wait; - - return $promise; -} - sub trainsearch_p { my ( $self, %opt ) = @_; |