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