view release on metacpan or  search on metacpan

lib/Mojo/DB/Results/Role/MoreMethods.pm  view on Meta::CPAN

        my $index = $indexes[0] // 0;
        $self->_assert_indexes($index);

        return $array->[$index];
    }
}

sub get_by_name {
    my $self = shift;

    my $options = ref $_[0] eq 'HASH' ? shift : {};
    my @names = @_;
    Carp::croak 'names required' unless @names;

    return $self->get($options, $self->_find_column_indexes(@names));
}

sub c {
    return shift->get(@_) if not defined wantarray;

    my @values = shift->get(@_);
    return @values ? Mojo::Collection->new(@values) : undef;
}

sub c_by_name {
    return shift->get_by_name(@_) if not defined wantarray;

    my @values = shift->get_by_name(@_);
    return @values ? Mojo::Collection->new(@values) : undef;
}

sub collections { Mojo::Collection->new(map { Mojo::Collection->new(@$_) } @{ shift->arrays }) }

sub flatten { shift->arrays->flatten }

sub hashify {
    my $self = shift;
    my ($collection, $get_keys, $get_value) = $self->_parse_transform_options({}, @_);

    return $collection->with_roles('+Transform')->hashify($get_keys, $get_value);
}

sub hashify_collect {
    my ($collection, $get_keys, $get_value, $flatten) = shift->_parse_transform_options({flatten_allowed => 1}, @_);

    return $collection->with_roles('+Transform')->hashify_collect({flatten => $flatten}, $get_keys, $get_value);
}

sub collect_by {
    my ($collection, $get_keys, $get_value, $flatten) = shift->_parse_transform_options({flatten_allowed => 1}, @_);

    return $collection->with_roles('+Transform')->collect_by({flatten => $flatten}, $get_keys, $get_value);
}

sub _parse_transform_options {
    my $self = shift;
    my $private_options = shift;
    my $options = ref $_[0] eq 'HASH' ? shift : {};

    my ($key, $key_ref)                       = _parse_and_validate_transform_key(shift);
    my ($value, $value_is_column, $value_ref) = _parse_and_validate_transform_value(@_);

    my ($type, $flatten) = _parse_and_validate_transform_options($private_options, $options);

    # if user will not access the rows and the type won't be used, default rows to arrays for speed
    if (($value_is_column or $flatten) and $key_ref ne 'CODE' and $value_ref ne 'CODE') {
        if ($type and $type ne 'array') {
            Carp::cluck 'Useless type option provided. array will be used for performance.';
        }
        $type = 'array';
    } elsif (not $type) {
        $type = 'hash';
    }

    my $get_keys   = $key_ref eq 'CODE'   ? $key : $self->_create_get_keys_sub($type, $key);
    my $get_value  = $value_ref eq 'CODE' ? $value
                   : $value_is_column     ? $self->_create_column_value_getter($type, $value)
                   : $flatten             ? $self->_create_flatten_value_getter($type)
                   : sub { $_ }
                   ;
    my $collection = $type eq 'array' ? $self->arrays
                   : $type eq 'c'     ? $self->collections
                   : $type eq 'hash'  ? $self->hashes
                   : $self->structs
                   ;

    return $collection, $get_keys, $get_value, $flatten;
}

sub _parse_and_validate_transform_key {
    my ($key) = @_;

    my $key_ref = ref $key;
    if ($key_ref) {
        Carp::confess qq{key must be an arrayref, a sub or a non-empty string, but had ref '$key_ref'}
            unless $key_ref eq 'ARRAY' or $key_ref eq 'CODE';

        if ($key_ref eq 'ARRAY') {
            Carp::confess 'key array must not be empty' unless @$key;
            Carp::confess 'key array elements must be defined and non-empty' if grep { not defined or $_ eq '' } @$key;
        }
    } else {
        Carp::confess 'key was undefined or an empty string' unless defined $key and $key ne '';
        $key = [$key];
    }

    return $key, $key_ref;
}

sub _parse_and_validate_transform_value {
    my ($value, $value_is_column);

    my $value_ref;
    if (@_ == 1) {
        $value = shift;

        $value_ref = ref $value;
        if ($value_ref) {
            Carp::confess qq{value must be a sub or non-empty string, but was '$value_ref'} unless $value_ref eq 'CODE';
        } elsif (not defined $value or $value eq '') {
            Carp::confess 'value must not be undefined or an empty string';
        } else {
            $value_is_column = 1;
        }
    } elsif (@_ > 1) {
        Carp::confess 'too many arguments provided (more than one value)';
    }

    return $value, $value_is_column, $value_ref // '';
}

sub _parse_and_validate_transform_options {
    my ($private_options, $options) = @_;

    my $flatten;
    if ($private_options->{flatten_allowed}) {
        $flatten = delete $options->{flatten};
    } else {
        Carp::confess 'flatten not allowed' if exists $options->{flatten};
    }

    my $flatten_allowed_text = $private_options->{flatten_allowed} ? 'In addition to flatten, ' : '';
    Carp::confess "${flatten_allowed_text}one key/value pair is allowed for options"
        if keys %$options > 1;

    my $type;
    if (%$options) {
        ($type) = keys %$options;

        my @valid_types = qw(array c hash struct);
        Carp::confess "${flatten_allowed_text}option must be one of: @{[ join ', ', @valid_types ]}"
            unless grep { $type eq $_ } @valid_types;
    }

    return $type, $flatten;
}

sub _create_get_keys_sub {
    my ($self, $type, $key) = @_;

    if ($type eq 'array' or $type eq 'c') {
        my @key_indexes = $self->_find_column_indexes(@$key);
        return sub { @{$_}[@key_indexes] };
    } elsif ($type eq 'hash') {
        # assert columns exist
        $self->_find_column_indexes(@$key);

        return sub { @{$_}{@$key} };
    } else {
        # assert columns exist
        $self->_find_column_indexes(@$key);

        return sub {
            map { $_[0]->${\$_} } @$key
        };
    }
}

sub _create_column_value_getter {
    my ($self, $type, $value) = @_;

    if ($type eq 'array' or $type eq 'c') {
        my $column_index = $self->_find_column_indexes($value);
        return sub { $_->[$column_index] };
    } elsif ($type eq 'hash') {
        # assert that column exists
        $self->_find_column_indexes($value);

        return sub { $_->{$value} };
    } else {
        # assert that column exists
        $self->_find_column_indexes($value);