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