#!/usr/bin/perl

use strict;

use XML::Parser;
use IO::File;
use IO::Pipe;

sub genviz {
    my($file, $outfile)= @_;
    my %nodes;
    my $chars;
    my $in_node;
    my $in_lan;
    my $lan;
    my %links;
    my %lans;
    my $rv;
    my $dotfile = "/tmp/split$$.dot";
    my $neato = "/usr/local/bin/neato";
    my $g = new IO::File(">$dotfile") || return;
    my $p = new IO::Pipe() || return;
    my $out = new IO::File(">$outfile");

    sub start_element { 
	my($expat, $element) = @_;
	$in_node++ if $element eq "node";
	if ( $element eq "lan" ) {
	    $in_lan++;
	    $lan = {};
	}
    }

    sub end_element {
	my($expat, $element) = @_;

	$in_node = 0 if $element eq "node";
	$nodes{$chars} = "node" if $in_node && $element eq "vname";
	if ($in_lan) {
	    if ( $element ne "lan") {
		$lan->{$element} = $chars if $element =~/(vname|vnode)/;
	    }
	    else {
		$in_lan = 0;
		my $vname = $lan->{'vname'};
		if ( $links{$vname} && @{$links{$vname}} ==2 ) {
		    # this link needs to be a lan
		    $nodes{$vname} = "lan";
		    $lans{$lan->{'vname'}} = ();
		    foreach my $l (@{$links{$vname}}) {
			push(@{$lans{$vname}}, $l);
		    }
		    push(@{$lans{$vname}}, $lan->{'vnode'});
		    $links{$vname} = ();
		    $lan={};
		    return;
		}
		if ( $lans{$vname} && @{$lans{$vname}}) {
		    push(@{$lans{$vname}}, $lan->{'vnode'});
		    $lan = {};
		    return;
		}
		$links{$vname} = () unless $links{$vname};
		push(@{$links{$vname}}, $lan->{'vnode'});
		$lan = {};
		return;
	    }
	}
    }
    sub found_chars { 
	my($expat, $data) = @_;
	$chars = $data;
    }

    my $parser = new XML::Parser(Handlers => { 
	    Start => \&start_element, 
	    End => \&end_element,
	    Char => \&found_chars
	});

    print "$file\n";
    $parser->parsefile($file);

    print $g "graph G {\n";
    foreach my $n (keys %nodes) {
	print $g "\t$n\n";
    }
    foreach my $l (keys %links) {
	print $g "\t", join(" -- ", @{$links{$l}}), "\n";
    }
    foreach my $l (keys %lans) {
	foreach my $n (@{$lans{$l}}) {
	    print $g "\t $n -- $l\n";
	}
    }
    print $g "}\n";
    $g->close();
    $p->reader("$neato  -Gstart=rand -Gepsilon=0.005 -Gmaxiter=20000 " .
	"-Gpack=true $dotfile");
    print $out "<vis>\n";
    while (<$p>) {
	/^\s*(\w+)\s+\[.*pos=\"(\d+),(\d+)\"/ && do {
	    my ($n, $x, $y) = ($1, $2, $3);

	    print "<node><name>$n</name><x>$x</x><y>$y</y><type>$nodes{$n}". 
		"</type></node>\n" if $nodes{$n};
	};
    }
    print $out "</vis>\n";
    $p->close();
    unlink("$dotfile");
}

genviz($ARGV[0], $ARGV[1]);
