summaryrefslogtreecommitdiff
path: root/lib/Graph
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Graph')
-rw-r--r--lib/Graph/GEXF.pm146
-rw-r--r--lib/Graph/GEXF/Attribute.pm14
-rw-r--r--lib/Graph/GEXF/Edge.pm18
-rw-r--r--lib/Graph/GEXF/Node.pm50
-rw-r--r--lib/Graph/GEXF/Role/Attributes.pm35
-rw-r--r--lib/Graph/GEXF/Role/XML.pm67
6 files changed, 330 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;
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-06 03:53:39 +0000