File Coverage

blib/lib/Class/ExtraAttributes.pm

Criterion	Covered	Total	%
statement	27	27	100.0
branch	12	12	100.0
condition	2	2	100.0
subroutine	7	7	100.0
pod	1	1	100.0
total	49	49	100.0

package Class::ExtraAttributes;

# version
$VERSION= '1.00';

# be as strict and verbose as possible
use strict;
use warnings;

# modules that we need
use OOB qw( OOB_get OOB_set );

# additionals attributes per class
my %attributes;

# satisfy -require-
1;

#-------------------------------------------------------------------------------
#
# Class Methods
#
#-------------------------------------------------------------------------------
# attributes
#
# Return the extra attributes for the given class
#
#  IN: 1 Class::ExtraAttributes (ignored)
#      2 class to return extra attributes of (optional)
# OUT: 1 list (or list ref) with extra attributes

sub attributes {
    # fetch attributes
    my @attributes= keys %{ $attributes{ $_[1] ? $_[1] : caller() } || {} };

    return wantarray ? @attributes : \@attributes;
}    #attributes

#-------------------------------------------------------------------------------
#
# Standard Perl features
#
#-------------------------------------------------------------------------------
# import
#
# Export any constants requested
#
#  IN: 1 class (ignored)
#      2..N attributes to be defined

sub import {
    my $class= shift;

    # nothing to export
    return if !@_;

    # determine namespace to export to
    my $namespace=  caller();
    my $attributes= $attributes{$namespace} ||= {};

    # create accessor / mutator for given attributes
    no strict 'refs';
    foreach my $method ( grep { !exists $attributes->{$_} } @_ ) {

        # make sure we don't cloak anything
        die "Can already do '$method' on class $namespace"
          if $namespace->can($method);

        # install accessor / mutator
        $attributes->{$method}= undef;
        *{ $namespace . '::' . $method }= sub {
            return @_ == 2
             ? OOB_set( $_[0], $method => $_[1], $namespace )
             : OOB_get( $_[0], $method, $namespace );
        };
    }

    return;
}    #import

#-------------------------------------------------------------------------------

__END__