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