summaryrefslogtreecommitdiff
path: root/lib/Graph/GEXF/Role/XML.pm
blob: c157d45d882acd1bf23fe067d7d4879e0116651b (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
package Graph::GEXF::Role::XML;

use Moose::Role;

use XML::Simple;

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

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

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,
            }
        }
    };

    foreach my $attr_id ($self->attributes_node_list) {
        my $attribute = $self->get_node_attribute($attr_id);
        $graph->{gexf}->{graph}->{attributes}->{class} = 'node';
        push @{$graph->{gexf}->{graph}->{attributes}->{attribute}},
          { id    => $attribute->{id},
            type  => $attribute->{type},
            title => $attribute->{title},
          };
    }

    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     => $edges_id,
                source => $edge->source,
                target => $edge->target
              };
        }
    }

    my $xml_out = XMLout($graph, AttrIndent => 1, keepRoot => 1);
    $xml_out;
}

1;