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 };
[download]

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;
[download]

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 };
[download]

-- Randal L. Schwartz, Perl hacker
Be sure to read my standard disclaimer if this is a reply.

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;
[download]