Fix #2 - support viz elements

- refactoring of this role
- add support for viz elements to nodes and edges

Signed-off-by: franck cuny <franck@lumberjaph.net>

1 files changed, 117 insertions, 41 deletions

diff --git a/lib/Graph/GEXF/Role/XML.pm b/lib/Graph/GEXF/Role/XML.pm
index 47b0f52..cf12170 100644
--- a/lib/Graph/GEXF/Role/XML.pm
+++ b/lib/Graph/GEXF/Role/XML.pm
@@ -13,59 +13,25 @@ has gexf_ns => (
 has gexf_version => (
     is      => 'ro',
     isa     => 'Num',
-    default => '1.1'
+    default => '1.2'
 );
 
 sub to_xml {
     my $self = shift;
 
-    my $graph = {
-        gexf => {
-            xmlns   => $self->gexf_ns,
-            version => $self->gexf_version,
-            meta    => {creator => ['Graph::GEXF']},
-            graph   => {
-                mode            => $self->graph_mode,
-                defaultedgetype => $self->edge_type,
-            }
-        }
-    };
-
-    $self->add_attributes($graph, 'node');
-    $self->add_attributes($graph, 'edge');
+    my $graph = $self->_init_graph();
 
-    my $edges_id = 0;
-
-    foreach my $node_id ($self->all_nodes) {
-        my $node = $self->get_node($node_id);
-        my $node_desc = {
-            id => $node->id,
-            label => $node->label,
-        };
-
-        foreach my $attr_id ($node->attributes_node_list) {
-            my $attr = $node->get_node_attribute($attr_id);
-            push @{$node_desc->{attvalues}->{attvalue}}, {for => $attr->{id}, value => $attr->{value}};
-        }
-
-        push @{$graph->{gexf}->{graph}->{nodes}->{node}}, $node_desc;
-        
-        foreach my $edge_id ($node->all_edges) {
-            my $edge = $node->get_edge($edge_id);
-            push @{$graph->{gexf}->{graph}->{edges}->{edge}},
-              { id     => $edge->id,
-                source => $edge->source,
-                target => $edge->target,
-                weight => $edge->weight,
-              };
-        }
+    foreach (qw/node edge/) {
+        $self->_add_attributes( $graph, $_ );
     }
 
+    $self->_add_nodes($graph);
+
     my $xml_out = XMLout($graph, AttrIndent => 1, keepRoot => 1);
     $xml_out;
 }
 
-sub add_attributes {
+sub _add_attributes {
     my ($self, $graph, $type) = @_;
 
     my $list_attr = 'attributes_' . $type . '_list';
@@ -87,6 +53,116 @@ sub add_attributes {
     push @{$graph->{gexf}->{graph}->{attributes}}, $attributes;
 }
 
+sub _init_graph {
+    my $self = shift;
+
+    # XXX this need some refactoring
+    return {
+        gexf => {
+            xmlns   => $self->gexf_ns,
+            version => $self->gexf_version,
+            meta    => {creator => ['Graph::GEXF']},
+            graph   => {
+                mode            => $self->graph_mode,
+                defaultedgetype => $self->edge_type,
+            }
+        }
+    };
+}
+
+sub _add_nodes {
+    my ( $self, $graph ) = @_;
+
+    my $edges_id = 0;
+
+    foreach my $node_id ( $self->all_nodes ) {
+        my $node = $self->get_node($node_id);
+        my ( $node_desc, $edges ) = $self->_create_node($node);
+        push @{ $graph->{gexf}->{graph}->{nodes}->{node} }, $node_desc;
+        foreach my $edge (@$edges) {
+            push @{ $graph->{gexf}->{graph}->{edges}->{edge} }, $edge;
+        }
+    }
+}
+
+sub _create_node {
+    my ( $self, $node ) = @_;
+
+    my $label = $node->label || $node->id;
+
+    my $node_desc = { id => $node->id, label => $label };
+
+    foreach my $attr_id ( $node->attributes_node_list ) {
+        my $attr = $node->get_node_attribute($attr_id);
+        push @{ $node_desc->{attvalues}->{attvalue} },
+          { for => $attr->{id}, value => $attr->{value} };
+    }
+
+    $self->_add_visualizations_elements($node, $node_desc);
+
+    my @edges =
+      map { $self->_create_edge( $node->get_edge($_) ) } $node->all_edges;
+
+    return ($node_desc, \@edges);
+}
+
+sub _create_edge {
+    my ( $self, $edge ) = @_;
+    my $edge_desc = {
+        id     => $edge->id,
+        source => $edge->source,
+        target => $edge->target,
+        weight => $edge->weight,
+    };
+
+    $self->_add_shape($edge, $edge_desc);
+    
+    return $edge_desc;
+}
+
+sub _add_visualizations_elements {
+    my ( $self, $node, $node_desc ) = @_;
+
+    return unless $self->has_visualization;
+
+    foreach (qw/colors size shape position/){
+        my $method = "_add_$_";
+        $self->$method($node, $node_desc);
+    }
+}
+
+sub _add_colors {
+    my ( $self, $element, $element_desc ) = @_;
+
+    return unless $element->has_colors;
+    push @{ $element_desc->{'viz:color'} },
+      $self->_add_viz_elements( $element, qw/r g b a/ );
+}
+
+sub _add_size {
+    my ($self, $element, $element_desc) = @_;
+    push @{$element_desc->{'viz:size'}}, {value => $element->size};
+}
+
+sub _add_shape {
+    my ($self, $element, $element_desc) = @_;
+    push @{$element_desc->{'viz:shape'}}, {value => $element->shape};
+}
+
+sub _add_position {
+    my ($self, $element, $element_desc) = @_;
+
+    return unless $element->has_position;
+    push @{ $element_desc->{'viz:position'} },
+      $self->_add_viz_elements( $element, qw/x y z/ );
+}
+
+sub _add_viz_elements {
+    my ( $self, $element, @attrs ) = @_;
+    my %hash = map { $_ => $element->$_ } @attrs;
+    \%hash;
+}
+
 no Moose::Role;
 
 1;