Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

descending a tree of hash references

by Amoe (Friar)
on Feb 19, 2002 at 21:18 UTC ( #146435=perlquestion: print w/ replies, xml ) Need Help??
Amoe has asked for the wisdom of the Perl Monks concerning the following question:

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

Comment on descending a tree of hash references
Select or Download Code
Re: descending a tree of hash references
by Chmrr (Vicar) on Feb 19, 2002 at 22:01 UTC

    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'

Re: descending a tree of hash references
by YuckFoo (Abbot) on Feb 19, 2002 at 22:11 UTC
    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; } }

      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
        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

Re: descending a tree of hash references
by trs80 (Priest) on Feb 19, 2002 at 23:23 UTC
    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.
      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

        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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://146435]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (6)
As of 2014-09-21 21:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (176 votes), past polls