File Coverage

blib/lib/Graph/Writer/daVinci.pm

Criterion	Covered	Total	%
statement	55	82	67.0
branch	10	18	55.5
condition			n/a
subroutine	6	7	85.7
pod			n/a
total	71	107	66.3

#
# Graph::Writer::daVinci - write a directed graph out in daVinci format
#
package Graph::Writer::daVinci;
$Graph::Writer::daVinci::VERSION = '2.09';
use 5.006;
use strict;
use warnings;

use parent 'Graph::Writer';

#-----------------------------------------------------------------------
# List of valid daVinci attributes for the entire graph, per node,
# and per edge. You can set other attributes, but they won't get
# written out.
#-----------------------------------------------------------------------
my %valid_attributes =
(
    node  => [qw(OBJECT FONTFAMILY FONTSTYLE COLOR CCOLOR _GO _CGO
		ICONFILE CICONFILE HIDDEN BORDER)],

    edge  => [qw(EDGECOLOR EDGEPATTERN _DIR HEAD)],
);

#=======================================================================
#
# _write_graph()
#
# The private method which actually does the writing out in
# daVinci format.
#
# This is called from the public method, write_graph(), which is
# found in Graph::Writer.
#
#=======================================================================
sub _write_graph
{
    my $self  = shift;
    my $graph = shift;
    my $FILE  = shift;

    my $v;
    my $from;
    my $to;
    my $gn;
    my $aref;
    my @keys;
    my (@nodes, @edges);
    my %done = ();
    my $node;


    @nodes = sort $graph->source_vertices;
    if (@nodes == 0)
    {
        die "expecting source vertices!\n";
    }

    print $FILE "[\n";
    while (@nodes > 0)
    {
        $node = shift @nodes;
        $self->_dump_node($graph, $FILE, $node, \%done, 1);
        print $FILE ",\n" if @nodes > 0;
    }
    print $FILE "\n]\n";

    return 1;

    #-------------------------------------------------------------------
    # Generate a list of edges, along with any attributes
    #-------------------------------------------------------------------
    print $FILE "\n  /* list of edges */\n";
    @edges = sort _by_vertex $graph->edges;
    for (my $i = 0; $i < @edges; $i++)
    {
        ($from, $to) = @{ $edges[$i] };
        print $FILE "  $from -> $to";
        $aref = $graph->get_graph_attributes($from, $to);
        @keys = grep(exists $aref->{$_}, @{$valid_attributes{'edge'}});
        if (@keys > 0)
        {
            print $FILE " [", join(',',
                        map { "$_ = \"".$aref->{$_}."\"" } @keys), "]";
        }
        print $FILE ", " if $i < @edges - 1;
    }

    return 1;
}


sub _by_vertex
{
    return $a->[0].$a->[1] cmp $b->[0].$b->[1];
}


#=======================================================================
#
# _dump_node
#
# Write out a node, using a reference if we've already written it.
# If there are any outgoing edges, we dump them out, recursively
# calling ourself to dump the nodes at the other end of each edge.
#
#=======================================================================
sub _dump_node
{
    my    ($self, $graph, $FILE, $node, $doneref, $depth) = @_;
    my    $aref;
    my    @keys;
    my    @children;
    my    $child;
    local $_;


    if (exists $doneref->{$node})
    {
        print $FILE ' ' x (2 * $depth), "r(\"Node $node\")";
    }
    else
    {
        print $FILE ' ' x (2 * $depth), "l(\"Node $node\", n(\"\"";
        $aref = $graph->get_vertex_attributes($node);
        @keys = grep(exists $aref->{$_}, @{$valid_attributes{'node'}});
        if (@keys > 0)
        {
            print $FILE ", [", join(', ',
                        map { "a(\"$_\", \"".$aref->{$_}."\")" } @keys), "]";
        }
        else
        {
            print $FILE ", []";
        }

        $doneref->{$node} = 1;

        @children = sort $graph->successors($node);
        if (@children == 0)
        {
            print $FILE ", []";
        }
        else
        {
            print $FILE ",\n", ' ' x (2 * $depth + 1), "[\n";
            while (@children > 0)
            {
                $child = shift @children;
                print $FILE ' ' x (2 * $depth + 2),
                            "l(\"Edge ${node}->$child\", e(\"\", [";

                # write out any attributes of the edge
                $aref = $graph->get_edge_attributes($node, $child);
                @keys = grep(exists $aref->{$_}, @{$valid_attributes{'edge'}});
                if (@keys > 0)
                {
                    print $FILE join(', ',
                                map { "a(\"$_\", \"".$aref->{$_}."\")" } @keys);
                }

                print $FILE "],\n";
                $self->_dump_node($graph, $FILE, $child, $doneref, $depth+2);
                print $FILE "))";
                print $FILE ",\n" if @children > 0;
            }
            print $FILE ' ' x (2 * $depth + 1), "]";
        }
        print $FILE "))";
    }
}

1;

__END__