#!/usr/bin/perl
use strict;
use warnings;
use Benchmark qw(:all);
use Storable qw(dclone);

my %HoH = (
    elt1 => {
        A => 'ccc',
        B => 'ccc',
        C => 'ccc',
    },
    elt2 => {
        A => 'ccc',
        C => 'ccc',
        D => 'ccc',
        B => 'ccc',
    },
    elt3 => {
        A => 'ccc',
        E => 'ccc',
        C => 'ccc',
    },
);

sub perl_mouse {
    my %HoH = %{ dclone(shift) };
    my %count;
    my $count = keys %HoH;
    while (my ($name, $hash) = each %HoH) {
        while (my ($key) = each %$hash) {
            $count{$key}++;
        }
    }
    while (my ($name, $hash) = each %HoH) {
        while (my ($key) = each %$hash) {
            delete $$hash{$key} unless $count{$key} == $count;
        }
    }
}

sub skeeve1 {
    my %HoH = %{ dclone(shift) };
    my %count;
    my $count = scalar keys %HoH;
    for ( [ grep { $count != $count{$_} }
            map { ++$count{$_}; $_ }
            map { keys %{$HoH{$_}} }
            keys %HoH ] ) {
        for my $hash (values %HoH) {
            delete (@$hash{@$_});
        }
    }
}

sub skeeve2 {
    my %HoH = %{ dclone(shift) };
    my %count;
    my $count = scalar keys %HoH;
    my $k = [grep {$count == ++$count{$_}}
             map {keys %{$HoH{$_}}}
             keys %HoH];
    for my $h (values %HoH) {
        %$h = map { $_, $h->{$_}} @$k;
    }
}

sub blazar {
    my %HoH = %{ dclone(shift) };
    my @keys = keys %HoH;
    my %saw;
    for (@keys) {
        $saw{lc,}++ for keys %{ $HoH{$_} };
    }
    for (@keys) {
        my $h = $HoH{$_};
        $saw{lc,} < @keys and delete $h->{$_} for keys %$h;
    }
}

my $benchmark = timethese(5_000, {
        Perl_Mouse  => sub { perl_mouse(\%HoH) },
        Skeeve1     => sub { skeeve1(\%HoH) },
        Skeeve2     => sub { skeeve2(\%HoH) },
        Blazar      => sub { blazar(\%HoH) },
    }
);
print "\n";
cmpthese($benchmark);
[download]