path: root/lib/Graph/GEXF/Role/XML.pm

package Graph::GEXF::Role::XML;

use Moose::Role;

use XML::Simple;

has gexf_ns => (
    is      => 'ro',
    isa     => 'Str',
    default => 'http://www.gexf.net/1.2draft'
);

has gexf_version => (
    is      => 'ro',
    isa     => 'Num',
    default => '1.2'
);

sub to_xml {
    my $self = shift;

    my $graph = $self->_init_graph();

    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 {
    my ($self, $graph, $type) = @_;

    my $list_attr = 'attributes_' . $type . '_list';
    my $get_attr  = 'get_' . $type . '_attribute';

    my $attributes;
    $attributes->{class} = $type;

    foreach my $attr_id ($self->$list_attr) {
        my $attribute = $self->$get_attr($attr_id);
        push @{$attributes->{attribute}},
          { id      => $attribute->{id},
            type    => $attribute->{type},
            title   => $attribute->{title},
            default => $attribute->{default},
          };
    }

    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;