File Coverage

blib/lib/List/Util/Uniq.pm

Criterion	Covered	Total	%
statement	121	121	100.0
branch	44	50	88.0
condition	8	18	44.4
subroutine	27	27	100.0
pod	20	20	100.0
total	220	236	93.2

package List::Util::Uniq;

use strict;
use warnings;

use Exporter qw(import);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2024-01-19'; # DATE
our $DIST = 'List-Util-Uniq'; # DIST
our $VERSION = '0.008'; # VERSION

our @EXPORT_OK = qw(
                       uniq
                       uniqint
                       uniqnum
                       uniqstr

                       uniq_adj
                       uniq_adj_ci
                       uniq_ci
                       is_uniq
                       is_uniq_ci
                       is_monovalued
                       is_monovalued_ci

                       dupe
                       dupeint
                       dupenum
                       dupestr

                       dupe_ci

                       pushuniq
                       pushuniqint
                       pushuniqnum
                       pushuniqstr
               );

sub uniq_adj {
    my @res;

    return () unless @_;
    my $last = shift;
    push @res, $last;
    for (@_) {
        next if !defined($_) && !defined($last);
        # XXX $_ becomes stringified
        next if defined($_) && defined($last) && $_ eq $last;
        push @res, $_;
        $last = $_;
    }
    @res;
}

sub uniq_adj_ci {
    my @res;

    return () unless @_;
    my $last = shift;
    push @res, $last;
    for (@_) {
        next if !defined($_) && !defined($last);
        # XXX $_ becomes stringified
        next if defined($_) && defined($last) && lc($_) eq lc($last);
        push @res, $_;
        $last = $_;
    }
    @res;
}

sub uniq_ci {
    my @res;

    my %mem;
    my $undef_added;
    for (@_) {
        if (defined) {
            push @res, $_ unless $mem{lc $_}++;
        } else {
            push @res, $_ unless $undef_added++;
        }
    }
    @res;
}

sub is_uniq {
    my %vals;
    for (@_) {
        return 0 if $vals{$_}++;
    }
    1;
}

sub is_uniq_ci {
    my %vals;
    for (@_) {
        return 0 if $vals{lc $_}++;
    }
    1;
}

sub is_monovalued {
    my %vals;
    for (@_) {
        $vals{$_} = 1;
        return 0 if keys(%vals) > 1;
    }
    1;
}

sub is_monovalued_ci {
    my %vals;
    for (@_) {
        $vals{lc $_} = 1;
        return 0 if keys(%vals) > 1;
    }
    1;
}

sub uniqint {
    my (@uniqs, %vals);
    for (@_) {
        no warnings 'numeric';
        ++$vals{int $_} == 1 and push @uniqs, $_;
    }
    @uniqs;
}

sub uniqnum {
    my (@uniqs, %vals);
    for (@_) {
        no warnings 'numeric';
        ++$vals{$_+0} == 1 and push @uniqs, $_;
    }
    @uniqs;
}

sub uniqstr {
    my (@uniqs, %vals);
    for (@_) {
        ++$vals{$_} == 1 and push @uniqs, $_;
    }
    @uniqs;
}

sub uniq { goto \&uniqstr }

sub dupeint {
    my (@dupes, %vals);
    for (@_) {
        no warnings 'numeric';
        ++$vals{int $_} > 1 and push @dupes, $_;
    }
    @dupes;
}

sub dupenum {
    my (@dupes, %vals);
    for (@_) {
        no warnings 'numeric';
        ++$vals{$_+0} > 1 and push @dupes, $_;
    }
    @dupes;
}

sub dupestr {
    my (@dupes, %vals);
    for (@_) {
        ++$vals{$_} > 1 and push @dupes, $_;
    }
    @dupes;
}

sub dupe { goto \&dupestr }

sub dupe_ci {
    my @res;

    my %mem;
    my $undef_added;
    for (@_) {
        if (defined) {
            push @res, $_ if $mem{lc $_}++;
        } else {
            push @res, $_ if $undef_added++;
        }
    }
    @res;
}

sub pushuniqstr(\@@) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    my $ary = shift;

    my %vals;
    for (@$ary) { $vals{$_}++ }

    for my $item (@_) {
        next if $vals{$item}++;
        push @$ary, $item;
    }
}

sub pushuniqnum(\@@) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    my $ary = shift;

    my %vals;
    for (@$ary) { $vals{$_+0}++ }

    for my $item (@_) {
        next if $vals{$item+0}++;
        push @$ary, $item;
    }
}

sub pushuniqint(\@@) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    my $ary = shift;

    my %vals;
    for (@$ary) { $vals{int $_}++ }

    for my $item (@_) {
        next if $vals{int $item}++;
        push @$ary, $item;
    }
}

sub pushuniq(\@@) { goto \&pushuniqstr } ## no critic: Subroutines::ProhibitSubroutinePrototypes

1;
# ABSTRACT: List utilities related to finding unique items

__END__