1N/Apackage Tie::RefHash;
1N/A
1N/Aour $VERSION = 1.31;
1N/A
1N/A=head1 NAME
1N/A
1N/ATie::RefHash - use references as hash keys
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A require 5.004;
1N/A use Tie::RefHash;
1N/A tie HASHVARIABLE, 'Tie::RefHash', LIST;
1N/A tie HASHVARIABLE, 'Tie::RefHash::Nestable', LIST;
1N/A
1N/A untie HASHVARIABLE;
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/AThis module provides the ability to use references as hash keys if you
1N/Afirst C<tie> the hash variable to this module. Normally, only the
1N/Akeys of the tied hash itself are preserved as references; to use
1N/Areferences as keys in hashes-of-hashes, use Tie::RefHash::Nestable,
1N/Aincluded as part of Tie::RefHash.
1N/A
1N/AIt is implemented using the standard perl TIEHASH interface. Please
1N/Asee the C<tie> entry in perlfunc(1) and perltie(1) for more information.
1N/A
1N/AThe Nestable version works by looking for hash references being stored
1N/Aand converting them to tied hashes so that they too can have
1N/Areferences as keys. This will happen without warning whenever you
1N/Astore a reference to one of your own hashes in the tied hash.
1N/A
1N/A=head1 EXAMPLE
1N/A
1N/A use Tie::RefHash;
1N/A tie %h, 'Tie::RefHash';
1N/A $a = [];
1N/A $b = {};
1N/A $c = \*main;
1N/A $d = \"gunk";
1N/A $e = sub { 'foo' };
1N/A %h = ($a => 1, $b => 2, $c => 3, $d => 4, $e => 5);
1N/A $a->[0] = 'foo';
1N/A $b->{foo} = 'bar';
1N/A for (keys %h) {
1N/A print ref($_), "\n";
1N/A }
1N/A
1N/A tie %h, 'Tie::RefHash::Nestable';
1N/A $h{$a}->{$b} = 1;
1N/A for (keys %h, keys %{$h{$a}}) {
1N/A print ref($_), "\n";
1N/A }
1N/A
1N/A=head1 AUTHOR
1N/A
1N/AGurusamy Sarathy gsar@activestate.com
1N/A
1N/A'Nestable' by Ed Avis ed@membled.com
1N/A
1N/A=head1 VERSION
1N/A
1N/AVersion 1.30
1N/A
1N/A=head1 SEE ALSO
1N/A
1N/Aperl(1), perlfunc(1), perltie(1)
1N/A
1N/A=cut
1N/A
1N/Ause Tie::Hash;
1N/Ause vars '@ISA';
1N/A@ISA = qw(Tie::Hash);
1N/Ause strict;
1N/A
1N/Arequire overload; # to support objects with overloaded ""
1N/A
1N/Asub TIEHASH {
1N/A my $c = shift;
1N/A my $s = [];
1N/A bless $s, $c;
1N/A while (@_) {
1N/A $s->STORE(shift, shift);
1N/A }
1N/A return $s;
1N/A}
1N/A
1N/Asub FETCH {
1N/A my($s, $k) = @_;
1N/A if (ref $k) {
1N/A my $kstr = overload::StrVal($k);
1N/A if (defined $s->[0]{$kstr}) {
1N/A $s->[0]{$kstr}[1];
1N/A }
1N/A else {
1N/A undef;
1N/A }
1N/A }
1N/A else {
1N/A $s->[1]{$k};
1N/A }
1N/A}
1N/A
1N/Asub STORE {
1N/A my($s, $k, $v) = @_;
1N/A if (ref $k) {
1N/A $s->[0]{overload::StrVal($k)} = [$k, $v];
1N/A }
1N/A else {
1N/A $s->[1]{$k} = $v;
1N/A }
1N/A $v;
1N/A}
1N/A
1N/Asub DELETE {
1N/A my($s, $k) = @_;
1N/A (ref $k) ? delete($s->[0]{overload::StrVal($k)}) : delete($s->[1]{$k});
1N/A}
1N/A
1N/Asub EXISTS {
1N/A my($s, $k) = @_;
1N/A (ref $k) ? exists($s->[0]{overload::StrVal($k)}) : exists($s->[1]{$k});
1N/A}
1N/A
1N/Asub FIRSTKEY {
1N/A my $s = shift;
1N/A keys %{$s->[0]}; # reset iterator
1N/A keys %{$s->[1]}; # reset iterator
1N/A $s->[2] = 0; # flag for iteration, see NEXTKEY
1N/A $s->NEXTKEY;
1N/A}
1N/A
1N/Asub NEXTKEY {
1N/A my $s = shift;
1N/A my ($k, $v);
1N/A if (!$s->[2]) {
1N/A if (($k, $v) = each %{$s->[0]}) {
1N/A return $v->[0];
1N/A }
1N/A else {
1N/A $s->[2] = 1;
1N/A }
1N/A }
1N/A return each %{$s->[1]};
1N/A}
1N/A
1N/Asub CLEAR {
1N/A my $s = shift;
1N/A $s->[2] = 0;
1N/A %{$s->[0]} = ();
1N/A %{$s->[1]} = ();
1N/A}
1N/A
1N/Apackage Tie::RefHash::Nestable;
1N/Ause vars '@ISA';
1N/A@ISA = 'Tie::RefHash';
1N/A
1N/Asub STORE {
1N/A my($s, $k, $v) = @_;
1N/A if (ref($v) eq 'HASH' and not tied %$v) {
1N/A my @elems = %$v;
1N/A tie %$v, ref($s), @elems;
1N/A }
1N/A $s->SUPER::STORE($k, $v);
1N/A}
1N/A
1N/A1;