File Coverage

blib/lib/List/Util/Uniq.pm

Criterion	Covered	Total	%
statement	99	99	100.0
branch	38	44	86.3
condition	8	18	44.4
subroutine	23	23	100.0
pod	12	16	75.0
total	180	200	90.0

package List::Util::Uniq;

use strict;
use warnings;

use Exporter qw(import);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-06-21'; # DATE
our $DIST = 'List-Util-Uniq'; # DIST
our $VERSION = '0.006'; # 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
               );

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

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

__END__