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