1 | =head1 NAME
|
---|
2 | X<tie>
|
---|
3 |
|
---|
4 | perltie - how to hide an object class in a simple variable
|
---|
5 |
|
---|
6 | =head1 SYNOPSIS
|
---|
7 |
|
---|
8 | tie VARIABLE, CLASSNAME, LIST
|
---|
9 |
|
---|
10 | $object = tied VARIABLE
|
---|
11 |
|
---|
12 | untie VARIABLE
|
---|
13 |
|
---|
14 | =head1 DESCRIPTION
|
---|
15 |
|
---|
16 | Prior to release 5.0 of Perl, a programmer could use dbmopen()
|
---|
17 | to connect an on-disk database in the standard Unix dbm(3x)
|
---|
18 | format magically to a %HASH in their program. However, their Perl was either
|
---|
19 | built with one particular dbm library or another, but not both, and
|
---|
20 | you couldn't extend this mechanism to other packages or types of variables.
|
---|
21 |
|
---|
22 | Now you can.
|
---|
23 |
|
---|
24 | The tie() function binds a variable to a class (package) that will provide
|
---|
25 | the implementation for access methods for that variable. Once this magic
|
---|
26 | has been performed, accessing a tied variable automatically triggers
|
---|
27 | method calls in the proper class. The complexity of the class is
|
---|
28 | hidden behind magic methods calls. The method names are in ALL CAPS,
|
---|
29 | which is a convention that Perl uses to indicate that they're called
|
---|
30 | implicitly rather than explicitly--just like the BEGIN() and END()
|
---|
31 | functions.
|
---|
32 |
|
---|
33 | In the tie() call, C<VARIABLE> is the name of the variable to be
|
---|
34 | enchanted. C<CLASSNAME> is the name of a class implementing objects of
|
---|
35 | the correct type. Any additional arguments in the C<LIST> are passed to
|
---|
36 | the appropriate constructor method for that class--meaning TIESCALAR(),
|
---|
37 | TIEARRAY(), TIEHASH(), or TIEHANDLE(). (Typically these are arguments
|
---|
38 | such as might be passed to the dbminit() function of C.) The object
|
---|
39 | returned by the "new" method is also returned by the tie() function,
|
---|
40 | which would be useful if you wanted to access other methods in
|
---|
41 | C<CLASSNAME>. (You don't actually have to return a reference to a right
|
---|
42 | "type" (e.g., HASH or C<CLASSNAME>) so long as it's a properly blessed
|
---|
43 | object.) You can also retrieve a reference to the underlying object
|
---|
44 | using the tied() function.
|
---|
45 |
|
---|
46 | Unlike dbmopen(), the tie() function will not C<use> or C<require> a module
|
---|
47 | for you--you need to do that explicitly yourself.
|
---|
48 |
|
---|
49 | =head2 Tying Scalars
|
---|
50 | X<scalar, tying>
|
---|
51 |
|
---|
52 | A class implementing a tied scalar should define the following methods:
|
---|
53 | TIESCALAR, FETCH, STORE, and possibly UNTIE and/or DESTROY.
|
---|
54 |
|
---|
55 | Let's look at each in turn, using as an example a tie class for
|
---|
56 | scalars that allows the user to do something like:
|
---|
57 |
|
---|
58 | tie $his_speed, 'Nice', getppid();
|
---|
59 | tie $my_speed, 'Nice', $$;
|
---|
60 |
|
---|
61 | And now whenever either of those variables is accessed, its current
|
---|
62 | system priority is retrieved and returned. If those variables are set,
|
---|
63 | then the process's priority is changed!
|
---|
64 |
|
---|
65 | We'll use Jarkko Hietaniemi <F<[email protected]>>'s BSD::Resource class (not
|
---|
66 | included) to access the PRIO_PROCESS, PRIO_MIN, and PRIO_MAX constants
|
---|
67 | from your system, as well as the getpriority() and setpriority() system
|
---|
68 | calls. Here's the preamble of the class.
|
---|
69 |
|
---|
70 | package Nice;
|
---|
71 | use Carp;
|
---|
72 | use BSD::Resource;
|
---|
73 | use strict;
|
---|
74 | $Nice::DEBUG = 0 unless defined $Nice::DEBUG;
|
---|
75 |
|
---|
76 | =over 4
|
---|
77 |
|
---|
78 | =item TIESCALAR classname, LIST
|
---|
79 | X<TIESCALAR>
|
---|
80 |
|
---|
81 | This is the constructor for the class. That means it is
|
---|
82 | expected to return a blessed reference to a new scalar
|
---|
83 | (probably anonymous) that it's creating. For example:
|
---|
84 |
|
---|
85 | sub TIESCALAR {
|
---|
86 | my $class = shift;
|
---|
87 | my $pid = shift || $$; # 0 means me
|
---|
88 |
|
---|
89 | if ($pid !~ /^\d+$/) {
|
---|
90 | carp "Nice::Tie::Scalar got non-numeric pid $pid" if $^W;
|
---|
91 | return undef;
|
---|
92 | }
|
---|
93 |
|
---|
94 | unless (kill 0, $pid) { # EPERM or ERSCH, no doubt
|
---|
95 | carp "Nice::Tie::Scalar got bad pid $pid: $!" if $^W;
|
---|
96 | return undef;
|
---|
97 | }
|
---|
98 |
|
---|
99 | return bless \$pid, $class;
|
---|
100 | }
|
---|
101 |
|
---|
102 | This tie class has chosen to return an error rather than raising an
|
---|
103 | exception if its constructor should fail. While this is how dbmopen() works,
|
---|
104 | other classes may well not wish to be so forgiving. It checks the global
|
---|
105 | variable C<$^W> to see whether to emit a bit of noise anyway.
|
---|
106 |
|
---|
107 | =item FETCH this
|
---|
108 | X<FETCH>
|
---|
109 |
|
---|
110 | This method will be triggered every time the tied variable is accessed
|
---|
111 | (read). It takes no arguments beyond its self reference, which is the
|
---|
112 | object representing the scalar we're dealing with. Because in this case
|
---|
113 | we're using just a SCALAR ref for the tied scalar object, a simple $$self
|
---|
114 | allows the method to get at the real value stored there. In our example
|
---|
115 | below, that real value is the process ID to which we've tied our variable.
|
---|
116 |
|
---|
117 | sub FETCH {
|
---|
118 | my $self = shift;
|
---|
119 | confess "wrong type" unless ref $self;
|
---|
120 | croak "usage error" if @_;
|
---|
121 | my $nicety;
|
---|
122 | local($!) = 0;
|
---|
123 | $nicety = getpriority(PRIO_PROCESS, $$self);
|
---|
124 | if ($!) { croak "getpriority failed: $!" }
|
---|
125 | return $nicety;
|
---|
126 | }
|
---|
127 |
|
---|
128 | This time we've decided to blow up (raise an exception) if the renice
|
---|
129 | fails--there's no place for us to return an error otherwise, and it's
|
---|
130 | probably the right thing to do.
|
---|
131 |
|
---|
132 | =item STORE this, value
|
---|
133 | X<STORE>
|
---|
134 |
|
---|
135 | This method will be triggered every time the tied variable is set
|
---|
136 | (assigned). Beyond its self reference, it also expects one (and only one)
|
---|
137 | argument--the new value the user is trying to assign. Don't worry about
|
---|
138 | returning a value from STORE -- the semantic of assignment returning the
|
---|
139 | assigned value is implemented with FETCH.
|
---|
140 |
|
---|
141 | sub STORE {
|
---|
142 | my $self = shift;
|
---|
143 | confess "wrong type" unless ref $self;
|
---|
144 | my $new_nicety = shift;
|
---|
145 | croak "usage error" if @_;
|
---|
146 |
|
---|
147 | if ($new_nicety < PRIO_MIN) {
|
---|
148 | carp sprintf
|
---|
149 | "WARNING: priority %d less than minimum system priority %d",
|
---|
150 | $new_nicety, PRIO_MIN if $^W;
|
---|
151 | $new_nicety = PRIO_MIN;
|
---|
152 | }
|
---|
153 |
|
---|
154 | if ($new_nicety > PRIO_MAX) {
|
---|
155 | carp sprintf
|
---|
156 | "WARNING: priority %d greater than maximum system priority %d",
|
---|
157 | $new_nicety, PRIO_MAX if $^W;
|
---|
158 | $new_nicety = PRIO_MAX;
|
---|
159 | }
|
---|
160 |
|
---|
161 | unless (defined setpriority(PRIO_PROCESS, $$self, $new_nicety)) {
|
---|
162 | confess "setpriority failed: $!";
|
---|
163 | }
|
---|
164 | }
|
---|
165 |
|
---|
166 | =item UNTIE this
|
---|
167 | X<UNTIE>
|
---|
168 |
|
---|
169 | This method will be triggered when the C<untie> occurs. This can be useful
|
---|
170 | if the class needs to know when no further calls will be made. (Except DESTROY
|
---|
171 | of course.) See L<The C<untie> Gotcha> below for more details.
|
---|
172 |
|
---|
173 | =item DESTROY this
|
---|
174 | X<DESTROY>
|
---|
175 |
|
---|
176 | This method will be triggered when the tied variable needs to be destructed.
|
---|
177 | As with other object classes, such a method is seldom necessary, because Perl
|
---|
178 | deallocates its moribund object's memory for you automatically--this isn't
|
---|
179 | C++, you know. We'll use a DESTROY method here for debugging purposes only.
|
---|
180 |
|
---|
181 | sub DESTROY {
|
---|
182 | my $self = shift;
|
---|
183 | confess "wrong type" unless ref $self;
|
---|
184 | carp "[ Nice::DESTROY pid $$self ]" if $Nice::DEBUG;
|
---|
185 | }
|
---|
186 |
|
---|
187 | =back
|
---|
188 |
|
---|
189 | That's about all there is to it. Actually, it's more than all there
|
---|
190 | is to it, because we've done a few nice things here for the sake
|
---|
191 | of completeness, robustness, and general aesthetics. Simpler
|
---|
192 | TIESCALAR classes are certainly possible.
|
---|
193 |
|
---|
194 | =head2 Tying Arrays
|
---|
195 | X<array, tying>
|
---|
196 |
|
---|
197 | A class implementing a tied ordinary array should define the following
|
---|
198 | methods: TIEARRAY, FETCH, STORE, FETCHSIZE, STORESIZE and perhaps UNTIE and/or DESTROY.
|
---|
199 |
|
---|
200 | FETCHSIZE and STORESIZE are used to provide C<$#array> and
|
---|
201 | equivalent C<scalar(@array)> access.
|
---|
202 |
|
---|
203 | The methods POP, PUSH, SHIFT, UNSHIFT, SPLICE, DELETE, and EXISTS are
|
---|
204 | required if the perl operator with the corresponding (but lowercase) name
|
---|
205 | is to operate on the tied array. The B<Tie::Array> class can be used as a
|
---|
206 | base class to implement the first five of these in terms of the basic
|
---|
207 | methods above. The default implementations of DELETE and EXISTS in
|
---|
208 | B<Tie::Array> simply C<croak>.
|
---|
209 |
|
---|
210 | In addition EXTEND will be called when perl would have pre-extended
|
---|
211 | allocation in a real array.
|
---|
212 |
|
---|
213 | For this discussion, we'll implement an array whose elements are a fixed
|
---|
214 | size at creation. If you try to create an element larger than the fixed
|
---|
215 | size, you'll take an exception. For example:
|
---|
216 |
|
---|
217 | use FixedElem_Array;
|
---|
218 | tie @array, 'FixedElem_Array', 3;
|
---|
219 | $array[0] = 'cat'; # ok.
|
---|
220 | $array[1] = 'dogs'; # exception, length('dogs') > 3.
|
---|
221 |
|
---|
222 | The preamble code for the class is as follows:
|
---|
223 |
|
---|
224 | package FixedElem_Array;
|
---|
225 | use Carp;
|
---|
226 | use strict;
|
---|
227 |
|
---|
228 | =over 4
|
---|
229 |
|
---|
230 | =item TIEARRAY classname, LIST
|
---|
231 | X<TIEARRAY>
|
---|
232 |
|
---|
233 | This is the constructor for the class. That means it is expected to
|
---|
234 | return a blessed reference through which the new array (probably an
|
---|
235 | anonymous ARRAY ref) will be accessed.
|
---|
236 |
|
---|
237 | In our example, just to show you that you don't I<really> have to return an
|
---|
238 | ARRAY reference, we'll choose a HASH reference to represent our object.
|
---|
239 | A HASH works out well as a generic record type: the C<{ELEMSIZE}> field will
|
---|
240 | store the maximum element size allowed, and the C<{ARRAY}> field will hold the
|
---|
241 | true ARRAY ref. If someone outside the class tries to dereference the
|
---|
242 | object returned (doubtless thinking it an ARRAY ref), they'll blow up.
|
---|
243 | This just goes to show you that you should respect an object's privacy.
|
---|
244 |
|
---|
245 | sub TIEARRAY {
|
---|
246 | my $class = shift;
|
---|
247 | my $elemsize = shift;
|
---|
248 | if ( @_ || $elemsize =~ /\D/ ) {
|
---|
249 | croak "usage: tie ARRAY, '" . __PACKAGE__ . "', elem_size";
|
---|
250 | }
|
---|
251 | return bless {
|
---|
252 | ELEMSIZE => $elemsize,
|
---|
253 | ARRAY => [],
|
---|
254 | }, $class;
|
---|
255 | }
|
---|
256 |
|
---|
257 | =item FETCH this, index
|
---|
258 | X<FETCH>
|
---|
259 |
|
---|
260 | This method will be triggered every time an individual element the tied array
|
---|
261 | is accessed (read). It takes one argument beyond its self reference: the
|
---|
262 | index whose value we're trying to fetch.
|
---|
263 |
|
---|
264 | sub FETCH {
|
---|
265 | my $self = shift;
|
---|
266 | my $index = shift;
|
---|
267 | return $self->{ARRAY}->[$index];
|
---|
268 | }
|
---|
269 |
|
---|
270 | If a negative array index is used to read from an array, the index
|
---|
271 | will be translated to a positive one internally by calling FETCHSIZE
|
---|
272 | before being passed to FETCH. You may disable this feature by
|
---|
273 | assigning a true value to the variable C<$NEGATIVE_INDICES> in the
|
---|
274 | tied array class.
|
---|
275 |
|
---|
276 | As you may have noticed, the name of the FETCH method (et al.) is the same
|
---|
277 | for all accesses, even though the constructors differ in names (TIESCALAR
|
---|
278 | vs TIEARRAY). While in theory you could have the same class servicing
|
---|
279 | several tied types, in practice this becomes cumbersome, and it's easiest
|
---|
280 | to keep them at simply one tie type per class.
|
---|
281 |
|
---|
282 | =item STORE this, index, value
|
---|
283 | X<STORE>
|
---|
284 |
|
---|
285 | This method will be triggered every time an element in the tied array is set
|
---|
286 | (written). It takes two arguments beyond its self reference: the index at
|
---|
287 | which we're trying to store something and the value we're trying to put
|
---|
288 | there.
|
---|
289 |
|
---|
290 | In our example, C<undef> is really C<$self-E<gt>{ELEMSIZE}> number of
|
---|
291 | spaces so we have a little more work to do here:
|
---|
292 |
|
---|
293 | sub STORE {
|
---|
294 | my $self = shift;
|
---|
295 | my( $index, $value ) = @_;
|
---|
296 | if ( length $value > $self->{ELEMSIZE} ) {
|
---|
297 | croak "length of $value is greater than $self->{ELEMSIZE}";
|
---|
298 | }
|
---|
299 | # fill in the blanks
|
---|
300 | $self->EXTEND( $index ) if $index > $self->FETCHSIZE();
|
---|
301 | # right justify to keep element size for smaller elements
|
---|
302 | $self->{ARRAY}->[$index] = sprintf "%$self->{ELEMSIZE}s", $value;
|
---|
303 | }
|
---|
304 |
|
---|
305 | Negative indexes are treated the same as with FETCH.
|
---|
306 |
|
---|
307 | =item FETCHSIZE this
|
---|
308 | X<FETCHSIZE>
|
---|
309 |
|
---|
310 | Returns the total number of items in the tied array associated with
|
---|
311 | object I<this>. (Equivalent to C<scalar(@array)>). For example:
|
---|
312 |
|
---|
313 | sub FETCHSIZE {
|
---|
314 | my $self = shift;
|
---|
315 | return scalar @{$self->{ARRAY}};
|
---|
316 | }
|
---|
317 |
|
---|
318 | =item STORESIZE this, count
|
---|
319 | X<STORESIZE>
|
---|
320 |
|
---|
321 | Sets the total number of items in the tied array associated with
|
---|
322 | object I<this> to be I<count>. If this makes the array larger then
|
---|
323 | class's mapping of C<undef> should be returned for new positions.
|
---|
324 | If the array becomes smaller then entries beyond count should be
|
---|
325 | deleted.
|
---|
326 |
|
---|
327 | In our example, 'undef' is really an element containing
|
---|
328 | C<$self-E<gt>{ELEMSIZE}> number of spaces. Observe:
|
---|
329 |
|
---|
330 | sub STORESIZE {
|
---|
331 | my $self = shift;
|
---|
332 | my $count = shift;
|
---|
333 | if ( $count > $self->FETCHSIZE() ) {
|
---|
334 | foreach ( $count - $self->FETCHSIZE() .. $count ) {
|
---|
335 | $self->STORE( $_, '' );
|
---|
336 | }
|
---|
337 | } elsif ( $count < $self->FETCHSIZE() ) {
|
---|
338 | foreach ( 0 .. $self->FETCHSIZE() - $count - 2 ) {
|
---|
339 | $self->POP();
|
---|
340 | }
|
---|
341 | }
|
---|
342 | }
|
---|
343 |
|
---|
344 | =item EXTEND this, count
|
---|
345 | X<EXTEND>
|
---|
346 |
|
---|
347 | Informative call that array is likely to grow to have I<count> entries.
|
---|
348 | Can be used to optimize allocation. This method need do nothing.
|
---|
349 |
|
---|
350 | In our example, we want to make sure there are no blank (C<undef>)
|
---|
351 | entries, so C<EXTEND> will make use of C<STORESIZE> to fill elements
|
---|
352 | as needed:
|
---|
353 |
|
---|
354 | sub EXTEND {
|
---|
355 | my $self = shift;
|
---|
356 | my $count = shift;
|
---|
357 | $self->STORESIZE( $count );
|
---|
358 | }
|
---|
359 |
|
---|
360 | =item EXISTS this, key
|
---|
361 | X<EXISTS>
|
---|
362 |
|
---|
363 | Verify that the element at index I<key> exists in the tied array I<this>.
|
---|
364 |
|
---|
365 | In our example, we will determine that if an element consists of
|
---|
366 | C<$self-E<gt>{ELEMSIZE}> spaces only, it does not exist:
|
---|
367 |
|
---|
368 | sub EXISTS {
|
---|
369 | my $self = shift;
|
---|
370 | my $index = shift;
|
---|
371 | return 0 if ! defined $self->{ARRAY}->[$index] ||
|
---|
372 | $self->{ARRAY}->[$index] eq ' ' x $self->{ELEMSIZE};
|
---|
373 | return 1;
|
---|
374 | }
|
---|
375 |
|
---|
376 | =item DELETE this, key
|
---|
377 | X<DELETE>
|
---|
378 |
|
---|
379 | Delete the element at index I<key> from the tied array I<this>.
|
---|
380 |
|
---|
381 | In our example, a deleted item is C<$self-E<gt>{ELEMSIZE}> spaces:
|
---|
382 |
|
---|
383 | sub DELETE {
|
---|
384 | my $self = shift;
|
---|
385 | my $index = shift;
|
---|
386 | return $self->STORE( $index, '' );
|
---|
387 | }
|
---|
388 |
|
---|
389 | =item CLEAR this
|
---|
390 | X<CLEAR>
|
---|
391 |
|
---|
392 | Clear (remove, delete, ...) all values from the tied array associated with
|
---|
393 | object I<this>. For example:
|
---|
394 |
|
---|
395 | sub CLEAR {
|
---|
396 | my $self = shift;
|
---|
397 | return $self->{ARRAY} = [];
|
---|
398 | }
|
---|
399 |
|
---|
400 | =item PUSH this, LIST
|
---|
401 | X<PUSH>
|
---|
402 |
|
---|
403 | Append elements of I<LIST> to the array. For example:
|
---|
404 |
|
---|
405 | sub PUSH {
|
---|
406 | my $self = shift;
|
---|
407 | my @list = @_;
|
---|
408 | my $last = $self->FETCHSIZE();
|
---|
409 | $self->STORE( $last + $_, $list[$_] ) foreach 0 .. $#list;
|
---|
410 | return $self->FETCHSIZE();
|
---|
411 | }
|
---|
412 |
|
---|
413 | =item POP this
|
---|
414 | X<POP>
|
---|
415 |
|
---|
416 | Remove last element of the array and return it. For example:
|
---|
417 |
|
---|
418 | sub POP {
|
---|
419 | my $self = shift;
|
---|
420 | return pop @{$self->{ARRAY}};
|
---|
421 | }
|
---|
422 |
|
---|
423 | =item SHIFT this
|
---|
424 | X<SHIFT>
|
---|
425 |
|
---|
426 | Remove the first element of the array (shifting other elements down)
|
---|
427 | and return it. For example:
|
---|
428 |
|
---|
429 | sub SHIFT {
|
---|
430 | my $self = shift;
|
---|
431 | return shift @{$self->{ARRAY}};
|
---|
432 | }
|
---|
433 |
|
---|
434 | =item UNSHIFT this, LIST
|
---|
435 | X<UNSHIFT>
|
---|
436 |
|
---|
437 | Insert LIST elements at the beginning of the array, moving existing elements
|
---|
438 | up to make room. For example:
|
---|
439 |
|
---|
440 | sub UNSHIFT {
|
---|
441 | my $self = shift;
|
---|
442 | my @list = @_;
|
---|
443 | my $size = scalar( @list );
|
---|
444 | # make room for our list
|
---|
445 | @{$self->{ARRAY}}[ $size .. $#{$self->{ARRAY}} + $size ]
|
---|
446 | = @{$self->{ARRAY}};
|
---|
447 | $self->STORE( $_, $list[$_] ) foreach 0 .. $#list;
|
---|
448 | }
|
---|
449 |
|
---|
450 | =item SPLICE this, offset, length, LIST
|
---|
451 | X<SPLICE>
|
---|
452 |
|
---|
453 | Perform the equivalent of C<splice> on the array.
|
---|
454 |
|
---|
455 | I<offset> is optional and defaults to zero, negative values count back
|
---|
456 | from the end of the array.
|
---|
457 |
|
---|
458 | I<length> is optional and defaults to rest of the array.
|
---|
459 |
|
---|
460 | I<LIST> may be empty.
|
---|
461 |
|
---|
462 | Returns a list of the original I<length> elements at I<offset>.
|
---|
463 |
|
---|
464 | In our example, we'll use a little shortcut if there is a I<LIST>:
|
---|
465 |
|
---|
466 | sub SPLICE {
|
---|
467 | my $self = shift;
|
---|
468 | my $offset = shift || 0;
|
---|
469 | my $length = shift || $self->FETCHSIZE() - $offset;
|
---|
470 | my @list = ();
|
---|
471 | if ( @_ ) {
|
---|
472 | tie @list, __PACKAGE__, $self->{ELEMSIZE};
|
---|
473 | @list = @_;
|
---|
474 | }
|
---|
475 | return splice @{$self->{ARRAY}}, $offset, $length, @list;
|
---|
476 | }
|
---|
477 |
|
---|
478 | =item UNTIE this
|
---|
479 | X<UNTIE>
|
---|
480 |
|
---|
481 | Will be called when C<untie> happens. (See L<The C<untie> Gotcha> below.)
|
---|
482 |
|
---|
483 | =item DESTROY this
|
---|
484 | X<DESTROY>
|
---|
485 |
|
---|
486 | This method will be triggered when the tied variable needs to be destructed.
|
---|
487 | As with the scalar tie class, this is almost never needed in a
|
---|
488 | language that does its own garbage collection, so this time we'll
|
---|
489 | just leave it out.
|
---|
490 |
|
---|
491 | =back
|
---|
492 |
|
---|
493 | =head2 Tying Hashes
|
---|
494 | X<hash, tying>
|
---|
495 |
|
---|
496 | Hashes were the first Perl data type to be tied (see dbmopen()). A class
|
---|
497 | implementing a tied hash should define the following methods: TIEHASH is
|
---|
498 | the constructor. FETCH and STORE access the key and value pairs. EXISTS
|
---|
499 | reports whether a key is present in the hash, and DELETE deletes one.
|
---|
500 | CLEAR empties the hash by deleting all the key and value pairs. FIRSTKEY
|
---|
501 | and NEXTKEY implement the keys() and each() functions to iterate over all
|
---|
502 | the keys. SCALAR is triggered when the tied hash is evaluated in scalar
|
---|
503 | context. UNTIE is called when C<untie> happens, and DESTROY is called when
|
---|
504 | the tied variable is garbage collected.
|
---|
505 |
|
---|
506 | If this seems like a lot, then feel free to inherit from merely the
|
---|
507 | standard Tie::StdHash module for most of your methods, redefining only the
|
---|
508 | interesting ones. See L<Tie::Hash> for details.
|
---|
509 |
|
---|
510 | Remember that Perl distinguishes between a key not existing in the hash,
|
---|
511 | and the key existing in the hash but having a corresponding value of
|
---|
512 | C<undef>. The two possibilities can be tested with the C<exists()> and
|
---|
513 | C<defined()> functions.
|
---|
514 |
|
---|
515 | Here's an example of a somewhat interesting tied hash class: it gives you
|
---|
516 | a hash representing a particular user's dot files. You index into the hash
|
---|
517 | with the name of the file (minus the dot) and you get back that dot file's
|
---|
518 | contents. For example:
|
---|
519 |
|
---|
520 | use DotFiles;
|
---|
521 | tie %dot, 'DotFiles';
|
---|
522 | if ( $dot{profile} =~ /MANPATH/ ||
|
---|
523 | $dot{login} =~ /MANPATH/ ||
|
---|
524 | $dot{cshrc} =~ /MANPATH/ )
|
---|
525 | {
|
---|
526 | print "you seem to set your MANPATH\n";
|
---|
527 | }
|
---|
528 |
|
---|
529 | Or here's another sample of using our tied class:
|
---|
530 |
|
---|
531 | tie %him, 'DotFiles', 'daemon';
|
---|
532 | foreach $f ( keys %him ) {
|
---|
533 | printf "daemon dot file %s is size %d\n",
|
---|
534 | $f, length $him{$f};
|
---|
535 | }
|
---|
536 |
|
---|
537 | In our tied hash DotFiles example, we use a regular
|
---|
538 | hash for the object containing several important
|
---|
539 | fields, of which only the C<{LIST}> field will be what the
|
---|
540 | user thinks of as the real hash.
|
---|
541 |
|
---|
542 | =over 5
|
---|
543 |
|
---|
544 | =item USER
|
---|
545 |
|
---|
546 | whose dot files this object represents
|
---|
547 |
|
---|
548 | =item HOME
|
---|
549 |
|
---|
550 | where those dot files live
|
---|
551 |
|
---|
552 | =item CLOBBER
|
---|
553 |
|
---|
554 | whether we should try to change or remove those dot files
|
---|
555 |
|
---|
556 | =item LIST
|
---|
557 |
|
---|
558 | the hash of dot file names and content mappings
|
---|
559 |
|
---|
560 | =back
|
---|
561 |
|
---|
562 | Here's the start of F<Dotfiles.pm>:
|
---|
563 |
|
---|
564 | package DotFiles;
|
---|
565 | use Carp;
|
---|
566 | sub whowasi { (caller(1))[3] . '()' }
|
---|
567 | my $DEBUG = 0;
|
---|
568 | sub debug { $DEBUG = @_ ? shift : 1 }
|
---|
569 |
|
---|
570 | For our example, we want to be able to emit debugging info to help in tracing
|
---|
571 | during development. We keep also one convenience function around
|
---|
572 | internally to help print out warnings; whowasi() returns the function name
|
---|
573 | that calls it.
|
---|
574 |
|
---|
575 | Here are the methods for the DotFiles tied hash.
|
---|
576 |
|
---|
577 | =over 4
|
---|
578 |
|
---|
579 | =item TIEHASH classname, LIST
|
---|
580 | X<TIEHASH>
|
---|
581 |
|
---|
582 | This is the constructor for the class. That means it is expected to
|
---|
583 | return a blessed reference through which the new object (probably but not
|
---|
584 | necessarily an anonymous hash) will be accessed.
|
---|
585 |
|
---|
586 | Here's the constructor:
|
---|
587 |
|
---|
588 | sub TIEHASH {
|
---|
589 | my $self = shift;
|
---|
590 | my $user = shift || $>;
|
---|
591 | my $dotdir = shift || '';
|
---|
592 | croak "usage: @{[&whowasi]} [USER [DOTDIR]]" if @_;
|
---|
593 | $user = getpwuid($user) if $user =~ /^\d+$/;
|
---|
594 | my $dir = (getpwnam($user))[7]
|
---|
595 | || croak "@{[&whowasi]}: no user $user";
|
---|
596 | $dir .= "/$dotdir" if $dotdir;
|
---|
597 |
|
---|
598 | my $node = {
|
---|
599 | USER => $user,
|
---|
600 | HOME => $dir,
|
---|
601 | LIST => {},
|
---|
602 | CLOBBER => 0,
|
---|
603 | };
|
---|
604 |
|
---|
605 | opendir(DIR, $dir)
|
---|
606 | || croak "@{[&whowasi]}: can't opendir $dir: $!";
|
---|
607 | foreach $dot ( grep /^\./ && -f "$dir/$_", readdir(DIR)) {
|
---|
608 | $dot =~ s/^\.//;
|
---|
609 | $node->{LIST}{$dot} = undef;
|
---|
610 | }
|
---|
611 | closedir DIR;
|
---|
612 | return bless $node, $self;
|
---|
613 | }
|
---|
614 |
|
---|
615 | It's probably worth mentioning that if you're going to filetest the
|
---|
616 | return values out of a readdir, you'd better prepend the directory
|
---|
617 | in question. Otherwise, because we didn't chdir() there, it would
|
---|
618 | have been testing the wrong file.
|
---|
619 |
|
---|
620 | =item FETCH this, key
|
---|
621 | X<FETCH>
|
---|
622 |
|
---|
623 | This method will be triggered every time an element in the tied hash is
|
---|
624 | accessed (read). It takes one argument beyond its self reference: the key
|
---|
625 | whose value we're trying to fetch.
|
---|
626 |
|
---|
627 | Here's the fetch for our DotFiles example.
|
---|
628 |
|
---|
629 | sub FETCH {
|
---|
630 | carp &whowasi if $DEBUG;
|
---|
631 | my $self = shift;
|
---|
632 | my $dot = shift;
|
---|
633 | my $dir = $self->{HOME};
|
---|
634 | my $file = "$dir/.$dot";
|
---|
635 |
|
---|
636 | unless (exists $self->{LIST}->{$dot} || -f $file) {
|
---|
637 | carp "@{[&whowasi]}: no $dot file" if $DEBUG;
|
---|
638 | return undef;
|
---|
639 | }
|
---|
640 |
|
---|
641 | if (defined $self->{LIST}->{$dot}) {
|
---|
642 | return $self->{LIST}->{$dot};
|
---|
643 | } else {
|
---|
644 | return $self->{LIST}->{$dot} = `cat $dir/.$dot`;
|
---|
645 | }
|
---|
646 | }
|
---|
647 |
|
---|
648 | It was easy to write by having it call the Unix cat(1) command, but it
|
---|
649 | would probably be more portable to open the file manually (and somewhat
|
---|
650 | more efficient). Of course, because dot files are a Unixy concept, we're
|
---|
651 | not that concerned.
|
---|
652 |
|
---|
653 | =item STORE this, key, value
|
---|
654 | X<STORE>
|
---|
655 |
|
---|
656 | This method will be triggered every time an element in the tied hash is set
|
---|
657 | (written). It takes two arguments beyond its self reference: the index at
|
---|
658 | which we're trying to store something, and the value we're trying to put
|
---|
659 | there.
|
---|
660 |
|
---|
661 | Here in our DotFiles example, we'll be careful not to let
|
---|
662 | them try to overwrite the file unless they've called the clobber()
|
---|
663 | method on the original object reference returned by tie().
|
---|
664 |
|
---|
665 | sub STORE {
|
---|
666 | carp &whowasi if $DEBUG;
|
---|
667 | my $self = shift;
|
---|
668 | my $dot = shift;
|
---|
669 | my $value = shift;
|
---|
670 | my $file = $self->{HOME} . "/.$dot";
|
---|
671 | my $user = $self->{USER};
|
---|
672 |
|
---|
673 | croak "@{[&whowasi]}: $file not clobberable"
|
---|
674 | unless $self->{CLOBBER};
|
---|
675 |
|
---|
676 | open(F, "> $file") || croak "can't open $file: $!";
|
---|
677 | print F $value;
|
---|
678 | close(F);
|
---|
679 | }
|
---|
680 |
|
---|
681 | If they wanted to clobber something, they might say:
|
---|
682 |
|
---|
683 | $ob = tie %daemon_dots, 'daemon';
|
---|
684 | $ob->clobber(1);
|
---|
685 | $daemon_dots{signature} = "A true daemon\n";
|
---|
686 |
|
---|
687 | Another way to lay hands on a reference to the underlying object is to
|
---|
688 | use the tied() function, so they might alternately have set clobber
|
---|
689 | using:
|
---|
690 |
|
---|
691 | tie %daemon_dots, 'daemon';
|
---|
692 | tied(%daemon_dots)->clobber(1);
|
---|
693 |
|
---|
694 | The clobber method is simply:
|
---|
695 |
|
---|
696 | sub clobber {
|
---|
697 | my $self = shift;
|
---|
698 | $self->{CLOBBER} = @_ ? shift : 1;
|
---|
699 | }
|
---|
700 |
|
---|
701 | =item DELETE this, key
|
---|
702 | X<DELETE>
|
---|
703 |
|
---|
704 | This method is triggered when we remove an element from the hash,
|
---|
705 | typically by using the delete() function. Again, we'll
|
---|
706 | be careful to check whether they really want to clobber files.
|
---|
707 |
|
---|
708 | sub DELETE {
|
---|
709 | carp &whowasi if $DEBUG;
|
---|
710 |
|
---|
711 | my $self = shift;
|
---|
712 | my $dot = shift;
|
---|
713 | my $file = $self->{HOME} . "/.$dot";
|
---|
714 | croak "@{[&whowasi]}: won't remove file $file"
|
---|
715 | unless $self->{CLOBBER};
|
---|
716 | delete $self->{LIST}->{$dot};
|
---|
717 | my $success = unlink($file);
|
---|
718 | carp "@{[&whowasi]}: can't unlink $file: $!" unless $success;
|
---|
719 | $success;
|
---|
720 | }
|
---|
721 |
|
---|
722 | The value returned by DELETE becomes the return value of the call
|
---|
723 | to delete(). If you want to emulate the normal behavior of delete(),
|
---|
724 | you should return whatever FETCH would have returned for this key.
|
---|
725 | In this example, we have chosen instead to return a value which tells
|
---|
726 | the caller whether the file was successfully deleted.
|
---|
727 |
|
---|
728 | =item CLEAR this
|
---|
729 | X<CLEAR>
|
---|
730 |
|
---|
731 | This method is triggered when the whole hash is to be cleared, usually by
|
---|
732 | assigning the empty list to it.
|
---|
733 |
|
---|
734 | In our example, that would remove all the user's dot files! It's such a
|
---|
735 | dangerous thing that they'll have to set CLOBBER to something higher than
|
---|
736 | 1 to make it happen.
|
---|
737 |
|
---|
738 | sub CLEAR {
|
---|
739 | carp &whowasi if $DEBUG;
|
---|
740 | my $self = shift;
|
---|
741 | croak "@{[&whowasi]}: won't remove all dot files for $self->{USER}"
|
---|
742 | unless $self->{CLOBBER} > 1;
|
---|
743 | my $dot;
|
---|
744 | foreach $dot ( keys %{$self->{LIST}}) {
|
---|
745 | $self->DELETE($dot);
|
---|
746 | }
|
---|
747 | }
|
---|
748 |
|
---|
749 | =item EXISTS this, key
|
---|
750 | X<EXISTS>
|
---|
751 |
|
---|
752 | This method is triggered when the user uses the exists() function
|
---|
753 | on a particular hash. In our example, we'll look at the C<{LIST}>
|
---|
754 | hash element for this:
|
---|
755 |
|
---|
756 | sub EXISTS {
|
---|
757 | carp &whowasi if $DEBUG;
|
---|
758 | my $self = shift;
|
---|
759 | my $dot = shift;
|
---|
760 | return exists $self->{LIST}->{$dot};
|
---|
761 | }
|
---|
762 |
|
---|
763 | =item FIRSTKEY this
|
---|
764 | X<FIRSTKEY>
|
---|
765 |
|
---|
766 | This method will be triggered when the user is going
|
---|
767 | to iterate through the hash, such as via a keys() or each()
|
---|
768 | call.
|
---|
769 |
|
---|
770 | sub FIRSTKEY {
|
---|
771 | carp &whowasi if $DEBUG;
|
---|
772 | my $self = shift;
|
---|
773 | my $a = keys %{$self->{LIST}}; # reset each() iterator
|
---|
774 | each %{$self->{LIST}}
|
---|
775 | }
|
---|
776 |
|
---|
777 | =item NEXTKEY this, lastkey
|
---|
778 | X<NEXTKEY>
|
---|
779 |
|
---|
780 | This method gets triggered during a keys() or each() iteration. It has a
|
---|
781 | second argument which is the last key that had been accessed. This is
|
---|
782 | useful if you're carrying about ordering or calling the iterator from more
|
---|
783 | than one sequence, or not really storing things in a hash anywhere.
|
---|
784 |
|
---|
785 | For our example, we're using a real hash so we'll do just the simple
|
---|
786 | thing, but we'll have to go through the LIST field indirectly.
|
---|
787 |
|
---|
788 | sub NEXTKEY {
|
---|
789 | carp &whowasi if $DEBUG;
|
---|
790 | my $self = shift;
|
---|
791 | return each %{ $self->{LIST} }
|
---|
792 | }
|
---|
793 |
|
---|
794 | =item SCALAR this
|
---|
795 | X<SCALAR>
|
---|
796 |
|
---|
797 | This is called when the hash is evaluated in scalar context. In order
|
---|
798 | to mimic the behaviour of untied hashes, this method should return a
|
---|
799 | false value when the tied hash is considered empty. If this method does
|
---|
800 | not exist, perl will make some educated guesses and return true when
|
---|
801 | the hash is inside an iteration. If this isn't the case, FIRSTKEY is
|
---|
802 | called, and the result will be a false value if FIRSTKEY returns the empty
|
---|
803 | list, true otherwise.
|
---|
804 |
|
---|
805 | However, you should B<not> blindly rely on perl always doing the right
|
---|
806 | thing. Particularly, perl will mistakenly return true when you clear the
|
---|
807 | hash by repeatedly calling DELETE until it is empty. You are therefore
|
---|
808 | advised to supply your own SCALAR method when you want to be absolutely
|
---|
809 | sure that your hash behaves nicely in scalar context.
|
---|
810 |
|
---|
811 | In our example we can just call C<scalar> on the underlying hash
|
---|
812 | referenced by C<$self-E<gt>{LIST}>:
|
---|
813 |
|
---|
814 | sub SCALAR {
|
---|
815 | carp &whowasi if $DEBUG;
|
---|
816 | my $self = shift;
|
---|
817 | return scalar %{ $self->{LIST} }
|
---|
818 | }
|
---|
819 |
|
---|
820 | =item UNTIE this
|
---|
821 | X<UNTIE>
|
---|
822 |
|
---|
823 | This is called when C<untie> occurs. See L<The C<untie> Gotcha> below.
|
---|
824 |
|
---|
825 | =item DESTROY this
|
---|
826 | X<DESTROY>
|
---|
827 |
|
---|
828 | This method is triggered when a tied hash is about to go out of
|
---|
829 | scope. You don't really need it unless you're trying to add debugging
|
---|
830 | or have auxiliary state to clean up. Here's a very simple function:
|
---|
831 |
|
---|
832 | sub DESTROY {
|
---|
833 | carp &whowasi if $DEBUG;
|
---|
834 | }
|
---|
835 |
|
---|
836 | =back
|
---|
837 |
|
---|
838 | Note that functions such as keys() and values() may return huge lists
|
---|
839 | when used on large objects, like DBM files. You may prefer to use the
|
---|
840 | each() function to iterate over such. Example:
|
---|
841 |
|
---|
842 | # print out history file offsets
|
---|
843 | use NDBM_File;
|
---|
844 | tie(%HIST, 'NDBM_File', '/usr/lib/news/history', 1, 0);
|
---|
845 | while (($key,$val) = each %HIST) {
|
---|
846 | print $key, ' = ', unpack('L',$val), "\n";
|
---|
847 | }
|
---|
848 | untie(%HIST);
|
---|
849 |
|
---|
850 | =head2 Tying FileHandles
|
---|
851 | X<filehandle, tying>
|
---|
852 |
|
---|
853 | This is partially implemented now.
|
---|
854 |
|
---|
855 | A class implementing a tied filehandle should define the following
|
---|
856 | methods: TIEHANDLE, at least one of PRINT, PRINTF, WRITE, READLINE, GETC,
|
---|
857 | READ, and possibly CLOSE, UNTIE and DESTROY. The class can also provide: BINMODE,
|
---|
858 | OPEN, EOF, FILENO, SEEK, TELL - if the corresponding perl operators are
|
---|
859 | used on the handle.
|
---|
860 |
|
---|
861 | When STDERR is tied, its PRINT method will be called to issue warnings
|
---|
862 | and error messages. This feature is temporarily disabled during the call,
|
---|
863 | which means you can use C<warn()> inside PRINT without starting a recursive
|
---|
864 | loop. And just like C<__WARN__> and C<__DIE__> handlers, STDERR's PRINT
|
---|
865 | method may be called to report parser errors, so the caveats mentioned under
|
---|
866 | L<perlvar/%SIG> apply.
|
---|
867 |
|
---|
868 | All of this is especially useful when perl is embedded in some other
|
---|
869 | program, where output to STDOUT and STDERR may have to be redirected
|
---|
870 | in some special way. See nvi and the Apache module for examples.
|
---|
871 |
|
---|
872 | In our example we're going to create a shouting handle.
|
---|
873 |
|
---|
874 | package Shout;
|
---|
875 |
|
---|
876 | =over 4
|
---|
877 |
|
---|
878 | =item TIEHANDLE classname, LIST
|
---|
879 | X<TIEHANDLE>
|
---|
880 |
|
---|
881 | This is the constructor for the class. That means it is expected to
|
---|
882 | return a blessed reference of some sort. The reference can be used to
|
---|
883 | hold some internal information.
|
---|
884 |
|
---|
885 | sub TIEHANDLE { print "<shout>\n"; my $i; bless \$i, shift }
|
---|
886 |
|
---|
887 | =item WRITE this, LIST
|
---|
888 | X<WRITE>
|
---|
889 |
|
---|
890 | This method will be called when the handle is written to via the
|
---|
891 | C<syswrite> function.
|
---|
892 |
|
---|
893 | sub WRITE {
|
---|
894 | $r = shift;
|
---|
895 | my($buf,$len,$offset) = @_;
|
---|
896 | print "WRITE called, \$buf=$buf, \$len=$len, \$offset=$offset";
|
---|
897 | }
|
---|
898 |
|
---|
899 | =item PRINT this, LIST
|
---|
900 | X<PRINT>
|
---|
901 |
|
---|
902 | This method will be triggered every time the tied handle is printed to
|
---|
903 | with the C<print()> function.
|
---|
904 | Beyond its self reference it also expects the list that was passed to
|
---|
905 | the print function.
|
---|
906 |
|
---|
907 | sub PRINT { $r = shift; $$r++; print join($,,map(uc($_),@_)),$\ }
|
---|
908 |
|
---|
909 | =item PRINTF this, LIST
|
---|
910 | X<PRINTF>
|
---|
911 |
|
---|
912 | This method will be triggered every time the tied handle is printed to
|
---|
913 | with the C<printf()> function.
|
---|
914 | Beyond its self reference it also expects the format and list that was
|
---|
915 | passed to the printf function.
|
---|
916 |
|
---|
917 | sub PRINTF {
|
---|
918 | shift;
|
---|
919 | my $fmt = shift;
|
---|
920 | print sprintf($fmt, @_);
|
---|
921 | }
|
---|
922 |
|
---|
923 | =item READ this, LIST
|
---|
924 | X<READ>
|
---|
925 |
|
---|
926 | This method will be called when the handle is read from via the C<read>
|
---|
927 | or C<sysread> functions.
|
---|
928 |
|
---|
929 | sub READ {
|
---|
930 | my $self = shift;
|
---|
931 | my $bufref = \$_[0];
|
---|
932 | my(undef,$len,$offset) = @_;
|
---|
933 | print "READ called, \$buf=$bufref, \$len=$len, \$offset=$offset";
|
---|
934 | # add to $$bufref, set $len to number of characters read
|
---|
935 | $len;
|
---|
936 | }
|
---|
937 |
|
---|
938 | =item READLINE this
|
---|
939 | X<READLINE>
|
---|
940 |
|
---|
941 | This method will be called when the handle is read from via <HANDLE>.
|
---|
942 | The method should return undef when there is no more data.
|
---|
943 |
|
---|
944 | sub READLINE { $r = shift; "READLINE called $$r times\n"; }
|
---|
945 |
|
---|
946 | =item GETC this
|
---|
947 | X<GETC>
|
---|
948 |
|
---|
949 | This method will be called when the C<getc> function is called.
|
---|
950 |
|
---|
951 | sub GETC { print "Don't GETC, Get Perl"; return "a"; }
|
---|
952 |
|
---|
953 | =item CLOSE this
|
---|
954 | X<CLOSE>
|
---|
955 |
|
---|
956 | This method will be called when the handle is closed via the C<close>
|
---|
957 | function.
|
---|
958 |
|
---|
959 | sub CLOSE { print "CLOSE called.\n" }
|
---|
960 |
|
---|
961 | =item UNTIE this
|
---|
962 | X<UNTIE>
|
---|
963 |
|
---|
964 | As with the other types of ties, this method will be called when C<untie> happens.
|
---|
965 | It may be appropriate to "auto CLOSE" when this occurs. See
|
---|
966 | L<The C<untie> Gotcha> below.
|
---|
967 |
|
---|
968 | =item DESTROY this
|
---|
969 | X<DESTROY>
|
---|
970 |
|
---|
971 | As with the other types of ties, this method will be called when the
|
---|
972 | tied handle is about to be destroyed. This is useful for debugging and
|
---|
973 | possibly cleaning up.
|
---|
974 |
|
---|
975 | sub DESTROY { print "</shout>\n" }
|
---|
976 |
|
---|
977 | =back
|
---|
978 |
|
---|
979 | Here's how to use our little example:
|
---|
980 |
|
---|
981 | tie(*FOO,'Shout');
|
---|
982 | print FOO "hello\n";
|
---|
983 | $a = 4; $b = 6;
|
---|
984 | print FOO $a, " plus ", $b, " equals ", $a + $b, "\n";
|
---|
985 | print <FOO>;
|
---|
986 |
|
---|
987 | =head2 UNTIE this
|
---|
988 | X<UNTIE>
|
---|
989 |
|
---|
990 | You can define for all tie types an UNTIE method that will be called
|
---|
991 | at untie(). See L<The C<untie> Gotcha> below.
|
---|
992 |
|
---|
993 | =head2 The C<untie> Gotcha
|
---|
994 | X<untie>
|
---|
995 |
|
---|
996 | If you intend making use of the object returned from either tie() or
|
---|
997 | tied(), and if the tie's target class defines a destructor, there is a
|
---|
998 | subtle gotcha you I<must> guard against.
|
---|
999 |
|
---|
1000 | As setup, consider this (admittedly rather contrived) example of a
|
---|
1001 | tie; all it does is use a file to keep a log of the values assigned to
|
---|
1002 | a scalar.
|
---|
1003 |
|
---|
1004 | package Remember;
|
---|
1005 |
|
---|
1006 | use strict;
|
---|
1007 | use warnings;
|
---|
1008 | use IO::File;
|
---|
1009 |
|
---|
1010 | sub TIESCALAR {
|
---|
1011 | my $class = shift;
|
---|
1012 | my $filename = shift;
|
---|
1013 | my $handle = new IO::File "> $filename"
|
---|
1014 | or die "Cannot open $filename: $!\n";
|
---|
1015 |
|
---|
1016 | print $handle "The Start\n";
|
---|
1017 | bless {FH => $handle, Value => 0}, $class;
|
---|
1018 | }
|
---|
1019 |
|
---|
1020 | sub FETCH {
|
---|
1021 | my $self = shift;
|
---|
1022 | return $self->{Value};
|
---|
1023 | }
|
---|
1024 |
|
---|
1025 | sub STORE {
|
---|
1026 | my $self = shift;
|
---|
1027 | my $value = shift;
|
---|
1028 | my $handle = $self->{FH};
|
---|
1029 | print $handle "$value\n";
|
---|
1030 | $self->{Value} = $value;
|
---|
1031 | }
|
---|
1032 |
|
---|
1033 | sub DESTROY {
|
---|
1034 | my $self = shift;
|
---|
1035 | my $handle = $self->{FH};
|
---|
1036 | print $handle "The End\n";
|
---|
1037 | close $handle;
|
---|
1038 | }
|
---|
1039 |
|
---|
1040 | 1;
|
---|
1041 |
|
---|
1042 | Here is an example that makes use of this tie:
|
---|
1043 |
|
---|
1044 | use strict;
|
---|
1045 | use Remember;
|
---|
1046 |
|
---|
1047 | my $fred;
|
---|
1048 | tie $fred, 'Remember', 'myfile.txt';
|
---|
1049 | $fred = 1;
|
---|
1050 | $fred = 4;
|
---|
1051 | $fred = 5;
|
---|
1052 | untie $fred;
|
---|
1053 | system "cat myfile.txt";
|
---|
1054 |
|
---|
1055 | This is the output when it is executed:
|
---|
1056 |
|
---|
1057 | The Start
|
---|
1058 | 1
|
---|
1059 | 4
|
---|
1060 | 5
|
---|
1061 | The End
|
---|
1062 |
|
---|
1063 | So far so good. Those of you who have been paying attention will have
|
---|
1064 | spotted that the tied object hasn't been used so far. So lets add an
|
---|
1065 | extra method to the Remember class to allow comments to be included in
|
---|
1066 | the file -- say, something like this:
|
---|
1067 |
|
---|
1068 | sub comment {
|
---|
1069 | my $self = shift;
|
---|
1070 | my $text = shift;
|
---|
1071 | my $handle = $self->{FH};
|
---|
1072 | print $handle $text, "\n";
|
---|
1073 | }
|
---|
1074 |
|
---|
1075 | And here is the previous example modified to use the C<comment> method
|
---|
1076 | (which requires the tied object):
|
---|
1077 |
|
---|
1078 | use strict;
|
---|
1079 | use Remember;
|
---|
1080 |
|
---|
1081 | my ($fred, $x);
|
---|
1082 | $x = tie $fred, 'Remember', 'myfile.txt';
|
---|
1083 | $fred = 1;
|
---|
1084 | $fred = 4;
|
---|
1085 | comment $x "changing...";
|
---|
1086 | $fred = 5;
|
---|
1087 | untie $fred;
|
---|
1088 | system "cat myfile.txt";
|
---|
1089 |
|
---|
1090 | When this code is executed there is no output. Here's why:
|
---|
1091 |
|
---|
1092 | When a variable is tied, it is associated with the object which is the
|
---|
1093 | return value of the TIESCALAR, TIEARRAY, or TIEHASH function. This
|
---|
1094 | object normally has only one reference, namely, the implicit reference
|
---|
1095 | from the tied variable. When untie() is called, that reference is
|
---|
1096 | destroyed. Then, as in the first example above, the object's
|
---|
1097 | destructor (DESTROY) is called, which is normal for objects that have
|
---|
1098 | no more valid references; and thus the file is closed.
|
---|
1099 |
|
---|
1100 | In the second example, however, we have stored another reference to
|
---|
1101 | the tied object in $x. That means that when untie() gets called
|
---|
1102 | there will still be a valid reference to the object in existence, so
|
---|
1103 | the destructor is not called at that time, and thus the file is not
|
---|
1104 | closed. The reason there is no output is because the file buffers
|
---|
1105 | have not been flushed to disk.
|
---|
1106 |
|
---|
1107 | Now that you know what the problem is, what can you do to avoid it?
|
---|
1108 | Prior to the introduction of the optional UNTIE method the only way
|
---|
1109 | was the good old C<-w> flag. Which will spot any instances where you call
|
---|
1110 | untie() and there are still valid references to the tied object. If
|
---|
1111 | the second script above this near the top C<use warnings 'untie'>
|
---|
1112 | or was run with the C<-w> flag, Perl prints this
|
---|
1113 | warning message:
|
---|
1114 |
|
---|
1115 | untie attempted while 1 inner references still exist
|
---|
1116 |
|
---|
1117 | To get the script to work properly and silence the warning make sure
|
---|
1118 | there are no valid references to the tied object I<before> untie() is
|
---|
1119 | called:
|
---|
1120 |
|
---|
1121 | undef $x;
|
---|
1122 | untie $fred;
|
---|
1123 |
|
---|
1124 | Now that UNTIE exists the class designer can decide which parts of the
|
---|
1125 | class functionality are really associated with C<untie> and which with
|
---|
1126 | the object being destroyed. What makes sense for a given class depends
|
---|
1127 | on whether the inner references are being kept so that non-tie-related
|
---|
1128 | methods can be called on the object. But in most cases it probably makes
|
---|
1129 | sense to move the functionality that would have been in DESTROY to the UNTIE
|
---|
1130 | method.
|
---|
1131 |
|
---|
1132 | If the UNTIE method exists then the warning above does not occur. Instead the
|
---|
1133 | UNTIE method is passed the count of "extra" references and can issue its own
|
---|
1134 | warning if appropriate. e.g. to replicate the no UNTIE case this method can
|
---|
1135 | be used:
|
---|
1136 |
|
---|
1137 | sub UNTIE
|
---|
1138 | {
|
---|
1139 | my ($obj,$count) = @_;
|
---|
1140 | carp "untie attempted while $count inner references still exist" if $count;
|
---|
1141 | }
|
---|
1142 |
|
---|
1143 | =head1 SEE ALSO
|
---|
1144 |
|
---|
1145 | See L<DB_File> or L<Config> for some interesting tie() implementations.
|
---|
1146 | A good starting point for many tie() implementations is with one of the
|
---|
1147 | modules L<Tie::Scalar>, L<Tie::Array>, L<Tie::Hash>, or L<Tie::Handle>.
|
---|
1148 |
|
---|
1149 | =head1 BUGS
|
---|
1150 |
|
---|
1151 | The bucket usage information provided by C<scalar(%hash)> is not
|
---|
1152 | available. What this means is that using %tied_hash in boolean
|
---|
1153 | context doesn't work right (currently this always tests false,
|
---|
1154 | regardless of whether the hash is empty or hash elements).
|
---|
1155 |
|
---|
1156 | Localizing tied arrays or hashes does not work. After exiting the
|
---|
1157 | scope the arrays or the hashes are not restored.
|
---|
1158 |
|
---|
1159 | Counting the number of entries in a hash via C<scalar(keys(%hash))>
|
---|
1160 | or C<scalar(values(%hash)>) is inefficient since it needs to iterate
|
---|
1161 | through all the entries with FIRSTKEY/NEXTKEY.
|
---|
1162 |
|
---|
1163 | Tied hash/array slices cause multiple FETCH/STORE pairs, there are no
|
---|
1164 | tie methods for slice operations.
|
---|
1165 |
|
---|
1166 | You cannot easily tie a multilevel data structure (such as a hash of
|
---|
1167 | hashes) to a dbm file. The first problem is that all but GDBM and
|
---|
1168 | Berkeley DB have size limitations, but beyond that, you also have problems
|
---|
1169 | with how references are to be represented on disk. One experimental
|
---|
1170 | module that does attempt to address this need is DBM::Deep. Check your
|
---|
1171 | nearest CPAN site as described in L<perlmodlib> for source code. Note
|
---|
1172 | that despite its name, DBM::Deep does not use dbm. Another earlier attempt
|
---|
1173 | at solving the problem is MLDBM, which is also available on the CPAN, but
|
---|
1174 | which has some fairly serious limitations.
|
---|
1175 |
|
---|
1176 | Tied filehandles are still incomplete. sysopen(), truncate(),
|
---|
1177 | flock(), fcntl(), stat() and -X can't currently be trapped.
|
---|
1178 |
|
---|
1179 | =head1 AUTHOR
|
---|
1180 |
|
---|
1181 | Tom Christiansen
|
---|
1182 |
|
---|
1183 | TIEHANDLE by Sven Verdoolaege <F<[email protected]>> and Doug MacEachern <F<[email protected]>>
|
---|
1184 |
|
---|
1185 | UNTIE by Nick Ing-Simmons <F<[email protected]>>
|
---|
1186 |
|
---|
1187 | SCALAR by Tassilo von Parseval <F<[email protected]>>
|
---|
1188 |
|
---|
1189 | Tying Arrays by Casey West <F<[email protected]>>
|
---|