File Coverage

blib/lib/Hash/Convert.pm

Criterion	Covered	Total	%
statement	106	109	97.2
branch	40	44	90.9
condition	13	18	72.2
subroutine	18	18	100.0
pod	5	7	71.4
total	182	196	92.8

package Hash::Convert;
use 5.008005;
use strict;
use warnings;

use Carp qw(croak);

our $VERSION = "0.04";

my $allow_combine = [
    [qw/from/],
    [qw/from default/],

    [qw/from via/],
    [qw/from via default/],

    [qw/contain/],
    [qw/contain default/],

    [qw/define/],
];

sub new {
    my ($class, $rules, $opts) = @_;

    my $self = bless {
        rules         => $rules,
    }, $class;

    $self->_prepare($rules, $opts);

    $self;
}

sub _validate_cmd {
    my ($self, $cmd_map) = @_;

    for my $combine (@{$allow_combine}) {
        my $valid = [grep { $cmd_map->{$_} } @$combine];

        if ( scalar @$valid == scalar keys %$cmd_map ) {
            return 1;
        }
    }
    return 0;
}

sub _prepare_opts {
    my ($self, $rules, $opts) = @_;

    if (my $pass = $opts->{pass}) {
        $pass = [$pass] unless (ref $pass);
        for my $name (@$pass) {
            $rules->{$name} = { from => $name };
        }
    }
}

sub _prepare {
    my ($self, $rules, $opts) = @_;

    $self->_prepare_opts($rules, $opts);

    for my $name (sort keys %$rules) {
        my $rule = $rules->{$name};
        my %cmds = map { $_ => 1 } keys %{$rule};

        unless ($self->_validate_cmd(\%cmds)) {
            croak sprintf "%s rules invalid combinations (%s)", $name, join(',', sort keys %cmds);
        }
        if ($cmds{from} && not $cmds{via}) {
            if ( (ref $rule->{from} eq 'ARRAY') && (scalar @{$rule->{from}} != 1) ) {
                croak sprintf "multiple value allowed only 'via' rule. ( from => [%s] )", join(', ', map { "'$_'" } @{$rule->{from}} );
            }
        }

        if ($cmds{contain}) {
            $self->_prepare($rule->{contain});
        }
        else {
            $rule->{from} = [$rule->{from}] if ($rule->{from} && ref $rule->{from} ne 'ARRAY');
        }
    }

}

sub convert {
    my ($self, @before) = @_;

    if (@before && scalar @before == 1 && ref $before[0] eq 'HASH') {
        my $after = $self->_process($self->{rules}, $before[0]);
        return $after;
    }
    elsif (@before && scalar @before % 2 == 0) {
        my %hash  = @before;
        my $after =  $self->_process($self->{rules}, \%hash);
        return %{$after};
    }
    else {
        croak 'convert require HASH or HASH ref'
    }
}

sub _process {
    my ($self, $rules, $before) = @_;

    my %after;
    for my $name (sort keys %$rules) {
        my $rule = $rules->{$name};

        if (exists $rule->{via}) {
            $self->via($name, $rule, $before, \%after);
        }
        elsif (exists $rule->{from}) {
            $self->from($name, $rule, $before, \%after);
        }
        elsif (exists $rule->{contain}) {
            $self->contain($name, $rule, $before, \%after);
        }
        elsif (exists $rule->{define}) {
            $self->define($name, $rule, $before, \%after);
        }
        else {
            # not do this
        }
    }
    return \%after;
}

sub _is_all_exists {
    my ($self, $before, $names) = @_;

    my $exists_size = grep { $self->_resolve_exists($before, $_) } @$names;
    if ($exists_size == scalar @$names) {
        return 1;
    }
    return 0;
}

sub from {
    my ($self, $name, $rule, $before, $after) = @_;

    if ($self->_is_all_exists($before, $rule->{from})) {
        $after->{$name} = $self->_resolve_value($before, $rule->{from}->[0]);
    } elsif (exists $rule->{default}) {
        $after->{$name} = $self->default($rule->{default});
    }
}

sub via {
    my ($self, $name, $rule, $before, $after) = @_;

    if ($self->_is_all_exists($before, $rule->{from})) {
        my @args = map { $self->_resolve_value($before, $_) } @{$rule->{from}};
        $after->{$name} = $rule->{via}->(@args);
    } elsif (exists $rule->{default}) {
        $after->{$name} = $self->default($rule->{default});
    }
}

sub define {
    my ($self, $name, $rule, $before, $after) = @_;
    $after->{$name} = $rule->{define};
}

sub contain {
    my ($self, $name, $rule, $before, $after) = @_;

    my $value = $self->_process($rule->{contain}, $before);
    if (not %$value) {
        if (exists $rule->{default}) {
            $after->{$name} = $self->default($rule->{default});
        }
        else {
            # nop
        }
    }
    else {
        $after->{$name} = $value;
    }
}

sub default {
    my ($self, $default) = @_;

    if (ref $default eq 'CODE') {
        return $default->();
    }
    return $default;
}

sub _resolve_value {
    my ($self, $before, $name) = @_;

    my @struct = split /\./, $name;
    my $value = $before;
    for my $point (@struct) {
        $value = $value->{$point};
    }
    return $value;
}

sub _resolve_exists {
    my ($self, $before, $name) = @_;

    my $is_exists = 0;
    my @struct = split /\./, $name;
    my $value = $before;
    for my $point (@struct) {
        $is_exists = exists $value->{$point};
        $value = $value->{$point};
    }
    return $is_exists;
}

1;
__END__