diff options
| -rw-r--r-- | lib/Graph/GEXF/Role/XML.pm | 158 |
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; |