From faf6949033a021bffab3c91a04665efef4378b28 Mon Sep 17 00:00:00 2001 From: franck cuny Date: Fri, 16 Jul 2010 11:19:15 +0200 Subject: basic gexf generation --- lib/Graph/GEXF/Attribute.pm | 14 ++++++++ lib/Graph/GEXF/Edge.pm | 18 +++++++++++ lib/Graph/GEXF/Node.pm | 50 +++++++++++++++++++++++++++++ lib/Graph/GEXF/Role/Attributes.pm | 35 ++++++++++++++++++++ lib/Graph/GEXF/Role/XML.pm | 67 +++++++++++++++++++++++++++++++++++++++ 5 files changed, 184 insertions(+) create mode 100644 lib/Graph/GEXF/Attribute.pm create mode 100644 lib/Graph/GEXF/Edge.pm create mode 100644 lib/Graph/GEXF/Node.pm create mode 100644 lib/Graph/GEXF/Role/Attributes.pm create mode 100644 lib/Graph/GEXF/Role/XML.pm (limited to 'lib/Graph/GEXF') 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; -- cgit v1.2.3