Commit | Line | Data |
cb1a09d0 |
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 |
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 |
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 |
5a964f20 |
26 | method calls in the proper class. The complexity of the class is |
cb1a09d0 |
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 |
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 | |
5aabfad6 |
63 | We'll use Jarkko Hietaniemi <F<jhi@iki.fi>>'s BSD::Resource class (not |
64 | included) to access the PRIO_PROCESS, PRIO_MIN, and PRIO_MAX constants |
65 | from your system, as well as the getpriority() and setpriority() system |
66 | calls. Here's the preamble of the class. |
cb1a09d0 |
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 |
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 |
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 |
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 |
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 |
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 |
a60c0954 |
183 | methods: TIEARRAY, FETCH, STORE, FETCHSIZE, STORESIZE and perhaps DESTROY. |
cb1a09d0 |
184 | |
a60c0954 |
185 | FETCHSIZE and STORESIZE are used to provide C<$#array> and |
186 | equivalent C<scalar(@array)> access. |
c47ff5f1 |
187 | |
01020589 |
188 | The methods POP, PUSH, SHIFT, UNSHIFT, SPLICE, DELETE, and EXISTS are |
189 | required if the perl operator with the corresponding (but lowercase) name |
190 | is to operate on the tied array. The B<Tie::Array> class can be used as a |
191 | base class to implement the first five of these in terms of the basic |
192 | methods above. The default implementations of DELETE and EXISTS in |
193 | B<Tie::Array> simply C<croak>. |
a60c0954 |
194 | |
195 | In addition EXTEND will be called when perl would have pre-extended |
196 | allocation in a real array. |
197 | |
198 | This means that tied arrays are now I<complete>. The example below needs |
199 | upgrading to illustrate this. (The documentation in B<Tie::Array> is more |
200 | complete.) |
cb1a09d0 |
201 | |
202 | For this discussion, we'll implement an array whose indices are fixed at |
203 | its creation. If you try to access anything beyond those bounds, you'll |
a60c0954 |
204 | take an exception. For example: |
cb1a09d0 |
205 | |
206 | require Bounded_Array; |
1f57c600 |
207 | tie @ary, 'Bounded_Array', 2; |
cb1a09d0 |
208 | $| = 1; |
209 | for $i (0 .. 10) { |
210 | print "setting index $i: "; |
211 | $ary[$i] = 10 * $i; |
212 | $ary[$i] = 10 * $i; |
213 | print "value of elt $i now $ary[$i]\n"; |
214 | } |
215 | |
216 | The preamble code for the class is as follows: |
217 | |
218 | package Bounded_Array; |
219 | use Carp; |
220 | use strict; |
221 | |
222 | =over |
223 | |
224 | =item TIEARRAY classname, LIST |
225 | |
226 | This is the constructor for the class. That means it is expected to |
227 | return a blessed reference through which the new array (probably an |
228 | anonymous ARRAY ref) will be accessed. |
229 | |
230 | In our example, just to show you that you don't I<really> have to return an |
231 | ARRAY reference, we'll choose a HASH reference to represent our object. |
232 | A HASH works out well as a generic record type: the C<{BOUND}> field will |
03dc9dad |
233 | store the maximum bound allowed, and the C<{ARRAY}> field will hold the |
cb1a09d0 |
234 | true ARRAY ref. If someone outside the class tries to dereference the |
235 | object returned (doubtless thinking it an ARRAY ref), they'll blow up. |
236 | This just goes to show you that you should respect an object's privacy. |
237 | |
238 | sub TIEARRAY { |
239 | my $class = shift; |
240 | my $bound = shift; |
241 | confess "usage: tie(\@ary, 'Bounded_Array', max_subscript)" |
242 | if @_ || $bound =~ /\D/; |
243 | return bless { |
244 | BOUND => $bound, |
245 | ARRAY => [], |
246 | }, $class; |
247 | } |
248 | |
249 | =item FETCH this, index |
250 | |
251 | This method will be triggered every time an individual element the tied array |
252 | is accessed (read). It takes one argument beyond its self reference: the |
253 | index whose value we're trying to fetch. |
254 | |
255 | sub FETCH { |
256 | my($self,$idx) = @_; |
257 | if ($idx > $self->{BOUND}) { |
258 | confess "Array OOB: $idx > $self->{BOUND}"; |
259 | } |
260 | return $self->{ARRAY}[$idx]; |
261 | } |
262 | |
0b931be4 |
263 | If a negative array index is used to read from an array, the index |
264 | will be translated to a positive one internally by calling FETCHSIZE |
265 | before being passed to FETCH. |
266 | |
cb1a09d0 |
267 | As you may have noticed, the name of the FETCH method (et al.) is the same |
268 | for all accesses, even though the constructors differ in names (TIESCALAR |
269 | vs TIEARRAY). While in theory you could have the same class servicing |
270 | several tied types, in practice this becomes cumbersome, and it's easiest |
5f05dabc |
271 | to keep them at simply one tie type per class. |
cb1a09d0 |
272 | |
273 | =item STORE this, index, value |
274 | |
275 | This method will be triggered every time an element in the tied array is set |
276 | (written). It takes two arguments beyond its self reference: the index at |
277 | which we're trying to store something and the value we're trying to put |
278 | there. For example: |
279 | |
280 | sub STORE { |
281 | my($self, $idx, $value) = @_; |
282 | print "[STORE $value at $idx]\n" if _debug; |
283 | if ($idx > $self->{BOUND} ) { |
284 | confess "Array OOB: $idx > $self->{BOUND}"; |
285 | } |
286 | return $self->{ARRAY}[$idx] = $value; |
287 | } |
0b931be4 |
288 | |
289 | Negative indexes are treated the same as with FETCH. |
cb1a09d0 |
290 | |
291 | =item DESTROY this |
292 | |
293 | This method will be triggered when the tied variable needs to be destructed. |
184e9718 |
294 | As with the scalar tie class, this is almost never needed in a |
cb1a09d0 |
295 | language that does its own garbage collection, so this time we'll |
296 | just leave it out. |
297 | |
298 | =back |
299 | |
300 | The code we presented at the top of the tied array class accesses many |
301 | elements of the array, far more than we've set the bounds to. Therefore, |
302 | it will blow up once they try to access beyond the 2nd element of @ary, as |
303 | the following output demonstrates: |
304 | |
305 | setting index 0: value of elt 0 now 0 |
306 | setting index 1: value of elt 1 now 10 |
307 | setting index 2: value of elt 2 now 20 |
308 | setting index 3: Array OOB: 3 > 2 at Bounded_Array.pm line 39 |
309 | Bounded_Array::FETCH called at testba line 12 |
310 | |
311 | =head2 Tying Hashes |
312 | |
be3174d2 |
313 | Hashes were the first Perl data type to be tied (see dbmopen()). A class |
314 | implementing a tied hash should define the following methods: TIEHASH is |
315 | the constructor. FETCH and STORE access the key and value pairs. EXISTS |
316 | reports whether a key is present in the hash, and DELETE deletes one. |
317 | CLEAR empties the hash by deleting all the key and value pairs. FIRSTKEY |
318 | and NEXTKEY implement the keys() and each() functions to iterate over all |
319 | the keys. And DESTROY is called when the tied variable is garbage |
320 | collected. |
aa689395 |
321 | |
322 | If this seems like a lot, then feel free to inherit from merely the |
323 | standard Tie::Hash module for most of your methods, redefining only the |
324 | interesting ones. See L<Tie::Hash> for details. |
cb1a09d0 |
325 | |
326 | Remember that Perl distinguishes between a key not existing in the hash, |
327 | and the key existing in the hash but having a corresponding value of |
328 | C<undef>. The two possibilities can be tested with the C<exists()> and |
329 | C<defined()> functions. |
330 | |
331 | Here's an example of a somewhat interesting tied hash class: it gives you |
5f05dabc |
332 | a hash representing a particular user's dot files. You index into the hash |
333 | with the name of the file (minus the dot) and you get back that dot file's |
cb1a09d0 |
334 | contents. For example: |
335 | |
336 | use DotFiles; |
1f57c600 |
337 | tie %dot, 'DotFiles'; |
cb1a09d0 |
338 | if ( $dot{profile} =~ /MANPATH/ || |
339 | $dot{login} =~ /MANPATH/ || |
340 | $dot{cshrc} =~ /MANPATH/ ) |
341 | { |
5f05dabc |
342 | print "you seem to set your MANPATH\n"; |
cb1a09d0 |
343 | } |
344 | |
345 | Or here's another sample of using our tied class: |
346 | |
1f57c600 |
347 | tie %him, 'DotFiles', 'daemon'; |
cb1a09d0 |
348 | foreach $f ( keys %him ) { |
349 | printf "daemon dot file %s is size %d\n", |
350 | $f, length $him{$f}; |
351 | } |
352 | |
353 | In our tied hash DotFiles example, we use a regular |
354 | hash for the object containing several important |
355 | fields, of which only the C<{LIST}> field will be what the |
356 | user thinks of as the real hash. |
357 | |
358 | =over 5 |
359 | |
360 | =item USER |
361 | |
362 | whose dot files this object represents |
363 | |
364 | =item HOME |
365 | |
5f05dabc |
366 | where those dot files live |
cb1a09d0 |
367 | |
368 | =item CLOBBER |
369 | |
370 | whether we should try to change or remove those dot files |
371 | |
372 | =item LIST |
373 | |
5f05dabc |
374 | the hash of dot file names and content mappings |
cb1a09d0 |
375 | |
376 | =back |
377 | |
378 | Here's the start of F<Dotfiles.pm>: |
379 | |
380 | package DotFiles; |
381 | use Carp; |
382 | sub whowasi { (caller(1))[3] . '()' } |
383 | my $DEBUG = 0; |
384 | sub debug { $DEBUG = @_ ? shift : 1 } |
385 | |
5f05dabc |
386 | For our example, we want to be able to emit debugging info to help in tracing |
cb1a09d0 |
387 | during development. We keep also one convenience function around |
388 | internally to help print out warnings; whowasi() returns the function name |
389 | that calls it. |
390 | |
391 | Here are the methods for the DotFiles tied hash. |
392 | |
393 | =over |
394 | |
395 | =item TIEHASH classname, LIST |
396 | |
397 | This is the constructor for the class. That means it is expected to |
398 | return a blessed reference through which the new object (probably but not |
399 | necessarily an anonymous hash) will be accessed. |
400 | |
401 | Here's the constructor: |
402 | |
403 | sub TIEHASH { |
404 | my $self = shift; |
405 | my $user = shift || $>; |
406 | my $dotdir = shift || ''; |
407 | croak "usage: @{[&whowasi]} [USER [DOTDIR]]" if @_; |
408 | $user = getpwuid($user) if $user =~ /^\d+$/; |
409 | my $dir = (getpwnam($user))[7] |
410 | || croak "@{[&whowasi]}: no user $user"; |
411 | $dir .= "/$dotdir" if $dotdir; |
412 | |
413 | my $node = { |
414 | USER => $user, |
415 | HOME => $dir, |
416 | LIST => {}, |
417 | CLOBBER => 0, |
418 | }; |
419 | |
420 | opendir(DIR, $dir) |
421 | || croak "@{[&whowasi]}: can't opendir $dir: $!"; |
422 | foreach $dot ( grep /^\./ && -f "$dir/$_", readdir(DIR)) { |
423 | $dot =~ s/^\.//; |
424 | $node->{LIST}{$dot} = undef; |
425 | } |
426 | closedir DIR; |
427 | return bless $node, $self; |
428 | } |
429 | |
430 | It's probably worth mentioning that if you're going to filetest the |
431 | return values out of a readdir, you'd better prepend the directory |
5f05dabc |
432 | in question. Otherwise, because we didn't chdir() there, it would |
2ae324a7 |
433 | have been testing the wrong file. |
cb1a09d0 |
434 | |
435 | =item FETCH this, key |
436 | |
437 | This method will be triggered every time an element in the tied hash is |
438 | accessed (read). It takes one argument beyond its self reference: the key |
439 | whose value we're trying to fetch. |
440 | |
441 | Here's the fetch for our DotFiles example. |
442 | |
443 | sub FETCH { |
444 | carp &whowasi if $DEBUG; |
445 | my $self = shift; |
446 | my $dot = shift; |
447 | my $dir = $self->{HOME}; |
448 | my $file = "$dir/.$dot"; |
449 | |
450 | unless (exists $self->{LIST}->{$dot} || -f $file) { |
451 | carp "@{[&whowasi]}: no $dot file" if $DEBUG; |
452 | return undef; |
453 | } |
454 | |
455 | if (defined $self->{LIST}->{$dot}) { |
456 | return $self->{LIST}->{$dot}; |
457 | } else { |
458 | return $self->{LIST}->{$dot} = `cat $dir/.$dot`; |
459 | } |
460 | } |
461 | |
462 | It was easy to write by having it call the Unix cat(1) command, but it |
463 | would probably be more portable to open the file manually (and somewhat |
5f05dabc |
464 | more efficient). Of course, because dot files are a Unixy concept, we're |
cb1a09d0 |
465 | not that concerned. |
466 | |
467 | =item STORE this, key, value |
468 | |
469 | This method will be triggered every time an element in the tied hash is set |
470 | (written). It takes two arguments beyond its self reference: the index at |
471 | which we're trying to store something, and the value we're trying to put |
472 | there. |
473 | |
474 | Here in our DotFiles example, we'll be careful not to let |
475 | them try to overwrite the file unless they've called the clobber() |
476 | method on the original object reference returned by tie(). |
477 | |
478 | sub STORE { |
479 | carp &whowasi if $DEBUG; |
480 | my $self = shift; |
481 | my $dot = shift; |
482 | my $value = shift; |
483 | my $file = $self->{HOME} . "/.$dot"; |
484 | my $user = $self->{USER}; |
485 | |
486 | croak "@{[&whowasi]}: $file not clobberable" |
487 | unless $self->{CLOBBER}; |
488 | |
489 | open(F, "> $file") || croak "can't open $file: $!"; |
490 | print F $value; |
491 | close(F); |
492 | } |
493 | |
494 | If they wanted to clobber something, they might say: |
495 | |
496 | $ob = tie %daemon_dots, 'daemon'; |
497 | $ob->clobber(1); |
498 | $daemon_dots{signature} = "A true daemon\n"; |
499 | |
6fdf61fb |
500 | Another way to lay hands on a reference to the underlying object is to |
501 | use the tied() function, so they might alternately have set clobber |
502 | using: |
503 | |
504 | tie %daemon_dots, 'daemon'; |
505 | tied(%daemon_dots)->clobber(1); |
506 | |
507 | The clobber method is simply: |
cb1a09d0 |
508 | |
509 | sub clobber { |
510 | my $self = shift; |
511 | $self->{CLOBBER} = @_ ? shift : 1; |
512 | } |
513 | |
514 | =item DELETE this, key |
515 | |
516 | This method is triggered when we remove an element from the hash, |
517 | typically by using the delete() function. Again, we'll |
518 | be careful to check whether they really want to clobber files. |
519 | |
520 | sub DELETE { |
521 | carp &whowasi if $DEBUG; |
522 | |
523 | my $self = shift; |
524 | my $dot = shift; |
525 | my $file = $self->{HOME} . "/.$dot"; |
526 | croak "@{[&whowasi]}: won't remove file $file" |
527 | unless $self->{CLOBBER}; |
528 | delete $self->{LIST}->{$dot}; |
1f57c600 |
529 | my $success = unlink($file); |
530 | carp "@{[&whowasi]}: can't unlink $file: $!" unless $success; |
531 | $success; |
cb1a09d0 |
532 | } |
533 | |
1f57c600 |
534 | The value returned by DELETE becomes the return value of the call |
535 | to delete(). If you want to emulate the normal behavior of delete(), |
536 | you should return whatever FETCH would have returned for this key. |
537 | In this example, we have chosen instead to return a value which tells |
538 | the caller whether the file was successfully deleted. |
539 | |
cb1a09d0 |
540 | =item CLEAR this |
541 | |
542 | This method is triggered when the whole hash is to be cleared, usually by |
543 | assigning the empty list to it. |
544 | |
5f05dabc |
545 | In our example, that would remove all the user's dot files! It's such a |
cb1a09d0 |
546 | dangerous thing that they'll have to set CLOBBER to something higher than |
547 | 1 to make it happen. |
548 | |
549 | sub CLEAR { |
550 | carp &whowasi if $DEBUG; |
551 | my $self = shift; |
5f05dabc |
552 | croak "@{[&whowasi]}: won't remove all dot files for $self->{USER}" |
cb1a09d0 |
553 | unless $self->{CLOBBER} > 1; |
554 | my $dot; |
555 | foreach $dot ( keys %{$self->{LIST}}) { |
556 | $self->DELETE($dot); |
557 | } |
558 | } |
559 | |
560 | =item EXISTS this, key |
561 | |
562 | This method is triggered when the user uses the exists() function |
563 | on a particular hash. In our example, we'll look at the C<{LIST}> |
564 | hash element for this: |
565 | |
566 | sub EXISTS { |
567 | carp &whowasi if $DEBUG; |
568 | my $self = shift; |
569 | my $dot = shift; |
570 | return exists $self->{LIST}->{$dot}; |
571 | } |
572 | |
573 | =item FIRSTKEY this |
574 | |
575 | This method will be triggered when the user is going |
576 | to iterate through the hash, such as via a keys() or each() |
577 | call. |
578 | |
579 | sub FIRSTKEY { |
580 | carp &whowasi if $DEBUG; |
581 | my $self = shift; |
6fdf61fb |
582 | my $a = keys %{$self->{LIST}}; # reset each() iterator |
cb1a09d0 |
583 | each %{$self->{LIST}} |
584 | } |
585 | |
586 | =item NEXTKEY this, lastkey |
587 | |
588 | This method gets triggered during a keys() or each() iteration. It has a |
589 | second argument which is the last key that had been accessed. This is |
590 | useful if you're carrying about ordering or calling the iterator from more |
591 | than one sequence, or not really storing things in a hash anywhere. |
592 | |
5f05dabc |
593 | For our example, we're using a real hash so we'll do just the simple |
594 | thing, but we'll have to go through the LIST field indirectly. |
cb1a09d0 |
595 | |
596 | sub NEXTKEY { |
597 | carp &whowasi if $DEBUG; |
598 | my $self = shift; |
599 | return each %{ $self->{LIST} } |
600 | } |
601 | |
602 | =item DESTROY this |
603 | |
604 | This method is triggered when a tied hash is about to go out of |
605 | scope. You don't really need it unless you're trying to add debugging |
606 | or have auxiliary state to clean up. Here's a very simple function: |
607 | |
608 | sub DESTROY { |
609 | carp &whowasi if $DEBUG; |
610 | } |
611 | |
612 | =back |
613 | |
1d2dff63 |
614 | Note that functions such as keys() and values() may return huge lists |
615 | when used on large objects, like DBM files. You may prefer to use the |
616 | each() function to iterate over such. Example: |
cb1a09d0 |
617 | |
618 | # print out history file offsets |
619 | use NDBM_File; |
1f57c600 |
620 | tie(%HIST, 'NDBM_File', '/usr/lib/news/history', 1, 0); |
cb1a09d0 |
621 | while (($key,$val) = each %HIST) { |
622 | print $key, ' = ', unpack('L',$val), "\n"; |
623 | } |
624 | untie(%HIST); |
625 | |
626 | =head2 Tying FileHandles |
627 | |
184e9718 |
628 | This is partially implemented now. |
a7adf1f0 |
629 | |
2ae324a7 |
630 | A class implementing a tied filehandle should define the following |
1d603a67 |
631 | methods: TIEHANDLE, at least one of PRINT, PRINTF, WRITE, READLINE, GETC, |
4592e6ca |
632 | READ, and possibly CLOSE and DESTROY. The class can also provide: BINMODE, |
633 | OPEN, EOF, FILENO, SEEK, TELL - if the corresponding perl operators are |
634 | used on the handle. |
a7adf1f0 |
635 | |
636 | It is especially useful when perl is embedded in some other program, |
637 | where output to STDOUT and STDERR may have to be redirected in some |
638 | special way. See nvi and the Apache module for examples. |
639 | |
640 | In our example we're going to create a shouting handle. |
641 | |
642 | package Shout; |
643 | |
644 | =over |
645 | |
646 | =item TIEHANDLE classname, LIST |
647 | |
648 | This is the constructor for the class. That means it is expected to |
184e9718 |
649 | return a blessed reference of some sort. The reference can be used to |
5f05dabc |
650 | hold some internal information. |
a7adf1f0 |
651 | |
7e1af8bc |
652 | sub TIEHANDLE { print "<shout>\n"; my $i; bless \$i, shift } |
a7adf1f0 |
653 | |
1d603a67 |
654 | =item WRITE this, LIST |
655 | |
656 | This method will be called when the handle is written to via the |
657 | C<syswrite> function. |
658 | |
659 | sub WRITE { |
660 | $r = shift; |
661 | my($buf,$len,$offset) = @_; |
662 | print "WRITE called, \$buf=$buf, \$len=$len, \$offset=$offset"; |
663 | } |
664 | |
a7adf1f0 |
665 | =item PRINT this, LIST |
666 | |
46fc3d4c |
667 | This method will be triggered every time the tied handle is printed to |
668 | with the C<print()> function. |
184e9718 |
669 | Beyond its self reference it also expects the list that was passed to |
a7adf1f0 |
670 | the print function. |
671 | |
58f51617 |
672 | sub PRINT { $r = shift; $$r++; print join($,,map(uc($_),@_)),$\ } |
673 | |
46fc3d4c |
674 | =item PRINTF this, LIST |
675 | |
676 | This method will be triggered every time the tied handle is printed to |
677 | with the C<printf()> function. |
678 | Beyond its self reference it also expects the format and list that was |
679 | passed to the printf function. |
680 | |
681 | sub PRINTF { |
682 | shift; |
683 | my $fmt = shift; |
684 | print sprintf($fmt, @_)."\n"; |
685 | } |
686 | |
1d603a67 |
687 | =item READ this, LIST |
2ae324a7 |
688 | |
689 | This method will be called when the handle is read from via the C<read> |
690 | or C<sysread> functions. |
691 | |
692 | sub READ { |
889a76e8 |
693 | my $self = shift; |
694 | my $$bufref = \$_[0]; |
695 | my(undef,$len,$offset) = @_; |
696 | print "READ called, \$buf=$bufref, \$len=$len, \$offset=$offset"; |
697 | # add to $$bufref, set $len to number of characters read |
698 | $len; |
2ae324a7 |
699 | } |
700 | |
58f51617 |
701 | =item READLINE this |
702 | |
2ae324a7 |
703 | This method will be called when the handle is read from via <HANDLE>. |
704 | The method should return undef when there is no more data. |
58f51617 |
705 | |
889a76e8 |
706 | sub READLINE { $r = shift; "READLINE called $$r times\n"; } |
a7adf1f0 |
707 | |
2ae324a7 |
708 | =item GETC this |
709 | |
710 | This method will be called when the C<getc> function is called. |
711 | |
712 | sub GETC { print "Don't GETC, Get Perl"; return "a"; } |
713 | |
1d603a67 |
714 | =item CLOSE this |
715 | |
716 | This method will be called when the handle is closed via the C<close> |
717 | function. |
718 | |
719 | sub CLOSE { print "CLOSE called.\n" } |
720 | |
a7adf1f0 |
721 | =item DESTROY this |
722 | |
723 | As with the other types of ties, this method will be called when the |
724 | tied handle is about to be destroyed. This is useful for debugging and |
725 | possibly cleaning up. |
726 | |
727 | sub DESTROY { print "</shout>\n" } |
728 | |
729 | =back |
730 | |
731 | Here's how to use our little example: |
732 | |
733 | tie(*FOO,'Shout'); |
734 | print FOO "hello\n"; |
735 | $a = 4; $b = 6; |
736 | print FOO $a, " plus ", $b, " equals ", $a + $b, "\n"; |
58f51617 |
737 | print <FOO>; |
cb1a09d0 |
738 | |
2752eb9f |
739 | =head2 The C<untie> Gotcha |
740 | |
741 | If you intend making use of the object returned from either tie() or |
742 | tied(), and if the tie's target class defines a destructor, there is a |
743 | subtle gotcha you I<must> guard against. |
744 | |
745 | As setup, consider this (admittedly rather contrived) example of a |
746 | tie; all it does is use a file to keep a log of the values assigned to |
747 | a scalar. |
748 | |
749 | package Remember; |
750 | |
751 | use strict; |
9f1b1f2d |
752 | use warnings; |
2752eb9f |
753 | use IO::File; |
754 | |
755 | sub TIESCALAR { |
756 | my $class = shift; |
757 | my $filename = shift; |
758 | my $handle = new IO::File "> $filename" |
759 | or die "Cannot open $filename: $!\n"; |
760 | |
761 | print $handle "The Start\n"; |
762 | bless {FH => $handle, Value => 0}, $class; |
763 | } |
764 | |
765 | sub FETCH { |
766 | my $self = shift; |
767 | return $self->{Value}; |
768 | } |
769 | |
770 | sub STORE { |
771 | my $self = shift; |
772 | my $value = shift; |
773 | my $handle = $self->{FH}; |
774 | print $handle "$value\n"; |
775 | $self->{Value} = $value; |
776 | } |
777 | |
778 | sub DESTROY { |
779 | my $self = shift; |
780 | my $handle = $self->{FH}; |
781 | print $handle "The End\n"; |
782 | close $handle; |
783 | } |
784 | |
785 | 1; |
786 | |
787 | Here is an example that makes use of this tie: |
788 | |
789 | use strict; |
790 | use Remember; |
791 | |
792 | my $fred; |
793 | tie $fred, 'Remember', 'myfile.txt'; |
794 | $fred = 1; |
795 | $fred = 4; |
796 | $fred = 5; |
797 | untie $fred; |
798 | system "cat myfile.txt"; |
799 | |
800 | This is the output when it is executed: |
801 | |
802 | The Start |
803 | 1 |
804 | 4 |
805 | 5 |
806 | The End |
807 | |
808 | So far so good. Those of you who have been paying attention will have |
809 | spotted that the tied object hasn't been used so far. So lets add an |
810 | extra method to the Remember class to allow comments to be included in |
811 | the file -- say, something like this: |
812 | |
813 | sub comment { |
814 | my $self = shift; |
815 | my $text = shift; |
816 | my $handle = $self->{FH}; |
817 | print $handle $text, "\n"; |
818 | } |
819 | |
820 | And here is the previous example modified to use the C<comment> method |
821 | (which requires the tied object): |
822 | |
823 | use strict; |
824 | use Remember; |
825 | |
826 | my ($fred, $x); |
827 | $x = tie $fred, 'Remember', 'myfile.txt'; |
828 | $fred = 1; |
829 | $fred = 4; |
830 | comment $x "changing..."; |
831 | $fred = 5; |
832 | untie $fred; |
833 | system "cat myfile.txt"; |
834 | |
835 | When this code is executed there is no output. Here's why: |
836 | |
837 | When a variable is tied, it is associated with the object which is the |
838 | return value of the TIESCALAR, TIEARRAY, or TIEHASH function. This |
839 | object normally has only one reference, namely, the implicit reference |
840 | from the tied variable. When untie() is called, that reference is |
841 | destroyed. Then, as in the first example above, the object's |
842 | destructor (DESTROY) is called, which is normal for objects that have |
843 | no more valid references; and thus the file is closed. |
844 | |
845 | In the second example, however, we have stored another reference to |
19799a22 |
846 | the tied object in $x. That means that when untie() gets called |
2752eb9f |
847 | there will still be a valid reference to the object in existence, so |
848 | the destructor is not called at that time, and thus the file is not |
849 | closed. The reason there is no output is because the file buffers |
850 | have not been flushed to disk. |
851 | |
852 | Now that you know what the problem is, what can you do to avoid it? |
853 | Well, the good old C<-w> flag will spot any instances where you call |
854 | untie() and there are still valid references to the tied object. If |
9f1b1f2d |
855 | the second script above this near the top C<use warnings 'untie'> |
856 | or was run with the C<-w> flag, Perl prints this |
2752eb9f |
857 | warning message: |
858 | |
859 | untie attempted while 1 inner references still exist |
860 | |
861 | To get the script to work properly and silence the warning make sure |
862 | there are no valid references to the tied object I<before> untie() is |
863 | called: |
864 | |
865 | undef $x; |
866 | untie $fred; |
867 | |
cb1a09d0 |
868 | =head1 SEE ALSO |
869 | |
870 | See L<DB_File> or L<Config> for some interesting tie() implementations. |
3d0ae7ba |
871 | A good starting point for many tie() implementations is with one of the |
872 | modules L<Tie::Scalar>, L<Tie::Array>, L<Tie::Hash>, or L<Tie::Handle>. |
cb1a09d0 |
873 | |
874 | =head1 BUGS |
875 | |
c07a80fd |
876 | You cannot easily tie a multilevel data structure (such as a hash of |
877 | hashes) to a dbm file. The first problem is that all but GDBM and |
878 | Berkeley DB have size limitations, but beyond that, you also have problems |
879 | with how references are to be represented on disk. One experimental |
5f05dabc |
880 | module that does attempt to address this need partially is the MLDBM |
f102b883 |
881 | module. Check your nearest CPAN site as described in L<perlmodlib> for |
c07a80fd |
882 | source code to MLDBM. |
883 | |
cb1a09d0 |
884 | =head1 AUTHOR |
885 | |
886 | Tom Christiansen |
a7adf1f0 |
887 | |
46fc3d4c |
888 | TIEHANDLE by Sven Verdoolaege <F<skimo@dns.ufsia.ac.be>> and Doug MacEachern <F<dougm@osf.org>> |