Replace MULTIPLE first keys of multi-dimensional Hash in perl

Viewed 210

Following on from a similar question I asked (Change first key of multi-dimensional Hash in perl) I have a multi-dimensional hash in perl and would like to change MULTIPLE first keys for a chosen value. For example, I have the hash

my %Hash1;
$Hash1{1}{12}=1;
$Hash1{1}{10}=1;
$Hash1{2}{31}=1;
$Hash1{3}{52}=1;
$Hash1{3}{58}=1;
$Hash1{4}{82}=1;
$Hash1{4}{154}=1;

Now I want to replace the values 3 and 4 in the first key with the value 300. After this I would get:

$Hash1{1}{12}=1;
$Hash1{1}{10}=1;
$Hash1{2}{31}=1;
$Hash1{300}{52}=1;
$Hash1{300}{58}=1;
$Hash1{300}{82}=1;
$Hash1{300}{154}=1;

I know I could create a new hash by scanning the original hash and doing the following:

my %Hash2;
foreach my $key1 (sort keys %Hash1) {
    foreach my $key2 (keys %{ $Hash1{$key1} }) {
        if($key1==3 || $key1==4){
            $Hash2{300}{$key2}=1;
        } else {
            $Hash2{$key1}{$key2}=1;
        }
    }
}

But is there a quicker way?

2 Answers
$Hash1{300} = {%{$Hash1{3}},%{$Hash1{4}}};
delete $Hash1{3};
delete $Hash1{4};

If you need to replace too many keys, the following function may help.

Use it like replace_first_keys( \%Hash1, [ 3, 4 ], 300 );. The three parameters are reference of hash to modify, reference to array with keys to replace, and the replacement key.

use List::Util;

# REPLACE FIRST KEYS OF $hash LISTED IN @$replace WITH THE KEY $replacement    
sub replace_first_keys {
    my ( $hash, $replace, $replacement ) = @_;
    unshift @$replace, $replacement if exists $hash->{$replacement};
    $hash->{$replacement} = {
        map { %{ delete $hash->{$_} } }
          grep { ( exists $hash->{$_} ) && ( ref $hash->{$_} eq 'HASH' ) }
          ( List::Util::uniq @$replace )
    };
    $hash;
}

It also tries to handle the following situations sensibly:

  • replace_first_keys( \%Hash1, [ 3, 4 ], 2 ); (replacement key exists, older values are overwritten on conflict)
  • replace_first_keys( \%Hash1, [ 3, 4 ], 4 ); (replacement also present in replace list)

Use this script if you wish to test this.

Related