descending a tree of hash references

[Amoe]

Rightyright. I have a hash reference which contains an unknown amount of hash references as values, which themselves contain hash references...and so on ad finitum, you know the drill. We'll call it $structure. That's all very easy to access when I know what I'm looking for. But, say I get a series of keys from a user, and have them in an array. The array looks like this:

('stuff', 'hierarchy', 'album')

Here, stuff is the first-level key of the structure, hierarchy is the hash reference returned by $structure->{stuff}, et cetera, et cetera. To write it in Perl, this chain would look like this:

$structure->{stuff}{hierarchy}{album}

I figured out a way to descend the structure when I only have to locate a value from it based on that list:

my $target = 'bar';    # the end key

my $path = ('stuff', 'hierarchy', 'album');

my $nodule = $structure;

while (my $next_key = shift @path) {
    $nodule = $nodule->{$next_key};
}

my $triumphant = $nodule->{$target};

That made me feel pretty good. But then the jig was up: I had to change a value in the structure. Essentially, I had to change $nodule->{$target}. I can't just convert that - it needs to be reflected as a change in the whole $structure, and I'm wiping out the rest of the structure as I go along. The only way I can think of doing this at the moment is by constructing an elaborate eval STRING statement by concatenating the list into Perl syntax and running that. But that introduces a whole range of new concerns, and I don't really want to do that. There must be another way.

--
my one true love

[Chmrr]

I've been in your exact same position before. Here's a snippet which may save you some hair-pulling:

#!/usr/bin/perl -w
use strict;
use Data::Dumper;
my $s = {
     foo =>'bar',
     baz => {
         troz  => 'zort',
         blort => {
               poit => 'qux',
              }
        }
    };

print Dumper $s;
# This works in 5.6.1 and later
set($s, qw/baz blort poit/) = "Whee!";
set($s, qw/baz troz/) = "Joy!";
# In 5.6.0 (and earlier) you have to:
# set($s, qw/baz blort/)->{poit} = "Whee!";
# set($s, qw/baz/)->{troz} = "Joy!";
print Dumper $s;

sub set : lvalue {
  @_ == 1 ? $_[0] : set($_[0]{$_[1]},@_[2..$#_]);
}

perl -pe '"I lo*`+$^X$\"$]!$/"=~m%(.*)%s;$_=$1;y^`+*^e v^#$&V"+@( NO CARRIER'

[YuckFoo]

Amoe,

It's not clear to me what you are trying to do. After you have traversed the hash refs as you have shown and $nodule has the hash ref of $structure->{stuff}{hierarchy}{album}, then changing $nodule->{$target} will have the effect of changing $structure->{stuff}{hierarchy}{album}{$target}.

Some more code or context would be useful.

YuckFoo

Update: Some code to traverse a list of hash keys and change the last one. HTH.

#!/usr/bin/perl

   use strict;

   my ($hash);

   $hash->{one}{two}{three} = 'before';
   print "$hash->{one}{two}{three}\n";

   changehash($hash, [qw(one two three)], 'after');
   print "$hash->{one}{two}{three}\n";

#-----------------------------------------------------------
sub changehash {

   my ($node, $keys, $val) = @_;
   my $key;

   my $last = pop(@{$keys});

   for $key (@{$keys}) {
      if (defined ($node->{$key})) {
         $node = $node->{$key};
      }
      else {
         print STDERR "Unknown key: $key\n";
         return;
      }
   }

   if (defined ($node->{$last})) {
      $node->{$last} = $val
   }
   else {
      print STDERR "Unknown key: $last\n";
      return;
   }
}

[Amoe]

Hey YuckFoo. Ready for context? Here goes...

I'm getting a hashref from a DB_File, and unfreezing the data structure contained within with Storable. Then I traverse a user-defined path in the hashref and set a key in it, and it'll eventually get frozen back to the DB_File. An added complication (one that I should have mentioned, with hindsight :() is that if the full path doesn't exist, I have to create all the hashrefs leading up to the end - whilst still preserving everything that was in the original data structure. Here's a literal chunk of code from what I have.

    # the first element of $path is always a key in the DB_File
    my ($root, $tip) = (shift(@path), pop(@path));
    
    # get old tree
    my $old = thaw($db{$root});
    
    # start off at the root
    $nodule = $old;
    
    while (my $next_key = shift @path) {
        unless (exists $nodule->{$next_key}) {
            $nodule->{$next_key} = {};    
        }
        $nodule = $nodule->{$next_key};
    }
    
    $nodule->{$tip} = $content;
    print Dumper($old);

The thing is, when I print $old with Data::Dumper, I would expect it to be a structure looking like this (given that @path = ('foo', 'bar'), $tip = 'baz' and $content = 'some arbitrary data'):

$VAR1 = {foo =>
        {bar =>
            {baz => 'some arbitrary data'}
        }
    };

Instead it looks like:

$VAR1 = undef;

So that's what I want to achieve, and the example I gave in the question seems to be lose context in this environment, when by all rights it should work. Damn real life.



--
my one true love

[YuckFoo]

Amoe,

Thanks, problem well stated. Unfortunately I couldn't reproduce the problem. I think you are not getting what you expect in $old when thawing. Try print Dumper($old) immediately after thawing.

YuckFoo

[trs80]

UPDATE/WARNING: I was curious how difficult an eval solution might be, but as merlyn points out, this code is dangerous and slower then other safer solutions. Despite merlyn's staunch reply about not using it, it is still a soltuion and we all know TIMTOWTDI. The original poster made it clear that he understood eval was a bad idea. I learned my lesson, I will not post code just to post code, bad trs80, bad.

I know you requested a non eval solution, but I couldn't restrain myself.

use strict;
use warnings;

my $structure = {
    stuff => { 


        hierarchy => { 
            album => { 
                bar => 'the right one',
               },
        },  
    },
};

my $path = [ 'stuff', 'hierarchy', 'album' , 'bar' ];

print get_structure_value($structure,$path) , "\n";
$structure = return_new_structure($structure,$path,'new value');
print get_structure_value($structure,$path) , "\n";

sub make_eval {
    my ($path) = shift;
    my $string = "\$hashref->";
    $string .= "{$_}" for @$path;
    return $string;
}

sub get_structure_value {
    my ($hashref,$path) = @_;
    my $string = &make_eval($path);
    return eval($string);
}

sub return_new_structure {
    my ($hashref,$path,$set) = @_;
    my $string = &make_eval($path); 
    eval("$string = '$set'");
    return $hashref;
}

Excuse the verbose sub names, I wanted it to be clear what each did, I created a sigle sub to being with but I didn't like the interface, I think this makes it clear what you are getting back.

[merlyn]

sub make_eval { 
    my ($path) = shift; 
    my $string = "\$hashref->"; 
    $string .= "{$_}" for @$path; 
    return $string; 
}

Dangerous and broken when $_ contains anything unusual, and slower than hell unneccessarily even when it doesn't. Please don't use this code for anything.

-- Randal L. Schwartz, Perl hacker

[tachyon]

You gotta love eval :0)

my $path = [ 'stuff', 'hierarchy', 'album', 'Oops}=do{warn"JaPh!"}# <-
+ run any arbitrary code' ];

cheers

tachyon

s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print