Commit | Line | Data |
---|---|---|
cb1a09d0 AD |
1 | =head1 NAME |
2 | ||
3 | perltie - how to hide an object class in a simple variable | |
4 | ||
5 | =head1 SYNOPSIS | |
6 | ||
7 | tie VARIABLE, CLASSNAME, LIST | |
8 | ||
6fdf61fb | 9 | $object = tied VARIABLE |
10 | ||
cb1a09d0 AD |
11 | untie VARIABLE |
12 | ||
13 | =head1 DESCRIPTION | |
14 | ||
15 | Prior to release 5.0 of Perl, a programmer could use dbmopen() | |
5f05dabc | 16 | to connect an on-disk database in the standard Unix dbm(3x) |
17 | format magically to a %HASH in their program. However, their Perl was either | |
cb1a09d0 AD |
18 | built with one particular dbm library or another, but not both, and |
19 | you couldn't extend this mechanism to other packages or types of variables. | |
20 | ||
21 | Now you can. | |
22 | ||
23 | The tie() function binds a variable to a class (package) that will provide | |
24 | the implementation for access methods for that variable. Once this magic | |
25 | has been performed, accessing a tied variable automatically triggers | |
26 | method calls in the proper class. All of the complexity of the class is | |
27 | hidden behind magic methods calls. The method names are in ALL CAPS, | |
28 | which is a convention that Perl uses to indicate that they're called | |
29 | implicitly rather than explicitly--just like the BEGIN() and END() | |
30 | functions. | |
31 | ||
32 | In the tie() call, C<VARIABLE> is the name of the variable to be | |
33 | enchanted. C<CLASSNAME> is the name of a class implementing objects of | |
34 | the correct type. Any additional arguments in the C<LIST> are passed to | |
35 | the appropriate constructor method for that class--meaning TIESCALAR(), | |
5f05dabc | 36 | TIEARRAY(), TIEHASH(), or TIEHANDLE(). (Typically these are arguments |
a7adf1f0 | 37 | such as might be passed to the dbminit() function of C.) The object |
38 | returned by the "new" method is also returned by the tie() function, | |
39 | which would be useful if you wanted to access other methods in | |
40 | C<CLASSNAME>. (You don't actually have to return a reference to a right | |
5f05dabc | 41 | "type" (e.g., HASH or C<CLASSNAME>) so long as it's a properly blessed |
a7adf1f0 | 42 | object.) You can also retrieve a reference to the underlying object |
43 | using the tied() function. | |
cb1a09d0 AD |
44 | |
45 | Unlike dbmopen(), the tie() function will not C<use> or C<require> a module | |
46 | for you--you need to do that explicitly yourself. | |
47 | ||
48 | =head2 Tying Scalars | |
49 | ||
50 | A class implementing a tied scalar should define the following methods: | |
51 | TIESCALAR, FETCH, STORE, and possibly DESTROY. | |
52 | ||
53 | Let's look at each in turn, using as an example a tie class for | |
54 | scalars that allows the user to do something like: | |
55 | ||
56 | tie $his_speed, 'Nice', getppid(); | |
57 | tie $my_speed, 'Nice', $$; | |
58 | ||
59 | And now whenever either of those variables is accessed, its current | |
60 | system priority is retrieved and returned. If those variables are set, | |
61 | then the process's priority is changed! | |
62 | ||
63 | We'll use Jarkko Hietaniemi F<E<lt>Jarkko.Hietaniemi@hut.fiE<gt>>'s | |
64 | BSD::Resource class (not included) to access the PRIO_PROCESS, PRIO_MIN, | |
65 | and PRIO_MAX constants from your system, as well as the getpriority() and | |
66 | setpriority() system calls. Here's the preamble of the class. | |
67 | ||
68 | package Nice; | |
69 | use Carp; | |
70 | use BSD::Resource; | |
71 | use strict; | |
72 | $Nice::DEBUG = 0 unless defined $Nice::DEBUG; | |
73 | ||
74 | =over | |
75 | ||
76 | =item TIESCALAR classname, LIST | |
77 | ||
78 | This is the constructor for the class. That means it is | |
79 | expected to return a blessed reference to a new scalar | |
80 | (probably anonymous) that it's creating. For example: | |
81 | ||
82 | sub TIESCALAR { | |
83 | my $class = shift; | |
84 | my $pid = shift || $$; # 0 means me | |
85 | ||
86 | if ($pid !~ /^\d+$/) { | |
6fdf61fb | 87 | carp "Nice::Tie::Scalar got non-numeric pid $pid" if $^W; |
cb1a09d0 AD |
88 | return undef; |
89 | } | |
90 | ||
91 | unless (kill 0, $pid) { # EPERM or ERSCH, no doubt | |
6fdf61fb | 92 | carp "Nice::Tie::Scalar got bad pid $pid: $!" if $^W; |
cb1a09d0 AD |
93 | return undef; |
94 | } | |
95 | ||
96 | return bless \$pid, $class; | |
97 | } | |
98 | ||
99 | This tie class has chosen to return an error rather than raising an | |
100 | exception if its constructor should fail. While this is how dbmopen() works, | |
101 | other classes may well not wish to be so forgiving. It checks the global | |
102 | variable C<$^W> to see whether to emit a bit of noise anyway. | |
103 | ||
104 | =item FETCH this | |
105 | ||
106 | This method will be triggered every time the tied variable is accessed | |
107 | (read). It takes no arguments beyond its self reference, which is the | |
5f05dabc | 108 | object representing the scalar we're dealing with. Because in this case |
109 | we're using just a SCALAR ref for the tied scalar object, a simple $$self | |
cb1a09d0 AD |
110 | allows the method to get at the real value stored there. In our example |
111 | below, that real value is the process ID to which we've tied our variable. | |
112 | ||
113 | sub FETCH { | |
114 | my $self = shift; | |
115 | confess "wrong type" unless ref $self; | |
116 | croak "usage error" if @_; | |
117 | my $nicety; | |
118 | local($!) = 0; | |
119 | $nicety = getpriority(PRIO_PROCESS, $$self); | |
120 | if ($!) { croak "getpriority failed: $!" } | |
121 | return $nicety; | |
122 | } | |
123 | ||
124 | This time we've decided to blow up (raise an exception) if the renice | |
125 | fails--there's no place for us to return an error otherwise, and it's | |
126 | probably the right thing to do. | |
127 | ||
128 | =item STORE this, value | |
129 | ||
130 | This method will be triggered every time the tied variable is set | |
131 | (assigned). Beyond its self reference, it also expects one (and only one) | |
132 | argument--the new value the user is trying to assign. | |
133 | ||
134 | sub STORE { | |
135 | my $self = shift; | |
136 | confess "wrong type" unless ref $self; | |
137 | my $new_nicety = shift; | |
138 | croak "usage error" if @_; | |
139 | ||
140 | if ($new_nicety < PRIO_MIN) { | |
141 | carp sprintf | |
142 | "WARNING: priority %d less than minimum system priority %d", | |
143 | $new_nicety, PRIO_MIN if $^W; | |
144 | $new_nicety = PRIO_MIN; | |
145 | } | |
146 | ||
147 | if ($new_nicety > PRIO_MAX) { | |
148 | carp sprintf | |
149 | "WARNING: priority %d greater than maximum system priority %d", | |
150 | $new_nicety, PRIO_MAX if $^W; | |
151 | $new_nicety = PRIO_MAX; | |
152 | } | |
153 | ||
154 | unless (defined setpriority(PRIO_PROCESS, $$self, $new_nicety)) { | |
155 | confess "setpriority failed: $!"; | |
156 | } | |
157 | return $new_nicety; | |
158 | } | |
159 | ||
160 | =item DESTROY this | |
161 | ||
162 | This method will be triggered when the tied variable needs to be destructed. | |
5f05dabc | 163 | As with other object classes, such a method is seldom necessary, because Perl |
cb1a09d0 AD |
164 | deallocates its moribund object's memory for you automatically--this isn't |
165 | C++, you know. We'll use a DESTROY method here for debugging purposes only. | |
166 | ||
167 | sub DESTROY { | |
168 | my $self = shift; | |
169 | confess "wrong type" unless ref $self; | |
170 | carp "[ Nice::DESTROY pid $$self ]" if $Nice::DEBUG; | |
171 | } | |
172 | ||
173 | =back | |
174 | ||
175 | That's about all there is to it. Actually, it's more than all there | |
5f05dabc | 176 | is to it, because we've done a few nice things here for the sake |
cb1a09d0 AD |
177 | of completeness, robustness, and general aesthetics. Simpler |
178 | TIESCALAR classes are certainly possible. | |
179 | ||
180 | =head2 Tying Arrays | |
181 | ||
182 | A class implementing a tied ordinary array should define the following | |
183 | methods: TIEARRAY, FETCH, STORE, and perhaps DESTROY. | |
184 | ||
185 | B<WARNING>: Tied arrays are I<incomplete>. They are also distinctly lacking | |
186 | something for the C<$#ARRAY> access (which is hard, as it's an lvalue), as | |
187 | well as the other obvious array functions, like push(), pop(), shift(), | |
188 | unshift(), and splice(). | |
189 | ||
190 | For this discussion, we'll implement an array whose indices are fixed at | |
191 | its creation. If you try to access anything beyond those bounds, you'll | |
192 | take an exception. (Well, if you access an individual element; an | |
193 | aggregate assignment would be missed.) For example: | |
194 | ||
195 | require Bounded_Array; | |
1f57c600 | 196 | tie @ary, 'Bounded_Array', 2; |
cb1a09d0 AD |
197 | $| = 1; |
198 | for $i (0 .. 10) { | |
199 | print "setting index $i: "; | |
200 | $ary[$i] = 10 * $i; | |
201 | $ary[$i] = 10 * $i; | |
202 | print "value of elt $i now $ary[$i]\n"; | |
203 | } | |
204 | ||
205 | The preamble code for the class is as follows: | |
206 | ||
207 | package Bounded_Array; | |
208 | use Carp; | |
209 | use strict; | |
210 | ||
211 | =over | |
212 | ||
213 | =item TIEARRAY classname, LIST | |
214 | ||
215 | This is the constructor for the class. That means it is expected to | |
216 | return a blessed reference through which the new array (probably an | |
217 | anonymous ARRAY ref) will be accessed. | |
218 | ||
219 | In our example, just to show you that you don't I<really> have to return an | |
220 | ARRAY reference, we'll choose a HASH reference to represent our object. | |
221 | A HASH works out well as a generic record type: the C<{BOUND}> field will | |
03dc9dad | 222 | store the maximum bound allowed, and the C<{ARRAY}> field will hold the |
cb1a09d0 AD |
223 | true ARRAY ref. If someone outside the class tries to dereference the |
224 | object returned (doubtless thinking it an ARRAY ref), they'll blow up. | |
225 | This just goes to show you that you should respect an object's privacy. | |
226 | ||
227 | sub TIEARRAY { | |
228 | my $class = shift; | |
229 | my $bound = shift; | |
230 | confess "usage: tie(\@ary, 'Bounded_Array', max_subscript)" | |
231 | if @_ || $bound =~ /\D/; | |
232 | return bless { | |
233 | BOUND => $bound, | |
234 | ARRAY => [], | |
235 | }, $class; | |
236 | } | |
237 | ||
238 | =item FETCH this, index | |
239 | ||
240 | This method will be triggered every time an individual element the tied array | |
241 | is accessed (read). It takes one argument beyond its self reference: the | |
242 | index whose value we're trying to fetch. | |
243 | ||
244 | sub FETCH { | |
245 | my($self,$idx) = @_; | |
246 | if ($idx > $self->{BOUND}) { | |
247 | confess "Array OOB: $idx > $self->{BOUND}"; | |
248 | } | |
249 | return $self->{ARRAY}[$idx]; | |
250 | } | |
251 | ||
252 | As you may have noticed, the name of the FETCH method (et al.) is the same | |
253 | for all accesses, even though the constructors differ in names (TIESCALAR | |
254 | vs TIEARRAY). While in theory you could have the same class servicing | |
255 | several tied types, in practice this becomes cumbersome, and it's easiest | |
5f05dabc | 256 | to keep them at simply one tie type per class. |
cb1a09d0 AD |
257 | |
258 | =item STORE this, index, value | |
259 | ||
260 | This method will be triggered every time an element in the tied array is set | |
261 | (written). It takes two arguments beyond its self reference: the index at | |
262 | which we're trying to store something and the value we're trying to put | |
263 | there. For example: | |
264 | ||
265 | sub STORE { | |
266 | my($self, $idx, $value) = @_; | |
267 | print "[STORE $value at $idx]\n" if _debug; | |
268 | if ($idx > $self->{BOUND} ) { | |
269 | confess "Array OOB: $idx > $self->{BOUND}"; | |
270 | } | |
271 | return $self->{ARRAY}[$idx] = $value; | |
272 | } | |
273 | ||
274 | =item DESTROY this | |
275 | ||
276 | This method will be triggered when the tied variable needs to be destructed. | |
184e9718 | 277 | As with the scalar tie class, this is almost never needed in a |
cb1a09d0 AD |
278 | language that does its own garbage collection, so this time we'll |
279 | just leave it out. | |
280 | ||
281 | =back | |
282 | ||
283 | The code we presented at the top of the tied array class accesses many | |
284 | elements of the array, far more than we've set the bounds to. Therefore, | |
285 | it will blow up once they try to access beyond the 2nd element of @ary, as | |
286 | the following output demonstrates: | |
287 | ||
288 | setting index 0: value of elt 0 now 0 | |
289 | setting index 1: value of elt 1 now 10 | |
290 | setting index 2: value of elt 2 now 20 | |
291 | setting index 3: Array OOB: 3 > 2 at Bounded_Array.pm line 39 | |
292 | Bounded_Array::FETCH called at testba line 12 | |
293 | ||
294 | =head2 Tying Hashes | |
295 | ||
aa689395 | 296 | As the first Perl data type to be tied (see dbmopen()), hashes have the |
297 | most complete and useful tie() implementation. A class implementing a | |
298 | tied hash should define the following methods: TIEHASH is the constructor. | |
299 | FETCH and STORE access the key and value pairs. EXISTS reports whether a | |
300 | key is present in the hash, and DELETE deletes one. CLEAR empties the | |
301 | hash by deleting all the key and value pairs. FIRSTKEY and NEXTKEY | |
302 | implement the keys() and each() functions to iterate over all the keys. | |
303 | And DESTROY is called when the tied variable is garbage collected. | |
304 | ||
305 | If this seems like a lot, then feel free to inherit from merely the | |
306 | standard Tie::Hash module for most of your methods, redefining only the | |
307 | interesting ones. See L<Tie::Hash> for details. | |
cb1a09d0 AD |
308 | |
309 | Remember that Perl distinguishes between a key not existing in the hash, | |
310 | and the key existing in the hash but having a corresponding value of | |
311 | C<undef>. The two possibilities can be tested with the C<exists()> and | |
312 | C<defined()> functions. | |
313 | ||
314 | Here's an example of a somewhat interesting tied hash class: it gives you | |
5f05dabc | 315 | a hash representing a particular user's dot files. You index into the hash |
316 | with the name of the file (minus the dot) and you get back that dot file's | |
cb1a09d0 AD |
317 | contents. For example: |
318 | ||
319 | use DotFiles; | |
1f57c600 | 320 | tie %dot, 'DotFiles'; |
cb1a09d0 AD |
321 | if ( $dot{profile} =~ /MANPATH/ || |
322 | $dot{login} =~ /MANPATH/ || | |
323 | $dot{cshrc} =~ /MANPATH/ ) | |
324 | { | |
5f05dabc | 325 | print "you seem to set your MANPATH\n"; |
cb1a09d0 AD |
326 | } |
327 | ||
328 | Or here's another sample of using our tied class: | |
329 | ||
1f57c600 | 330 | tie %him, 'DotFiles', 'daemon'; |
cb1a09d0 AD |
331 | foreach $f ( keys %him ) { |
332 | printf "daemon dot file %s is size %d\n", | |
333 | $f, length $him{$f}; | |
334 | } | |
335 | ||
336 | In our tied hash DotFiles example, we use a regular | |
337 | hash for the object containing several important | |
338 | fields, of which only the C<{LIST}> field will be what the | |
339 | user thinks of as the real hash. | |
340 | ||
341 | =over 5 | |
342 | ||
343 | =item USER | |
344 | ||
345 | whose dot files this object represents | |
346 | ||
347 | =item HOME | |
348 | ||
5f05dabc | 349 | where those dot files live |
cb1a09d0 AD |
350 | |
351 | =item CLOBBER | |
352 | ||
353 | whether we should try to change or remove those dot files | |
354 | ||
355 | =item LIST | |
356 | ||
5f05dabc | 357 | the hash of dot file names and content mappings |
cb1a09d0 AD |
358 | |
359 | =back | |
360 | ||
361 | Here's the start of F<Dotfiles.pm>: | |
362 | ||
363 | package DotFiles; | |
364 | use Carp; | |
365 | sub whowasi { (caller(1))[3] . '()' } | |
366 | my $DEBUG = 0; | |
367 | sub debug { $DEBUG = @_ ? shift : 1 } | |
368 | ||
5f05dabc | 369 | For our example, we want to be able to emit debugging info to help in tracing |
cb1a09d0 AD |
370 | during development. We keep also one convenience function around |
371 | internally to help print out warnings; whowasi() returns the function name | |
372 | that calls it. | |
373 | ||
374 | Here are the methods for the DotFiles tied hash. | |
375 | ||
376 | =over | |
377 | ||
378 | =item TIEHASH classname, LIST | |
379 | ||
380 | This is the constructor for the class. That means it is expected to | |
381 | return a blessed reference through which the new object (probably but not | |
382 | necessarily an anonymous hash) will be accessed. | |
383 | ||
384 | Here's the constructor: | |
385 | ||
386 | sub TIEHASH { | |
387 | my $self = shift; | |
388 | my $user = shift || $>; | |
389 | my $dotdir = shift || ''; | |
390 | croak "usage: @{[&whowasi]} [USER [DOTDIR]]" if @_; | |
391 | $user = getpwuid($user) if $user =~ /^\d+$/; | |
392 | my $dir = (getpwnam($user))[7] | |
393 | || croak "@{[&whowasi]}: no user $user"; | |
394 | $dir .= "/$dotdir" if $dotdir; | |
395 | ||
396 | my $node = { | |
397 | USER => $user, | |
398 | HOME => $dir, | |
399 | LIST => {}, | |
400 | CLOBBER => 0, | |
401 | }; | |
402 | ||
403 | opendir(DIR, $dir) | |
404 | || croak "@{[&whowasi]}: can't opendir $dir: $!"; | |
405 | foreach $dot ( grep /^\./ && -f "$dir/$_", readdir(DIR)) { | |
406 | $dot =~ s/^\.//; | |
407 | $node->{LIST}{$dot} = undef; | |
408 | } | |
409 | closedir DIR; | |
410 | return bless $node, $self; | |
411 | } | |
412 | ||
413 | It's probably worth mentioning that if you're going to filetest the | |
414 | return values out of a readdir, you'd better prepend the directory | |
5f05dabc | 415 | in question. Otherwise, because we didn't chdir() there, it would |
cb1a09d0 AD |
416 | have been testing the wrong file. |
417 | ||
418 | =item FETCH this, key | |
419 | ||
420 | This method will be triggered every time an element in the tied hash is | |
421 | accessed (read). It takes one argument beyond its self reference: the key | |
422 | whose value we're trying to fetch. | |
423 | ||
424 | Here's the fetch for our DotFiles example. | |
425 | ||
426 | sub FETCH { | |
427 | carp &whowasi if $DEBUG; | |
428 | my $self = shift; | |
429 | my $dot = shift; | |
430 | my $dir = $self->{HOME}; | |
431 | my $file = "$dir/.$dot"; | |
432 | ||
433 | unless (exists $self->{LIST}->{$dot} || -f $file) { | |
434 | carp "@{[&whowasi]}: no $dot file" if $DEBUG; | |
435 | return undef; | |
436 | } | |
437 | ||
438 | if (defined $self->{LIST}->{$dot}) { | |
439 | return $self->{LIST}->{$dot}; | |
440 | } else { | |
441 | return $self->{LIST}->{$dot} = `cat $dir/.$dot`; | |
442 | } | |
443 | } | |
444 | ||
445 | It was easy to write by having it call the Unix cat(1) command, but it | |
446 | would probably be more portable to open the file manually (and somewhat | |
5f05dabc | 447 | more efficient). Of course, because dot files are a Unixy concept, we're |
cb1a09d0 AD |
448 | not that concerned. |
449 | ||
450 | =item STORE this, key, value | |
451 | ||
452 | This method will be triggered every time an element in the tied hash is set | |
453 | (written). It takes two arguments beyond its self reference: the index at | |
454 | which we're trying to store something, and the value we're trying to put | |
455 | there. | |
456 | ||
457 | Here in our DotFiles example, we'll be careful not to let | |
458 | them try to overwrite the file unless they've called the clobber() | |
459 | method on the original object reference returned by tie(). | |
460 | ||
461 | sub STORE { | |
462 | carp &whowasi if $DEBUG; | |
463 | my $self = shift; | |
464 | my $dot = shift; | |
465 | my $value = shift; | |
466 | my $file = $self->{HOME} . "/.$dot"; | |
467 | my $user = $self->{USER}; | |
468 | ||
469 | croak "@{[&whowasi]}: $file not clobberable" | |
470 | unless $self->{CLOBBER}; | |
471 | ||
472 | open(F, "> $file") || croak "can't open $file: $!"; | |
473 | print F $value; | |
474 | close(F); | |
475 | } | |
476 | ||
477 | If they wanted to clobber something, they might say: | |
478 | ||
479 | $ob = tie %daemon_dots, 'daemon'; | |
480 | $ob->clobber(1); | |
481 | $daemon_dots{signature} = "A true daemon\n"; | |
482 | ||
6fdf61fb | 483 | Another way to lay hands on a reference to the underlying object is to |
484 | use the tied() function, so they might alternately have set clobber | |
485 | using: | |
486 | ||
487 | tie %daemon_dots, 'daemon'; | |
488 | tied(%daemon_dots)->clobber(1); | |
489 | ||
490 | The clobber method is simply: | |
cb1a09d0 AD |
491 | |
492 | sub clobber { | |
493 | my $self = shift; | |
494 | $self->{CLOBBER} = @_ ? shift : 1; | |
495 | } | |
496 | ||
497 | =item DELETE this, key | |
498 | ||
499 | This method is triggered when we remove an element from the hash, | |
500 | typically by using the delete() function. Again, we'll | |
501 | be careful to check whether they really want to clobber files. | |
502 | ||
503 | sub DELETE { | |
504 | carp &whowasi if $DEBUG; | |
505 | ||
506 | my $self = shift; | |
507 | my $dot = shift; | |
508 | my $file = $self->{HOME} . "/.$dot"; | |
509 | croak "@{[&whowasi]}: won't remove file $file" | |
510 | unless $self->{CLOBBER}; | |
511 | delete $self->{LIST}->{$dot}; | |
1f57c600 | 512 | my $success = unlink($file); |
513 | carp "@{[&whowasi]}: can't unlink $file: $!" unless $success; | |
514 | $success; | |
cb1a09d0 AD |
515 | } |
516 | ||
1f57c600 | 517 | The value returned by DELETE becomes the return value of the call |
518 | to delete(). If you want to emulate the normal behavior of delete(), | |
519 | you should return whatever FETCH would have returned for this key. | |
520 | In this example, we have chosen instead to return a value which tells | |
521 | the caller whether the file was successfully deleted. | |
522 | ||
cb1a09d0 AD |
523 | =item CLEAR this |
524 | ||
525 | This method is triggered when the whole hash is to be cleared, usually by | |
526 | assigning the empty list to it. | |
527 | ||
5f05dabc | 528 | In our example, that would remove all the user's dot files! It's such a |
cb1a09d0 AD |
529 | dangerous thing that they'll have to set CLOBBER to something higher than |
530 | 1 to make it happen. | |
531 | ||
532 | sub CLEAR { | |
533 | carp &whowasi if $DEBUG; | |
534 | my $self = shift; | |
5f05dabc | 535 | croak "@{[&whowasi]}: won't remove all dot files for $self->{USER}" |
cb1a09d0 AD |
536 | unless $self->{CLOBBER} > 1; |
537 | my $dot; | |
538 | foreach $dot ( keys %{$self->{LIST}}) { | |
539 | $self->DELETE($dot); | |
540 | } | |
541 | } | |
542 | ||
543 | =item EXISTS this, key | |
544 | ||
545 | This method is triggered when the user uses the exists() function | |
546 | on a particular hash. In our example, we'll look at the C<{LIST}> | |
547 | hash element for this: | |
548 | ||
549 | sub EXISTS { | |
550 | carp &whowasi if $DEBUG; | |
551 | my $self = shift; | |
552 | my $dot = shift; | |
553 | return exists $self->{LIST}->{$dot}; | |
554 | } | |
555 | ||
556 | =item FIRSTKEY this | |
557 | ||
558 | This method will be triggered when the user is going | |
559 | to iterate through the hash, such as via a keys() or each() | |
560 | call. | |
561 | ||
562 | sub FIRSTKEY { | |
563 | carp &whowasi if $DEBUG; | |
564 | my $self = shift; | |
6fdf61fb | 565 | my $a = keys %{$self->{LIST}}; # reset each() iterator |
cb1a09d0 AD |
566 | each %{$self->{LIST}} |
567 | } | |
568 | ||
569 | =item NEXTKEY this, lastkey | |
570 | ||
571 | This method gets triggered during a keys() or each() iteration. It has a | |
572 | second argument which is the last key that had been accessed. This is | |
573 | useful if you're carrying about ordering or calling the iterator from more | |
574 | than one sequence, or not really storing things in a hash anywhere. | |
575 | ||
5f05dabc | 576 | For our example, we're using a real hash so we'll do just the simple |
577 | thing, but we'll have to go through the LIST field indirectly. | |
cb1a09d0 AD |
578 | |
579 | sub NEXTKEY { | |
580 | carp &whowasi if $DEBUG; | |
581 | my $self = shift; | |
582 | return each %{ $self->{LIST} } | |
583 | } | |
584 | ||
585 | =item DESTROY this | |
586 | ||
587 | This method is triggered when a tied hash is about to go out of | |
588 | scope. You don't really need it unless you're trying to add debugging | |
589 | or have auxiliary state to clean up. Here's a very simple function: | |
590 | ||
591 | sub DESTROY { | |
592 | carp &whowasi if $DEBUG; | |
593 | } | |
594 | ||
595 | =back | |
596 | ||
597 | Note that functions such as keys() and values() may return huge array | |
598 | values when used on large objects, like DBM files. You may prefer to | |
599 | use the each() function to iterate over such. Example: | |
600 | ||
601 | # print out history file offsets | |
602 | use NDBM_File; | |
1f57c600 | 603 | tie(%HIST, 'NDBM_File', '/usr/lib/news/history', 1, 0); |
cb1a09d0 AD |
604 | while (($key,$val) = each %HIST) { |
605 | print $key, ' = ', unpack('L',$val), "\n"; | |
606 | } | |
607 | untie(%HIST); | |
608 | ||
609 | =head2 Tying FileHandles | |
610 | ||
184e9718 | 611 | This is partially implemented now. |
a7adf1f0 | 612 | |
184e9718 | 613 | A class implementing a tied filehandle should define the following methods: |
58f51617 | 614 | TIEHANDLE, PRINT and/or READLINE, and possibly DESTROY. |
a7adf1f0 | 615 | |
616 | It is especially useful when perl is embedded in some other program, | |
617 | where output to STDOUT and STDERR may have to be redirected in some | |
618 | special way. See nvi and the Apache module for examples. | |
619 | ||
620 | In our example we're going to create a shouting handle. | |
621 | ||
622 | package Shout; | |
623 | ||
624 | =over | |
625 | ||
626 | =item TIEHANDLE classname, LIST | |
627 | ||
628 | This is the constructor for the class. That means it is expected to | |
184e9718 | 629 | return a blessed reference of some sort. The reference can be used to |
5f05dabc | 630 | hold some internal information. |
a7adf1f0 | 631 | |
7e1af8bc | 632 | sub TIEHANDLE { print "<shout>\n"; my $i; bless \$i, shift } |
a7adf1f0 | 633 | |
634 | =item PRINT this, LIST | |
635 | ||
636 | This method will be triggered every time the tied handle is printed to. | |
184e9718 | 637 | Beyond its self reference it also expects the list that was passed to |
a7adf1f0 | 638 | the print function. |
639 | ||
58f51617 SV |
640 | sub PRINT { $r = shift; $$r++; print join($,,map(uc($_),@_)),$\ } |
641 | ||
642 | =item READLINE this | |
643 | ||
644 | This method will be called when the handle is read from. The method | |
645 | should return undef when there is no more data. | |
646 | ||
647 | sub READLINE { $r = shift; "PRINT called $$r times\n"; } | |
a7adf1f0 | 648 | |
649 | =item DESTROY this | |
650 | ||
651 | As with the other types of ties, this method will be called when the | |
652 | tied handle is about to be destroyed. This is useful for debugging and | |
653 | possibly cleaning up. | |
654 | ||
655 | sub DESTROY { print "</shout>\n" } | |
656 | ||
657 | =back | |
658 | ||
659 | Here's how to use our little example: | |
660 | ||
661 | tie(*FOO,'Shout'); | |
662 | print FOO "hello\n"; | |
663 | $a = 4; $b = 6; | |
664 | print FOO $a, " plus ", $b, " equals ", $a + $b, "\n"; | |
58f51617 | 665 | print <FOO>; |
cb1a09d0 | 666 | |
2752eb9f PM |
667 | =head2 The C<untie> Gotcha |
668 | ||
669 | If you intend making use of the object returned from either tie() or | |
670 | tied(), and if the tie's target class defines a destructor, there is a | |
671 | subtle gotcha you I<must> guard against. | |
672 | ||
673 | As setup, consider this (admittedly rather contrived) example of a | |
674 | tie; all it does is use a file to keep a log of the values assigned to | |
675 | a scalar. | |
676 | ||
677 | package Remember; | |
678 | ||
679 | use strict; | |
680 | use IO::File; | |
681 | ||
682 | sub TIESCALAR { | |
683 | my $class = shift; | |
684 | my $filename = shift; | |
685 | my $handle = new IO::File "> $filename" | |
686 | or die "Cannot open $filename: $!\n"; | |
687 | ||
688 | print $handle "The Start\n"; | |
689 | bless {FH => $handle, Value => 0}, $class; | |
690 | } | |
691 | ||
692 | sub FETCH { | |
693 | my $self = shift; | |
694 | return $self->{Value}; | |
695 | } | |
696 | ||
697 | sub STORE { | |
698 | my $self = shift; | |
699 | my $value = shift; | |
700 | my $handle = $self->{FH}; | |
701 | print $handle "$value\n"; | |
702 | $self->{Value} = $value; | |
703 | } | |
704 | ||
705 | sub DESTROY { | |
706 | my $self = shift; | |
707 | my $handle = $self->{FH}; | |
708 | print $handle "The End\n"; | |
709 | close $handle; | |
710 | } | |
711 | ||
712 | 1; | |
713 | ||
714 | Here is an example that makes use of this tie: | |
715 | ||
716 | use strict; | |
717 | use Remember; | |
718 | ||
719 | my $fred; | |
720 | tie $fred, 'Remember', 'myfile.txt'; | |
721 | $fred = 1; | |
722 | $fred = 4; | |
723 | $fred = 5; | |
724 | untie $fred; | |
725 | system "cat myfile.txt"; | |
726 | ||
727 | This is the output when it is executed: | |
728 | ||
729 | The Start | |
730 | 1 | |
731 | 4 | |
732 | 5 | |
733 | The End | |
734 | ||
735 | So far so good. Those of you who have been paying attention will have | |
736 | spotted that the tied object hasn't been used so far. So lets add an | |
737 | extra method to the Remember class to allow comments to be included in | |
738 | the file -- say, something like this: | |
739 | ||
740 | sub comment { | |
741 | my $self = shift; | |
742 | my $text = shift; | |
743 | my $handle = $self->{FH}; | |
744 | print $handle $text, "\n"; | |
745 | } | |
746 | ||
747 | And here is the previous example modified to use the C<comment> method | |
748 | (which requires the tied object): | |
749 | ||
750 | use strict; | |
751 | use Remember; | |
752 | ||
753 | my ($fred, $x); | |
754 | $x = tie $fred, 'Remember', 'myfile.txt'; | |
755 | $fred = 1; | |
756 | $fred = 4; | |
757 | comment $x "changing..."; | |
758 | $fred = 5; | |
759 | untie $fred; | |
760 | system "cat myfile.txt"; | |
761 | ||
762 | When this code is executed there is no output. Here's why: | |
763 | ||
764 | When a variable is tied, it is associated with the object which is the | |
765 | return value of the TIESCALAR, TIEARRAY, or TIEHASH function. This | |
766 | object normally has only one reference, namely, the implicit reference | |
767 | from the tied variable. When untie() is called, that reference is | |
768 | destroyed. Then, as in the first example above, the object's | |
769 | destructor (DESTROY) is called, which is normal for objects that have | |
770 | no more valid references; and thus the file is closed. | |
771 | ||
772 | In the second example, however, we have stored another reference to | |
773 | the tied object in C<$x>. That means that when untie() gets called | |
774 | there will still be a valid reference to the object in existence, so | |
775 | the destructor is not called at that time, and thus the file is not | |
776 | closed. The reason there is no output is because the file buffers | |
777 | have not been flushed to disk. | |
778 | ||
779 | Now that you know what the problem is, what can you do to avoid it? | |
780 | Well, the good old C<-w> flag will spot any instances where you call | |
781 | untie() and there are still valid references to the tied object. If | |
782 | the second script above is run with the C<-w> flag, Perl prints this | |
783 | warning message: | |
784 | ||
785 | untie attempted while 1 inner references still exist | |
786 | ||
787 | To get the script to work properly and silence the warning make sure | |
788 | there are no valid references to the tied object I<before> untie() is | |
789 | called: | |
790 | ||
791 | undef $x; | |
792 | untie $fred; | |
793 | ||
cb1a09d0 AD |
794 | =head1 SEE ALSO |
795 | ||
796 | See L<DB_File> or L<Config> for some interesting tie() implementations. | |
797 | ||
798 | =head1 BUGS | |
799 | ||
800 | Tied arrays are I<incomplete>. They are also distinctly lacking something | |
801 | for the C<$#ARRAY> access (which is hard, as it's an lvalue), as well as | |
802 | the other obvious array functions, like push(), pop(), shift(), unshift(), | |
803 | and splice(). | |
804 | ||
c07a80fd | 805 | You cannot easily tie a multilevel data structure (such as a hash of |
806 | hashes) to a dbm file. The first problem is that all but GDBM and | |
807 | Berkeley DB have size limitations, but beyond that, you also have problems | |
808 | with how references are to be represented on disk. One experimental | |
5f05dabc | 809 | module that does attempt to address this need partially is the MLDBM |
c07a80fd | 810 | module. Check your nearest CPAN site as described in L<perlmod> for |
811 | source code to MLDBM. | |
812 | ||
cb1a09d0 AD |
813 | =head1 AUTHOR |
814 | ||
815 | Tom Christiansen | |
a7adf1f0 | 816 | |
184e9718 | 817 | TIEHANDLE by Sven Verdoolaege E<lt>F<skimo@dns.ufsia.ac.be>E<gt> |