[Summary view] [Print] [Text view]

   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(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  In our example we're going to create a shouting handle.
 873  
 874      package Shout;
 875  
 876  =over 4
 877  
 878  =item TIEHANDLE classname, LIST
 879  X<TIEHANDLE>
 880  
 881  This is the constructor for the class.  That means it is expected to
 882  return a blessed reference of some sort. The reference can be used to
 883  hold some internal information.
 884  
 885      sub TIEHANDLE { print "<shout>\n"; my $i; bless \$i, shift }
 886  
 887  =item WRITE this, LIST
 888  X<WRITE>
 889  
 890  This method will be called when the handle is written to via the
 891  C<syswrite> function.
 892  
 893      sub WRITE {
 894      $r = shift;
 895      my($buf,$len,$offset) = @_;
 896      print "WRITE called, \$buf=$buf, \$len=$len, \$offset=$offset";
 897      }
 898  
 899  =item PRINT this, LIST
 900  X<PRINT>
 901  
 902  This method will be triggered every time the tied handle is printed to
 903  with the C<print()> function.
 904  Beyond its self reference it also expects the list that was passed to
 905  the print function.
 906  
 907      sub PRINT { $r = shift; $$r++; print join($,,map(uc($_),@_)),$\ }
 908  
 909  =item PRINTF this, LIST
 910  X<PRINTF>
 911  
 912  This method will be triggered every time the tied handle is printed to
 913  with the C<printf()> function.
 914  Beyond its self reference it also expects the format and list that was
 915  passed to the printf function.
 916  
 917      sub PRINTF {
 918          shift;
 919          my $fmt = shift;
 920          print sprintf($fmt, @_);
 921      }
 922  
 923  =item READ this, LIST
 924  X<READ>
 925  
 926  This method will be called when the handle is read from via the C<read>
 927  or C<sysread> functions.
 928  
 929      sub READ {
 930      my $self = shift;
 931      my $bufref = \$_[0];
 932      my(undef,$len,$offset) = @_;
 933      print "READ called, \$buf=$bufref, \$len=$len, \$offset=$offset";
 934      # add to $$bufref, set $len to number of characters read
 935      $len;
 936      }
 937  
 938  =item READLINE this
 939  X<READLINE>
 940  
 941  This method will be called when the handle is read from via <HANDLE>.
 942  The method should return undef when there is no more data.
 943  
 944      sub READLINE { $r = shift; "READLINE called $$r times\n"; }
 945  
 946  =item GETC this
 947  X<GETC>
 948  
 949  This method will be called when the C<getc> function is called.
 950  
 951      sub GETC { print "Don't GETC, Get Perl"; return "a"; }
 952  
 953  =item CLOSE this
 954  X<CLOSE>
 955  
 956  This method will be called when the handle is closed via the C<close>
 957  function.
 958  
 959      sub CLOSE { print "CLOSE called.\n" }
 960  
 961  =item UNTIE this
 962  X<UNTIE>
 963  
 964  As with the other types of ties, this method will be called when C<untie> happens.
 965  It may be appropriate to "auto CLOSE" when this occurs.  See
 966  L<The C<untie> Gotcha> below.
 967  
 968  =item DESTROY this
 969  X<DESTROY>
 970  
 971  As with the other types of ties, this method will be called when the
 972  tied handle is about to be destroyed. This is useful for debugging and
 973  possibly cleaning up.
 974  
 975      sub DESTROY { print "</shout>\n" }
 976  
 977  =back
 978  
 979  Here's how to use our little example:
 980  
 981      tie(*FOO,'Shout');
 982      print FOO "hello\n";
 983      $a = 4; $b = 6;
 984      print FOO $a, " plus ", $b, " equals ", $a + $b, "\n";
 985      print <FOO>;
 986  
 987  =head2 UNTIE this
 988  X<UNTIE>
 989  
 990  You can define for all tie types an UNTIE method that will be called
 991  at untie().  See L<The C<untie> Gotcha> below.
 992  
 993  =head2 The C<untie> Gotcha
 994  X<untie>
 995  
 996  If you intend making use of the object returned from either tie() or
 997  tied(), and if the tie's target class defines a destructor, there is a
 998  subtle gotcha you I<must> guard against.
 999  
1000  As setup, consider this (admittedly rather contrived) example of a
1001  tie; all it does is use a file to keep a log of the values assigned to
1002  a scalar.
1003  
1004      package Remember;
1005  
1006      use strict;
1007      use warnings;
1008      use IO::File;
1009  
1010      sub TIESCALAR {
1011          my $class = shift;
1012          my $filename = shift;
1013          my $handle = IO::File->new( "> $filename" )
1014                           or die "Cannot open $filename: $!\n";
1015  
1016          print $handle "The Start\n";
1017          bless {FH => $handle, Value => 0}, $class;
1018      }
1019  
1020      sub FETCH {
1021          my $self = shift;
1022          return $self->{Value};
1023      }
1024  
1025      sub STORE {
1026          my $self = shift;
1027          my $value = shift;
1028          my $handle = $self->{FH};
1029          print $handle "$value\n";
1030          $self->{Value} = $value;
1031      }
1032  
1033      sub DESTROY {
1034          my $self = shift;
1035          my $handle = $self->{FH};
1036          print $handle "The End\n";
1037          close $handle;
1038      }
1039  
1040      1;
1041  
1042  Here is an example that makes use of this tie:
1043  
1044      use strict;
1045      use Remember;
1046  
1047      my $fred;
1048      tie $fred, 'Remember', 'myfile.txt';
1049      $fred = 1;
1050      $fred = 4;
1051      $fred = 5;
1052      untie $fred;
1053      system "cat myfile.txt";
1054  
1055  This is the output when it is executed:
1056  
1057      The Start
1058      1
1059      4
1060      5
1061      The End
1062  
1063  So far so good.  Those of you who have been paying attention will have
1064  spotted that the tied object hasn't been used so far.  So lets add an
1065  extra method to the Remember class to allow comments to be included in
1066  the file -- say, something like this:
1067  
1068      sub comment {
1069          my $self = shift;
1070          my $text = shift;
1071          my $handle = $self->{FH};
1072          print $handle $text, "\n";
1073      }
1074  
1075  And here is the previous example modified to use the C<comment> method
1076  (which requires the tied object):
1077  
1078      use strict;
1079      use Remember;
1080  
1081      my ($fred, $x);
1082      $x = tie $fred, 'Remember', 'myfile.txt';
1083      $fred = 1;
1084      $fred = 4;
1085      comment $x "changing...";
1086      $fred = 5;
1087      untie $fred;
1088      system "cat myfile.txt";
1089  
1090  When this code is executed there is no output.  Here's why:
1091  
1092  When a variable is tied, it is associated with the object which is the
1093  return value of the TIESCALAR, TIEARRAY, or TIEHASH function.  This
1094  object normally has only one reference, namely, the implicit reference
1095  from the tied variable.  When untie() is called, that reference is
1096  destroyed.  Then, as in the first example above, the object's
1097  destructor (DESTROY) is called, which is normal for objects that have
1098  no more valid references; and thus the file is closed.
1099  
1100  In the second example, however, we have stored another reference to
1101  the tied object in $x.  That means that when untie() gets called
1102  there will still be a valid reference to the object in existence, so
1103  the destructor is not called at that time, and thus the file is not
1104  closed.  The reason there is no output is because the file buffers
1105  have not been flushed to disk.
1106  
1107  Now that you know what the problem is, what can you do to avoid it?
1108  Prior to the introduction of the optional UNTIE method the only way
1109  was the good old C<-w> flag. Which will spot any instances where you call
1110  untie() and there are still valid references to the tied object.  If
1111  the second script above this near the top C<use warnings 'untie'>
1112  or was run with the C<-w> flag, Perl prints this
1113  warning message:
1114  
1115      untie attempted while 1 inner references still exist
1116  
1117  To get the script to work properly and silence the warning make sure
1118  there are no valid references to the tied object I<before> untie() is
1119  called:
1120  
1121      undef $x;
1122      untie $fred;
1123  
1124  Now that UNTIE exists the class designer can decide which parts of the
1125  class functionality are really associated with C<untie> and which with
1126  the object being destroyed. What makes sense for a given class depends
1127  on whether the inner references are being kept so that non-tie-related
1128  methods can be called on the object. But in most cases it probably makes
1129  sense to move the functionality that would have been in DESTROY to the UNTIE
1130  method.
1131  
1132  If the UNTIE method exists then the warning above does not occur. Instead the
1133  UNTIE method is passed the count of "extra" references and can issue its own
1134  warning if appropriate. e.g. to replicate the no UNTIE case this method can
1135  be used:
1136  
1137      sub UNTIE
1138      {
1139       my ($obj,$count) = @_;
1140       carp "untie attempted while $count inner references still exist" if $count;
1141      }
1142  
1143  =head1 SEE ALSO
1144  
1145  See L<DB_File> or L<Config> for some interesting tie() implementations.
1146  A good starting point for many tie() implementations is with one of the
1147  modules L<Tie::Scalar>, L<Tie::Array>, L<Tie::Hash>, or L<Tie::Handle>.
1148  
1149  =head1 BUGS
1150  
1151  The bucket usage information provided by C<scalar(%hash)> is not
1152  available.  What this means is that using %tied_hash in boolean
1153  context doesn't work right (currently this always tests false,
1154  regardless of whether the hash is empty or hash elements).
1155  
1156  Localizing tied arrays or hashes does not work.  After exiting the
1157  scope the arrays or the hashes are not restored.
1158  
1159  Counting the number of entries in a hash via C<scalar(keys(%hash))>
1160  or C<scalar(values(%hash)>) is inefficient since it needs to iterate
1161  through all the entries with FIRSTKEY/NEXTKEY.
1162  
1163  Tied hash/array slices cause multiple FETCH/STORE pairs, there are no
1164  tie methods for slice operations.
1165  
1166  You cannot easily tie a multilevel data structure (such as a hash of
1167  hashes) to a dbm file.  The first problem is that all but GDBM and
1168  Berkeley DB have size limitations, but beyond that, you also have problems
1169  with how references are to be represented on disk.  One experimental
1170  module that does attempt to address this need is DBM::Deep.  Check your
1171  nearest CPAN site as described in L<perlmodlib> for source code.  Note
1172  that despite its name, DBM::Deep does not use dbm.  Another earlier attempt
1173  at solving the problem is MLDBM, which is also available on the CPAN, but
1174  which has some fairly serious limitations.
1175  
1176  Tied filehandles are still incomplete.  sysopen(), truncate(),
1177  flock(), fcntl(), stat() and -X can't currently be trapped.
1178  
1179  =head1 AUTHOR
1180  
1181  Tom Christiansen
1182  
1183  TIEHANDLE by Sven Verdoolaege <F<skimo@dns.ufsia.ac.be>> and Doug MacEachern <F<dougm@osf.org>>
1184  
1185  UNTIE by Nick Ing-Simmons <F<nick@ing-simmons.net>>
1186  
1187  SCALAR by Tassilo von Parseval <F<tassilo.von.parseval@rwth-aachen.de>>
1188  
1189  Tying Arrays by Casey West <F<casey@geeknest.com>>