File Coverage

blib/lib/Hash/Subset.pm

Criterion	Covered	Total	%
statement	38	39	97.4
branch	24	26	92.3
condition			n/a
subroutine	8	8	100.0
pod	4	4	100.0
total	74	77	96.1

package Hash::Subset;

our $DATE = '2019-11-19'; # DATE
our $VERSION = '0.005'; # 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_src) = @_;

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

    my %subset;
    my $ref = ref $keys_src;
    if ($ref eq 'ARRAY') {
        if ($reverse) {
            for my $key (keys %$hash) {
                $subset{$key} = $hash->{$key}
                    unless grep { $key eq $_ } @$keys_src;
            }
        } else {
            for (@$keys_src) {
                $subset{$_} = $hash->{$_} if exists $hash->{$_};
            }
        }
    } elsif ($ref eq 'HASH') {
        if ($reverse) {
            for (keys %$hash) {
                $subset{$_} = $hash->{$_} unless exists $keys_src->{$_};
            }
        } else {
            for (keys %$keys_src) {
                $subset{$_} = $hash->{$_} if exists $hash->{$_};
            }
        }
    } elsif ($ref eq 'CODE') {
        if ($reverse) {
            for (keys %$hash) {
                $subset{$_} = $hash->{$_} unless $keys_src->($_, $hash->{$_});
            }
        } else {
            for (keys %$hash) {
                $subset{$_} = $hash->{$_} if $keys_src->($_, $hash->{$_});
            }
        }
    } else {
        die "Second argument (keys_src) must be a hashref/arrayref/coderef";
    }

    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__