diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/Graph/GEXF/Role/Attributes.pm | 39 | ||||
| -rw-r--r-- | lib/Graph/GEXF/Role/XML.pm | 46 |
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; |
