view release on metacpan or  search on metacpan

lib/Hash/Match.pm  view on Meta::CPAN

package Hash::Match;

# ABSTRACT: match contents of a hash against rules

use v5.14;
use warnings;

our $VERSION = 'v0.8.2';

use Carp qw/ croak /;
use List::AllUtils qw/ natatime /;
use Ref::Util qw/ is_arrayref is_blessed_ref is_coderef is_hashref is_ref is_regexpref /;

# RECOMMEND PREREQ: List::SomeUtils::XS
# RECOMMEND PREREQ: Ref::Util::XS

use namespace::autoclean;


sub new {
    my ($class, %args) = @_;

    if (my $rules = $args{rules}) {

        my $root = is_hashref($rules) ? '-all' : '-any';
        my $self = _compile_rule( $root => $rules, $class );
        bless $self, $class;

    } else {

        croak "Missing 'rules' attribute";

    }
}

sub _compile_match {
    my ($value) = @_;

    if ( is_ref($value) ) {

        return sub { ($_[0] // '') =~ $value } if is_regexpref($value);

        return sub { $value->($_[0]) } if is_coderef($value);

        croak sprintf('Unsupported type: \'%s\'', ref $value);

    } else {

        return sub { ($_[0] // '') eq $value } if (defined $value);

        return sub { !defined $_[0] };

    }
}

sub _key2fn {
    my ($key, $is_hash) = @_;

    state $KEY2FN = {
        '-all'    => List::AllUtils->can('all'),
        '-and'    => List::AllUtils->can('all'),
        '-any'    => List::AllUtils->can('any'),
        '-notall' => List::AllUtils->can('notall'),
        '-notany' => List::AllUtils->can('none'),
        '-or'     => List::AllUtils->can('any'),
    };

    # TODO: eventually add a warning message about -not being
    # deprecated.

    if ($key eq '-not') {
        $key = $is_hash ? '-notall' : '-notany';
    }

    $KEY2FN->{$key} or croak "Unsupported key: '${key}'";