File Coverage

blib/lib/Class/Accessor/Array/Glob.pm

Criterion	Covered	Total	%
statement	62	68	91.1
branch	18	36	50.0
condition	8	10	80.0
subroutine	7	7	100.0
pod			n/a
total	95	121	78.5

package Class::Accessor::Array::Glob;

our $DATE = '2016-03-29'; # DATE
our $VERSION = '0.01'; # VERSION

use 5.010001;
use strict 'subs', 'vars';
use warnings;

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

    no warnings 'redefine';

    my $max_idx;
    for (values %{$spec->{accessors}}) {
        $max_idx = $_ if !defined($max_idx) || $max_idx < $_;
    }

    my $glob_attribute = $spec->{glob_attribute};

    # generate accessors
    for my $meth (keys %{$spec->{accessors}}) {
        my $idx = $spec->{accessors}{$meth};
        my $is = 'rw';
        my $code_str = $is eq 'rw' ? 'sub (;$) { ' : 'sub () { ';
        if (defined($glob_attribute) && $glob_attribute eq $meth) {
            die "Glob attribute must be put at the last index"
                unless $idx == $max_idx;
            $code_str .= "splice(\@{\$_[0]}, $idx, scalar(\@{\$_[0]}), \@{\$_[1]}) if \@_ > 1; "
                if $is eq 'rw';
            $code_str .= "[ \@{\$_[0]}[$idx .. \$#{\$_[0]}] ]; ";
        } else {
            $code_str .= "\$_[0][$idx] = \$_[1] if \@_ > 1; "
                if $is eq 'rw';
            $code_str .= "\$_[0][$idx]; ";
        }
        $code_str .= "}";
        #say "D:accessor code for $meth: ", $code_str;
        *{"$caller\::$meth"} = eval $code_str;
        die if $@;
    }

    # generate constructor
    {
        my $n = ($max_idx // 0) + 1; $n-- if defined $glob_attribute;
        my $code_str = 'sub { my $class = shift; bless [(undef) x '.$n.'], $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 (supports globbing attribute)

__END__