satzbu has asked for the wisdom of the Perl Monks concerning the following question:

Dear monks i have a code to replace the hash keys against another hash value it replace the keys but it replace the first match of the key only it cant replace the second time the same key come means it shift the key value pair but i want to replace that key also this is my code

#!/usr/bin/perl use warnings; use strict; use Data::Dumper; use XML::Simple; my %xhash = ('a' => { 'b' => { ################################################# 'e' => 'E', 'c' => 'V', 'c' => 'C', 'content' => 'B' ################################################# }, 'content' => 'A ', 'd' => 'D' }); my %c_hash=('a' => { 'addval' => { 'b' => { 'addval' => { 'e' => { 'addv +al' => {}, 'repv +al' => '5' }, 'c' => { 'addv +al' => {}, 'repv +al' => '3' } }, 'repval' => '2' }, 'd' => { 'addval' => {}, 'repval' => '4' } }, 'repval' => '1' }); my %repl; # lookup table: a => 1, etc. traverse(\%c_hash, sub { my ($key, $val) = @_; $repl{$key} = $val; }, "collect" ); #print Dumper \%repl; # debug traverse(\%xhash, sub { my ($key, $val, $href) = @_; if (exists $repl{$key}) { my $newkey = $repl{$key}; $href->{$newkey} = $val; delete $href->{$key}; } }, "replace" ); print Dumper \%xhash; sub traverse { my ($hash, $callback, $mode) = @_; return unless ref($hash) eq "HASH"; for my $key (keys %$hash) { my $val = $hash->{$key}; if (ref($val) eq "HASH") { traverse($val, $callback, $mode); if ($mode eq "collect") { if (exists $val->{repval}) { $callback->($key, $val->{repval}); } } } if ($mode eq "replace") { $callback->($key, $val, $hash); } } } _output_ $VAR1 = { '1' => { '4' => 'D', 'content' => 'A ', '2' => { ################################################### '3' => 'C', 'content' => 'B ', '5' => 'E' ################################################### } } };

but my required output is

_Required output_ $VAR1 = { '1' => { '4' => 'D', 'content' => 'A ', '2' => { ############################################### '3' => 'C', '3' => 'V' 'content' => 'B ', '5' => 'E' ############################################### } } };

please help me to clear that error

Replies are listed 'Best First'.
Re: Help to handle subroutine
by almut (Canon) on Apr 16, 2010 at 11:19 UTC

    As already said, you generally can't have the same key twice at the same nesting level (hash) of your data structure.

    In response to your private msg, I had posted a solution on my scratchpad which should handle identical keys at different nesting levels.  Reposted here:

    In case the two hashes are always structurally equivalent, you could use a "traversal-ID" ($id here) to make the keys unique by adding the ID to the keys in the lookup table. It's a bit of a hack because it relies on a number of assumptions, but hopefully, it helps...

    For example, with a duplicate key 'a':

    #!/usr/bin/perl use warnings; use strict; use Data::Dumper; my %xhash = ('a' => { # <--- 1 'b' => { 'e' => 'E', 'c' => 'C', 'content' => 'B ' }, 'content' => 'A ', 'd' => 'D', 'a' => 'Foo' # <--- 2 }); my %c_hash=('a' => { # <--- +1 'addval' => { 'b' => { 'addval' => { 'e' => { 'addv +al' => {}, 'repv +al' => '5' }, 'c' => { 'addv +al' => {}, 'repv +al' => '3' } }, 'repval' => '2' }, 'd' => { 'addval' => {}, 'repval' => '4' }, 'a' => { # <--- +2 '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' => { # <--- 1 '4' => 'D', '99' => 'Foo', # <--- 2 'content' => 'A ', '2' => { '3' => 'C', 'content' => 'B ', '5' => 'E' } } };
Re: Help to handle subroutine
by jethro (Monsignor) on Apr 16, 2010 at 11:19 UTC

    There are two methods how you can store keys with the same value:

    1) Concatenate the values in a string, the relevant key would look like '3' => 'C:V',. You have to pick a separator that can't occur in the values. Extracting the values can be done with split()

    2) Use an array to collect the values, i.e. '3' => [ 'C','V' ]. Safe but slightly more complicated syntax. The preferred way

    If you insist on having duplicate keys, there is a third way: Add a suffix to the duplicate value if the value already exists, i.e. '3' => 'C', '3+' => 'V'. But this complicates your code, is a hack and I can't think of a single advantage to the first two methods

Re: Help to handle subroutine
by choroba (Cardinal) on Apr 16, 2010 at 10:31 UTC
    You should study the definition of a hash. Duplicate keys are not allowed. Tru using Data::Dumper on your input %xhash.