From f56bb307e5193f13b7e758ad6b685c4a8761a7c3 Mon Sep 17 00:00:00 2001
From: Daniel Friesel <derf@finalrewind.org>
Date: Sat, 5 Nov 2022 16:29:48 +0100
Subject: remove hafas/get_xml_p helper (not required for mgate.exe API)

---
 lib/DBInfoscreen/Helper/HAFAS.pm | 138 ---------------------------------------
 1 file changed, 138 deletions(-)

(limited to 'lib')

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 ) = @_;
 
-- 
cgit v1.2.3