File Coverage

blib/lib/Mojo/DB/Results/Role/MoreMethods.pm

Criterion	Covered	Total	%
statement	9	245	3.6
branch	0	168	0.0
condition	0	73	0.0
subroutine	3	49	6.1
pod	23	23	100.0
total	35	558	6.2

package Mojo::DB::Results::Role::MoreMethods;
use Mojo::Base -role;
use Mojo::Collection;
use Mojo::Util ();

with 'Mojo::DB::Results::Role::Struct';

our $VERSION = '0.03';

requires qw(array arrays columns hash hashes);

sub import {
    my $class = shift;

    my (@mysql_indexes) = grep { ($_[$_] // '') eq '-mysql' } 0..$#_;
    Carp::croak '-mysql flag provided more than once' if @mysql_indexes > 1;

    my $mysql_flag;
    if (@mysql_indexes) {
        splice @_, $mysql_indexes[0], 1;
        $mysql_flag = 1;
    }

    my (@pg_indexes) = grep { ($_[$_] // '') eq '-Pg' } 0..$#_;
    Carp::croak '-Pg flag provided more than once' if @pg_indexes > 1;

    my $pg_flag;
    if (@pg_indexes) {
        splice @_, $pg_indexes[0], 1;
        $pg_flag = 1;
    }

    my %options = @_;
    return unless %options or $mysql_flag or $pg_flag;

    my $results_class;
    if (exists $options{results_class}) {
        $results_class = delete $options{results_class};
        Carp::croak 'results_class must be a defined and non-empty value' unless defined $results_class and $results_class ne '';

        my $ref = ref $results_class;
        Carp::croak 'results_class must be a string or an arrayref' unless $ref eq '' or $ref eq 'ARRAY';

        if ($ref and $ref eq 'ARRAY') {
            Carp::croak 'results_class array cannot be empty' unless @$results_class;
            Carp::croak 'results_class array entries must be non-empty strings'
                unless scalar(grep { defined and not ref $_ and $_ ne '' } @$results_class) == @$results_class
        } else {
            $results_class = [$results_class];
        }
    }

    Carp::croak 'unknown options provided to import: ' . Mojo::Util::dumper \%options if %options;

    if ($mysql_flag or $pg_flag) {
        $results_class ||= [];
        if ($mysql_flag) {
            if (grep { $_ eq 'Mojo::mysql::Results' } @$results_class) {
                Carp::croak 'cannot provide -mysql flag and provide Mojo::mysql::Results in result_class';
            }

            push @$results_class, 'Mojo::mysql::Results';
        }

        if ($pg_flag) {
            if (grep { $_ eq 'Mojo::Pg::Results' } @$results_class) {
                Carp::croak 'cannot provide -Pg flag and provide Mojo::Pg::Results in result_class';
            }

            push @$results_class, 'Mojo::Pg::Results';
        }
    }

    if ($results_class) {
        require Role::Tiny;

        my %seen;
        for my $class (@$results_class) {
            Carp::croak "$class provided more than once to result_class" if $seen{$class}++;

            do { eval "require $class"; 1 } or Carp::croak "Failed to require $class";
            Role::Tiny->apply_roles_to_package($class, 'Mojo::DB::Results::Role::MoreMethods');
        }
    }
}

sub get {
    my $self = shift;

    my $options = ref $_[0] eq 'HASH' ? shift : {};
    my $die = delete $options->{die};
    my $one = delete $options->{one};
    my @indexes = @_;

    if ($one) {
        Carp::confess 'no rows returned' if $self->rows == 0;
        Carp::confess 'multiple rows returned' if $self->rows > 1;
    }

    my $wantarray = wantarray;
    if (not defined $wantarray) {
        Carp::cluck 'get or get variant called without using return value';

        if ($die or $one) {
            Carp::croak 'no results' unless $self->array;
        } else {
            $self->array;
            return;
        }
    } elsif ($wantarray) {
        my $array = $self->array;
        unless ($array) {
            Carp::confess 'no results' if $die or $one;
            return;
        }

        if (@indexes) {
            $self->_assert_indexes(@indexes);

            return @$array[@indexes];
        } else {
            return @$array;
        }
    } else {
        Carp::confess 'multiple indexes passed for single requested get value' if @indexes > 1;

        my $array = $self->array;
        unless ($array) {
            Carp::confess 'no results' if $die or $one;
            return;
        }

        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);

        return sub { $_->${\$value} };
    }
}

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

    if ($type eq 'array' or $type eq 'c') {
        return sub { @$_ };
    } elsif ($type eq 'hash') {
        my $columns = $self->columns;
        return sub { @{$_}{@$columns} };
    } else {
        my $columns = $self->columns;
        return sub {
            my $struct = $_;
            map { $struct->${\$_} } @$columns;
        };
    }
}

sub get_or_die { shift->get({die => 1}, @_) }

sub get_by_name_or_die { shift->get_by_name({die => 1}, @_) }

sub c_or_die { shift->c({die => 1}, @_) }

sub c_by_name_or_die { shift->c_by_name({die => 1}, @_) }

sub struct_or_die { $_[0]->_type_or_die('struct') }

sub array_or_die { $_[0]->_type_or_die('array') }

sub hash_or_die { $_[0]->_type_or_die('hash') }

sub _type_or_die {
    my ($self, $type) = @_;
    if (not defined wantarray) {
        Carp::cluck "${type}_or_die called without using return value";
    }

    Carp::croak 'no results' unless my $value = shift->$type;
    return $value;
}

sub one { shift->get({one => 1}, @_) }

sub one_by_name { shift->get_by_name({one => 1}, @_) }

sub one_c { shift->c({one => 1}, @_) }

sub one_c_by_name { shift->c_by_name({one => 1}, @_) }

sub one_struct { $_[0]->_one_type('struct') }

sub one_array { $_[0]->_one_type('array') }

sub one_hash { $_[0]->_one_type('hash') }

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

    Carp::confess 'no rows returned' if $self->rows == 0;
    Carp::confess 'multiple rows returned' if $self->rows > 1;

    return $self->$type;
}

sub _find_column_indexes {
    my $columns = shift->columns;

    return map { _find_column_index($columns, $_) } @_;
}

sub _find_column_index {
    my ($columns, $column) = @_;

    my @indexes = grep { $columns->[$_] eq $column } 0..$#$columns;
    Carp::confess "could not find column '$column' in returned columns" unless @indexes;
    Carp::confess "more than one column named '$column' in returned columns" if @indexes > 1;

    return $indexes[0];
}

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

    my $num_columns = @{ $self->columns };
    Carp::croak 'cannot index into a size zero results array' if $num_columns == 0;

    for my $index (@indexes) {
        Carp::croak "index out of valid range -$num_columns to @{[ $num_columns - 1 ]}"
            unless $index >= -$num_columns and $index < $num_columns;
    }
}

1;
__END__