X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/9a079709134ebbf4c935cc8752fdb564e5c82b94..c6c73c786b4d4a71e6f053b58104cf6488c744a4:/lib/Tie/RefHash.pm diff --git a/lib/Tie/RefHash.pm b/lib/Tie/RefHash.pm index 20f0d58..8555635 100644 --- a/lib/Tie/RefHash.pm +++ b/lib/Tie/RefHash.pm @@ -1,11 +1,73 @@ -# -# Tie/RefHash.pm - use references as hash keys -# -# Documentation at the __END__ -# - -require 5.004; package Tie::RefHash; + +our $VERSION = '1.21'; + +=head1 NAME + +Tie::RefHash - use references as hash keys + +=head1 SYNOPSIS + + 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. 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; + tie %h, 'Tie::RefHash'; + $a = []; + $b = {}; + $c = \*main; + $d = \"gunk"; + $e = sub { 'foo' }; + %h = ($a => 1, $b => 2, $c => 3, $d => 4, $e => 5); + $a->[0] = 'foo'; + $b->{foo} = 'bar'; + for (keys %h) { + print ref($_), "\n"; + } + + tie %h, 'Tie::RefHash::Nestable'; + $h{$a}->{$b} = 1; + for (keys %h, keys %{$h{$a}}) { + print ref($_), "\n"; + } + +=head1 AUTHOR + +Gurusamy Sarathy gsar@activestate.com + +=head1 VERSION + +Version 1.21 22 Jun 1999 + +=head1 SEE ALSO + +perl(1), perlfunc(1), perltie(1) + +=cut + +require 5.003_11; use Tie::Hash; @ISA = qw(Tie::Hash); use strict; @@ -22,7 +84,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 { @@ -48,7 +120,8 @@ sub EXISTS { sub FIRSTKEY { my $s = shift; - my $a = scalar(keys %{$s->[0]}) + scalar(keys %{$s->[1]}); + keys %{$s->[0]}; # reset iterator + keys %{$s->[1]}; # reset iterator $s->[2] = 0; $s->NEXTKEY; } @@ -74,63 +147,16 @@ sub CLEAR { %{$s->[1]} = (); } -1; - -__END__ - -=head1 NAME - -Tie::RefHash - use references as hash keys - - -=head1 SYNOPSIS - - require 5.004; - use Tie::RefHash; - tie HASHVARIABLE, 'Tie::RefHash', 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. - -It is implemented using the standard perl TIEHASH interface. Please -see the C entry in perlfunc(1) and perltie(1) for more information. - - -=head1 EXAMPLE - - use Tie::RefHash; - tie %h, 'Tie::RefHash'; - $a = []; - $b = {}; - $c = \*main; - $d = \"gunk"; - $e = sub { 'foo' }; - %h = ($a => 1, $b => 2, $c => 3, $d => 4, $e => 5); - $a->[0] = 'foo'; - $b->{foo} = 'bar'; - for (keys %h) { - print ref($_), "\n"; - } - - -=head1 AUTHOR - -Gurusamy Sarathy gsar@umich.edu - - -=head1 VERSION - -Version 1.2 15 Dec 1996 - - -=head1 SEE ALSO - -perl(1), perlfunc(1), perltie(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); +} -=cut +1;