Commits

Anonymous committed b5eceec

Add support for GraphViz subgraphs.

Comments (0)

Files changed (3)

Graph-Easy/CHANGES

 Revision history for Graph::Easy (formerly known as Graph::Simple):
 
+  * Add support for GraphViz subgraphs.
+    - Thanks to a patch by Yves Agostini ( http://www.crium.univ-metz.fr/ )
+
 2010-06-28 v0.68 Shlomi Fish 2933 tests
   * Add .*\.swp to the MANIFEST.SKIP in order to skip vim temporary files.
   * Fixed the signature file.

Graph-Easy/lib/Graph/Easy/As_graphviz.pm

   $txt . "$indent$first $self->{_edge_type} $other$edge_att\n";		# return edge text
   }
 
+sub _order_group 
+  {
+  my ($self,$group) = @_;
+  $group->{_order}++;
+  for my $sg (values %{$group->{groups}})
+	{
+		$self->_order_group($sg);
+	}
+  }
+
+
+sub _as_graphviz_group 
+  {
+  my ($self,$group) = @_;
+
+  my $txt = '';
+    # quote special chars in group name
+    my $name = $group->{name}; $name =~ s/([\[\]\(\)\{\}\#"])/\\$1/g;
+
+   return if $group->{_p};
+    # output group attributes first
+    my $indent = '  ' x ($group->{_order});
+    $txt .= $indent."subgraph \"cluster$group->{id}\" {\n${indent}label=\"$name\";\n";
+
+	for my $sg (values %{$group->{groups}})
+	{
+		#print '--'.$sg->{name}."\n";
+		$txt .= $self->_as_graphviz_group($sg,$indent);
+		$sg->{_p} = 1;
+	}
+    # Make a copy of the attributes, including our class attributes:
+    my $copy = {};
+    my $attribs = $group->get_attributes();
+
+    for my $a (keys %$attribs)
+      {
+      $copy->{$a} = $attribs->{$a};
+      }
+    # set some defaults
+    $copy->{'borderstyle'} = 'solid' unless defined $copy->{'borderstyle'};
+
+    my $out = $self->_remap_attributes( $group->class(), $copy, $remap, 'noquote');
+
+    # Set some defaults:
+    $out->{fillcolor} = '#a0d0ff' unless defined $out->{fillcolor};
+    $out->{labeljust} = 'l' unless defined $out->{labeljust};
+
+    my $att = '';
+    # we need to output style first ("filled" and "color" need come later)
+    for my $atr (reverse sort keys %$out)
+      {
+      my $v = $out->{$atr};
+      $v = '"' . $v . '"' if $v !~ /^[a-z0-9A-Z]+\z/;	# quote if nec.
+
+      # convert "x-dot-foo" to "foo". Special case "K":
+      my $name = $atr; $name =~ s/^x-dot-//; $name = 'K' if $name eq 'k';
+
+      $att .= $indent."$name=$v;\n";
+      }
+    $txt .= $att . "\n" if $att ne '';
+ 
+    # output nodes (w/ or w/o attributes) in that group
+    for my $n ($group->sorted_nodes())
+      {
+      # skip nodes that are relativ to others (these are done as part
+      # of the HTML-like label of their parent)
+      next if $n->{origin};
+
+      my $att = $n->attributes_as_graphviz();
+      $n->{_p} = undef;			# mark as processed
+      $txt .= $indent . $n->as_graphviz_txt() . $att . "\n";
+      }
+
+    # output node connections in this group
+    for my $e (values %{$group->{edges}})
+      {
+      next if exists $e->{_p};
+      $txt .= $self->_generate_edge($e, $indent);
+      }
+
+    $txt .= $indent."}\n";
+   
+   return $txt;
+  }
+
 sub _as_graphviz
   {
   my ($self) = @_;
   $self->_edges_into_groups() if $groups > 0;
 
   # output the groups (aka subclusters)
-  my $indent = '    ';
-  for my $group (sort { $a->{name} cmp $b->{name} } values %{$self->{groups}})
-    {
-    # quote special chars in group name
-    my $name = $group->{name}; $name =~ s/([\[\]\(\)\{\}\#"])/\\$1/g;
-
-    # output group attributes first
-    $txt .= "  subgraph \"cluster$group->{id}\" {\n${indent}label=\"$name\";\n";
-   
-    # Make a copy of the attributes, including our class attributes:
-    my $copy = {};
-    my $attribs = $group->get_attributes();
-
-    for my $a (keys %$attribs)
-      {
-      $copy->{$a} = $attribs->{$a};
-      }
-    # set some defaults
-    $copy->{'borderstyle'} = 'solid' unless defined $copy->{'borderstyle'};
-
-    my $out = $self->_remap_attributes( $group->class(), $copy, $remap, 'noquote');
-
-    # Set some defaults:
-    $out->{fillcolor} = '#a0d0ff' unless defined $out->{fillcolor};
-    $out->{labeljust} = 'l' unless defined $out->{labeljust};
-
-    my $att = '';
-    # we need to output style first ("filled" and "color" need come later)
-    for my $atr (reverse sort keys %$out)
-      {
-      my $v = $out->{$atr};
-      $v = '"' . $v . '"' if $v !~ /^[a-z0-9A-Z]+\z/;	# quote if nec.
-
-      # convert "x-dot-foo" to "foo". Special case "K":
-      my $name = $atr; $name =~ s/^x-dot-//; $name = 'K' if $name eq 'k';
-
-      $att .= "    $name=$v;\n";
-      }
-    $txt .= $att . "\n" if $att ne '';
- 
-    # output nodes (w/ or w/o attributes) in that group
-    for my $n ($group->sorted_nodes())
-      {
-      # skip nodes that are relativ to others (these are done as part
-      # of the HTML-like label of their parent)
-      next if $n->{origin};
-
-      my $att = $n->attributes_as_graphviz();
-      $n->{_p} = undef;			# mark as processed
-      $txt .= $indent . $n->as_graphviz_txt() . $att . "\n";
-      }
-
-    # output node connections in this group
-    for my $e (values %{$group->{edges}})
-      {
-      next if exists $e->{_p};
-      $txt .= $self->_generate_edge($e, $indent);
-      }
-
-    $txt .= "  }\n";
-    }
+  for my $group (values %{$self->{groups}})
+  {
+   $self->_order_group($group);
+  }
+  for my $group (sort { $a->{_order} cmp $b->{_order} } values %{$self->{groups}})
+  {
+    $txt .= $self->_as_graphviz_group($group) || '';
+  }
 
   my $root = $self->attribute('root');
   $root = '' unless defined $root;

Graph-Easy/t/graphviz.t

 
 BEGIN
    {
-   plan tests => 152;
+   plan tests => 157;
    chdir 't' if -d 't';
    use lib '../lib';
    use_ok ("Graph::Easy") or die($@);
 unlike ($grviz, qr/style=.*dashed/, "no dashed in output");
 unlike ($grviz, qr/peripheries/, "no peripheries in output");
 
+#############################################################################
+# subgraph
+
+#$graph = Graph::Easy->new();
+my $g  = Graph::Easy->new;
+my $a  = $g->add_group('A');
+my $b  = $g->add_group('B');
+my $c  = $g->add_group('C');
+my $d  = $g->add_group('D');
+my $n1 = $g->add_node('one');
+my $n2 = $g->add_node('two');
+my $n3 = $g->add_node('three');
+my $n4 = $g->add_node('four');
+
+$a->add_member($n1);
+$b->add_member($c);
+$b->add_member($n2);
+$a->add_member($b);
+$c->add_member($n3);
+$d->add_member($n4);
+
+$grviz = $g->as_graphviz();
+is($a->{_order},1,'subgraph A is level 1');
+is($d->{_order},1,'subgraph D is level 1');
+is($b->{_order},2,'subgraph B is level 2');
+is($c->{_order},3,'subgraph C is level 3');
+like($grviz,qr/subgraph "cluster\d+" {\n  label="A";\n    subgraph "cluster\d+" {/,'subgraph indent');