r59960 - in /branches/upstream/libgraph-easy-perl/current: CHANGES META.yml lib/Graph/Easy.pm lib/Graph/Easy/As_graphviz.pm t/graphviz.t
carnil-guest at users.alioth.debian.org
carnil-guest at users.alioth.debian.org
Thu Jul 1 21:34:18 UTC 2010
Author: carnil-guest
Date: Thu Jul 1 21:33:58 2010
New Revision: 59960
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=59960
Log:
[svn-upgrade] new version libgraph-easy-perl (0.69)
Modified:
branches/upstream/libgraph-easy-perl/current/CHANGES
branches/upstream/libgraph-easy-perl/current/META.yml
branches/upstream/libgraph-easy-perl/current/lib/Graph/Easy.pm
branches/upstream/libgraph-easy-perl/current/lib/Graph/Easy/As_graphviz.pm
branches/upstream/libgraph-easy-perl/current/t/graphviz.t
Modified: branches/upstream/libgraph-easy-perl/current/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgraph-easy-perl/current/CHANGES?rev=59960&op=diff
==============================================================================
--- branches/upstream/libgraph-easy-perl/current/CHANGES (original)
+++ branches/upstream/libgraph-easy-perl/current/CHANGES Thu Jul 1 21:33:58 2010
@@ -1,4 +1,8 @@
Revision history for Graph::Easy (formerly known as Graph::Simple):
+
+2010-07-01 v0.69 Shlomi Fish 2938 tests
+ * 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.
Modified: branches/upstream/libgraph-easy-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgraph-easy-perl/current/META.yml?rev=59960&op=diff
==============================================================================
--- branches/upstream/libgraph-easy-perl/current/META.yml (original)
+++ branches/upstream/libgraph-easy-perl/current/META.yml Thu Jul 1 21:33:58 2010
@@ -29,4 +29,4 @@
perl: 5.008002
resources:
license: http://opensource.org/licenses/gpl-license.php
-version: 0.68
+version: 0.69
Modified: branches/upstream/libgraph-easy-perl/current/lib/Graph/Easy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgraph-easy-perl/current/lib/Graph/Easy.pm?rev=59960&op=diff
==============================================================================
--- branches/upstream/libgraph-easy-perl/current/lib/Graph/Easy.pm (original)
+++ branches/upstream/libgraph-easy-perl/current/lib/Graph/Easy.pm Thu Jul 1 21:33:58 2010
@@ -17,7 +17,7 @@
use Graph::Easy::Node::Empty;
use Scalar::Util qw/weaken/;
-$VERSION = '0.68';
+$VERSION = '0.69';
@ISA = qw/Graph::Easy::Base/;
use strict;
Modified: branches/upstream/libgraph-easy-perl/current/lib/Graph/Easy/As_graphviz.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgraph-easy-perl/current/lib/Graph/Easy/As_graphviz.pm?rev=59960&op=diff
==============================================================================
--- branches/upstream/libgraph-easy-perl/current/lib/Graph/Easy/As_graphviz.pm (original)
+++ branches/upstream/libgraph-easy-perl/current/lib/Graph/Easy/As_graphviz.pm Thu Jul 1 21:33:58 2010
@@ -721,6 +721,91 @@
$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) = @_;
@@ -801,67 +886,14 @@
$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;
Modified: branches/upstream/libgraph-easy-perl/current/t/graphviz.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgraph-easy-perl/current/t/graphviz.t?rev=59960&op=diff
==============================================================================
--- branches/upstream/libgraph-easy-perl/current/t/graphviz.t (original)
+++ branches/upstream/libgraph-easy-perl/current/t/graphviz.t Thu Jul 1 21:33:58 2010
@@ -7,7 +7,7 @@
BEGIN
{
- plan tests => 152;
+ plan tests => 157;
chdir 't' if -d 't';
use lib '../lib';
use_ok ("Graph::Easy") or die($@);
@@ -674,3 +674,30 @@
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');
More information about the Pkg-perl-cvs-commits
mailing list