File Coverage

blib/lib/Graph/Writer/TGXML.pm

Criterion	Covered	Total	%
statement	45	47	95.7
branch			n/a
condition	5	11	45.4
subroutine	6	6	100.0
pod			n/a
total	56	64	87.5

#
# Graph::Writer::TGXML - write a directed graph out as TouchGraph LinkBrowser XML
#
# $Id$
#
package Graph::Writer::TGXML;

use strict;
use warnings;

use Graph::Writer;
use XML::Writer;

use vars qw(@ISA $VERSION);
$VERSION = 0.03;
@ISA = qw(Graph::Writer);


#=======================================================================
#
# _write_graph() - perform the writing of the graph
#
# This is invoked from the public write_graph() method,
# and is where the actual writing of the graph happens.
#
# Basically we start a graph element then:
#	[] dump out any attributes of the graph
#	[] dump out all vertices, with any attributes of each vertex
#	[] dump out all edges, with any attributes of each edge
# And then close the graph element. Ta da!
#
#=======================================================================
sub _write_graph
{
    my $self  = shift;
    my $graph = shift;
    my $FILE  = shift;

    my $v;
    my $from;
    my $to;
#    my %attributes;
    my $xmlwriter;


    $xmlwriter = XML::Writer->new(OUTPUT      => $FILE,
                                  DATA_MODE   => 1,
                                  DATA_INDENT => 2);
    $xmlwriter->setOutput($FILE);

    $xmlwriter->startTag('TOUCHGRAPH_LB', version => '1.20');

    $xmlwriter->startTag('NODESET');

    #-------------------------------------------------------------------
    # dump out vertices of the graph, including any attributes
    #-------------------------------------------------------------------
    foreach $v (sort { $a cmp $b  } ($graph->vertices))
    {
        my $attributes = $graph->get_vertex_attributes($v) || {};

#        print ">$v<\n";

        $xmlwriter->startTag('NODE', 'nodeID' => $v);
        $xmlwriter->emptyTag('NODE_LOCATION',
                             x => 633,
                             y => 30,
                             visible => 'true' );
        $xmlwriter->emptyTag('NODE_LABEL',
                             label => $attributes->{label} || $v,
                             shape => 2,
                             backColor => 'FFFFFF',
                             textColor => '000000',
                             fontSize => 16 );

        $xmlwriter->emptyTag('NODE_URL',
                             url => $attributes->{URL} || '',
                             urlIsLocal  => 'false',
                             urlIsXML =>'false' );

        $attributes->{tooltip} ||= '';
        $attributes->{tooltip} =~ s/\\74/
        $attributes->{tooltip} =~ s/\\76/>/g;
        $xmlwriter->emptyTag('NODE_HINT',
                             hint => $attributes->{tooltip} || '',
                             width => 400,
                             height => -1,
                             isHTML => 'false' );
        $xmlwriter->endTag('NODE');
    }

    $xmlwriter->endTag('NODESET');

    #-------------------------------------------------------------------
    # dump out edges of the graph, including any attributes
    #-------------------------------------------------------------------

    $xmlwriter->startTag('EDGESET');

    my @edges = $graph->edges;
    while (@edges)
    {
        ($from, $to) = splice(@edges, 0, 2);
#        my $attributes = $graph->get_edge_attributes($from, $to);

        $xmlwriter->emptyTag('EDGE',
                             fromID => $from,
                             toID => $to,
                             type => 1,
                             length => 40,
                             visible => 'true',
                             color => 'A0A0A0' );

    }

    $xmlwriter->endTag('EDGESET');

    $xmlwriter->endTag('TOUCHGRAPH_LB');
    $xmlwriter->end();

    return 1;
}

1;

__END__