scratchpad
almut
<p> (follow-up to [id://834482] to handle identical keys at different nesting levels) </p>
<p> In case the two hashes are always structurally equivalent, you could use a "traversal-ID" (<c>$id</c> here) to make the keys unique by adding the ID to the keys. It's a bit of a hack because it relies on a number of assumptions, but hopefully, it helps... </p>
<p> For example, with a duplicate key <c>'a'</c>: </p>
<c>
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
my %xhash = ('a' => {
'b' => {
'e' => 'E',
'c' => 'C',
'content' => 'B
'
},
'content' => 'A
',
'd' => 'D',
'a' => 'Foo'
});
my %c_hash=('a' => {
'addval' => {
'b' => {
'addval' => {
'e' => {
'addval' => {},
'repval' => '5'
},
'c' => {
'addval' => {},
'repval' => '3'
}
},
'repval' => '2'
},
'd' => {
'addval' => {},
'repval' => '4'
},
'a' => {
'addval' => {},
'repval' => '99'
},
},
'repval' => '1'
});
my $id;
sub traverse {
my ($hash, $callback, $mode, $start_id) = @_;
return unless ref($hash) eq "HASH";
$id = $start_id if defined $start_id;
for my $key (sort keys %$hash) {
my $val = $hash->{$key};
if (ref($val) eq "HASH") {
traverse($val, $callback, $mode);
if ($mode eq "collect") {
if (exists $val->{repval}) {
$id++;
$callback->("$key-$id", $val->{repval});
}
}
}
if ($mode eq "replace") {
$id++ unless $key eq "content";
$callback->("$key-$id", $val, $hash);
}
}
}
my %repl; # lookup table: a => 1, etc.
traverse(\%c_hash,
sub {
my ($key, $val) = @_;
$repl{$key} = $val;
},
"collect", 0
);
# print Dumper \%repl; # debug
traverse(\%xhash,
sub {
my ($key, $val, $href) = @_;
if (exists $repl{$key}) {
my $newkey = $repl{$key};
my ($oldkey) = split /-/, $key;
$href->{$newkey} = $val;
delete $href->{$oldkey};
}
},
"replace", 0
);
print Dumper \%xhash;
__END__
$VAR1 = {
'1' => {
'4' => 'D',
'99' => 'Foo',
'content' => 'A
',
'2' => {
'3' => 'C',
'content' => 'B
',
'5' => 'E'
}
}
};
</c>