diff options
Diffstat (limited to 'perllib/Graph/Attribute.pm')
-rw-r--r-- | perllib/Graph/Attribute.pm | 130 |
1 files changed, 0 insertions, 130 deletions
diff --git a/perllib/Graph/Attribute.pm b/perllib/Graph/Attribute.pm deleted file mode 100644 index 54fa29a3..00000000 --- a/perllib/Graph/Attribute.pm +++ /dev/null @@ -1,130 +0,0 @@ -package Graph::Attribute; - -use strict; - -sub _F () { 0 } -sub _COMPAT02 () { 0x00000001 } - -sub import { - my $package = shift; - my %attr = @_; - my $caller = caller(0); - if (exists $attr{array}) { - my $i = $attr{array}; - no strict 'refs'; - *{"${caller}::_get_attributes"} = sub { $_[0]->[ $i ] }; - *{"${caller}::_set_attributes"} = - sub { $_[0]->[ $i ] ||= { }; - $_[0]->[ $i ] = $_[1] if @_ == 2; - $_[0]->[ $i ] }; - *{"${caller}::_has_attributes"} = sub { defined $_[0]->[ $i ] }; - *{"${caller}::_delete_attributes"} = sub { undef $_[0]->[ $i ]; 1 }; - } elsif (exists $attr{hash}) { - my $k = $attr{hash}; - no strict 'refs'; - *{"${caller}::_get_attributes"} = sub { $_[0]->{ $k } }; - *{"${caller}::_set_attributes"} = - sub { $_[0]->{ $k } ||= { }; - $_[0]->{ $k } = $_[1] if @_ == 2; - $_[0]->{ $k } }; - *{"${caller}::_has_attributes"} = sub { defined $_[0]->{ $k } }; - *{"${caller}::_delete_attributes"} = sub { delete $_[0]->{ $k } }; - } else { - die "Graph::Attribute::import($package @_) caller $caller\n"; - } - my @api = qw(get_attribute - get_attributes - set_attribute - set_attributes - has_attribute - has_attributes - delete_attribute - delete_attributes - get_attribute_names - get_attribute_values); - if (exists $attr{map}) { - my $map = $attr{map}; - for my $api (@api) { - my ($first, $rest) = ($api =~ /^(\w+?)_(.+)/); - no strict 'refs'; - *{"${caller}::${first}_${map}_${rest}"} = \&$api; - } - } -} - -sub set_attribute { - my $g = shift; - my $v = pop; - my $a = pop; - my $p = $g->_set_attributes; - $p->{ $a } = $v; - return 1; -} - -sub set_attributes { - my $g = shift; - my $a = pop; - my $p = $g->_set_attributes( $a ); - return 1; -} - -sub has_attribute { - my $g = shift; - my $a = pop; - my $p = $g->_get_attributes; - $p ? exists $p->{ $a } : 0; -} - -sub has_attributes { - my $g = shift; - $g->_get_attributes ? 1 : 0; -} - -sub get_attribute { - my $g = shift; - my $a = pop; - my $p = $g->_get_attributes; - $p ? $p->{ $a } : undef; -} - -sub delete_attribute { - my $g = shift; - my $a = pop; - my $p = $g->_get_attributes; - if (defined $p) { - delete $p->{ $a }; - return 1; - } else { - return 0; - } -} - -sub delete_attributes { - my $g = shift; - if ($g->_has_attributes) { - $g->_delete_attributes; - return 1; - } else { - return 0; - } -} - -sub get_attribute_names { - my $g = shift; - my $p = $g->_get_attributes; - defined $p ? keys %{ $p } : ( ); -} - -sub get_attribute_values { - my $g = shift; - my $p = $g->_get_attributes; - defined $p ? values %{ $p } : ( ); -} - -sub get_attributes { - my $g = shift; - my $a = $g->_get_attributes; - ($g->[ _F ] & _COMPAT02) ? (defined $a ? %{ $a } : ()) : $a; -} - -1; |