Commit | Line | Data |
---|---|---|
64d0c973 | 1 | package Tie::Hash; |
cb1a09d0 | 2 | |
6af6617c | 3 | our $VERSION = '1.05'; |
b75c8c73 | 4 | |
cb1a09d0 AD |
5 | =head1 NAME |
6 | ||
d5582e24 | 7 | Tie::Hash, Tie::StdHash, Tie::ExtraHash - base class definitions for tied hashes |
cb1a09d0 AD |
8 | |
9 | =head1 SYNOPSIS | |
10 | ||
11 | package NewHash; | |
64d0c973 | 12 | require Tie::Hash; |
bbc7dcd2 | 13 | |
abc0156b | 14 | @ISA = qw(Tie::Hash); |
bbc7dcd2 | 15 | |
cb1a09d0 AD |
16 | sub DELETE { ... } # Provides needed method |
17 | sub CLEAR { ... } # Overrides inherited method | |
bbc7dcd2 MS |
18 | |
19 | ||
cb1a09d0 | 20 | package NewStdHash; |
64d0c973 | 21 | require Tie::Hash; |
bbc7dcd2 | 22 | |
abc0156b | 23 | @ISA = qw(Tie::StdHash); |
bbc7dcd2 | 24 | |
555bd962 BG |
25 | # All methods provided by default, define |
26 | # only those needing overrides | |
d5582e24 | 27 | # Accessors access the storage in %{$_[0]}; |
15634f32 | 28 | # TIEHASH should return a reference to the actual storage |
cb1a09d0 | 29 | sub DELETE { ... } |
bbc7dcd2 | 30 | |
d5582e24 IZ |
31 | package NewExtraHash; |
32 | require Tie::Hash; | |
33 | ||
abc0156b | 34 | @ISA = qw(Tie::ExtraHash); |
d5582e24 | 35 | |
555bd962 BG |
36 | # All methods provided by default, define |
37 | # only those needing overrides | |
d5582e24 | 38 | # Accessors access the storage in %{$_[0][0]}; |
555bd962 BG |
39 | # TIEHASH should return an array reference with the first element |
40 | # being the reference to the actual storage | |
d5582e24 IZ |
41 | sub DELETE { |
42 | $_[0][1]->('del', $_[0][0], $_[1]); # Call the report writer | |
96820f7c SR |
43 | delete $_[0][0]->{$_[1]}; # $_[0]->SUPER::DELETE($_[1]) |
44 | } | |
d5582e24 | 45 | |
bbc7dcd2 | 46 | |
cb1a09d0 | 47 | package main; |
bbc7dcd2 | 48 | |
c954a603 | 49 | tie %new_hash, 'NewHash'; |
50 | tie %new_std_hash, 'NewStdHash'; | |
d5582e24 IZ |
51 | tie %new_extra_hash, 'NewExtraHash', |
52 | sub {warn "Doing \U$_[1]\E of $_[2].\n"}; | |
cb1a09d0 AD |
53 | |
54 | =head1 DESCRIPTION | |
55 | ||
56 | This module provides some skeletal methods for hash-tying classes. See | |
64d0c973 RR |
57 | L<perltie> for a list of the functions required in order to tie a hash |
58 | to a package. The basic B<Tie::Hash> package provides a C<new> method, as well | |
d5582e24 IZ |
59 | as methods C<TIEHASH>, C<EXISTS> and C<CLEAR>. The B<Tie::StdHash> and |
60 | B<Tie::ExtraHash> packages | |
61 | provide most methods for hashes described in L<perltie> (the exceptions | |
62 | are C<UNTIE> and C<DESTROY>). They cause tied hashes to behave exactly like standard hashes, | |
63 | and allow for selective overwriting of methods. B<Tie::Hash> grandfathers the | |
64 | C<new> method: it is used if C<TIEHASH> is not defined | |
65 | in the case a class forgets to include a C<TIEHASH> method. | |
cb1a09d0 AD |
66 | |
67 | For developers wishing to write their own tied hashes, the required methods | |
64d0c973 RR |
68 | are briefly defined below. See the L<perltie> section for more detailed |
69 | descriptive, as well as example code: | |
70 | ||
bbc7dcd2 | 71 | =over 4 |
cb1a09d0 AD |
72 | |
73 | =item TIEHASH classname, LIST | |
74 | ||
64d0c973 | 75 | The method invoked by the command C<tie %hash, classname>. Associates a new |
cb1a09d0 AD |
76 | hash instance with the specified class. C<LIST> would represent additional |
77 | arguments (along the lines of L<AnyDBM_File> and compatriots) needed to | |
78 | complete the association. | |
79 | ||
80 | =item STORE this, key, value | |
81 | ||
82 | Store datum I<value> into I<key> for the tied hash I<this>. | |
83 | ||
84 | =item FETCH this, key | |
85 | ||
86 | Retrieve the datum in I<key> for the tied hash I<this>. | |
87 | ||
88 | =item FIRSTKEY this | |
89 | ||
51c7a601 | 90 | Return the first key in the hash. |
cb1a09d0 AD |
91 | |
92 | =item NEXTKEY this, lastkey | |
93 | ||
51c7a601 | 94 | Return the next key in the hash. |
cb1a09d0 AD |
95 | |
96 | =item EXISTS this, key | |
97 | ||
98 | Verify that I<key> exists with the tied hash I<this>. | |
99 | ||
01020589 GS |
100 | The B<Tie::Hash> implementation is a stub that simply croaks. |
101 | ||
cb1a09d0 AD |
102 | =item DELETE this, key |
103 | ||
104 | Delete the key I<key> from the tied hash I<this>. | |
105 | ||
106 | =item CLEAR this | |
107 | ||
108 | Clear all values from the tied hash I<this>. | |
109 | ||
a3bcc51e TP |
110 | =item SCALAR this |
111 | ||
112 | Returns what evaluating the hash in scalar context yields. | |
113 | ||
114 | B<Tie::Hash> does not implement this method (but B<Tie::StdHash> | |
115 | and B<Tie::ExtraHash> do). | |
116 | ||
cb1a09d0 AD |
117 | =back |
118 | ||
d5582e24 IZ |
119 | =head1 Inheriting from B<Tie::StdHash> |
120 | ||
121 | The accessor methods assume that the actual storage for the data in the tied | |
122 | hash is in the hash referenced by C<tied(%tiedhash)>. Thus overwritten | |
15634f32 | 123 | C<TIEHASH> method should return a hash reference, and the remaining methods |
d5582e24 IZ |
124 | should operate on the hash referenced by the first argument: |
125 | ||
126 | package ReportHash; | |
127 | our @ISA = 'Tie::StdHash'; | |
128 | ||
129 | sub TIEHASH { | |
130 | my $storage = bless {}, shift; | |
131 | warn "New ReportHash created, stored in $storage.\n"; | |
132 | $storage | |
133 | } | |
134 | sub STORE { | |
135 | warn "Storing data with key $_[1] at $_[0].\n"; | |
136 | $_[0]{$_[1]} = $_[2] | |
137 | } | |
138 | ||
cb1a09d0 | 139 | |
d5582e24 IZ |
140 | =head1 Inheriting from B<Tie::ExtraHash> |
141 | ||
142 | The accessor methods assume that the actual storage for the data in the tied | |
a3bcc51e | 143 | hash is in the hash referenced by C<(tied(%tiedhash))-E<gt>[0]>. Thus overwritten |
15634f32 | 144 | C<TIEHASH> method should return an array reference with the first |
d5582e24 | 145 | element being a hash reference, and the remaining methods should operate on the |
194eaab5 | 146 | hash C<< %{ $_[0]->[0] } >>: |
d5582e24 IZ |
147 | |
148 | package ReportHash; | |
1db7d662 | 149 | our @ISA = 'Tie::ExtraHash'; |
d5582e24 IZ |
150 | |
151 | sub TIEHASH { | |
1db7d662 BT |
152 | my $class = shift; |
153 | my $storage = bless [{}, @_], $class; | |
d5582e24 | 154 | warn "New ReportHash created, stored in $storage.\n"; |
1db7d662 | 155 | $storage; |
d5582e24 IZ |
156 | } |
157 | sub STORE { | |
158 | warn "Storing data with key $_[1] at $_[0].\n"; | |
159 | $_[0][0]{$_[1]} = $_[2] | |
160 | } | |
161 | ||
15634f32 | 162 | The default C<TIEHASH> method stores "extra" arguments to tie() starting |
d5582e24 IZ |
163 | from offset 1 in the array referenced by C<tied(%tiedhash)>; this is the |
164 | same storage algorithm as in TIEHASH subroutine above. Hence, a typical | |
165 | package inheriting from B<Tie::ExtraHash> does not need to overwrite this | |
166 | method. | |
167 | ||
a3bcc51e | 168 | =head1 C<SCALAR>, C<UNTIE> and C<DESTROY> |
d5582e24 IZ |
169 | |
170 | The methods C<UNTIE> and C<DESTROY> are not defined in B<Tie::Hash>, | |
171 | B<Tie::StdHash>, or B<Tie::ExtraHash>. Tied hashes do not require | |
3c4b39be | 172 | presence of these methods, but if defined, the methods will be called in |
d5582e24 IZ |
173 | proper time, see L<perltie>. |
174 | ||
a3bcc51e TP |
175 | C<SCALAR> is only defined in B<Tie::StdHash> and B<Tie::ExtraHash>. |
176 | ||
d5582e24 | 177 | If needed, these methods should be defined by the package inheriting from |
d195d98b | 178 | B<Tie::Hash>, B<Tie::StdHash>, or B<Tie::ExtraHash>. See L<perltie/"SCALAR"> |
a3bcc51e | 179 | to find out what happens when C<SCALAR> does not exist. |
cb1a09d0 AD |
180 | |
181 | =head1 MORE INFORMATION | |
182 | ||
8dcee03e | 183 | The packages relating to various DBM-related implementations (F<DB_File>, |
cb1a09d0 | 184 | F<NDBM_File>, etc.) show examples of general tied hashes, as does the |
64d0c973 | 185 | L<Config> module. While these do not utilize B<Tie::Hash>, they serve as |
cb1a09d0 AD |
186 | good working examples. |
187 | ||
188 | =cut | |
a6006777 | 189 | |
a0d0e21e | 190 | use Carp; |
d3a7d8c7 | 191 | use warnings::register; |
a0d0e21e LW |
192 | |
193 | sub new { | |
4633a7c4 LW |
194 | my $pkg = shift; |
195 | $pkg->TIEHASH(@_); | |
a0d0e21e LW |
196 | } |
197 | ||
198 | # Grandfather "new" | |
199 | ||
200 | sub TIEHASH { | |
4633a7c4 | 201 | my $pkg = shift; |
c9a84c8b NC |
202 | my $pkg_new = $pkg -> can ('new'); |
203 | ||
204 | if ($pkg_new and $pkg ne __PACKAGE__) { | |
205 | my $my_new = __PACKAGE__ -> can ('new'); | |
206 | if ($pkg_new == $my_new) { | |
207 | # | |
208 | # Prevent recursion | |
209 | # | |
210 | croak "$pkg must define either a TIEHASH() or a new() method"; | |
211 | } | |
212 | ||
213 | warnings::warnif ("WARNING: calling ${pkg}->new since " . | |
214 | "${pkg}->TIEHASH is missing"); | |
215 | $pkg -> new (@_); | |
a0d0e21e LW |
216 | } |
217 | else { | |
4633a7c4 | 218 | croak "$pkg doesn't define a TIEHASH method"; |
a0d0e21e LW |
219 | } |
220 | } | |
221 | ||
222 | sub EXISTS { | |
4633a7c4 LW |
223 | my $pkg = ref $_[0]; |
224 | croak "$pkg doesn't define an EXISTS method"; | |
a0d0e21e LW |
225 | } |
226 | ||
227 | sub CLEAR { | |
228 | my $self = shift; | |
229 | my $key = $self->FIRSTKEY(@_); | |
230 | my @keys; | |
231 | ||
232 | while (defined $key) { | |
233 | push @keys, $key; | |
234 | $key = $self->NEXTKEY(@_, $key); | |
235 | } | |
236 | foreach $key (@keys) { | |
237 | $self->DELETE(@_, $key); | |
238 | } | |
239 | } | |
240 | ||
64d0c973 | 241 | # The Tie::StdHash package implements standard perl hash behaviour. |
748a9306 LW |
242 | # It exists to act as a base class for classes which only wish to |
243 | # alter some parts of their behaviour. | |
244 | ||
64d0c973 | 245 | package Tie::StdHash; |
d5582e24 | 246 | # @ISA = qw(Tie::Hash); # would inherit new() only |
748a9306 LW |
247 | |
248 | sub TIEHASH { bless {}, $_[0] } | |
249 | sub STORE { $_[0]->{$_[1]} = $_[2] } | |
250 | sub FETCH { $_[0]->{$_[1]} } | |
251 | sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} } | |
252 | sub NEXTKEY { each %{$_[0]} } | |
253 | sub EXISTS { exists $_[0]->{$_[1]} } | |
254 | sub DELETE { delete $_[0]->{$_[1]} } | |
255 | sub CLEAR { %{$_[0]} = () } | |
a3bcc51e | 256 | sub SCALAR { scalar %{$_[0]} } |
748a9306 | 257 | |
d5582e24 IZ |
258 | package Tie::ExtraHash; |
259 | ||
260 | sub TIEHASH { my $p = shift; bless [{}, @_], $p } | |
261 | sub STORE { $_[0][0]{$_[1]} = $_[2] } | |
262 | sub FETCH { $_[0][0]{$_[1]} } | |
263 | sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} } | |
264 | sub NEXTKEY { each %{$_[0][0]} } | |
265 | sub EXISTS { exists $_[0][0]->{$_[1]} } | |
266 | sub DELETE { delete $_[0][0]->{$_[1]} } | |
267 | sub CLEAR { %{$_[0][0]} = () } | |
a3bcc51e | 268 | sub SCALAR { scalar %{$_[0][0]} } |
d5582e24 | 269 | |
a0d0e21e | 270 | 1; |