File Coverage

blib/lib/Hash/Squash.pm

Criterion	Covered	Total	%
statement	60	60	100.0
branch	25	26	96.1
condition	2	2	100.0
subroutine	10	10	100.0
pod	2	2	100.0
total	99	100	99.0

use strict;
use warnings;
package Hash::Squash;
# ABSTRACT: Remove numbered keys from a nested hash/array

use parent 'Exporter';
use List::Util qw/max/;

use version; our $VERSION = version->declare("v0.0.4");

our @EXPORT_OK = qw(squash unnumber);

sub squash   { _squash(shift) }
sub unnumber { _squash(shift, { keep_empty => 1 }) }

sub _squash {
    my ($obj, $arg) = @_;
    return $obj unless ref $obj;

    $obj = _squash_hash($obj, $arg);
    $obj = _squash_array($obj, $arg);

    return $obj;
}

sub _squash_hash {
    my ($obj, $arg) = @_;
    return $obj if ref $obj ne 'HASH';

    EMPTY_HASH: {
        last EMPTY_HASH if %{$obj};
        return (undef) unless exists $arg->{keep_empty};
        return (undef) unless $arg->{keep_empty};
        return +{};
    }

    my @keys = keys %{$obj};

    CONTAINS_NON_NUMERIC_KEYS: {
        last CONTAINS_NON_NUMERIC_KEYS unless grep {/\D/} @keys;
        my %hash = map { $_ => _squash($obj->{$_}, $arg) } @keys;
        return \%hash;
    }

    my $max = max(@keys) || 0;

    my @ar;
    for my $i (0 .. $max) {
        #
        # Some numbered keys might be partially discreated
        #
        push @ar, exists $obj->{$i} ? _squash($obj->{$i}, $arg) : (undef);
    }

    return \@ar;
}

sub _squash_array {
    my ($obj, $arg) = @_;
    return $obj if ref $obj ne 'ARRAY';

    my $keep_empty = exists $arg->{keep_empty} ? $arg->{keep_empty} : ();

    EMPTY_ARRAY: {
        last EMPTY_ARRAY if @{$obj} != 0;
        return (undef) unless $keep_empty;
        return [];
    }

    SINGLE_ELEMENT: {
        last SINGLE_ELEMENT if @{$obj} != 1;
        last SINGLE_ELEMENT if $keep_empty;
        return _squash($obj->[0]);
    }

    my @array = map { _squash($_, $arg) } @{$obj};

    return \@array;
}

1;
__END__