1*0Sstevel@tonic-gatepackage Tie::RefHash; 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateour $VERSION = 1.31; 4*0Sstevel@tonic-gate 5*0Sstevel@tonic-gate=head1 NAME 6*0Sstevel@tonic-gate 7*0Sstevel@tonic-gateTie::RefHash - use references as hash keys 8*0Sstevel@tonic-gate 9*0Sstevel@tonic-gate=head1 SYNOPSIS 10*0Sstevel@tonic-gate 11*0Sstevel@tonic-gate require 5.004; 12*0Sstevel@tonic-gate use Tie::RefHash; 13*0Sstevel@tonic-gate tie HASHVARIABLE, 'Tie::RefHash', LIST; 14*0Sstevel@tonic-gate tie HASHVARIABLE, 'Tie::RefHash::Nestable', LIST; 15*0Sstevel@tonic-gate 16*0Sstevel@tonic-gate untie HASHVARIABLE; 17*0Sstevel@tonic-gate 18*0Sstevel@tonic-gate=head1 DESCRIPTION 19*0Sstevel@tonic-gate 20*0Sstevel@tonic-gateThis module provides the ability to use references as hash keys if you 21*0Sstevel@tonic-gatefirst C<tie> the hash variable to this module. Normally, only the 22*0Sstevel@tonic-gatekeys of the tied hash itself are preserved as references; to use 23*0Sstevel@tonic-gatereferences as keys in hashes-of-hashes, use Tie::RefHash::Nestable, 24*0Sstevel@tonic-gateincluded as part of Tie::RefHash. 25*0Sstevel@tonic-gate 26*0Sstevel@tonic-gateIt is implemented using the standard perl TIEHASH interface. Please 27*0Sstevel@tonic-gatesee the C<tie> entry in perlfunc(1) and perltie(1) for more information. 28*0Sstevel@tonic-gate 29*0Sstevel@tonic-gateThe Nestable version works by looking for hash references being stored 30*0Sstevel@tonic-gateand converting them to tied hashes so that they too can have 31*0Sstevel@tonic-gatereferences as keys. This will happen without warning whenever you 32*0Sstevel@tonic-gatestore a reference to one of your own hashes in the tied hash. 33*0Sstevel@tonic-gate 34*0Sstevel@tonic-gate=head1 EXAMPLE 35*0Sstevel@tonic-gate 36*0Sstevel@tonic-gate use Tie::RefHash; 37*0Sstevel@tonic-gate tie %h, 'Tie::RefHash'; 38*0Sstevel@tonic-gate $a = []; 39*0Sstevel@tonic-gate $b = {}; 40*0Sstevel@tonic-gate $c = \*main; 41*0Sstevel@tonic-gate $d = \"gunk"; 42*0Sstevel@tonic-gate $e = sub { 'foo' }; 43*0Sstevel@tonic-gate %h = ($a => 1, $b => 2, $c => 3, $d => 4, $e => 5); 44*0Sstevel@tonic-gate $a->[0] = 'foo'; 45*0Sstevel@tonic-gate $b->{foo} = 'bar'; 46*0Sstevel@tonic-gate for (keys %h) { 47*0Sstevel@tonic-gate print ref($_), "\n"; 48*0Sstevel@tonic-gate } 49*0Sstevel@tonic-gate 50*0Sstevel@tonic-gate tie %h, 'Tie::RefHash::Nestable'; 51*0Sstevel@tonic-gate $h{$a}->{$b} = 1; 52*0Sstevel@tonic-gate for (keys %h, keys %{$h{$a}}) { 53*0Sstevel@tonic-gate print ref($_), "\n"; 54*0Sstevel@tonic-gate } 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gate=head1 AUTHOR 57*0Sstevel@tonic-gate 58*0Sstevel@tonic-gateGurusamy Sarathy gsar@activestate.com 59*0Sstevel@tonic-gate 60*0Sstevel@tonic-gate'Nestable' by Ed Avis ed@membled.com 61*0Sstevel@tonic-gate 62*0Sstevel@tonic-gate=head1 VERSION 63*0Sstevel@tonic-gate 64*0Sstevel@tonic-gateVersion 1.30 65*0Sstevel@tonic-gate 66*0Sstevel@tonic-gate=head1 SEE ALSO 67*0Sstevel@tonic-gate 68*0Sstevel@tonic-gateperl(1), perlfunc(1), perltie(1) 69*0Sstevel@tonic-gate 70*0Sstevel@tonic-gate=cut 71*0Sstevel@tonic-gate 72*0Sstevel@tonic-gateuse Tie::Hash; 73*0Sstevel@tonic-gateuse vars '@ISA'; 74*0Sstevel@tonic-gate@ISA = qw(Tie::Hash); 75*0Sstevel@tonic-gateuse strict; 76*0Sstevel@tonic-gate 77*0Sstevel@tonic-gaterequire overload; # to support objects with overloaded "" 78*0Sstevel@tonic-gate 79*0Sstevel@tonic-gatesub TIEHASH { 80*0Sstevel@tonic-gate my $c = shift; 81*0Sstevel@tonic-gate my $s = []; 82*0Sstevel@tonic-gate bless $s, $c; 83*0Sstevel@tonic-gate while (@_) { 84*0Sstevel@tonic-gate $s->STORE(shift, shift); 85*0Sstevel@tonic-gate } 86*0Sstevel@tonic-gate return $s; 87*0Sstevel@tonic-gate} 88*0Sstevel@tonic-gate 89*0Sstevel@tonic-gatesub FETCH { 90*0Sstevel@tonic-gate my($s, $k) = @_; 91*0Sstevel@tonic-gate if (ref $k) { 92*0Sstevel@tonic-gate my $kstr = overload::StrVal($k); 93*0Sstevel@tonic-gate if (defined $s->[0]{$kstr}) { 94*0Sstevel@tonic-gate $s->[0]{$kstr}[1]; 95*0Sstevel@tonic-gate } 96*0Sstevel@tonic-gate else { 97*0Sstevel@tonic-gate undef; 98*0Sstevel@tonic-gate } 99*0Sstevel@tonic-gate } 100*0Sstevel@tonic-gate else { 101*0Sstevel@tonic-gate $s->[1]{$k}; 102*0Sstevel@tonic-gate } 103*0Sstevel@tonic-gate} 104*0Sstevel@tonic-gate 105*0Sstevel@tonic-gatesub STORE { 106*0Sstevel@tonic-gate my($s, $k, $v) = @_; 107*0Sstevel@tonic-gate if (ref $k) { 108*0Sstevel@tonic-gate $s->[0]{overload::StrVal($k)} = [$k, $v]; 109*0Sstevel@tonic-gate } 110*0Sstevel@tonic-gate else { 111*0Sstevel@tonic-gate $s->[1]{$k} = $v; 112*0Sstevel@tonic-gate } 113*0Sstevel@tonic-gate $v; 114*0Sstevel@tonic-gate} 115*0Sstevel@tonic-gate 116*0Sstevel@tonic-gatesub DELETE { 117*0Sstevel@tonic-gate my($s, $k) = @_; 118*0Sstevel@tonic-gate (ref $k) ? delete($s->[0]{overload::StrVal($k)}) : delete($s->[1]{$k}); 119*0Sstevel@tonic-gate} 120*0Sstevel@tonic-gate 121*0Sstevel@tonic-gatesub EXISTS { 122*0Sstevel@tonic-gate my($s, $k) = @_; 123*0Sstevel@tonic-gate (ref $k) ? exists($s->[0]{overload::StrVal($k)}) : exists($s->[1]{$k}); 124*0Sstevel@tonic-gate} 125*0Sstevel@tonic-gate 126*0Sstevel@tonic-gatesub FIRSTKEY { 127*0Sstevel@tonic-gate my $s = shift; 128*0Sstevel@tonic-gate keys %{$s->[0]}; # reset iterator 129*0Sstevel@tonic-gate keys %{$s->[1]}; # reset iterator 130*0Sstevel@tonic-gate $s->[2] = 0; # flag for iteration, see NEXTKEY 131*0Sstevel@tonic-gate $s->NEXTKEY; 132*0Sstevel@tonic-gate} 133*0Sstevel@tonic-gate 134*0Sstevel@tonic-gatesub NEXTKEY { 135*0Sstevel@tonic-gate my $s = shift; 136*0Sstevel@tonic-gate my ($k, $v); 137*0Sstevel@tonic-gate if (!$s->[2]) { 138*0Sstevel@tonic-gate if (($k, $v) = each %{$s->[0]}) { 139*0Sstevel@tonic-gate return $v->[0]; 140*0Sstevel@tonic-gate } 141*0Sstevel@tonic-gate else { 142*0Sstevel@tonic-gate $s->[2] = 1; 143*0Sstevel@tonic-gate } 144*0Sstevel@tonic-gate } 145*0Sstevel@tonic-gate return each %{$s->[1]}; 146*0Sstevel@tonic-gate} 147*0Sstevel@tonic-gate 148*0Sstevel@tonic-gatesub CLEAR { 149*0Sstevel@tonic-gate my $s = shift; 150*0Sstevel@tonic-gate $s->[2] = 0; 151*0Sstevel@tonic-gate %{$s->[0]} = (); 152*0Sstevel@tonic-gate %{$s->[1]} = (); 153*0Sstevel@tonic-gate} 154*0Sstevel@tonic-gate 155*0Sstevel@tonic-gatepackage Tie::RefHash::Nestable; 156*0Sstevel@tonic-gateuse vars '@ISA'; 157*0Sstevel@tonic-gate@ISA = 'Tie::RefHash'; 158*0Sstevel@tonic-gate 159*0Sstevel@tonic-gatesub STORE { 160*0Sstevel@tonic-gate my($s, $k, $v) = @_; 161*0Sstevel@tonic-gate if (ref($v) eq 'HASH' and not tied %$v) { 162*0Sstevel@tonic-gate my @elems = %$v; 163*0Sstevel@tonic-gate tie %$v, ref($s), @elems; 164*0Sstevel@tonic-gate } 165*0Sstevel@tonic-gate $s->SUPER::STORE($k, $v); 166*0Sstevel@tonic-gate} 167*0Sstevel@tonic-gate 168*0Sstevel@tonic-gate1; 169