parse-TransXChange.pl


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
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 '}';