File Coverage

blib/lib/Class/Accessor/Array.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch	7	14	50.0
condition	2	2	100.0
subroutine	4	4	100.0
pod			n/a
total	48	55	87.2

package Class::Accessor::Array;

our $DATE = '2016-03-28'; # DATE
our $VERSION = '0.02'; # VERSION

sub import {
    my ($class0, $spec) = @_;
    my $caller = caller();

    no warnings 'redefine';

    # generate accessors
    for my $meth (keys %{$spec->{accessors}}) {
        my $idx = $spec->{accessors}{$meth};
        my $code_str = 'sub (;$) { ';
        $code_str .= "\$_[0][$idx] = \$_[1] if \@_ > 1; ";
        $code_str .= "\$_[0][$idx]; ";
        $code_str .= "}";
        #say "D:accessor code for $meth: ", $code_str;
        *{"$caller\::$meth"} = eval $code_str;
        die if $@;
    }

    # generate constructor
    {
        my $code_str = 'sub { my $class = shift; bless [], $class }';

        #say "D:constructor code for class $caller: ", $code_str;
        my $constructor = $spec->{constructor} || "new";
        unless (*{"$caller\::$constructor"}{CODE}) {
            *{"$caller\::$constructor"} = eval $code_str;
            die if $@;
        };
    };
}

1;
# ABSTRACT: Generate accessors/constructor for array-based object

__END__