diff options
-rw-r--r-- | lib/Graph/GEXF.pm | 18 | ||||
-rw-r--r-- | lib/Graph/GEXF/Role/Attributes.pm | 39 | ||||
-rw-r--r-- | lib/Graph/GEXF/Role/XML.pm | 46 | ||||
-rw-r--r-- | t/06-data.t | 2 |
4 files changed, 70 insertions, 35 deletions
diff --git a/lib/Graph/GEXF.pm b/lib/Graph/GEXF.pm index 83716c5..be65219 100644 --- a/lib/Graph/GEXF.pm +++ b/lib/Graph/GEXF.pm @@ -11,7 +11,7 @@ use Graph::GEXF::Node; with 'Graph::GEXF::Role::XML', - 'Graph::GEXF::Role::Attributes' => {for => [qw/node edge/]}; + 'Graph::GEXF::Role::Attributes' => {for => [qw/node edge/], with_method => 1}; has graph_mode => ( is => 'ro', @@ -42,18 +42,6 @@ has nodes => ( }, ); -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) = @_; @@ -73,7 +61,7 @@ sub add_node { $_ => { id => $attribute->{id}, name => $attribute->{name}, - type => $attribute->{type} + type => $attribute->{type}, } ); } $self->attributes_node_list; @@ -135,7 +123,7 @@ could be B<directed>, B<undirected>, B<mutual> or B<notset>. Default is B<direct =over 4 -=item add_node_attribute($name, $type) +=item add_node_attribute($name, $type, [$default_value]) Add attributes to node 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; diff --git a/t/06-data.t b/t/06-data.t index f9f2ea2..5df0bb9 100644 --- a/t/06-data.t +++ b/t/06-data.t @@ -5,7 +5,7 @@ use Test::More; use Graph::GEXF; my $graph = Graph::GEXF->new(); -$graph->add_node_attribute('url', 'string'); +$graph->add_node_attribute('url', 'string', 'http://'); $graph->add_node_attribute('indegree', 'float'); $graph->add_node_attribute('frog', 'boolean'); |