File Coverage

blib/lib/Array/Set.pm

Criterion	Covered	Total	%
statement	153	184	83.1
branch	150	190	78.9
condition	23	36	63.8
subroutine	9	9	100.0
pod	4	4	100.0
total	339	423	80.1

package Array::Set;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2021-05-13'; # DATE
our $DIST = 'Array-Set'; # DIST
our $VERSION = '0.061'; # VERSION

use 5.010001;
use strict;
use warnings;

use Exporter qw(import);
our @EXPORT_OK = qw(set_diff set_symdiff set_union set_intersect);

sub _doit {
    my $op = shift;

    my $opts;
    if (ref($_[0]) eq 'HASH') {
        $opts = shift;
    } else {
        $opts = {};
    }

    require Tie::IxHash;
    tie my(%res), 'Tie::IxHash';

    my $ic  = $opts->{ignore_case};
    my $ib  = $opts->{ignore_blanks};
    my $ar  = $opts->{allow_refs};
    my $ign = $ic || $ib || $ar;

    if ($ar) {
        require Storable;
    }

    my $i = 0;
  SET:
    for my $i (1..@_) {
        my $set = $_[$i-1];

        if ($op eq 'union') {

            if ($ign) {
                for (@$set) {

                    # determine key (this code is copy-pasted)
                    my $k = $ar ? (ref $_ ? "R" : defined($_) ? "S":"U") : ""; # R=ref/undef, D=defined scalar, U=undef
                    if ($k eq 'R') {
                        $k .= Storable::freeze($_);
                    } elsif (defined $_) {
                        $k .= $ic ? lc($_) : $_;
                        $k =~ s/\s+//g if $ib;
                    }

                    $res{$k} = $_ unless exists $res{$k};
                }
                # return result
                if ($i == @_) {
                    return [values %res];
                }
            } else {
                for (@$set) { $res{$_}++ }
                # return result
                if ($i == @_) {
                    return [keys %res];
                }
            }

        } elsif ($op eq 'intersect') {

            if ($ign) {
                if ($i == 1) {
                    for (@$set) {

                        # determine key (this code is copy-pasted)
                        my $k = $ar ? (ref $_ ? "R" : defined($_) ? "S":"U") : ""; # R=ref/undef, D=defined scalar, U=undef
                        if ($k eq 'R') {
                            $k .= Storable::freeze($_);
                        } elsif (defined $_) {
                            $k .= $ic ? lc($_) : $_;
                            $k =~ s/\s+//g if $ib;
                        }

                        $res{$k} = [1,$_] unless exists $res{$k};
                    }
                } else {
                    for (@$set) {

                        # determine key (this code is copy-pasted)
                        my $k = $ar ? (ref $_ ? "R" : defined($_) ? "S":"U") : ""; # R=ref/undef, D=defined scalar, U=undef
                        if ($k eq 'R') {
                            $k .= Storable::freeze($_);
                        } elsif (defined $_) {
                            $k .= $ic ? lc($_) : $_;
                            $k =~ s/\s+//g if $ib;
                        }

                        if ($res{$k} && $res{$k}[0] == $i-1) {
                            $res{$k}[0]++;
                        }
                    }
                }
                # return result
                if ($i == @_) {
                    return [map {$res{$_}[1]}
                                grep {$res{$_}[0] == $i} keys %res];
                }
            } else {
                if ($i == 1) {
                    for (@$set) { $res{$_} = 1 }
                } else {
                    for (@$set) {
                        if ($res{$_} && $res{$_} == $i-1) {
                            $res{$_}++;
                        }
                    }
                }
                # return result
                if ($i == @_) {
                    return [grep {$res{$_} == $i} keys %res];
                }
            }

        } elsif ($op eq 'diff') {

            if ($ign) {
                if ($i == 1) {
                    for (@$set) {

                        # determine key (this code is copy-pasted)
                        my $k = $ar ? (ref $_ ? "R" : defined($_) ? "S":"U") : ""; # R=ref/undef, D=defined scalar, U=undef
                        if ($k eq 'R') {
                            $k .= Storable::freeze($_);
                        } elsif (defined $_) {
                            $k .= $ic ? lc($_) : $_;
                            $k =~ s/\s+//g if $ib;
                        }

                        $res{$k} = $_ unless exists $res{$k};
                    }
                } else {
                    for (@$set) {

                        # determine key (this code is copy-pasted)
                        my $k = $ar ? (ref $_ ? "R" : defined($_) ? "S":"U") : ""; # R=ref/undef, D=defined scalar, U=undef
                        if ($k eq 'R') {
                            $k .= Storable::freeze($_);
                        } elsif (defined $_) {
                            $k .= $ic ? lc($_) : $_;
                            $k =~ s/\s+//g if $ib;
                        }

                        delete $res{$k};
                    }
                }
                # return result
                if ($i == @_) {
                    return [values %res];
                }
            } else {
                if ($i == 1) {
                    for (@$set) { $res{$_}++ }
                } else {
                    for (@$set) {
                        delete $res{$_};
                    }
                }
                # return result
                if ($i == @_) {
                    return [keys %res];
                }
            }

        } elsif ($op eq 'symdiff') {

            if ($ign) {
                if ($i == 1) {
                    for (@$set) {

                        # determine key (this code is copy-pasted)
                        my $k = $ar ? (ref $_ ? "R" : defined($_) ? "S":"U") : ""; # R=ref/undef, D=defined scalar, U=undef
                        if ($k eq 'R') {
                            $k .= Storable::freeze($_);
                        } elsif (defined $_) {
                            $k .= $ic ? lc($_) : $_;
                            $k =~ s/\s+//g if $ib;
                        }

                        $res{$k} = [1,$_] unless exists $res{$k};
                    }
                } else {
                    for (@$set) {

                        # determine key (this code is copy-pasted)
                        my $k = $ar ? (ref $_ ? "R" : defined($_) ? "S":"U") : ""; # R=ref/undef, D=defined scalar, U=undef
                        if ($k eq 'R') {
                            $k .= Storable::freeze($_);
                        } elsif (defined $_) {
                            $k .= $ic ? lc($_) : $_;
                            $k =~ s/\s+//g if $ib;
                        }

                        if (!$res{$k}) {
                            $res{$k} = [1, $_];
                        } elsif ($res{$k}[0] <= 2) {
                            $res{$k}[0]++;
                        }
                    }
                }
                # return result
                if ($i == @_) {
                    return [map {$res{$_}[1]}
                                grep {$res{$_}[0] == 1} keys %res];
                }
            } else {
                if ($i == 1) {
                    for (@$set) { $res{$_} = 1 }
                } else {
                    for (@$set) {
                        if (!$res{$_} || $res{$_} <= 2) {
                            $res{$_}++;
                        }
                    }
                }
                # return result
                if ($i == @_) {
                    return [grep {$res{$_} == 1} keys %res];
                }
            }

        }

    } # for set

    # caller does not specify any sets
    return [];
}

