File Coverage

blib/lib/Data/Focus/Lens/HashArray/Index.pm

Criterion	Covered	Total	%
statement	69	70	98.5
branch	26	30	86.6
condition			n/a
subroutine	8	8	100.0
pod	1	1	100.0
total	104	109	95.4

package Data::Focus::Lens::HashArray::Index;
use strict;
use warnings;
use parent qw(Data::Focus::Lens);
use Data::Focus::LensMaker ();
use Carp;

our @CARP_NOT = qw(Data::Focus::Lens Data::Focus);

sub new {
    my ($class, %args) = @_;
    my $indices = [];
    if(exists($args{index})) {
        if(ref($args{index}) eq "ARRAY") {
            $indices = $args{index};
        }else {
            $indices = [$args{index}];
        }
    }
    croak "index must be mandatory" if !@$indices;
    croak "index must be defined" if grep { !defined($_) } @$indices;
    my $self = bless {
        indices => $indices,
        immutable => $args{immutable},
    }, $class;
    return $self;
}

sub _getter {
    my ($self, $whole) = @_;
    my $type = ref($whole);
    if(!defined($whole)) {
        ## slots for autovivification
        return map { undef } @{$self->{indices}};
    }elsif($type eq "ARRAY") {
        my @indices = map { int($_) } @{$self->{indices}};
        return @{$whole}[@indices];
    }elsif($type eq "HASH") {
        return @{$whole}{@{$self->{indices}}};
    }else {
        ## no slot. cannot set.
        return ();
    }
}

sub _setter {
    my ($self, $whole, @parts) = @_;
    return $whole if !@parts;
    if(!defined($whole)) {
        ## autovivifying
        if(grep { $_ !~ /^\d+$/ } @{$self->{indices}}) {
            return +{ map { $self->{indices}[$_] => $parts[$_] } 0 .. $#{$self->{indices}} };
        }else {
            my $ret = [];
            $ret->[$self->{indices}[$_]] = $parts[$_] foreach 0 .. $#{$self->{indices}};
            return $ret;
        }
    }
    my $type = ref($whole);
    if($type eq "ARRAY") {
        my @indices = map { int($_) } @{$self->{indices}};
        my $ret = $self->{immutable} ? [@$whole] : $whole;
        foreach my $i (0 .. $#indices) {
            my $index = $indices[$i];
            croak "$index: negative out-of-range index" if $index < -(@$ret);
            $ret->[$index] = $parts[$i];
        }
        return $ret;
    }elsif($type eq "HASH") {
        my $ret = $self->{immutable} ? {%$whole} : $whole;
        $ret->{$self->{indices}[$_]} = $parts[$_] foreach 0 .. $#{$self->{indices}};
        return $ret;
    }else {
        confess "This should not be executed because the getter should return an empty list.";
    }
}

Data::Focus::LensMaker::make_lens_from_accessors(\&_getter, \&_setter);

1;

__END__