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;
| [reply] [d/l] |
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.
| [reply] |