basic gexf generation

12 files changed, 439 insertions, 0 deletions

diff --git a/lib/Graph/GEXF.pm b/lib/Graph/GEXF.pm
new file mode 100644
index 0000000..83716c5
--- /dev/null
+++ b/lib/Graph/GEXF.pm
@@ -0,0 +1,146 @@
+package Graph::GEXF;
+
+# ABSTRACT: Manipulate graph file in GEXF
+
+use Moose;
+
+use Data::UUID::LibUUID;
+use Moose::Util::TypeConstraints;
+
+use Graph::GEXF::Node;
+
+with
+  'Graph::GEXF::Role::XML',
+  'Graph::GEXF::Role::Attributes' => {for => [qw/node edge/]};
+
+has graph_mode => (
+    is       => 'ro',
+    isa      => enum([qw/static dynamic/]),
+    required => 1,
+    default  => 'static',
+);
+
+has edge_type => (
+    is       => 'ro',
+    isa      => enum([qw/directed undirected mutual notset/]),
+    required => 1,
+    default  => 'directed',
+);
+
+has nodes => (
+    traits  => ['Hash'],
+    is      => 'rw',
+    isa     => 'HashRef[Graph::GEXF::Node]',
+    default => sub { {} },
+    auto_deref=> 1,
+    handles => {
+        _node_exists => 'exists',
+        _add_node    => 'set',
+        total_nodes  => 'count',
+        get_node => 'get',
+        all_nodes => 'keys',
+    },
+);
+
+sub add_node_attribute {
+    my ($self, $name, $type) = @_;
+
+    my $id = $self->attributes_node_total();
+    my $attr = {
+        id    => $id,
+        title => $name,
+        type  => $type,
+    };
+    $self->set_node_attribute($name => $attr);
+}
+
+sub add_node {
+    my ($self, $id) = @_;
+
+    # TODO should be possible to add a Graph::GEXF::Node too
+
+    if ($id && $self->_node_exists($id)) {
+        die "Can't add node wih id $id: already exists";
+    }
+
+    $id = new_uuid_string() if !defined $id;
+
+    my $node = Graph::GEXF::Node->new(id => $id);
+
+    map {
+        my $attribute = $self->get_node_attribute($_);
+        $node->set_node_attribute(
+            $_ => {
+                id   => $attribute->{id},
+                name => $attribute->{name},
+                type => $attribute->{type}
+            }
+        );
+    } $self->attributes_node_list;
+
+    $self->_add_node($id => $node);
+    $node;
+}
+
+1;
+
+=head1 SYNOPSIS
+
+    # create a new graph
+    my $graph = Graph::GEXF->new();
+
+    # add some attributes for nodes
+    $graph->add_node_attribute('url', 'string');
+
+    # create a new node and set the label
+    my $n1 = $graph->add_node(0);
+    $n1->label('Gephi');
+
+    my $n2 = $graph->add_node(1);
+    $n2->label('WebAtlas');
+
+    my $n3 = $graph->add_node(2);
+    $n3->label('RTGI');
+
+    # create relations between nodes
+    $n1->link_to(1, 2);
+    $n2->link_to(0);
+    $n3->link_to(1);
+
+    # set the value for attributes
+    $n1->attribute('url' => 'http://gephi.org/');
+    $n2->attribute('url' => 'http://webatlas.fr/');
+    $n3->attribute('url' => 'http://rtgi.fr/');
+
+    # render the graph in XML
+    my $xml = $graph->to_xml;
+
+=head1 DESCRIPTION
+
+=head2 ATTRIBUTES
+
+=over 4
+
+=item graph_mode
+
+could be B<static> or B<dynamic>. Default is B<static>
+
+=item edge_type
+
+could be B<directed>, B<undirected>, B<mutual> or B<notset>. Default is B<directed>.
+
+=back
+
+=head2 METHODS
+
+=over 4
+
+=item add_node_attribute($name, $type)
+
+Add attributes to node
+
+=item add_node([$id])
+
+Add a new node to the graph
+
+=back
diff --git a/lib/Graph/GEXF/Attribute.pm b/lib/Graph/GEXF/Attribute.pm
new file mode 100644
index 0000000..fb18ea2
--- /dev/null
+++ b/lib/Graph/GEXF/Attribute.pm
@@ -0,0 +1,14 @@
+package Graph::GEXF::Attribute;
+
+use Moose;
+
+has id => (is => 'ro', isa => 'Int', required => 1,);
+has title => (is => 'rw', isa => 'Str');
+has value => (is => 'rw', isa => 'Str');
+has type  => (
+    is  => 'ro',
+    isa => enum([qw/string integer float double boolean date anyURI/])
+);
+
+1;
+
diff --git a/lib/Graph/GEXF/Edge.pm b/lib/Graph/GEXF/Edge.pm
new file mode 100644
index 0000000..26f2462
--- /dev/null
+++ b/lib/Graph/GEXF/Edge.pm
@@ -0,0 +1,18 @@
+package Graph::GEXF::Edge;
+
+use Moose;
+use Data::UUID::LibUUID;
+
+has id => (
+    is       => 'ro',
+    isa      => 'Str',
+    required => 1,
+    default  => sub { new_uuid_string() }
+);
+
+has source => (is => 'ro', isa => 'Str', required => 1);
+has target => (is => 'ro', isa => 'Str', required => 1);
+has label  => (is => 'rw', isa => 'Str');
+has weight => (is => 'rw', isa => 'Num', lazy => 1, default => 1);
+
+1;
diff --git a/lib/Graph/GEXF/Node.pm b/lib/Graph/GEXF/Node.pm
new file mode 100644
index 0000000..0c45a04
--- /dev/null
+++ b/lib/Graph/GEXF/Node.pm
@@ -0,0 +1,50 @@
+package Graph::GEXF::Node;
+
+use Moose;
+
+use Graph::GEXF::Edge;
+with 'Graph::GEXF::Role::Attributes' => {for => [qw/node/]};
+
+has id => (is => 'ro', isa => 'Str', required => 1);
+has label => (is => 'rw', isa => 'Str');
+
+has edges => (
+    traits  => ['Hash'],
+    is      => 'rw',
+    isa     => 'HashRef[Graph::GEXF::Edge]',
+    default => sub { {} },
+    handles => {
+        add_edge    => 'set',
+        has_link_to => 'exists',
+        all_edges => 'keys',
+        get_edge => 'get',
+    }
+);
+
+sub link_to {
+    my $self     = shift;
+    my @nodes_id = @_;
+
+    foreach my $node_id (@nodes_id) {
+        my $edge =
+          Graph::GEXF::Edge->new(source => $self->id, target => $node_id);
+
+        $self->add_edge($node_id => $edge);
+    }
+}
+
+sub attribute {
+    my ($self, $attribute_name, $value) = @_;
+
+#    return 0 unless $self->has_node_attribute;
+
+    if (!$self->has_node_attribute($attribute_name)) {
+        die "this attribute doesn't exists";
+    }
+
+    $self->node_attributes->{$attribute_name}->{value} = $value;
+
+    1;
+}
+
+1;
diff --git a/lib/Graph/GEXF/Role/Attributes.pm b/lib/Graph/GEXF/Role/Attributes.pm
new file mode 100644
index 0000000..644793d
--- /dev/null
+++ b/lib/Graph/GEXF/Role/Attributes.pm
@@ -0,0 +1,35 @@
+package Graph::GEXF::Role::Attributes;
+
+use MooseX::Role::Parameterized;
+
+parameter for => (
+    is       => 'ro',
+    required => 1,
+);
+
+role {
+    my $p = shift;
+
+    foreach my $type (@{$p->for}) {
+
+        my $attr_name = $type . '_attributes';
+
+        has $attr_name => (
+            traits  => ['Hash'],
+            is      => 'rw',
+            isa     => 'HashRef',
+            lazy    => 1,
+            default => sub { {} },
+            handles => {
+                'attributes_' . $type . '_total' => 'count',
+                'set_' . $type . '_attribute'    => 'set',
+                'get_' . $type . '_attribute'    => 'get',
+                'attributes_' . $type . '_list'  => 'keys',
+                'has_'.$type.'_attribute' => 'exists',
+            }
+        );
+    }
+
+};
+
+1;
diff --git a/lib/Graph/GEXF/Role/XML.pm b/lib/Graph/GEXF/Role/XML.pm
new file mode 100644
index 0000000..c157d45
--- /dev/null
+++ b/lib/Graph/GEXF/Role/XML.pm
@@ -0,0 +1,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;
diff --git a/t/01-basic.t b/t/01-basic.t
new file mode 100644
index 0000000..8e1a231
--- /dev/null
+++ b/t/01-basic.t
@@ -0,0 +1,12 @@
+use strict;
+use warnings;
+use Test::More;
+use Graph::GEXF;
+
+ok my $graph = Graph::GEXF->new(), 'graph created';
+ok my $n1 = $graph->add_node(), 'node created';
+ok $n1->id, 'node has an id';
+is $graph->total_nodes, 1, 'got one node';
+ok my $n2 = $graph->get_node($n1->id);
+
+done_testing;
diff --git a/t/02-graph.t b/t/02-graph.t
new file mode 100644
index 0000000..a81f889
--- /dev/null
+++ b/t/02-graph.t
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use Graph::GEXF;
+
+ok my $graph = Graph::GEXF->new(), 'graph created';
+
+$graph->add_node_attribute('url', 'anyURI');
+$graph->add_node_attribute('lf', 'integer');
+
+is $graph->total_attributes, 2, 'got 2 attributes';
+
+ok my $attr = $graph->get_attribute('url'), 'fetch first attribute';
+is $attr->{title}, 'url', 'first attribute is url';
+
+done_testing;
diff --git a/t/03-node.t b/t/03-node.t
new file mode 100644
index 0000000..ccd79fe
--- /dev/null
+++ b/t/03-node.t
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+use Test::More;
+
+use Graph::GEXF::Node;
+
+ok my $node = Graph::GEXF::Node->new(id =>0), 'node created';
+
+ok !$node->attribute('url', 'http://linkfluence.net'), 'can\'t add attribute, not attributes defined';
+
+ok $node = Graph::GEXF::Node->new(
+    id         => 0,
+    attributes => {url => {title => 'url', type => 'anyURI'}}
+  ),
+  'node created';
+
+ok $node->attribute('url', 'http://linkfluence.net'), 'add attribute url to node';
+
+done_testing;
diff --git a/t/04-edges.t b/t/04-edges.t
new file mode 100644
index 0000000..9ded831
--- /dev/null
+++ b/t/04-edges.t
@@ -0,0 +1,7 @@
+use strict;
+use warnings;
+use Test::More;
+
+ok 1;
+
+done_testing;
diff --git a/t/05-basic_graph.t b/t/05-basic_graph.t
new file mode 100644
index 0000000..ed1a921
--- /dev/null
+++ b/t/05-basic_graph.t
@@ -0,0 +1,20 @@
+use strict;
+use warnings;
+use Test::More;
+
+use Graph::GEXF;
+
+my $graph = Graph::GEXF->new();
+
+my $n1 = $graph->add_node;
+$n1->label('hello');
+
+my $n2 = $graph->add_node;
+$n2->label('world');
+
+$n1->link_to($n2->id);
+
+ok my $xml = $graph->to_xml;
+#print $xml;
+
+done_testing;
diff --git a/t/06-data.t b/t/06-data.t
new file mode 100644
index 0000000..f9f2ea2
--- /dev/null
+++ b/t/06-data.t
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+use Test::More;
+
+use Graph::GEXF;
+
+my $graph = Graph::GEXF->new();
+$graph->add_node_attribute('url', 'string');
+$graph->add_node_attribute('indegree', 'float');
+$graph->add_node_attribute('frog', 'boolean');
+
+my $n1 = $graph->add_node(0);
+$n1->label('Gephi');
+$n1->link_to(1, 2, 3);
+$n1->attribute('url' => 'http://gephi.org/');
+
+my $n2 = $graph->add_node(1);
+$n2->label('WebAtlas');
+$n2->link_to(0);
+$n2->attribute('url' => 'http://webatlas.fr/');
+
+my $n3 = $graph->add_node(2);
+$n3->label('RTGI');
+$n3->link_to(1);
+
+my $n4 = $graph->add_node(3);
+$n4->label('BarabasiLab');
+
+ok my $xml = $graph->to_xml;
+
+print $xml;
+
+done_testing;