summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/DBInfoscreen/Helper/HAFAS.pm138
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="... &gt; ..."> 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&amp;R};
- $body =~ s{& }{&amp; }g;
-
- # <Attribute [...] text="[...]"[...]"" /> is invalid XML.
- # Work around it.
- $body
- =~ s{<Attribute([^>]+)text="([^"]*)"([^"=>]*)""}{<Attribute$1text="$2&#042;$3&#042;"}s;
-
- # Same for <HIMMessage lead="[...]"[...]"[...]" />
- $body
- =~ s{<HIMMessage([^>]+)lead="([^"]*)"([^"=>]*)"([^"]*)"}{<Attribute$1text="$2&#042;$3&#042;$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&#11020;$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 ) = @_;