Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

How to tie multilevel (multidimensional) hash?

by mikezone (Novice)
on Feb 11, 2003 at 23:12 UTC ( #234549=perlquestion: print w/ replies, xml ) Need Help??
mikezone has asked for the wisdom of the Perl Monks concerning the following question:

Hello wise monks,

I'd like to have some syntactical sugar to wrap a datastructure that I have. What I'd like to do is say:

tie %$hash, "MultiHash"; $hash->{ x }{ y }{ z } = 10;
and have custom behaviour, based on the values of 'x', 'y', and 'z', and the dimension specified. In other words, if FETCH and STORE took multiple arguments for keys (along the lines of the following:)
sub STORE { my ($tied_hash, $value, @keys) = @_; my ($x, $y, $z) = @keys; # to stay consistent with above example if( $x == 'foo' ) { ... } ... } sub FETCH { my ($tied_hash, @keys) = @_; my ($x, $y, $z) = @keys; # to stay consistent with above example if( $x == 'foo' ) { ... } ... }
then I'd just write my code in the MultiHash::STORE and ::FETCH methods and be very happy. But these methods don't work that way.

So far, I've tried recursively nesting tied hashes (but that didn't work; the recursive FETCH call apparently received no argument for $key). I've looked at Tie::MLDBM and Tie::RefHash for possible insight but I didn't learn much, and both searching Google and the PerlMonks archive hasn't helped me.

How can I get around this problem?

Thanks in advance,
- m.

Comment on How to tie multilevel (multidimensional) hash?
Select or Download Code
Re: How to tie multilevel (multidimensional) hash?
by perrin (Chancellor) on Feb 11, 2003 at 23:51 UTC
    Seems like recursive tied hashes should work, and there's no other way to do it. Maybe you should post your recursive hash code.

      Here's my driving code, test.pl. I can get it to read the second dimension on the subsequent FETCH, but can't figure out how to write the recursive routine. The only recursive way I know is if I can supply the next parameter (eg. $self->FETCH( $dimension ), or implicitly, $node->{ $dimension }, where $dimension would first be 'x' and secondly 'y'). But the hash tie() API only presents one dimension at a time. A neat thing I have learned, so far, is that for storing multidimensional hashes, that the ongoing case is that the value will be an anonymous hash, and the terminus case is that the value is a scalar.

      test.pl

      #! /users/michwong/perl/bin/perl #! /users/michwong/perl/bin/perl -d:ptkdb use lib qw( . ); use MultiHash; tie %$hash, "MultiHash"; $hash->{ x }{ y } = 10; $hash->{ x }{ y };

      Here's my module, MultiHash.pm

      MultiHash.pm

      package MultiHash; sub TIEHASH { my ($class) = map { ref || $_ } shift; my $level = shift || 0; return bless { level => $level, data => {}, }, $class; } sub FETCH { my $self = shift; my $key = shift; if( UNIVERSAL::isa( $self, 'HASH' )) { print "($self) fetching '$key': $self->{ data }{ $key }\n"; } else { print "($self) fetching '$key': $self->{ data }{ $key }\n"; } return $self->{ data }{ $key }; } sub STORE { my $self = shift; my $key = shift; my $value = shift; RECURSE_CASE: { # ===== MULTIDIMENSIONAL HASH if( UNIVERSAL::isa( $value, 'HASH' )) { if( exists $self->{ data }{ $key } ) { $self->{ data }{ $key } = $value; print "($self) storing '$value' into '$key'\n"; } else { my $node; tie %$node, "MultiHash"; $self->{ data }{ $key } = $node; print "($self) storing '$value' into '$key' with new n +ode\n"; } last RECURSE_CASE; } if( UNIVERSAL::isa( $value, 'MultiHash' )) { if( exists $self->{ data }{ $key } ) { $self->{ data }{ $key } = $value; print "($self) storing '$value' into '$key'\n"; } else { my $node; tie %$node, "MultiHash"; $self->{ data }{ $key } = $node; print "($self) storing '$value' into '$key' with new n +ode\n"; } last RECURSE_CASE; } if( UNIVERSAL::isa( $value, 'SCALAR' )) { $self->{ data }; last RECURSE_CASE; } } return $value; } sub DELETE { my $self = shift; my $key = shift } sub FIRSTKEY { my $self = shift; my $temp = keys %{ $self->{ data }}; return scalar each %{ $self->{ data }}; } sub NEXTKEY { my $self = shift; return scalar each %{ $self->{ data }}; } 1;
        You have multiple hashes, so you need to tie all of them. I think that will work. You're just using autovivification to create them in the above script. Try something like this:
        use lib qw( . ); use MultiHash; my %hash_a; my %hash_b; tie %hash_a, "MultiHash"; tie %hash_b, "MultiHash"; $hash{ x } = \%hash_b; $hash{ x }{ y } = 10; $hash{ x }{ y };
•Re: How to tie multilevel (multidimensional) hash?
by merlyn (Sage) on Feb 12, 2003 at 02:35 UTC

      Thanks for your help merlyn! And thanks again for that wild party three years ago in Monterey. It's filled me with positive feelings about the Perl Community.

      I looked at Regexp::Common, and it uses a trick similar to what I want to do, but I don't quite think it's exactly the same thing. However, reading the module's FETCH() and wrapping my head around why the module uses both TIEHASH() and new() have all given me greater insight towards my problem. Or maybe it's so extremely clever in the usual Damian fashion that to grok it would take me a lifetime.

      - m.

      Well, merlyn, I guess my lifetime's over. Regexp::Common didn't have the answer in itself, but it did provide me the clue I needed. I'm sorry to have doubted it (well, to be honest, I just didn't see it until that flash of inspiration hit me, which is to say that the FETCH() must perform a nested tie as well as the STORE()). Here's my solution (some cleanup is still to be done as testing continues, but it works!):

      test.pl

      #! /users/michwong/perl/bin/perl #! /users/michwong/perl/bin/perl -d:ptkdb use lib qw( . ); use MultiHash; tie %$hash, "MultiHash"; $hash->{ x }{ y } = 10; print $hash->{ x }{ y }, "\n"; $hash->{ x }{ z } = 20; print $hash->{ x }{ z }, "\n"; </code>

      MultiHash.pm

      package MultiHash; sub TIEHASH { my ($class) = map { ref || $_ } shift; my $level = shift || 0; return bless { level => $level, data => {}, }, $class; } sub FETCH { my $self = shift; my $key = shift; if( exists( $self->{ data }{ $key } )) { return $self->{ data }{ $key }; } else { my $node = {}; tie %$node, "MultiHash"; $self->{ data }{ $key } = $node; return; } } sub STORE { my $self = shift; my $key = shift; my $value = shift; RECURSE_CASE: { # ===== MULTIDIMENSIONAL HASH if( UNIVERSAL::isa( $value, 'HASH' )) { if( exists $self->{ data }{ $key } ) { $self->{ data }{ $key } = $value; } else { my $node = {}; tie %$node, "MultiHash"; $self->{ data }{ $key } = $node; } last RECURSE_CASE; } if( UNIVERSAL::isa( $value, 'MultiHash' )) { if( exists $self->{ data }{ $key } ) { $self->{ data }{ $key } = $value; } else { my $node = {}; tie %$node, "MultiHash"; $self->{ data }{ $key } = $node; } last RECURSE_CASE; } if( UNIVERSAL::isa( $value, 'SCALAR' )) { $self->{ data }; last RECURSE_CASE; } } return $value; } sub DELETE { my $self = shift; my $key = shift } sub FIRSTKEY { my $self = shift; my $temp = keys %{ $self->{ data }}; return scalar each %{ $self->{ data }}; } sub NEXTKEY { my $self = shift; return scalar each %{ $self->{ data }}; } 1;

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (16)
As of 2014-10-21 15:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (105 votes), past polls