X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FTie%2FRefHash.pm;h=d4111d92e57b21529c297e2a5919b48a40d9db40;hb=778e8f972dad7252816055b155a64294366d7232;hp=ffa9eb20a00c0a100ba277be78584d16a617399e;hpb=632a9a7f3319d143cc62cb1495c02ec868a6dc88;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Tie/RefHash.pm b/lib/Tie/RefHash.pm index ffa9eb2..d4111d9 100644 --- a/lib/Tie/RefHash.pm +++ b/lib/Tie/RefHash.pm @@ -9,17 +9,26 @@ Tie::RefHash - use references as hash keys require 5.004; use Tie::RefHash; tie HASHVARIABLE, 'Tie::RefHash', LIST; + tie HASHVARIABLE, 'Tie::RefHash::Nestable', LIST; untie HASHVARIABLE; =head1 DESCRIPTION -This module provides the ability to use references as hash keys if -you first C the hash variable to this module. +This module provides the ability to use references as hash keys if you +first C the hash variable to this module. Normally, only the +keys of the tied hash itself are preserved as references; to use +references as keys in hashes-of-hashes, use Tie::RefHash::Nestable, +included as part of Tie::Hash. It is implemented using the standard perl TIEHASH interface. Please see the C entry in perlfunc(1) and perltie(1) for more information. +The Nestable version works by looking for hash references being stored +and converting them to tied hashes so that they too can have +references as keys. This will happen without warning whenever you +store a reference to one of your own hashes in the tied hash. + =head1 EXAMPLE use Tie::RefHash; @@ -36,6 +45,11 @@ see the C entry in perlfunc(1) and perltie(1) for more information. print ref($_), "\n"; } + tie %h, 'Tie::RefHash::Nestable'; + $h{$a}->{$b} = 1; + for (keys %h, keys %{$h{$a}}) { + print ref($_), "\n"; + } =head1 AUTHOR @@ -68,7 +82,17 @@ sub TIEHASH { sub FETCH { my($s, $k) = @_; - (ref $k) ? $s->[0]{"$k"}[1] : $s->[1]{$k}; + if (ref $k) { + if (defined $s->[0]{"$k"}) { + $s->[0]{"$k"}[1]; + } + else { + undef; + } + } + else { + $s->[1]{$k}; + } } sub STORE { @@ -121,4 +145,16 @@ sub CLEAR { %{$s->[1]} = (); } +package Tie::RefHash::Nestable; +use vars '@ISA'; @ISA = qw(Tie::RefHash); + +sub STORE { + my($s, $k, $v) = @_; + if (ref($v) eq 'HASH' and not tied %$v) { + my @elems = %$v; + tie %$v, ref($s), @elems; + } + $s->SUPER::STORE($k, $v); +} + 1;