File Coverage

blib/lib/Util/Underscore/ListUtils.pm

Criterion	Covered	Total	%
statement	86	122	70.4
branch	39	70	55.7
condition	5	12	41.6
subroutine	6	6	100.0
pod			n/a
total	136	210	64.7

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
# It takes the proper comparison operators as arguments.
# For max_*: lt, gt
# For min_*: gt, lt
my $minmax_by = sub {
    my ($lt, $gt) = @_;
    ## no critic (ProhibitStringyEval)
    return eval q~#line ~ . (__LINE__ + 1) . q~
        sub (&@) {
            my $key_func = shift;
            return if not @_ or not defined wantarray;
            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 $key ~ . $lt . q~ $max_key;
                    $max_key = $key if $key ~ . $gt . q~ $max_key;
                    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->();
                    next if $key ~ . $lt . q~ $max_key;
                    $max_key = $key if $key ~ . $gt . q~ $max_key;
                    $max_elem = \$_;
                }
                return $$max_elem;
            }
        }
    ~;
};

*max_by     = $minmax_by->(qw( <  >  ));
*max_str_by = $minmax_by->(qw( lt gt ));
*min_by     = $minmax_by->(qw( >  <  ));
*min_str_by = $minmax_by->(qw( gt lt ));


sub uniq_by (&@) {
    my $key_func = shift;
    return if not @_;
    if (not defined wantarray) {
        Carp::carp "Useless use of _::uniq_by in void context";
        return;
    }
    if (@_ == 1) {
        return (wantarray) ? @_ : 1;
    }

    # 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__