File Coverage

blib/lib/Array/Assign.pm

Criterion	Covered	Total	%
statement	48	52	92.3
branch	5	10	50.0
condition			n/a
subroutine	13	13	100.0
pod	9	9	100.0
total	75	84	89.2

package Array::Assign;
use strict;
use warnings;
use base qw(Exporter);
our @EXPORT = qw(
    arry_assign_i arry_assign_s
    arry_extract_i arry_extract_s
);

our $IDX_MAX = 1000;
our $VERSION = 0.01;

sub new {
    my ($cls,$idx_map) = @_;
    my $self = {};
    if(ref $idx_map eq 'HASH') {
        %$self = %$idx_map;
    } else {
        my @idx_arry;
        if(ref $idx_map eq 'ARRAY') {
            @idx_arry = @$idx_map;
        } else {
            @idx_arry = @_[1..$#_];
        }
        @{$self}{@idx_arry} = (0..$#idx_arry);
    }
    bless $self, $cls;
    return $self;
}

sub assign_s {
    my ($self,$target,%fields) = @_;
    &arry_assign_s($target, $self, %fields);
}

sub assign_i {
    shift;
    goto &arry_assign_i;
}

sub extract_s {
    my ($self,$source,%fields) = @_;
    &arry_extract_s($source, $self, %fields);
}

sub extract_i {
    shift;
    goto &arry_extract_i;
}


sub arry_assign_s(\@$%) {
    my ($target,$mapping,%assignments) = @_;
    while (my ($name,$value) = each %assignments) {
        my $idx = $mapping->{$name};
        die("Unknown name '$name'") unless defined $idx;
        $target->[$idx] = $value;
    }
    $target;
}

sub arry_assign_i(\@%)
{
    my ($target,%mappings) = @_;
    _idx_sanity_check(%mappings);

    @{$target}[keys %mappings] = values %mappings;
}


sub arry_extract_i(\@%)
{
    my ($source,%targets) = @_;
    _idx_sanity_check(%targets);
    while ( my ($idx,$ref) = each %targets) {
        $$ref = $source->[$idx];
    }
}

sub arry_extract_s(\@$%) {
    my ($source,$mappings,%targets) = @_;
    while (my ($name,$ref) = each %targets) {
        my $idx = $mappings->{$name};
        if(!defined $idx) {
            die("unknown parameter '$name'");
        }
        $$ref = $source->[$idx];
    }
}

sub _idx_sanity_check {
    my %mappings = @_;
    if(scalar (grep $_ > $IDX_MAX, keys %mappings) > 0) {
        die("Abnormally large index found. ".
            "Bump up \$IDX_MAX if this is not a mistake");
    }
}

__END__