How to dig into a specific hash depth?
I have a hash where I don't know its depth. I got it from DBI::selectall_hashref
where the second parameter is user supplied.
So, depending on the request, I might have something similar for a two-level hash.
hash_ref = (
aphrodite => (
foo => (
name => aphrodite,
foobar => foo
a => 1,
b => 2,
)
bar => (
name => aphrodite,
foobar => bar
a => 1,
b => 2,
)
)
apollo => (
...
)
ares => (
...
)
)
As you can see, the columns are key
redundant in the hash. I would like to delete extra keys.
If I know that this is a 2-level hash, I can easily solve my problem:
for my $name (keys $hash_ref) {
for my $foobar (keys $hash_ref->{$name}) {
my $h = $hash_ref->{$name}{$foobar};
delete $h->{name};
delete $h->{foobar};
}
}
However with a 3-level hash, I would need 3 cascade loops, etc.
How can I dynamically remove redundant keys from
$hash_ref
iename
andfoobar
?
My initial idea was to iterate over the hash recursively:
iterate($hash_ref, scalar @keys);
sub iterate {
my ($ref, $depth) = @_;
for(keys $ref) {
if ($depth > 0) {
iterate($ref->{$_}, $depth - 1);
}
else {
delete $ref->{$_} for(@keys);
}
}
}
It works, but it's ugly, very ugly ... Before I go any further, I would like to know if I missed anything. Perhaps the solution could be much simpler than I think.
Any ideas?
More details?
I am writing a database collector that accepts a custom configuration containing a SQL query $sql
and hash keys @keys
. So I get the values ββfrom the database with:
$dbh->selecthall_hashref($sql, \@keys, {}, @bind);
I also need to clean the extracted data according to the additional. Apply these rules, I have to iterate through the deepest level $hash_ref
for key / value access.
source to share
I think this does what you need. Basically, it recurses through the hash until it finds a layer where the hash values ββare not references. Then it removes the elements from that layer using the keys in@keys
use strict;
use warnings;
use 5.010;
use Data::Dump;
use List::Util 'any';
my $hash_ref = {
aphrodite => {
bar => { name => "aphrodite", foobar => "bar", a => 3, b => 4, },
foo => { name => "aphrodite", foobar => "foo", a => 1, b => 2, },
},
apollo => {
bar => { name => "apollo", foobar => "bar", a => 7, b => 8, },
foo => { name => "apollo", foobar => "foo", a => 5, b => 6, },
},
ares => {
bar => { name => "ares", foobar => "bar", a => 11, b => 12, },
foo => { name => "ares", foobar => "foo", a => 9, b => 10, },
},
};
my @keys = qw/ name foobar /;
remove_dups($hash_ref, \@keys);
dd $hash_ref;
sub remove_dups {
my ($href, $keys) = @_;
if ( any { ref } values %$href ) {
remove_dups($_, $keys) for values %$href;
}
else {
delete @{$href}{@$keys};
}
}
Output
{
aphrodite => { bar => { a => 3, b => 4 }, foo => { a => 1, b => 2 } },
apollo => { bar => { a => 7, b => 8 }, foo => { a => 5, b => 6 } },
ares => { bar => { a => 11, b => 12 }, foo => { a => 9, b => 10 } },
}
source to share