parse TXC to dot

1 files changed, 36 insertions, 0 deletions

diff --git a/parse-TransXChange.pl b/parse-TransXChange.pl
new file mode 100644
index 0000000..6426cba
--- /dev/null
+++ b/parse-TransXChange.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use 5.014;
+use XML::LibXML;
+use XML::LibXML::XPathContext;
+use Data::Printer;
+
+my $parser=XML::LibXML->new;
+my $doc=$parser->load_xml(location=>$ARGV[0]);
+my $xpath = XML::LibXML::XPathContext->new();
+$xpath->registerNs('t','http://www.transxchange.org.uk/');
+
+sub stop_point {
+    my ($ref) = @_;
+    return $xpath->findvalue("/t:TransXChange/t:StopPoints/t:AnnotatedStopPointRef[t:StopPointRef='$ref']/t:CommonName/text()",$doc);
+}
+
+my %links;
+my @sections = $xpath->findnodes('/t:TransXChange/t:RouteSections/t:RouteSection',$doc);
+for my $section (@sections) {
+    for my $link ($xpath->findnodes('t:RouteLink',$section)) {
+        my ($from) = stop_point($xpath->findnodes('t:From/t:StopPointRef/text()',$link));
+        my ($to) = stop_point($xpath->findnodes('t:To/t:StopPointRef/text()',$link));
+        $links{$from}->{$to}=1;
+    }
+}
+
+say 'digraph {';
+for my $from (keys %links) {
+    for my $to (keys %{$links{$from}}) {
+        printf qq{"%s" -> "%s"\n},
+            $from,$to;
+    }
+}
+say '}';