summaryrefslogtreecommitdiff
path: root/lib/Graph/GEXF/Role
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Graph/GEXF/Role')
-rw-r--r--lib/Graph/GEXF/Role/Attributes.pm60
-rw-r--r--lib/Graph/GEXF/Role/Viz/Color.pm32
-rw-r--r--lib/Graph/GEXF/Role/Viz/Position.pm18
-rw-r--r--lib/Graph/GEXF/Role/Viz/Shape.pm39
-rw-r--r--lib/Graph/GEXF/Role/Viz/Size.pm21
-rw-r--r--lib/Graph/GEXF/Role/XML.pm168
6 files changed, 338 insertions, 0 deletions
diff --git a/lib/Graph/GEXF/Role/Attributes.pm b/lib/Graph/GEXF/Role/Attributes.pm
new file mode 100644
index 0000000..e03f5b1
--- /dev/null
+++ b/lib/Graph/GEXF/Role/Attributes.pm
@@ -0,0 +1,60 @@
+package Graph::GEXF::Role::Attributes;
+
+use MooseX::Role::Parameterized;
+
+parameter for => (
+ is => 'ro',
+ required => 1,
+);
+
+parameter with_method => (
+ is => 'ro',
+ default => 0,
+);
+
+role {
+ my $p = shift;
+
+ foreach my $type (@{$p->for}) {
+
+ my $attr_name = $type . '_attributes';
+ my $total_attr = 'attributes_' . $type . '_total';
+ my $set_attr = 'set_' . $type . '_attribute';
+ my $get_attr = 'get_' . $type . '_attribute';
+ my $list_attr = 'attributes_' . $type . '_list';
+ my $has_attr = 'has_' . $type . '_attribute';
+
+ has $attr_name => (
+ traits => ['Hash'],
+ is => 'rw',
+ isa => 'HashRef',
+ lazy => 1,
+ default => sub { {} },
+ handles => {
+ $total_attr => 'count',
+ $set_attr => 'set',
+ $get_attr => 'get',
+ $list_attr => 'keys',
+ $has_attr => 'exists',
+ }
+ );
+
+ if ($p->with_method) {
+ my $method_name = 'add_' . $type . '_attribute';
+
+ method $method_name => sub {
+ my ($self, $name, $type, $default_value) = @_;
+ my $id = $self->$total_attr();
+ my $attr = {
+ id => $id,
+ title => $name,
+ type => $type,
+ default => [$default_value],
+ };
+ $self->$set_attr($name => $attr);
+ };
+ }
+ }
+};
+
+1;
diff --git a/lib/Graph/GEXF/Role/Viz/Color.pm b/lib/Graph/GEXF/Role/Viz/Color.pm
new file mode 100644
index 0000000..d7c30f1
--- /dev/null
+++ b/lib/Graph/GEXF/Role/Viz/Color.pm
@@ -0,0 +1,32 @@
+package Graph::GEXF::Role::Viz::Color;
+
+use Moose::Role;
+use Moose::Util::TypeConstraints;
+
+subtype RGBColor => as 'Num' => where { $_ >= 0 && $_ <= 255 };
+subtype Alpha => as 'Num' => where { $_ > 0 and $_ <= 1 };
+
+my $_has_colors = 0;
+
+has [qw/r g b/] => (
+ is => 'rw',
+ isa => 'RGBColor',
+ default => 0,
+ trigger => sub {$_has_colors++},
+ traits => ['Chained'],
+);
+
+has a => (
+ is => 'rw',
+ isa => 'Alpha',
+ default => 1,
+ traits => ['Chained'],
+);
+
+sub has_colors { $_has_colors }
+
+no Moose::Util::TypeConstraints;
+no Moose::Role;
+
+
+1;
diff --git a/lib/Graph/GEXF/Role/Viz/Position.pm b/lib/Graph/GEXF/Role/Viz/Position.pm
new file mode 100644
index 0000000..c9e79c3
--- /dev/null
+++ b/lib/Graph/GEXF/Role/Viz/Position.pm
@@ -0,0 +1,18 @@
+package Graph::GEXF::Role::Viz::Position;
+
+use Moose::Role;
+
+my $_has_position = 0;
+
+has [qw/x y z/] => (
+ is => 'rw',
+ isa => 'Num',
+ trigger => sub { $_has_position++ },
+ traits => ['Chained'],
+);
+
+sub has_position { $_has_position }
+
+no Moose::Role;
+
+1;
diff --git a/lib/Graph/GEXF/Role/Viz/Shape.pm b/lib/Graph/GEXF/Role/Viz/Shape.pm
new file mode 100644
index 0000000..b092d6d
--- /dev/null
+++ b/lib/Graph/GEXF/Role/Viz/Shape.pm
@@ -0,0 +1,39 @@
+package Graph::GEXF::Role::Viz::Shape;
+
+use Moose::Util::TypeConstraints;
+use MooseX::Role::Parameterized;
+
+enum EdgeShape => qw(solid doted dashed double);
+enum NodeShape => qw(disc square triangle diamond);
+
+parameter for => (
+ is => 'ro',
+ required => 1,
+);
+
+role {
+ my $p = shift;
+
+ my ( $type, $default );
+
+ $type = ucfirst( $p->for ) . 'Shape';
+
+ if ( $p->for eq 'node' ) {
+ $default = 'disc';
+ }
+ else {
+ $default = 'solid';
+ }
+
+ has shape => (
+ is => 'rw',
+ isa => $type,
+ default => $default,
+ traits => ['Chained'],
+ );
+};
+
+no Moose::Util::TypeConstraints;
+
+1;
+
diff --git a/lib/Graph/GEXF/Role/Viz/Size.pm b/lib/Graph/GEXF/Role/Viz/Size.pm
new file mode 100644
index 0000000..aef1574
--- /dev/null
+++ b/lib/Graph/GEXF/Role/Viz/Size.pm
@@ -0,0 +1,21 @@
+package Graph::GEXF::Role::Viz::Size;
+
+use MooseX::Role::Parameterized;
+
+parameter as => (
+ is => 'ro',
+ required => 1,
+);
+
+role {
+ my $p = shift;
+
+ has $p->as => (
+ is => 'rw',
+ isa => 'Num',
+ default => '1.0',
+ traits => ['Chained'],
+ );
+};
+
+1;
diff --git a/lib/Graph/GEXF/Role/XML.pm b/lib/Graph/GEXF/Role/XML.pm
new file mode 100644
index 0000000..cf12170
--- /dev/null
+++ b/lib/Graph/GEXF/Role/XML.pm
@@ -0,0 +1,168 @@
+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;
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-06 08:26:08 +0000