File Coverage

blib/lib/Graph/Writer/Dot.pm
Criterion Covered Total %
statement 43 54 79.6
branch 4 8 50.0
condition n/a
subroutine 7 7 100.0
pod n/a
total 54 69 78.2


line stmt bran cond sub pod time code
1             #
2             # Graph::Writer::Dot - write a directed graph out in Dot format
3             #
4             package Graph::Writer::Dot;
5             $Graph::Writer::Dot::VERSION = '2.08';
6 1     1   575 use 5.006;
  1         3  
7 1     1   5 use strict;
  1         1  
  1         19  
8 1     1   5 use warnings;
  1         1  
  1         23  
9              
10 1     1   4 use parent 'Graph::Writer';
  1         2  
  1         4  
11              
12             #-----------------------------------------------------------------------
13             # List of valid dot attributes for the entire graph, per node,
14             # and per edge. You can set other attributes, but they won't get
15             # written out.
16             #-----------------------------------------------------------------------
17             my %valid_attributes =
18             (
19             graph => [qw(bb bgcolor center clusterrank color comment compound
20             concentrate Damping defaultlist dim dpi epsilon fontcolor
21             fontname fontpath fontsize label labeljust labelloc layers
22             layersep lp margin maxiter mclimit mindist mode model nodesep
23             nojustify normalize nslimit nslimit1 ordering ordering
24             orientation outputorder overlap pack packmode page pagedir
25             quantum rank rankdir ranksep ratio remincross resolution
26             root rotate samplepoints searchsize sep showboxes size
27             splines start stylesheet target truecolor viewport voro_margin)],
28              
29             node => [qw(bottomlabel color comment distortion fillcolor fixedsize
30             fontcolor fontname fontsize group height width label layer
31             margin nojustify orientation peripheries pin pos rects regular
32             root shape shapefile showboxes sides skew style target
33             tooltip toplabel URL vertices width z)],
34              
35             edge => [qw(arrowhead arrowsize arrowtail color comment constraint decorate
36             dir fontcolor fontname fontsize headURL headclip headhref
37             headlabel headport headtarget headtooltip href id label
38             labelangle labeldistance labelfloat labelfontcolor labelfontname
39             labelfontsize layer len lhead lp ltail minlen nojustify
40             pos samehead sametail showboxes style tailURL tailclip
41             tailhref taillabel tailport tailtarget tailtooltip target
42             tooltip weight)],
43             );
44              
45             #=======================================================================
46             #
47             # _init()
48             #
49             # class-specific initialisation. There isn't any here, but it's
50             # kept as a place-holder.
51             #
52             #=======================================================================
53             sub _init
54             {
55 1     1   2 my $self = shift;
56              
57 1         7 $self->SUPER::_init();
58             }
59              
60             #=======================================================================
61             #
62             # _write_graph()
63             #
64             # The private method which actually does the writing out in
65             # dot format.
66             #
67             # This is called from the public method, write_graph(), which is
68             # found in Graph::Writer.
69             #
70             #=======================================================================
71             sub _write_graph
72             {
73 1     1   2 my $self = shift;
74 1         2 my $graph = shift;
75 1         2 my $FILE = shift;
76              
77 1         28 my $v;
78             my $from;
79 0         0 my $to;
80 0         0 my $gn;
81 0         0 my $attrref;
82 0         0 my @keys;
83              
84              
85             #-------------------------------------------------------------------
86             # If the graph has a 'name' attribute, then we use that for the
87             # name of the digraph instance. Else it's just 'g'.
88             #-------------------------------------------------------------------
89 1 50       6 $gn = $graph->has_graph_attribute('name') ? $graph->get_graph_attribute('name') : 'g';
90 1         17 print $FILE "digraph $gn\n{\n";
91              
92             #-------------------------------------------------------------------
93             # Dump out any overall attributes of the graph
94             #-------------------------------------------------------------------
95 1         5 $attrref = $graph->get_graph_attributes();
96 1         8 @keys = grep(exists $attrref->{$_}, @{$valid_attributes{'graph'}});
  1         39  
97 1 50       4 if (@keys > 0)
98             {
99 0         0 print $FILE " /* graph attributes */\n";
100 0         0 foreach my $a (@keys)
101             {
102 0         0 print $FILE " $a = \"", $attrref->{$a}, "\";\n";
103             }
104             }
105              
106             #-------------------------------------------------------------------
107             # Generate a list of nodes, with attributes for those that have any.
108             #-------------------------------------------------------------------
109 1         3 print $FILE "\n /* list of nodes */\n";
110 1         4 foreach $v (sort $graph->vertices)
111             {
112 5         66 print $FILE " \"$v\"";
113 5         14 $attrref = $graph->get_vertex_attributes($v);
114 5         377 @keys = grep(exists $attrref->{$_}, @{$valid_attributes{'node'}});
  5         28  
115 5 50       15 if (@keys > 0)
116             {
117             print $FILE " [", join(',',
118 0         0 map { "$_=\"".$attrref->{$_}."\"" } @keys), "]";
  0         0  
119             }
120 5         9 print $FILE ";\n";
121             }
122              
123             #-------------------------------------------------------------------
124             # Generate a list of edges, along with any attributes
125             #-------------------------------------------------------------------
126 1         3 print $FILE "\n /* list of edges */\n";
127 1         4 foreach my $edge (sort _by_vertex $graph->edges)
128             {
129 7         16 ($from, $to) = @$edge;
130 7         16 print $FILE " \"$from\" -> \"$to\"";
131 7         19 $attrref = $graph->get_edge_attributes($from, $to);
132 7         1992 @keys = grep(exists $attrref->{$_}, @{$valid_attributes{'edge'}});
  7         49  
133 7 50       16 if (@keys > 0)
134             {
135             print $FILE " [", join(',',
136 0         0 map { "$_ = \"".$attrref->{$_}."\"" } @keys), "]";
  0         0  
137             }
138 7         14 print $FILE ";\n";
139             }
140              
141             #-------------------------------------------------------------------
142             # close off the digraph instance
143             #-------------------------------------------------------------------
144 1         4 print $FILE "}\n";
145              
146 1         4 return 1;
147             }
148              
149              
150             sub _by_vertex
151             {
152 13     13   185 return $a->[0].$a->[1] cmp $b->[0].$b->[1];
153             }
154              
155              
156             1;
157              
158             __END__