Resolve against mainline
[p5sagit/p5-mst-13.2.git] / pod / perltie.pod
CommitLineData
cb1a09d0 1=head1 NAME
2
3perltie - 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
15Prior to release 5.0 of Perl, a programmer could use dbmopen()
5f05dabc 16to connect an on-disk database in the standard Unix dbm(3x)
17format magically to a %HASH in their program. However, their Perl was either
cb1a09d0 18built with one particular dbm library or another, but not both, and
19you couldn't extend this mechanism to other packages or types of variables.
20
21Now you can.
22
23The tie() function binds a variable to a class (package) that will provide
24the implementation for access methods for that variable. Once this magic
25has been performed, accessing a tied variable automatically triggers
26method calls in the proper class. All of the complexity of the class is
27hidden behind magic methods calls. The method names are in ALL CAPS,
28which is a convention that Perl uses to indicate that they're called
29implicitly rather than explicitly--just like the BEGIN() and END()
30functions.
31
32In the tie() call, C<VARIABLE> is the name of the variable to be
33enchanted. C<CLASSNAME> is the name of a class implementing objects of
34the correct type. Any additional arguments in the C<LIST> are passed to
35the appropriate constructor method for that class--meaning TIESCALAR(),
5f05dabc 36TIEARRAY(), TIEHASH(), or TIEHANDLE(). (Typically these are arguments
a7adf1f0 37such as might be passed to the dbminit() function of C.) The object
38returned by the "new" method is also returned by the tie() function,
39which would be useful if you wanted to access other methods in
40C<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 42object.) You can also retrieve a reference to the underlying object
43using the tied() function.
cb1a09d0 44
45Unlike dbmopen(), the tie() function will not C<use> or C<require> a module
46for you--you need to do that explicitly yourself.
47
48=head2 Tying Scalars
49
50A class implementing a tied scalar should define the following methods:
51TIESCALAR, FETCH, STORE, and possibly DESTROY.
52
53Let's look at each in turn, using as an example a tie class for
54scalars that allows the user to do something like:
55
56 tie $his_speed, 'Nice', getppid();
57 tie $my_speed, 'Nice', $$;
58
59And now whenever either of those variables is accessed, its current
60system priority is retrieved and returned. If those variables are set,
61then the process's priority is changed!
62
5aabfad6 63We'll use Jarkko Hietaniemi <F<jhi@iki.fi>>'s BSD::Resource class (not
64included) to access the PRIO_PROCESS, PRIO_MIN, and PRIO_MAX constants
65from your system, as well as the getpriority() and setpriority() system
66calls. 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
78This is the constructor for the class. That means it is
79expected 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
99This tie class has chosen to return an error rather than raising an
100exception if its constructor should fail. While this is how dbmopen() works,
101other classes may well not wish to be so forgiving. It checks the global
102variable C<$^W> to see whether to emit a bit of noise anyway.
103
104=item FETCH this
105
106This 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 108object representing the scalar we're dealing with. Because in this case
109we're using just a SCALAR ref for the tied scalar object, a simple $$self
cb1a09d0 110allows the method to get at the real value stored there. In our example
111below, 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
124This time we've decided to blow up (raise an exception) if the renice
125fails--there's no place for us to return an error otherwise, and it's
126probably the right thing to do.
127
128=item STORE this, value
129
130This method will be triggered every time the tied variable is set
131(assigned). Beyond its self reference, it also expects one (and only one)
132argument--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
162This method will be triggered when the tied variable needs to be destructed.
5f05dabc 163As with other object classes, such a method is seldom necessary, because Perl
cb1a09d0 164deallocates its moribund object's memory for you automatically--this isn't
165C++, 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
175That's about all there is to it. Actually, it's more than all there
5f05dabc 176is to it, because we've done a few nice things here for the sake
cb1a09d0 177of completeness, robustness, and general aesthetics. Simpler
178TIESCALAR classes are certainly possible.
179
180=head2 Tying Arrays
181
182A class implementing a tied ordinary array should define the following
183methods: TIEARRAY, FETCH, STORE, and perhaps DESTROY.
184
185B<WARNING>: Tied arrays are I<incomplete>. They are also distinctly lacking
186something for the C<$#ARRAY> access (which is hard, as it's an lvalue), as
187well as the other obvious array functions, like push(), pop(), shift(),
188unshift(), and splice().
189
190For this discussion, we'll implement an array whose indices are fixed at
191its creation. If you try to access anything beyond those bounds, you'll
192take an exception. (Well, if you access an individual element; an
193aggregate assignment would be missed.) For example:
194
195 require Bounded_Array;
1f57c600 196 tie @ary, 'Bounded_Array', 2;
cb1a09d0 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
205The 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
215This is the constructor for the class. That means it is expected to
216return a blessed reference through which the new array (probably an
217anonymous ARRAY ref) will be accessed.
218
219In our example, just to show you that you don't I<really> have to return an
220ARRAY reference, we'll choose a HASH reference to represent our object.
221A HASH works out well as a generic record type: the C<{BOUND}> field will
03dc9dad 222store the maximum bound allowed, and the C<{ARRAY}> field will hold the
cb1a09d0 223true ARRAY ref. If someone outside the class tries to dereference the
224object returned (doubtless thinking it an ARRAY ref), they'll blow up.
225This 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
240This method will be triggered every time an individual element the tied array
241is accessed (read). It takes one argument beyond its self reference: the
242index 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
252As you may have noticed, the name of the FETCH method (et al.) is the same
253for all accesses, even though the constructors differ in names (TIESCALAR
254vs TIEARRAY). While in theory you could have the same class servicing
255several tied types, in practice this becomes cumbersome, and it's easiest
5f05dabc 256to keep them at simply one tie type per class.
cb1a09d0 257
258=item STORE this, index, value
259
260This 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
262which we're trying to store something and the value we're trying to put
263there. 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
276This method will be triggered when the tied variable needs to be destructed.
184e9718 277As with the scalar tie class, this is almost never needed in a
cb1a09d0 278language that does its own garbage collection, so this time we'll
279just leave it out.
280
281=back
282
283The code we presented at the top of the tied array class accesses many
284elements of the array, far more than we've set the bounds to. Therefore,
285it will blow up once they try to access beyond the 2nd element of @ary, as
286the 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 296As the first Perl data type to be tied (see dbmopen()), hashes have the
297most complete and useful tie() implementation. A class implementing a
298tied hash should define the following methods: TIEHASH is the constructor.
299FETCH and STORE access the key and value pairs. EXISTS reports whether a
300key is present in the hash, and DELETE deletes one. CLEAR empties the
301hash by deleting all the key and value pairs. FIRSTKEY and NEXTKEY
302implement the keys() and each() functions to iterate over all the keys.
303And DESTROY is called when the tied variable is garbage collected.
304
305If this seems like a lot, then feel free to inherit from merely the
306standard Tie::Hash module for most of your methods, redefining only the
307interesting ones. See L<Tie::Hash> for details.
cb1a09d0 308
309Remember that Perl distinguishes between a key not existing in the hash,
310and the key existing in the hash but having a corresponding value of
311C<undef>. The two possibilities can be tested with the C<exists()> and
312C<defined()> functions.
313
314Here's an example of a somewhat interesting tied hash class: it gives you
5f05dabc 315a hash representing a particular user's dot files. You index into the hash
316with the name of the file (minus the dot) and you get back that dot file's
cb1a09d0 317contents. For example:
318
319 use DotFiles;
1f57c600 320 tie %dot, 'DotFiles';
cb1a09d0 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 326 }
327
328Or here's another sample of using our tied class:
329
1f57c600 330 tie %him, 'DotFiles', 'daemon';
cb1a09d0 331 foreach $f ( keys %him ) {
332 printf "daemon dot file %s is size %d\n",
333 $f, length $him{$f};
334 }
335
336In our tied hash DotFiles example, we use a regular
337hash for the object containing several important
338fields, of which only the C<{LIST}> field will be what the
339user thinks of as the real hash.
340
341=over 5
342
343=item USER
344
345whose dot files this object represents
346
347=item HOME
348
5f05dabc 349where those dot files live
cb1a09d0 350
351=item CLOBBER
352
353whether we should try to change or remove those dot files
354
355=item LIST
356
5f05dabc 357the hash of dot file names and content mappings
cb1a09d0 358
359=back
360
361Here'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 369For our example, we want to be able to emit debugging info to help in tracing
cb1a09d0 370during development. We keep also one convenience function around
371internally to help print out warnings; whowasi() returns the function name
372that calls it.
373
374Here are the methods for the DotFiles tied hash.
375
376=over
377
378=item TIEHASH classname, LIST
379
380This is the constructor for the class. That means it is expected to
381return a blessed reference through which the new object (probably but not
382necessarily an anonymous hash) will be accessed.
383
384Here'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
413It's probably worth mentioning that if you're going to filetest the
414return values out of a readdir, you'd better prepend the directory
5f05dabc 415in question. Otherwise, because we didn't chdir() there, it would
2ae324a7 416have been testing the wrong file.
cb1a09d0 417
418=item FETCH this, key
419
420This method will be triggered every time an element in the tied hash is
421accessed (read). It takes one argument beyond its self reference: the key
422whose value we're trying to fetch.
423
424Here'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
445It was easy to write by having it call the Unix cat(1) command, but it
446would probably be more portable to open the file manually (and somewhat
5f05dabc 447more efficient). Of course, because dot files are a Unixy concept, we're
cb1a09d0 448not that concerned.
449
450=item STORE this, key, value
451
452This 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
454which we're trying to store something, and the value we're trying to put
455there.
456
457Here in our DotFiles example, we'll be careful not to let
458them try to overwrite the file unless they've called the clobber()
459method 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
477If 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 483Another way to lay hands on a reference to the underlying object is to
484use the tied() function, so they might alternately have set clobber
485using:
486
487 tie %daemon_dots, 'daemon';
488 tied(%daemon_dots)->clobber(1);
489
490The clobber method is simply:
cb1a09d0 491
492 sub clobber {
493 my $self = shift;
494 $self->{CLOBBER} = @_ ? shift : 1;
495 }
496
497=item DELETE this, key
498
499This method is triggered when we remove an element from the hash,
500typically by using the delete() function. Again, we'll
501be 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 515 }
516
1f57c600 517The value returned by DELETE becomes the return value of the call
518to delete(). If you want to emulate the normal behavior of delete(),
519you should return whatever FETCH would have returned for this key.
520In this example, we have chosen instead to return a value which tells
521the caller whether the file was successfully deleted.
522
cb1a09d0 523=item CLEAR this
524
525This method is triggered when the whole hash is to be cleared, usually by
526assigning the empty list to it.
527
5f05dabc 528In our example, that would remove all the user's dot files! It's such a
cb1a09d0 529dangerous thing that they'll have to set CLOBBER to something higher than
5301 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 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
545This method is triggered when the user uses the exists() function
546on a particular hash. In our example, we'll look at the C<{LIST}>
547hash 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
558This method will be triggered when the user is going
559to iterate through the hash, such as via a keys() or each()
560call.
561
562 sub FIRSTKEY {
563 carp &whowasi if $DEBUG;
564 my $self = shift;
6fdf61fb 565 my $a = keys %{$self->{LIST}}; # reset each() iterator
cb1a09d0 566 each %{$self->{LIST}}
567 }
568
569=item NEXTKEY this, lastkey
570
571This method gets triggered during a keys() or each() iteration. It has a
572second argument which is the last key that had been accessed. This is
573useful if you're carrying about ordering or calling the iterator from more
574than one sequence, or not really storing things in a hash anywhere.
575
5f05dabc 576For our example, we're using a real hash so we'll do just the simple
577thing, but we'll have to go through the LIST field indirectly.
cb1a09d0 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
587This method is triggered when a tied hash is about to go out of
588scope. You don't really need it unless you're trying to add debugging
589or 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
597Note that functions such as keys() and values() may return huge array
598values when used on large objects, like DBM files. You may prefer to
599use 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 604 while (($key,$val) = each %HIST) {
605 print $key, ' = ', unpack('L',$val), "\n";
606 }
607 untie(%HIST);
608
609=head2 Tying FileHandles
610
184e9718 611This is partially implemented now.
a7adf1f0 612
2ae324a7 613A class implementing a tied filehandle should define the following
46fc3d4c 614methods: TIEHANDLE, at least one of PRINT, PRINTF, READLINE, GETC, or READ,
2ae324a7 615and possibly DESTROY.
a7adf1f0 616
617It is especially useful when perl is embedded in some other program,
618where output to STDOUT and STDERR may have to be redirected in some
619special way. See nvi and the Apache module for examples.
620
621In our example we're going to create a shouting handle.
622
623 package Shout;
624
625=over
626
627=item TIEHANDLE classname, LIST
628
629This is the constructor for the class. That means it is expected to
184e9718 630return a blessed reference of some sort. The reference can be used to
5f05dabc 631hold some internal information.
a7adf1f0 632
7e1af8bc 633 sub TIEHANDLE { print "<shout>\n"; my $i; bless \$i, shift }
a7adf1f0 634
635=item PRINT this, LIST
636
46fc3d4c 637This method will be triggered every time the tied handle is printed to
638with the C<print()> function.
184e9718 639Beyond its self reference it also expects the list that was passed to
a7adf1f0 640the print function.
641
58f51617 642 sub PRINT { $r = shift; $$r++; print join($,,map(uc($_),@_)),$\ }
643
46fc3d4c 644=item PRINTF this, LIST
645
646This method will be triggered every time the tied handle is printed to
647with the C<printf()> function.
648Beyond its self reference it also expects the format and list that was
649passed to the printf function.
650
651 sub PRINTF {
652 shift;
653 my $fmt = shift;
654 print sprintf($fmt, @_)."\n";
655 }
656
2ae324a7 657=item READ this LIST
658
659This method will be called when the handle is read from via the C<read>
660or C<sysread> functions.
661
662 sub READ {
663 $r = shift;
664 my($buf,$len,$offset) = @_;
665 print "READ called, \$buf=$buf, \$len=$len, \$offset=$offset";
666 }
667
58f51617 668=item READLINE this
669
2ae324a7 670This method will be called when the handle is read from via <HANDLE>.
671The method should return undef when there is no more data.
58f51617 672
673 sub READLINE { $r = shift; "PRINT called $$r times\n"; }
a7adf1f0 674
2ae324a7 675=item GETC this
676
677This method will be called when the C<getc> function is called.
678
679 sub GETC { print "Don't GETC, Get Perl"; return "a"; }
680
a7adf1f0 681=item DESTROY this
682
683As with the other types of ties, this method will be called when the
684tied handle is about to be destroyed. This is useful for debugging and
685possibly cleaning up.
686
687 sub DESTROY { print "</shout>\n" }
688
689=back
690
691Here's how to use our little example:
692
693 tie(*FOO,'Shout');
694 print FOO "hello\n";
695 $a = 4; $b = 6;
696 print FOO $a, " plus ", $b, " equals ", $a + $b, "\n";
58f51617 697 print <FOO>;
cb1a09d0 698
2752eb9f 699=head2 The C<untie> Gotcha
700
701If you intend making use of the object returned from either tie() or
702tied(), and if the tie's target class defines a destructor, there is a
703subtle gotcha you I<must> guard against.
704
705As setup, consider this (admittedly rather contrived) example of a
706tie; all it does is use a file to keep a log of the values assigned to
707a scalar.
708
709 package Remember;
710
711 use strict;
712 use IO::File;
713
714 sub TIESCALAR {
715 my $class = shift;
716 my $filename = shift;
717 my $handle = new IO::File "> $filename"
718 or die "Cannot open $filename: $!\n";
719
720 print $handle "The Start\n";
721 bless {FH => $handle, Value => 0}, $class;
722 }
723
724 sub FETCH {
725 my $self = shift;
726 return $self->{Value};
727 }
728
729 sub STORE {
730 my $self = shift;
731 my $value = shift;
732 my $handle = $self->{FH};
733 print $handle "$value\n";
734 $self->{Value} = $value;
735 }
736
737 sub DESTROY {
738 my $self = shift;
739 my $handle = $self->{FH};
740 print $handle "The End\n";
741 close $handle;
742 }
743
744 1;
745
746Here is an example that makes use of this tie:
747
748 use strict;
749 use Remember;
750
751 my $fred;
752 tie $fred, 'Remember', 'myfile.txt';
753 $fred = 1;
754 $fred = 4;
755 $fred = 5;
756 untie $fred;
757 system "cat myfile.txt";
758
759This is the output when it is executed:
760
761 The Start
762 1
763 4
764 5
765 The End
766
767So far so good. Those of you who have been paying attention will have
768spotted that the tied object hasn't been used so far. So lets add an
769extra method to the Remember class to allow comments to be included in
770the file -- say, something like this:
771
772 sub comment {
773 my $self = shift;
774 my $text = shift;
775 my $handle = $self->{FH};
776 print $handle $text, "\n";
777 }
778
779And here is the previous example modified to use the C<comment> method
780(which requires the tied object):
781
782 use strict;
783 use Remember;
784
785 my ($fred, $x);
786 $x = tie $fred, 'Remember', 'myfile.txt';
787 $fred = 1;
788 $fred = 4;
789 comment $x "changing...";
790 $fred = 5;
791 untie $fred;
792 system "cat myfile.txt";
793
794When this code is executed there is no output. Here's why:
795
796When a variable is tied, it is associated with the object which is the
797return value of the TIESCALAR, TIEARRAY, or TIEHASH function. This
798object normally has only one reference, namely, the implicit reference
799from the tied variable. When untie() is called, that reference is
800destroyed. Then, as in the first example above, the object's
801destructor (DESTROY) is called, which is normal for objects that have
802no more valid references; and thus the file is closed.
803
804In the second example, however, we have stored another reference to
805the tied object in C<$x>. That means that when untie() gets called
806there will still be a valid reference to the object in existence, so
807the destructor is not called at that time, and thus the file is not
808closed. The reason there is no output is because the file buffers
809have not been flushed to disk.
810
811Now that you know what the problem is, what can you do to avoid it?
812Well, the good old C<-w> flag will spot any instances where you call
813untie() and there are still valid references to the tied object. If
814the second script above is run with the C<-w> flag, Perl prints this
815warning message:
816
817 untie attempted while 1 inner references still exist
818
819To get the script to work properly and silence the warning make sure
820there are no valid references to the tied object I<before> untie() is
821called:
822
823 undef $x;
824 untie $fred;
825
cb1a09d0 826=head1 SEE ALSO
827
828See L<DB_File> or L<Config> for some interesting tie() implementations.
829
830=head1 BUGS
831
832Tied arrays are I<incomplete>. They are also distinctly lacking something
833for the C<$#ARRAY> access (which is hard, as it's an lvalue), as well as
834the other obvious array functions, like push(), pop(), shift(), unshift(),
835and splice().
836
c07a80fd 837You cannot easily tie a multilevel data structure (such as a hash of
838hashes) to a dbm file. The first problem is that all but GDBM and
839Berkeley DB have size limitations, but beyond that, you also have problems
840with how references are to be represented on disk. One experimental
5f05dabc 841module that does attempt to address this need partially is the MLDBM
f102b883 842module. Check your nearest CPAN site as described in L<perlmodlib> for
c07a80fd 843source code to MLDBM.
844
cb1a09d0 845=head1 AUTHOR
846
847Tom Christiansen
a7adf1f0 848
46fc3d4c 849TIEHANDLE by Sven Verdoolaege <F<skimo@dns.ufsia.ac.be>> and Doug MacEachern <F<dougm@osf.org>>