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