File Coverage

blib/lib/Util/Underscore/ListUtils.pm

Criterion	Covered	Total	%
statement	53	53	100.0
branch	26	26	100.0
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	85	85	100.0

package Util::Underscore::ListUtils;

#ABSTRACT: Interface to List::Util and List::MoreUtils

use strict;
use warnings;

## no critic (ProhibitMultiplePackages)
package    # hide from PAUSE
    _;

## no critic (ProhibitSubroutinePrototypes)


# this function generates max_by, max_str_by, min_by, min_str_by
my $minmax_by = sub {
    my ($is_less_than) = @_;

    return sub (&@) {
        my $key_func = shift;

        return if not defined wantarray;  # nop in void context
        return if not @_;
        return $_[0] if not @_ > 1;

        if (wantarray) {
            my $max_key = do {
                local *_ = \$_[0];
                $key_func->();
            };
            my @max_elems = shift;
            for (@_) {
                my $key = $key_func->();
                next if $is_less_than->($key, $max_key);
                if ($is_less_than->($max_key, $key)) {
                    $max_key = $key;
                    @max_elems = ();
                }
                push @max_elems, $_;
            }
            return @max_elems;
        }
        else {
            my $max_elem = \shift;
            my $max_key = do {
                local *_ = $max_elem;
                $key_func->();
            };
            for (@_) {
                my $key = $key_func->();
                if ($is_less_than->($max_key, $key)) {
                    $max_key = $key;
                    $max_elem = \$_;
                }
            }
            return $$max_elem;
        }
    };
};

*max_by     = $minmax_by->(sub { $_[0] <  $_[1] });
*max_str_by = $minmax_by->(sub { $_[0] lt $_[1] });
*min_by     = $minmax_by->(sub { $_[1] <  $_[0] });
*min_str_by = $minmax_by->(sub { $_[1] lt $_[0] });


sub uniq_by (&@) {
    my $key_func = shift;

    if (not defined wantarray) {
        Carp::carp "Useless use of _::uniq_by in void context";
        return;
    }

    if (@_ <= 1) {
        return @_ if wantarray;
        return 0+@_;
    }

    # caller context is propagated to grep, so this does the right thing.
    my %seen;
    grep { not $seen{ $key_func->() }++ } @_;
}


sub classify (&@) {
    my $key_func = shift;
    return if not @_;
    if (not defined wantarray) {
        Carp::carp "Useless use of _::classify in void context";
        return;
    }
    my %categories;
    push @{ $categories{ $key_func->() } }, $_ for @_;
    (wantarray) ? %categories : \%categories;
}


## no critic (ProtectPrivateVars)
$Util::Underscore::_ASSIGN_ALIASES->(
    'List::Util',
    reduce    => 'reduce',
    any       => 'any',
    all       => 'all',
    none      => 'none',
    max       => 'max',
    max_str   => 'maxstr',
    min       => 'min',
    min_str   => 'minstr',
    sum       => 'sum',
    product   => 'product',
    pairgrep  => 'pairgrep',
    pairfirst => 'pairfirst',
    pairmap   => 'pairmap',
    shuffle   => 'shuffle',
);

## no critic (ProtectPrivateVars)
$Util::Underscore::_ASSIGN_ALIASES->(
    'List::MoreUtils',
    first       => 'first_value',
    first_index => 'first_index',
    last        => 'last_value',
    last_index  => 'last_index',
    natatime    => 'natatime',
    uniq        => 'uniq',
    part        => 'part',
    each_array  => 'each_arrayref',
);

sub zip {
    goto &List::MoreUtils::zip;    # adios, prototypes!
}

1;

__END__