File Coverage

blib/lib/Hash/Subset.pm

Criterion	Covered	Total	%
statement	39	40	97.5
branch	22	24	91.6
condition			n/a
subroutine	8	8	100.0
pod	4	4	100.0
total	73	76	96.0

package Hash::Subset;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2020-06-11'; # DATE
our $DIST = 'Hash-Subset'; # DIST
our $VERSION = '0.006'; # VERSION

use strict;
use warnings;

use Exporter qw(import);
our @EXPORT_OK = qw(
                       hash_subset
                       hashref_subset
                       hash_subset_without
                       hashref_subset_without
               );

sub _routine {
    my ($which, $hash, @keys_srcs) = @_;

    my $reverse = $which =~ /_without\z/;
    my $return_ref = $which =~ /\Ahashref_/;

    my %subset;
    %subset = %$hash if $reverse;

    for my $keys_src (@keys_srcs) {
        my $ref = ref $keys_src;
        if ($ref eq 'ARRAY') {
            if ($reverse) {
                for (@$keys_src) {
                    delete $subset{$_};
                }
            } else {
                for (@$keys_src) {
                    $subset{$_} = $hash->{$_} if exists $hash->{$_};
                }
            }
        } elsif ($ref eq 'HASH') {
            if ($reverse) {
                for (keys %$keys_src) {
                    delete $subset{$_};
                }
            } else {
                for (keys %$keys_src) {
                    $subset{$_} = $hash->{$_} if exists $hash->{$_};
                }
            }
        } elsif ($ref eq 'CODE') {
            if ($reverse) {
                for (keys %$hash) {
                    delete $subset{$_} if $keys_src->($_, $hash->{$_});
                }
            } else {
                for (keys %$hash) {
                    $subset{$_} = $hash->{$_} if $keys_src->($_, $hash->{$_});
                }
            }
        } else {
            die "Key source ($keys_src) must be a hashref/arrayref/coderef";
        }
    } # for $keys_src

    if ($return_ref) {
        return \%subset;
    } else {
        return %subset;
    }
}

sub hash_subset    { _routine('hash_subset'   , @_) }
sub hashref_subset { _routine('hashref_subset', @_) }
sub hash_subset_without    { _routine('hash_subset_without'   , @_) }
sub hashref_subset_without { _routine('hashref_subset_without', @_) }

1;
# ABSTRACT: Produce subset of a hash

__END__