File Coverage

blib/lib/Mojo/Collection/Role/Transform.pm

Criterion	Covered	Total	%
statement	68	68	100.0
branch	26	26	100.0
condition	16	18	88.8
subroutine	16	16	100.0
pod	3	3	100.0
total	129	131	98.4

package Mojo::Collection::Role::Transform;
use Mojo::Base -role;
use Carp ();

our $VERSION = '0.01';

requires 'reduce';

sub hashify { _reduce(shift, \&_multi_key_hash_assign, {}, @_) }

sub hashify_collect {
    my $self = shift;

    if (ref $_[0] eq 'HASH' and _parse_flatten_option(shift)) {
        return _reduce($self, \&_multi_key_hash_collect_and_flatten, {}, @_)
    }

    return _reduce($self, \&_multi_key_hash_collect, {}, @_);
}

sub collect_by {
    my $self = shift;

    if (ref $_[0] eq 'HASH' and _parse_flatten_option(shift)) {
        return _reduce($self, \&_collect_by_and_flatten, [Mojo::Collection->new, {}], @_)->[0];
    }

    return _reduce($self, \&_collect_by, [Mojo::Collection->new, {}], @_)->[0];
}

sub _multi_key_hash_assign {
    my ($hash, $keys, $value, @extra_values) = @_;
    Carp::confess 'multiple values returned from get_value sub when one is expected' if @extra_values;

    _create_leading_key_hashes($hash, $keys)->{$keys->[-1]} = $value;
}

sub _multi_key_hash_collect {
    my ($hash, $keys, @values) = @_;

    push @{ _create_leading_key_hashes($hash, $keys)->{$keys->[-1]} ||= Mojo::Collection->new }, @values;
}

sub _multi_key_hash_collect_and_flatten {
    my ($hash, $keys, @values) = @_;

    push
        @{ _create_leading_key_hashes($hash, $keys)->{$keys->[-1]} ||= Mojo::Collection->new },
        _flatten(@values);
}

sub _collect_by {
    my ($collection, $hash, $keys, @values) = (@{+shift}, @_);

    my $leading_hash = _create_leading_key_hashes($hash, $keys);
    unless (exists $leading_hash->{$keys->[-1]}) {
        push @$collection, $leading_hash->{$keys->[-1]} = Mojo::Collection->new;
    }

    push @{ $leading_hash->{$keys->[-1]} }, @values;
}

sub _collect_by_and_flatten {
    my ($collection, $hash, $keys, @values) = (@{+shift}, @_);

    my $leading_hash = _create_leading_key_hashes($hash, $keys);
    unless (exists $leading_hash->{$keys->[-1]}) {
        push @$collection, $leading_hash->{$keys->[-1]} = Mojo::Collection->new;
    }

    push @{ $leading_hash->{$keys->[-1]} }, _flatten(@values);
}

sub _create_leading_key_hashes {
    my ($hash, $keys) = @_;

    my $cur_hash = $hash;
    for my $key (@$keys[0..$#$keys - 1]) {
        $cur_hash = $hash->{$key} ||= {};
    }

    return $cur_hash;
}

sub _reduce {
    my ($self, $apply_key_and_value, $initial) = (shift, shift, shift);

    unless (@_) {
        Carp::croak 'must provide get_keys sub';
    }

    my $get_keys = shift;
    my $get_keys_ref = ref $get_keys || 'scalar value';
    Carp::croak qq{get_keys sub must be a subroutine, but was '$get_keys_ref'} unless $get_keys_ref eq 'CODE';

    my $get_value;
    if (@_) {
        $get_value = shift;
        my $get_value_ref = ref $get_value || 'scalar value';
        Carp::croak qq{get_value must be a subroutine if provided, but was '$get_value_ref'} if $get_value_ref ne 'CODE';
    } else {
        $get_value = sub { $_ };
    }

    return $self->reduce(sub {
        local $_ = $b;
        $apply_key_and_value->($a, [$get_keys->($b)], $get_value->($b));

        $a;
    }, $initial);
}

sub _flatten { map { ref($_) ? _flatten(@$_) : $_ } @_ }

sub _parse_flatten_option {
    my ($options) = @_;
    return unless %$options;

    Carp::confess 'only one option can be provided' if keys %$options > 1;

    my $flatten = delete $options->{flatten};

    Carp::confess 'unknown options provided: ' . Mojo::Util::dumper $options if %$options;

    return $flatten;
}

1;
__END__