sub set_diff {
    my $opts = ref($_[0]) eq 'HASH' ? shift : {};
    if ($opts->{ignore_case} || $opts->{ignore_blanks} || $opts->{allow_refs}) {
        _doit('diff', $opts, @_);
    } else {
        # fast version, without ib/ic/ar
        my $set1 = shift;
        my $res = $set1;
        while (@_) {
            my %set2 = map { $_=>1 } @{ shift @_ };
            $res = [];
            for my $el (@$set1) {
                push @$res, $el unless $set2{$el};
            }
            $set1 = $res;
        }
        $res;
    }
}

sub set_symdiff {
    my $opts = ref($_[0]) eq 'HASH' ? shift : {};
    if ($opts->{ignore_case} || $opts->{ignore_blanks} || $opts->{allow_refs}) {
        _doit('symdiff', $opts, @_);
    } else {
        # fast version, without ib/ic/ar
        my $set1 = shift;
        my $res = $set1;
        my %set1;
        my %set2;
        while (@_) {
            my $set2 = shift;
            $set2{$_} = 1 for @$set2;
            $res = [];
            for my $el (@$set1) {
                push @$res, $el unless $set2{$el};
            }
            $set1{$_} = 1 for @$set1;
            for my $el (@$set2) {
                push @$res, $el unless $set1{$el};
            }
            $set1 = $res;
        }
        $res;
    }
}

sub set_union {
    my $opts = ref($_[0]) eq 'HASH' ? shift : {};
    if ($opts->{ignore_case} || $opts->{ignore_blanks} || $opts->{allow_refs}) {
        _doit('union', $opts, @_);
    } else {
        # fast version, without ib/ic/ar
        my %mem;
        my $res = [];
        while (@_) {
            for my $el (@{ shift @_ }) {
                push @$res, $el unless $mem{$el}++;
            }
        }
        $res;
    }
}

sub set_intersect {
    my $opts = ref($_[0]) eq 'HASH' ? shift : {};
    if ($opts->{ignore_case} || $opts->{ignore_blanks} || $opts->{allow_refs}) {
        _doit('intersect', $opts, @_);
    } else {
        # fast version, without ib/ic/ar
        my $set1 = shift;
        my $res = $set1;
        while (@_) {
            my %set2 = map { $_=>1 } @{ shift @_ };
            $res = [];
            for my $el (@$set1) {
                push @$res, $el if $set2{$el};
            }
            $set1 = $res;
        }
        $res;
    }
}

1;
# ABSTRACT: Perform set operations on arrays

__END__