summaryrefslogtreecommitdiff
path: root/lib/Graph/GEXF/Role
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/Graph/GEXF/Role/Attributes.pm39
-rw-r--r--lib/Graph/GEXF/Role/XML.pm46
2 files changed, 66 insertions, 19 deletions
diff --git a/lib/Graph/GEXF/Role/Attributes.pm b/lib/Graph/GEXF/Role/Attributes.pm
index 644793d..e03f5b1 100644
--- a/lib/Graph/GEXF/Role/Attributes.pm
+++ b/lib/Graph/GEXF/Role/Attributes.pm
@@ -7,12 +7,22 @@ parameter for => (
required => 1,
);
+parameter with_method => (
+ is => 'ro',
+ default => 0,
+);
+
role {
my $p = shift;
foreach my $type (@{$p->for}) {
- my $attr_name = $type . '_attributes';
+ 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'],
@@ -21,15 +31,30 @@ role {
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',
+ $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/XML.pm b/lib/Graph/GEXF/Role/XML.pm
index c157d45..b434746 100644
--- a/lib/Graph/GEXF/Role/XML.pm
+++ b/lib/Graph/GEXF/Role/XML.pm
@@ -4,10 +4,17 @@ use Moose::Role;
use XML::Simple;
-has gexf_ns =>
- (is => 'ro', isa => 'Str', default => 'http://www.gexf.net/1.1draft');
+has gexf_ns => (
+ is => 'ro',
+ isa => 'Str',
+ default => 'http://www.gexf.net/1.1draft'
+);
-has gexf_version => (is => 'ro', isa => 'Num', default => '1.1');
+has gexf_version => (
+ is => 'ro',
+ isa => 'Num',
+ default => '1.1'
+);
sub to_xml {
my $self = shift;
@@ -24,15 +31,8 @@ sub to_xml {
}
};
- 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},
- };
- }
+ $self->add_attributes($graph, 'node');
+ $self->add_attributes($graph, 'edge');
my $edges_id = 0;
@@ -64,4 +64,26 @@ sub to_xml {
$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;
+}
+
1;