File Coverage

blib/lib/Bubblegum/Object/Hash.pm

Criterion	Covered	Total	%
statement	143	145	98.6
branch	19	30	63.3
condition	1	3	33.3
subroutine	36	36	100.0
pod	30	30	100.0
total	229	244	93.8

# ABSTRACT: Common Methods for Operating on Hash References
package Bubblegum::Object::Hash;

use 5.10.0;
use namespace::autoclean;

use Bubblegum::Class 'with';
use Bubblegum::Constraints -isas, -types;

with 'Bubblegum::Object::Role::Defined';
with 'Bubblegum::Object::Role::Keyed';
with 'Bubblegum::Object::Role::Ref';
with 'Bubblegum::Object::Role::Coercive';
with 'Bubblegum::Object::Role::Output';

use Clone 'clone';

our @ISA = (); # non-object

our $VERSION = '0.45'; # VERSION

sub aslice {
    goto &array_slice;
}

sub array_slice {
    my $self = CORE::shift;
    my @keys = map { type_string $_ } @_;
    return [@{$self}{@keys}];
}

sub clear {
    goto ∅
}

sub defined {
    my $self = CORE::shift;
    my $key  = type_string CORE::shift;
    return CORE::defined $self->{$key};
}

sub delete {
    my $self = CORE::shift;
    my $key  = type_string CORE::shift;
    return CORE::delete $self->{$key};
}

sub each {
    my $self = CORE::shift;
    my $code = CORE::shift;

    $code = $code->codify if isa_string $code;
    type_coderef $code;

    for my $key (CORE::keys %$self) {
      $code->($key, $self->{$key}, @_);
    }

    return $self;
}

sub each_key {
    my $self = CORE::shift;
    my $code = CORE::shift;

    $code = $code->codify if isa_string $code;
    type_coderef $code;

    $code->($_, @_) for CORE::keys %$self;
    return $self;
}

sub each_n_values {
    my $self   = CORE::shift;
    my $number = $_[0] ? type_number CORE::shift : 2;
    my $code   = CORE::shift;

    $code = $code->codify if isa_string $code;
    type_coderef $code;

    my @values = CORE::values %$self;
    $code->(CORE::splice(@values, 0, $number), @_) while @values;
    return $self;
}

sub each_value {
    my $self = CORE::shift;
    my $code = CORE::shift;

    $code = $code->codify if isa_string $code;
    type_coderef $code;

    $code->($_, @_) for CORE::values %$self;
    return $self;
}

sub empty {
    my $self = CORE::shift;
    CORE::delete @$self{CORE::keys%$self};
    return $self;
}

sub exists {
    my $self = CORE::shift;
    my $key  = type_string CORE::shift;
    return CORE::exists $self->{$key};
}

sub filter_exclude {
    my $self = CORE::shift;
    my @keys = map { type_string $_ } @_;
    my %i    = map { $_ => type_string $_ } @keys;

    return {CORE::map { CORE::exists $self->{$_} ? ($_ => $self->{$_}) : () }
        CORE::grep { not CORE::exists $i{$_} } CORE::keys %$self};
}

sub filter_include {
    my $self = CORE::shift;
    my @keys = map { type_string $_ } @_;

    return {CORE::map { CORE::exists $self->{$_} ? ($_ => $self->{$_}) : () }
        @keys};
}

sub get {
    my $self = CORE::shift;
    my $key  = type_string CORE::shift;
    return $self->{$key};
}

sub hash_slice {
    my $self = CORE::shift;
    my @keys = map { type_string $_ } @_;
    return {CORE::map { $_ => $self->{$_} } @keys};
}

sub hslice {
    goto &hash_slice;
}

sub invert {
    my $self = CORE::shift;
    my $temp = {};

    for (CORE::keys %$self) {
        CORE::defined $self->{$_} ?
            $temp->{CORE::delete $self->{$_}} = $_ :
            CORE::delete $self->{$_};
    }

    for (CORE::keys %$temp) {
        $self->{$_} = CORE::delete $temp->{$_};
    }

    return $self;
}

sub iterator {
    my $self = CORE::shift;
    my @keys = CORE::keys %{$self};

    my $i = 0;
    return sub {
        return undef if $i > $#keys;
        return $self->{$keys[$i++]};
    }
}

sub keys {
    my $self = CORE::shift;
    return [CORE::keys %$self];
}

sub lookup {
    my $self = CORE::shift;
    my $key  = type_string CORE::shift;
    my @keys = CORE::split /\./, $key;
    my $node = $self;
    for my $key (@keys) {
        if ('HASH' eq CORE::ref $node) {
            return undef unless CORE::exists $node->{$key};
            $node = $node->{$key};
        }
        else {
            return undef;
        }
    }
    return $node;
}

sub pairs {
    goto &pairs_array;
}

sub pairs_array {
    my $self = CORE::shift;
    return [CORE::map { [ $_, $self->{$_} ] } CORE::keys %$self];
}

sub print {
    my $self = CORE::shift;
    return CORE::print %$self, @_;
}

sub list {
    my $self = CORE::shift;
    return %$self;
}

sub merge {
    my $self = CORE::shift;
    my @hashes = CORE::map type_hashref($_), @_;

    return clone $self unless @hashes;
    return clone merge($self, merge(@hashes)) if @hashes > 1;

    my ($right) = @hashes;

    my %merge = %$self;
    for my $key (CORE::keys %$right) {
        my ($hr, $hl) = CORE::map { ref $$_{$key} eq 'HASH' }
            $right, $self;
        if ($hr and $hl){
            $merge{$key} = merge($self->{$key}, $right->{$key})
        }
        else {
            $merge{$key} = $right->{$key}
        }
    }

    return clone \%merge;
}

sub reset {
    my $self = CORE::shift;
    @$self{CORE::keys%$self}=();
    return $self;
}

sub reverse {
    my $self = CORE::shift;
    my $temp = {};

    for (CORE::keys %$self) {
        $temp->{$_} = $self->{$_} if defined $self->{$_};
    }

    return {CORE::reverse %$temp};
}

sub say {
    my $self = CORE::shift;
    return print(%$self, @_, "\n");
}

sub set {
    my $self = CORE::shift;
    my $key  = type_string CORE::shift;
    return $self->{$key} = CORE::shift;
}

sub values {
    my $self = CORE::shift;
    return [CORE::values %$self];
}

1;

__END__