Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Return a Deep Hash Reference from Array of Keys

by bratwiz (Sexton)
on Aug 14, 2013 at 21:07 UTC ( #1049478=perlquestion: print w/replies, xml ) Need Help??
bratwiz has asked for the wisdom of the Perl Monks concerning the following question:

Greetings Fellow Monks, Monkettes & Monkees...

I was writing a program today and hit upon a Perl question I've never thought about before. Suppose I have some sort of hash structure (such as the one in my example below) and I would like to "reach in" and manipulate one of the nested hashes and that I know the necessary keys and in the correct order, but I only have them in an array form (i.e., qw/level1key level2key.../ etc.) What is the best method to return a reference from the hash using an array of keys?

I have constructed the following example which seems to work acceptably, but my question is: "Is the only and/or best approach to solve the problem?"

(Btw, the hash in the example is completely arbitrary and has no real-world significance)

Thanks

Jwhitten

#! /bin/perl use Data::Dumper; my $hash = { 'wheels' => { 'four' => { 'car' => { 'plain' => { 'sporty' => 'honda', 'retro' => 'volkswagon', }, 'fancy' => { 'red' => 'ferrari', 'silver' => 'maserati', }, }, 'truck' => { 'light' => { 'chevy' => 'pickup', }, 'utility' => { 'us' => 'mail', 'city' => 'trash', 'muni' => 'power', }, }, }, 'one' => 'Unicycle', 'two' => { 'pedals' => 'bicycle', 'motorized' => 'motorcycle', }, 'three' => 'tricycle', }, }; ##--------------------------- ## DEEP REFERENCE ##--------------------------- fetch($hash, 'wheels'); fetch($hash, 'wheels', 'one'); fetch($hash, 'wheels', 'four', 'truck', 'utility'); fetch($hash, 'wheels', 'four', 'truck', 'utility', 'blah'); # doesn't +exist sub fetch { my ($hash, @keys) = @_; print "==> Fetching [" . join(', ', @keys) . ']' . "\n"; my $results = deep_reference($hash, @keys); print Dumper($results), "\n\n"; } sub deep_reference { my ($hash, @keys) = @_; my $ref = undef; my $code = '$hash->' . join('->', map { "{$_}" } @keys); return eval $code; }

Produces:

==> Fetching [wheels] $VAR1 = { 'three' => 'tricycle', 'one' => 'Unicycle', 'two' => { 'pedals' => 'bicycle', 'motorized' => 'motorcycle' }, 'four' => { 'car' => { 'plain' => { 'sporty' => 'honda', 'retro' => 'volkswagon' }, 'fancy' => { 'silver' => 'maserati', 'red' => 'ferrari' } }, 'truck' => { 'light' => { 'chevy' => 'pickup' }, 'utility' => { 'city' => 'trash', 'muni' => 'power', 'us' => 'mail' } } } }; ==> Fetching [wheels, one] $VAR1 = 'Unicycle'; ==> Fetching [wheels, four, truck, utility] $VAR1 = { 'city' => 'trash', 'muni' => 'power', 'us' => 'mail' }; ==> Fetching [wheels, four, truck, utility, blah] $VAR1 = undef;

Replies are listed 'Best First'.
Re: Return a Deep Hash Reference from Array of Keys
by choroba (Bishop) on Aug 14, 2013 at 21:49 UTC
    See Data::Diver:
    use Data::Diver 'Dive'; print Dive($hash, qw(wheels four truck utility muni));
    لսႽ ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

      Thanks everybody for your responses! I didn't know about Data::Diver. I played around with it yesterday and its a very nice package and does exactly what I need.

      Thanks!

      John

Re: Return a Deep Hash Reference from Array of Keys
by tangent (Vicar) on Aug 14, 2013 at 21:52 UTC
    I doubt if this is the 'best' method but this is how I would do it:
    sub fetch { my ($hash, @keys) = @_; print "==> Fetching [" . join(', ', @keys) . ']' . "\n"; for my $key (@keys) { return unless ref $hash eq 'HASH' && exists $hash->{$key}; $hash = $hash->{$key}; } print Dumper($hash), "\n\n"; }
Re: Return a Deep Hash Reference from Array of Keys
by Laurent_R (Canon) on Aug 15, 2013 at 09:30 UTC

    What about something like this:

    DB<9> @list = qw /wheels four/; DB<10> print Dumper $hash->{shift @list}{shift @list}; $VAR1 = { 'car' => { 'plain' => { 'sporty' => 'honda', 'retro' => 'volkswagon' }, 'fancy' => { 'silver' => 'maserati', 'red' => 'ferrari' } }, 'truck' => { 'light' => { 'chevy' => 'pickup' }, 'utility' => { 'city' => 'trash', 'muni' => 'power', 'us' => 'mail' } } }; DB<11>

      Interesting idea, but it doesn't actually work.

      Here is the output:

      #! /bin/perl use Data::Dumper; my $hash = { 'wheels' => { 'four' => { 'car' => { 'plain' => { 'sporty' => 'honda', 'retro' => 'volkswagon', }, 'fancy' => { 'red' => 'ferrari', 'silver' => 'maserati', }, }, 'truck' => { 'light' => { 'chevy' => 'pickup', }, 'utility' => { 'us' => 'mail', 'city' => 'trash', 'muni' => 'power', 'corp' => { 'dom' => 'dominion p +ower', 'vap' => 'virginia p +ower', }, }, }, }, 'one' => 'Unicycle', 'two' => { 'pedals' => 'bicycle', 'motorized' => 'motorcycle', }, 'three' => 'tricycle', }; ##--------------------------- ## DEEP REFERENCE ##--------------------------- fetch2($hash, 'wheels'); fetch2($hash, 'wheels', 'four', 'truck', 'utility', 'blah'); fetch2($hash, 'wheels', 'four', 'truck', 'utility', 'corp', 'dom'); ## Using your suggested technique sub fetch2 { my ($hash, @keys) = @_; print "==> Fetching [" . join(', ', @keys) . ']' . "\n"; print Dumper $hash->{shift @keys}{shift @keys}; }

      Produces:

      ==> Fetching [wheels] $VAR1 = undef; ==> Fetching [wheels, four, truck, utility, blah] $VAR1 = { 'car' => { 'plain' => { 'sporty' => 'honda', 'retro' => 'volkswagon' }, 'fancy' => { 'silver' => 'maserati', 'red' => 'ferrari' } }, 'truck' => { 'light' => { 'chevy' => 'pickup' }, 'utility' => { 'city' => 'trash', 'muni' => 'power', 'us' => 'mail', 'corp' => { 'dom' => 'dominion p +ower', 'vap' => 'virginia p +ower' } } } }; ==> Fetching [wheels, four, truck, utility, corp, dom] $VAR1 = { 'car' => { 'plain' => { 'sporty' => 'honda', 'retro' => 'volkswagon' }, 'fancy' => { 'silver' => 'maserati', 'red' => 'ferrari' } }, 'truck' => { 'light' => { 'chevy' => 'pickup' }, 'utility' => { 'city' => 'trash', 'muni' => 'power', 'us' => 'mail', 'corp' => { 'dom' => 'dominion p +ower', 'vap' => 'virginia p +ower' } } } };

      Whereas the expected result should be:

      ==> Fetching [wheels] $VAR1 = { 'three' => 'tricycle', 'one' => 'Unicycle', 'two' => { 'pedals' => 'bicycle', 'motorized' => 'motorcycle' }, 'four' => { 'car' => { 'plain' => { 'sporty' => 'honda', 'retro' => 'volkswagon' }, 'fancy' => { 'silver' => 'maserati', 'red' => 'ferrari' } }, 'truck' => { 'light' => { 'chevy' => 'pickup' }, 'utility' => { 'city' => 'trash', 'muni' => 'power', 'us' => 'mail', 'corp' => { 'dom' => + 'dominion power', 'vap' => + 'virginia power' } } } } }; ==> Fetching [wheels, four, truck, utility, blah] (nothing, because it doesn't exist) ==> Fetching [wheels, four, truck, utility, corp, dom] $VAR1 = 'dominion power';

        The example under the debugger that I gave works only for a two-level hash dereferencing. It has to be adapted for other levels.

        I slightly modified the program you made based on my idea so that it takes into account the number of elements in the array of keys, as follows:

        #! /bin/perl use Data::Dumper; my $hash = { 'wheels' => { 'four' => { 'car' => { 'plain' => { 'sporty' => 'honda', 'retro' => 'volkswagon', }, 'fancy' => { 'red' => 'ferrari', 'silver' => 'maserati', }, }, 'truck' => { 'light' => { 'chevy' => 'pickup', }, 'utility' => { 'us' => 'mail', 'city' => 'trash', 'muni' => 'power', 'corp' => { 'dom' => 'dominion p +ower', 'vap' => 'virginia p +ower', }, }, }, }, 'one' => 'Unicycle', 'two' => { 'pedals' => 'bicycle', 'motorized' => 'motorcycle', }, 'three' => 'tricycle', } }; ##--------------------------- ## DEEP REFERENCE ##--------------------------- fetch2($hash, 'wheels'); fetch2($hash, 'wheels', 'four', 'truck'); fetch2($hash, 'wheels', 'four', 'truck', 'utility'); fetch2($hash, 'wheels', 'four', 'truck', 'utility', 'blah'); fetch2($hash, 'wheels', 'four', 'truck', 'utility', 'corp', 'dom'); ## Using your suggested technique sub fetch2 { my ($hash, @keys) = @_; print "==> Fetching [" . join(', ', @keys) . ']' . "\n"; my $command_string = 'print Dumper $hash->' . '{shift @keys}' +x scalar @keys; eval "$command_string"; }
        And I get the following output, which seems correct to me:

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1049478]
Approved by Old_Gray_Bear
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (8)
As of 2018-07-16 18:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?















    Results (346 votes). Check out past polls.

    Notices?