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

Hello Monks,

I would like to replace a key-value pair that is arbitrarily deep in a multi-level hash with only the value.
For example, I would like to turn the following hash: 
my $element = {
          'check' => {
                     'field' => 'OLK_BO_BK_TYPE'
                   },
          'type' => 'case',
          'case' => [
                    {
                      'value' => '1',
                      'resultset' => 'BROKER'
                    },
                    {
                      'value' => '3',
                      'resultset' => {
                                      'field' => 'OLK_BO_BK_DESC'
                                     },
                    },
                  ]
        };

[download]
into this:
my $element = {
          'check' = 'OLK_BO_BK_TYPE',
          'type' => 'case',
          'case' => [
                    {
                      'value' => '1',
                      'resultset' => 'BROKER'
                    },
                    {
                      'value' => '3',
                      'resultset' => 'OLK_BO_BK_DESC'
                    },
                  ]
        };

[download]

replacing every occurence of field with just its value. Here's what I have so far:
hash_walk($element);

sub hash_walk
{
  my $element = shift;
           
  if(ref($element) =~ /HASH/ )
  {    
      foreach my $key (keys %$element)
      {
          if ($key =~ /field/)
          { 
             # do something here? 
             print "found $$element{$key}\n";
          }   
          hash_walk($$element{$key});
      }
  }
  elsif (ref($element) =~ /ARRAY/)
  {
      foreach my $index (@$element)
      {
        hash_walk($index);
      }
  }  
}

[download]

Maybe a hash slice at the crucial point? Any help appreciated.
-micmac

Replies are listed 'Best First'.
Re: replace a key with its value
by moritz (Cardinal) on Jul 08, 2009 at 15:22 UTC
    What you should do is:
    • write a recursive function that actually copies the data structure
    • if a hash contains just one pair, return the value instead of the hashref

    That might look like this: 

    use Scalar::Util qw(reftype);
sub copy_and_prune {
   my $item = shift;
   return $item unless defined ref($item);
   if (reftype($item) eq 'HASH') {
       if (1 == keys %$item) {
            # return the one value here
       } else {
           my %ret;
           while (my ($key, $value) = each %$item) {
                 $ret{$key} = copy_and_prune($value);
           }
           return \%ret;
       }
   } elsif ( # other cases ...

}

    [download]
[reply]
[d/l]
Re: replace a key with its value
by spazm (Monk) on Jul 08, 2009 at 19:26 UTC
    This is slightly more complicated than your average hash walker, since we need to know how to modify the parent. This solution passes around an $extra hash with information on how to update the parent. $extra is expected to have keys parent and key. Based on the ref of parent, we update it as a hash or an array. We could make this a bit cleaner by a closure as the extra argument, and we call the closure when we find a match. 
    #!/usr/bin/perl -w

use strict;
use Data::Dumper;
use Test::More tests => 1;

my $element = {
          'check' => {
                     'field' => 'OLK_BO_BK_TYPE'
                   },
          'type' => 'case',
          'case' => [
                    {
                      'value' => '1',
                      'resultset' => 'BROKER'
                    },
                    {
                      'value' => '3',
                      'resultset' => {
                                      'field' => 'OLK_BO_BK_DESC'
                                     },
                    },
                  ]
        };

my $expected = {
          'check' => 'OLK_BO_BK_TYPE',
          'type' => 'case',
          'case' => [
                    {
                      'value' => '1',
                      'resultset' => 'BROKER'
                    },
                    {
                      'value' => '3',
                      'resultset' => 'OLK_BO_BK_DESC',
                    },
                  ]
        };

hash_walk($element);
is_deeply( $element, $expected, "hash_walk worked as expected");

sub hash_walk {
    my ( $element, $extra ) = @_;
    my ( $parent, $pkey );
    if ($extra) {
        $parent = $extra->{parent};
        $pkey   = $extra->{key};
    }

    if ( ref($element) =~ /HASH/ ) {
        foreach my $key ( keys %$element ) {
            if ( $key =~ /field/ ) {
                if ( ref($parent) eq 'HASH' ) {
                    $parent->{$pkey} = $element->{$key};
                }
                elsif ( ref( $parent eq 'ARRAY' ) ) {
                    $parent->[$pkey] = $element->{$key};
                }
                else {
                    warn("I don't know what to do with field in parent
+[$parent]"
                    );
                }
            }
            else {
                hash_walk( $element->{$key},
                    { parent => $element, key => $key } );
            }
        }
    }
    elsif ( ref($element) =~ /ARRAY/ ) {
        my $upper = @$element - 1;
        foreach my $i ( 0 .. $upper ) {
            my $index = $element->[$i];
            hash_walk( $index, { parent => $element, key => $i } );
        }
    }

    [download]
[reply]
[d/l]
      In this version I pass around a closure code reference to get evaluated when we find matching fields.

      I find this much prettier, since we aren't duplicating the ref code and it simplifies the matching code. 

      #!/usr/bin/perl -w

use strict;
use Data::Dumper;
use Test::More tests => 1;

my $element = {
          'check' => {
                     'field' => 'OLK_BO_BK_TYPE'
                   },
          'type' => 'case',
          'case' => [
                    {
                      'value' => '1',
                      'resultset' => 'BROKER'
                    },
                    {
                      'value' => '3',
                      'resultset' => {
                                      'field' => 'OLK_BO_BK_DESC'
                                     },
                    },
                  ]
        };

my $expected = {
          'check' => 'OLK_BO_BK_TYPE',
          'type' => 'case',
          'case' => [
                    {
                      'value' => '1',
                      'resultset' => 'BROKER'
                    },
                    {
                      'value' => '3',
                      'resultset' => 'OLK_BO_BK_DESC',
                    },
                  ]
        };

hash_walk($element);
is_deeply( $element, $expected, "hash_walk worked as expected");

sub hash_walk {
    my ( $element, $update ) = @_;

    if ( ref($element) =~ /HASH/ ) {
        foreach my $key ( keys %$element ) {
        my $value = $element->{$key};
            if ( $key =~ /field/ ) {
        $update->( $value);
            }
            else {
                hash_walk( $value,
                    sub { $element->{$key} = shift } );
            }
        }
    }
    elsif ( ref($element) =~ /ARRAY/ ) {
        my $upper = @$element - 1;
        foreach my $i ( 0 .. $upper ) {
            my $index = $element->[$i];
            hash_walk( $index, sub { $element->[$i] = shift } );
        }
    }
}

      [download]
[reply]
[d/l]
      Thank-you very, very much. The parent/closure ideas are excellent and I would never have thought of that.
      Much obliged,
      -micmac
      tx to moritz also for the helpful tidbit.
[reply]

Back to Seekers of Perl Wisdom