1N/A=head1 NAME
1N/A
1N/Aperltie - how to hide an object class in a simple variable
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A tie VARIABLE, CLASSNAME, LIST
1N/A
1N/A $object = tied VARIABLE
1N/A
1N/A untie VARIABLE
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/APrior to release 5.0 of Perl, a programmer could use dbmopen()
1N/Ato connect an on-disk database in the standard Unix dbm(3x)
1N/Aformat magically to a %HASH in their program. However, their Perl was either
1N/Abuilt with one particular dbm library or another, but not both, and
1N/Ayou couldn't extend this mechanism to other packages or types of variables.
1N/A
1N/ANow you can.
1N/A
1N/AThe tie() function binds a variable to a class (package) that will provide
1N/Athe implementation for access methods for that variable. Once this magic
1N/Ahas been performed, accessing a tied variable automatically triggers
1N/Amethod calls in the proper class. The complexity of the class is
1N/Ahidden behind magic methods calls. The method names are in ALL CAPS,
1N/Awhich is a convention that Perl uses to indicate that they're called
1N/Aimplicitly rather than explicitly--just like the BEGIN() and END()
1N/Afunctions.
1N/A
1N/AIn the tie() call, C<VARIABLE> is the name of the variable to be
1N/Aenchanted. C<CLASSNAME> is the name of a class implementing objects of
1N/Athe correct type. Any additional arguments in the C<LIST> are passed to
1N/Athe appropriate constructor method for that class--meaning TIESCALAR(),
1N/ATIEARRAY(), TIEHASH(), or TIEHANDLE(). (Typically these are arguments
1N/Asuch as might be passed to the dbminit() function of C.) The object
1N/Areturned by the "new" method is also returned by the tie() function,
1N/Awhich would be useful if you wanted to access other methods in
1N/AC<CLASSNAME>. (You don't actually have to return a reference to a right
1N/A"type" (e.g., HASH or C<CLASSNAME>) so long as it's a properly blessed
1N/Aobject.) You can also retrieve a reference to the underlying object
1N/Ausing the tied() function.
1N/A
1N/AUnlike dbmopen(), the tie() function will not C<use> or C<require> a module
1N/Afor you--you need to do that explicitly yourself.
1N/A
1N/A=head2 Tying Scalars
1N/A
1N/AA class implementing a tied scalar should define the following methods:
1N/ATIESCALAR, FETCH, STORE, and possibly UNTIE and/or DESTROY.
1N/A
1N/ALet's look at each in turn, using as an example a tie class for
1N/Ascalars that allows the user to do something like:
1N/A
1N/A tie $his_speed, 'Nice', getppid();
1N/A tie $my_speed, 'Nice', $$;
1N/A
1N/AAnd now whenever either of those variables is accessed, its current
1N/Asystem priority is retrieved and returned. If those variables are set,
1N/Athen the process's priority is changed!
1N/A
1N/AWe'll use Jarkko Hietaniemi <F<jhi@iki.fi>>'s BSD::Resource class (not
1N/Aincluded) to access the PRIO_PROCESS, PRIO_MIN, and PRIO_MAX constants
1N/Afrom your system, as well as the getpriority() and setpriority() system
1N/Acalls. Here's the preamble of the class.
1N/A
1N/A package Nice;
1N/A use Carp;
1N/A use BSD::Resource;
1N/A use strict;
1N/A $Nice::DEBUG = 0 unless defined $Nice::DEBUG;
1N/A
1N/A=over 4
1N/A
1N/A=item TIESCALAR classname, LIST
1N/A
1N/AThis is the constructor for the class. That means it is
1N/Aexpected to return a blessed reference to a new scalar
1N/A(probably anonymous) that it's creating. For example:
1N/A
1N/A sub TIESCALAR {
1N/A my $class = shift;
1N/A my $pid = shift || $$; # 0 means me
1N/A
1N/A if ($pid !~ /^\d+$/) {
1N/A carp "Nice::Tie::Scalar got non-numeric pid $pid" if $^W;
1N/A return undef;
1N/A }
1N/A
1N/A unless (kill 0, $pid) { # EPERM or ERSCH, no doubt
1N/A carp "Nice::Tie::Scalar got bad pid $pid: $!" if $^W;
1N/A return undef;
1N/A }
1N/A
1N/A return bless \$pid, $class;
1N/A }
1N/A
1N/AThis tie class has chosen to return an error rather than raising an
1N/Aexception if its constructor should fail. While this is how dbmopen() works,
1N/Aother classes may well not wish to be so forgiving. It checks the global
1N/Avariable C<$^W> to see whether to emit a bit of noise anyway.
1N/A
1N/A=item FETCH this
1N/A
1N/AThis method will be triggered every time the tied variable is accessed
1N/A(read). It takes no arguments beyond its self reference, which is the
1N/Aobject representing the scalar we're dealing with. Because in this case
1N/Awe're using just a SCALAR ref for the tied scalar object, a simple $$self
1N/Aallows the method to get at the real value stored there. In our example
1N/Abelow, that real value is the process ID to which we've tied our variable.
1N/A
1N/A sub FETCH {
1N/A my $self = shift;
1N/A confess "wrong type" unless ref $self;
1N/A croak "usage error" if @_;
1N/A my $nicety;
1N/A local($!) = 0;
1N/A $nicety = getpriority(PRIO_PROCESS, $$self);
1N/A if ($!) { croak "getpriority failed: $!" }
1N/A return $nicety;
1N/A }
1N/A
1N/AThis time we've decided to blow up (raise an exception) if the renice
1N/Afails--there's no place for us to return an error otherwise, and it's
1N/Aprobably the right thing to do.
1N/A
1N/A=item STORE this, value
1N/A
1N/AThis method will be triggered every time the tied variable is set
1N/A(assigned). Beyond its self reference, it also expects one (and only one)
1N/Aargument--the new value the user is trying to assign. Don't worry about
1N/Areturning a value from STORE -- the semantic of assignment returning the
1N/Aassigned value is implemented with FETCH.
1N/A
1N/A sub STORE {
1N/A my $self = shift;
1N/A confess "wrong type" unless ref $self;
1N/A my $new_nicety = shift;
1N/A croak "usage error" if @_;
1N/A
1N/A if ($new_nicety < PRIO_MIN) {
1N/A carp sprintf
1N/A "WARNING: priority %d less than minimum system priority %d",
1N/A $new_nicety, PRIO_MIN if $^W;
1N/A $new_nicety = PRIO_MIN;
1N/A }
1N/A
1N/A if ($new_nicety > PRIO_MAX) {
1N/A carp sprintf
1N/A "WARNING: priority %d greater than maximum system priority %d",
1N/A $new_nicety, PRIO_MAX if $^W;
1N/A $new_nicety = PRIO_MAX;
1N/A }
1N/A
1N/A unless (defined setpriority(PRIO_PROCESS, $$self, $new_nicety)) {
1N/A confess "setpriority failed: $!";
1N/A }
1N/A }
1N/A
1N/A=item UNTIE this
1N/A
1N/AThis method will be triggered when the C<untie> occurs. This can be useful
1N/Aif the class needs to know when no further calls will be made. (Except DESTROY
1N/Aof course.) See L<The C<untie> Gotcha> below for more details.
1N/A
1N/A=item DESTROY this
1N/A
1N/AThis method will be triggered when the tied variable needs to be destructed.
1N/AAs with other object classes, such a method is seldom necessary, because Perl
1N/Adeallocates its moribund object's memory for you automatically--this isn't
1N/AC++, you know. We'll use a DESTROY method here for debugging purposes only.
1N/A
1N/A sub DESTROY {
1N/A my $self = shift;
1N/A confess "wrong type" unless ref $self;
1N/A carp "[ Nice::DESTROY pid $$self ]" if $Nice::DEBUG;
1N/A }
1N/A
1N/A=back
1N/A
1N/AThat's about all there is to it. Actually, it's more than all there
1N/Ais to it, because we've done a few nice things here for the sake
1N/Aof completeness, robustness, and general aesthetics. Simpler
1N/ATIESCALAR classes are certainly possible.
1N/A
1N/A=head2 Tying Arrays
1N/A
1N/AA class implementing a tied ordinary array should define the following
1N/Amethods: TIEARRAY, FETCH, STORE, FETCHSIZE, STORESIZE and perhaps UNTIE and/or DESTROY.
1N/A
1N/AFETCHSIZE and STORESIZE are used to provide C<$#array> and
1N/Aequivalent C<scalar(@array)> access.
1N/A
1N/AThe methods POP, PUSH, SHIFT, UNSHIFT, SPLICE, DELETE, and EXISTS are
1N/Arequired if the perl operator with the corresponding (but lowercase) name
1N/Ais to operate on the tied array. The B<Tie::Array> class can be used as a
1N/Abase class to implement the first five of these in terms of the basic
1N/Amethods above. The default implementations of DELETE and EXISTS in
1N/AB<Tie::Array> simply C<croak>.
1N/A
1N/AIn addition EXTEND will be called when perl would have pre-extended
1N/Aallocation in a real array.
1N/A
1N/AFor this discussion, we'll implement an array whose elements are a fixed
1N/Asize at creation. If you try to create an element larger than the fixed
1N/Asize, you'll take an exception. For example:
1N/A
1N/A use FixedElem_Array;
1N/A tie @array, 'FixedElem_Array', 3;
1N/A $array[0] = 'cat'; # ok.
1N/A $array[1] = 'dogs'; # exception, length('dogs') > 3.
1N/A
1N/AThe preamble code for the class is as follows:
1N/A
1N/A package FixedElem_Array;
1N/A use Carp;
1N/A use strict;
1N/A
1N/A=over 4
1N/A
1N/A=item TIEARRAY classname, LIST
1N/A
1N/AThis is the constructor for the class. That means it is expected to
1N/Areturn a blessed reference through which the new array (probably an
1N/Aanonymous ARRAY ref) will be accessed.
1N/A
1N/AIn our example, just to show you that you don't I<really> have to return an
1N/AARRAY reference, we'll choose a HASH reference to represent our object.
1N/AA HASH works out well as a generic record type: the C<{ELEMSIZE}> field will
1N/Astore the maximum element size allowed, and the C<{ARRAY}> field will hold the
1N/Atrue ARRAY ref. If someone outside the class tries to dereference the
1N/Aobject returned (doubtless thinking it an ARRAY ref), they'll blow up.
1N/AThis just goes to show you that you should respect an object's privacy.
1N/A
1N/A sub TIEARRAY {
1N/A my $class = shift;
1N/A my $elemsize = shift;
1N/A if ( @_ || $elemsize =~ /\D/ ) {
1N/A croak "usage: tie ARRAY, '" . __PACKAGE__ . "', elem_size";
1N/A }
1N/A return bless {
1N/A ELEMSIZE => $elemsize,
1N/A ARRAY => [],
1N/A }, $class;
1N/A }
1N/A
1N/A=item FETCH this, index
1N/A
1N/AThis method will be triggered every time an individual element the tied array
1N/Ais accessed (read). It takes one argument beyond its self reference: the
1N/Aindex whose value we're trying to fetch.
1N/A
1N/A sub FETCH {
1N/A my $self = shift;
1N/A my $index = shift;
1N/A return $self->{ARRAY}->[$index];
1N/A }
1N/A
1N/AIf a negative array index is used to read from an array, the index
1N/Awill be translated to a positive one internally by calling FETCHSIZE
1N/Abefore being passed to FETCH. You may disable this feature by
1N/Aassigning a true value to the variable C<$NEGATIVE_INDICES> in the
1N/Atied array class.
1N/A
1N/AAs you may have noticed, the name of the FETCH method (et al.) is the same
1N/Afor all accesses, even though the constructors differ in names (TIESCALAR
1N/Avs TIEARRAY). While in theory you could have the same class servicing
1N/Aseveral tied types, in practice this becomes cumbersome, and it's easiest
1N/Ato keep them at simply one tie type per class.
1N/A
1N/A=item STORE this, index, value
1N/A
1N/AThis method will be triggered every time an element in the tied array is set
1N/A(written). It takes two arguments beyond its self reference: the index at
1N/Awhich we're trying to store something and the value we're trying to put
1N/Athere.
1N/A
1N/AIn our example, C<undef> is really C<$self-E<gt>{ELEMSIZE}> number of
1N/Aspaces so we have a little more work to do here:
1N/A
1N/A sub STORE {
1N/A my $self = shift;
1N/A my( $index, $value ) = @_;
1N/A if ( length $value > $self->{ELEMSIZE} ) {
1N/A croak "length of $value is greater than $self->{ELEMSIZE}";
1N/A }
1N/A # fill in the blanks
1N/A $self->EXTEND( $index ) if $index > $self->FETCHSIZE();
1N/A # right justify to keep element size for smaller elements
1N/A $self->{ARRAY}->[$index] = sprintf "%$self->{ELEMSIZE}s", $value;
1N/A }
1N/A
1N/ANegative indexes are treated the same as with FETCH.
1N/A
1N/A=item FETCHSIZE this
1N/A
1N/AReturns the total number of items in the tied array associated with
1N/Aobject I<this>. (Equivalent to C<scalar(@array)>). For example:
1N/A
1N/A sub FETCHSIZE {
1N/A my $self = shift;
1N/A return scalar @{$self->{ARRAY}};
1N/A }
1N/A
1N/A=item STORESIZE this, count
1N/A
1N/ASets the total number of items in the tied array associated with
1N/Aobject I<this> to be I<count>. If this makes the array larger then
1N/Aclass's mapping of C<undef> should be returned for new positions.
1N/AIf the array becomes smaller then entries beyond count should be
1N/Adeleted.
1N/A
1N/AIn our example, 'undef' is really an element containing
1N/AC<$self-E<gt>{ELEMSIZE}> number of spaces. Observe:
1N/A
1N/A sub STORESIZE {
1N/A my $self = shift;
1N/A my $count = shift;
1N/A if ( $count > $self->FETCHSIZE() ) {
1N/A foreach ( $count - $self->FETCHSIZE() .. $count ) {
1N/A $self->STORE( $_, '' );
1N/A }
1N/A } elsif ( $count < $self->FETCHSIZE() ) {
1N/A foreach ( 0 .. $self->FETCHSIZE() - $count - 2 ) {
1N/A $self->POP();
1N/A }
1N/A }
1N/A }
1N/A
1N/A=item EXTEND this, count
1N/A
1N/AInformative call that array is likely to grow to have I<count> entries.
1N/ACan be used to optimize allocation. This method need do nothing.
1N/A
1N/AIn our example, we want to make sure there are no blank (C<undef>)
1N/Aentries, so C<EXTEND> will make use of C<STORESIZE> to fill elements
1N/Aas needed:
1N/A
1N/A sub EXTEND {
1N/A my $self = shift;
1N/A my $count = shift;
1N/A $self->STORESIZE( $count );
1N/A }
1N/A
1N/A=item EXISTS this, key
1N/A
1N/AVerify that the element at index I<key> exists in the tied array I<this>.
1N/A
1N/AIn our example, we will determine that if an element consists of
1N/AC<$self-E<gt>{ELEMSIZE}> spaces only, it does not exist:
1N/A
1N/A sub EXISTS {
1N/A my $self = shift;
1N/A my $index = shift;
1N/A return 0 if ! defined $self->{ARRAY}->[$index] ||
1N/A $self->{ARRAY}->[$index] eq ' ' x $self->{ELEMSIZE};
1N/A return 1;
1N/A }
1N/A
1N/A=item DELETE this, key
1N/A
1N/ADelete the element at index I<key> from the tied array I<this>.
1N/A
1N/AIn our example, a deleted item is C<$self-E<gt>{ELEMSIZE}> spaces:
1N/A
1N/A sub DELETE {
1N/A my $self = shift;
1N/A my $index = shift;
1N/A return $self->STORE( $index, '' );
1N/A }
1N/A
1N/A=item CLEAR this
1N/A
1N/AClear (remove, delete, ...) all values from the tied array associated with
1N/Aobject I<this>. For example:
1N/A
1N/A sub CLEAR {
1N/A my $self = shift;
1N/A return $self->{ARRAY} = [];
1N/A }
1N/A
1N/A=item PUSH this, LIST
1N/A
1N/AAppend elements of I<LIST> to the array. For example:
1N/A
1N/A sub PUSH {
1N/A my $self = shift;
1N/A my @list = @_;
1N/A my $last = $self->FETCHSIZE();
1N/A $self->STORE( $last + $_, $list[$_] ) foreach 0 .. $#list;
1N/A return $self->FETCHSIZE();
1N/A }
1N/A
1N/A=item POP this
1N/A
1N/ARemove last element of the array and return it. For example:
1N/A
1N/A sub POP {
1N/A my $self = shift;
1N/A return pop @{$self->{ARRAY}};
1N/A }
1N/A
1N/A=item SHIFT this
1N/A
1N/ARemove the first element of the array (shifting other elements down)
1N/Aand return it. For example:
1N/A
1N/A sub SHIFT {
1N/A my $self = shift;
1N/A return shift @{$self->{ARRAY}};
1N/A }
1N/A
1N/A=item UNSHIFT this, LIST
1N/A
1N/AInsert LIST elements at the beginning of the array, moving existing elements
1N/Aup to make room. For example:
1N/A
1N/A sub UNSHIFT {
1N/A my $self = shift;
1N/A my @list = @_;
1N/A my $size = scalar( @list );
1N/A # make room for our list
1N/A @{$self->{ARRAY}}[ $size .. $#{$self->{ARRAY}} + $size ]
1N/A = @{$self->{ARRAY}};
1N/A $self->STORE( $_, $list[$_] ) foreach 0 .. $#list;
1N/A }
1N/A
1N/A=item SPLICE this, offset, length, LIST
1N/A
1N/APerform the equivalent of C<splice> on the array.
1N/A
1N/AI<offset> is optional and defaults to zero, negative values count back
1N/Afrom the end of the array.
1N/A
1N/AI<length> is optional and defaults to rest of the array.
1N/A
1N/AI<LIST> may be empty.
1N/A
1N/AReturns a list of the original I<length> elements at I<offset>.
1N/A
1N/AIn our example, we'll use a little shortcut if there is a I<LIST>:
1N/A
1N/A sub SPLICE {
1N/A my $self = shift;
1N/A my $offset = shift || 0;
1N/A my $length = shift || $self->FETCHSIZE() - $offset;
1N/A my @list = ();
1N/A if ( @_ ) {
1N/A tie @list, __PACKAGE__, $self->{ELEMSIZE};
1N/A @list = @_;
1N/A }
1N/A return splice @{$self->{ARRAY}}, $offset, $length, @list;
1N/A }
1N/A
1N/A=item UNTIE this
1N/A
1N/AWill be called when C<untie> happens. (See L<The C<untie> Gotcha> below.)
1N/A
1N/A=item DESTROY this
1N/A
1N/AThis method will be triggered when the tied variable needs to be destructed.
1N/AAs with the scalar tie class, this is almost never needed in a
1N/Alanguage that does its own garbage collection, so this time we'll
1N/Ajust leave it out.
1N/A
1N/A=back
1N/A
1N/A=head2 Tying Hashes
1N/A
1N/AHashes were the first Perl data type to be tied (see dbmopen()). A class
1N/Aimplementing a tied hash should define the following methods: TIEHASH is
1N/Athe constructor. FETCH and STORE access the key and value pairs. EXISTS
1N/Areports whether a key is present in the hash, and DELETE deletes one.
1N/ACLEAR empties the hash by deleting all the key and value pairs. FIRSTKEY
1N/Aand NEXTKEY implement the keys() and each() functions to iterate over all
1N/Athe keys. SCALAR is triggered when the tied hash is evaluated in scalar
1N/Acontext. UNTIE is called when C<untie> happens, and DESTROY is called when
1N/Athe tied variable is garbage collected.
1N/A
1N/AIf this seems like a lot, then feel free to inherit from merely the
1N/Astandard Tie::StdHash module for most of your methods, redefining only the
1N/Ainteresting ones. See L<Tie::Hash> for details.
1N/A
1N/ARemember that Perl distinguishes between a key not existing in the hash,
1N/Aand the key existing in the hash but having a corresponding value of
1N/AC<undef>. The two possibilities can be tested with the C<exists()> and
1N/AC<defined()> functions.
1N/A
1N/AHere's an example of a somewhat interesting tied hash class: it gives you
1N/Aa hash representing a particular user's dot files. You index into the hash
1N/Awith the name of the file (minus the dot) and you get back that dot file's
1N/Acontents. For example:
1N/A
1N/A use DotFiles;
1N/A tie %dot, 'DotFiles';
1N/A if ( $dot{profile} =~ /MANPATH/ ||
1N/A $dot{login} =~ /MANPATH/ ||
1N/A $dot{cshrc} =~ /MANPATH/ )
1N/A {
1N/A print "you seem to set your MANPATH\n";
1N/A }
1N/A
1N/AOr here's another sample of using our tied class:
1N/A
1N/A tie %him, 'DotFiles', 'daemon';
1N/A foreach $f ( keys %him ) {
1N/A printf "daemon dot file %s is size %d\n",
1N/A $f, length $him{$f};
1N/A }
1N/A
1N/AIn our tied hash DotFiles example, we use a regular
1N/Ahash for the object containing several important
1N/Afields, of which only the C<{LIST}> field will be what the
1N/Auser thinks of as the real hash.
1N/A
1N/A=over 5
1N/A
1N/A=item USER
1N/A
1N/Awhose dot files this object represents
1N/A
1N/A=item HOME
1N/A
1N/Awhere those dot files live
1N/A
1N/A=item CLOBBER
1N/A
1N/Awhether we should try to change or remove those dot files
1N/A
1N/A=item LIST
1N/A
1N/Athe hash of dot file names and content mappings
1N/A
1N/A=back
1N/A
1N/AHere's the start of F<Dotfiles.pm>:
1N/A
1N/A package DotFiles;
1N/A use Carp;
1N/A sub whowasi { (caller(1))[3] . '()' }
1N/A my $DEBUG = 0;
1N/A sub debug { $DEBUG = @_ ? shift : 1 }
1N/A
1N/AFor our example, we want to be able to emit debugging info to help in tracing
1N/Aduring development. We keep also one convenience function around
1N/Ainternally to help print out warnings; whowasi() returns the function name
1N/Athat calls it.
1N/A
1N/AHere are the methods for the DotFiles tied hash.
1N/A
1N/A=over 4
1N/A
1N/A=item TIEHASH classname, LIST
1N/A
1N/AThis is the constructor for the class. That means it is expected to
1N/Areturn a blessed reference through which the new object (probably but not
1N/Anecessarily an anonymous hash) will be accessed.
1N/A
1N/AHere's the constructor:
1N/A
1N/A sub TIEHASH {
1N/A my $self = shift;
1N/A my $user = shift || $>;
1N/A my $dotdir = shift || '';
1N/A croak "usage: @{[&whowasi]} [USER [DOTDIR]]" if @_;
1N/A $user = getpwuid($user) if $user =~ /^\d+$/;
1N/A my $dir = (getpwnam($user))[7]
1N/A || croak "@{[&whowasi]}: no user $user";
1N/A $dir .= "/$dotdir" if $dotdir;
1N/A
1N/A my $node = {
1N/A USER => $user,
1N/A HOME => $dir,
1N/A LIST => {},
1N/A CLOBBER => 0,
1N/A };
1N/A
1N/A opendir(DIR, $dir)
1N/A || croak "@{[&whowasi]}: can't opendir $dir: $!";
1N/A foreach $dot ( grep /^\./ && -f "$dir/$_", readdir(DIR)) {
1N/A $dot =~ s/^\.//;
1N/A $node->{LIST}{$dot} = undef;
1N/A }
1N/A closedir DIR;
1N/A return bless $node, $self;
1N/A }
1N/A
1N/AIt's probably worth mentioning that if you're going to filetest the
1N/Areturn values out of a readdir, you'd better prepend the directory
1N/Ain question. Otherwise, because we didn't chdir() there, it would
1N/Ahave been testing the wrong file.
1N/A
1N/A=item FETCH this, key
1N/A
1N/AThis method will be triggered every time an element in the tied hash is
1N/Aaccessed (read). It takes one argument beyond its self reference: the key
1N/Awhose value we're trying to fetch.
1N/A
1N/AHere's the fetch for our DotFiles example.
1N/A
1N/A sub FETCH {
1N/A carp &whowasi if $DEBUG;
1N/A my $self = shift;
1N/A my $dot = shift;
1N/A my $dir = $self->{HOME};
1N/A my $file = "$dir/.$dot";
1N/A
1N/A unless (exists $self->{LIST}->{$dot} || -f $file) {
1N/A carp "@{[&whowasi]}: no $dot file" if $DEBUG;
1N/A return undef;
1N/A }
1N/A
1N/A if (defined $self->{LIST}->{$dot}) {
1N/A return $self->{LIST}->{$dot};
1N/A } else {
1N/A return $self->{LIST}->{$dot} = `cat $dir/.$dot`;
1N/A }
1N/A }
1N/A
1N/AIt was easy to write by having it call the Unix cat(1) command, but it
1N/Awould probably be more portable to open the file manually (and somewhat
1N/Amore efficient). Of course, because dot files are a Unixy concept, we're
1N/Anot that concerned.
1N/A
1N/A=item STORE this, key, value
1N/A
1N/AThis method will be triggered every time an element in the tied hash is set
1N/A(written). It takes two arguments beyond its self reference: the index at
1N/Awhich we're trying to store something, and the value we're trying to put
1N/Athere.
1N/A
1N/AHere in our DotFiles example, we'll be careful not to let
1N/Athem try to overwrite the file unless they've called the clobber()
1N/Amethod on the original object reference returned by tie().
1N/A
1N/A sub STORE {
1N/A carp &whowasi if $DEBUG;
1N/A my $self = shift;
1N/A my $dot = shift;
1N/A my $value = shift;
1N/A my $file = $self->{HOME} . "/.$dot";
1N/A my $user = $self->{USER};
1N/A
1N/A croak "@{[&whowasi]}: $file not clobberable"
1N/A unless $self->{CLOBBER};
1N/A
1N/A open(F, "> $file") || croak "can't open $file: $!";
1N/A print F $value;
1N/A close(F);
1N/A }
1N/A
1N/AIf they wanted to clobber something, they might say:
1N/A
1N/A $ob = tie %daemon_dots, 'daemon';
1N/A $ob->clobber(1);
1N/A $daemon_dots{signature} = "A true daemon\n";
1N/A
1N/AAnother way to lay hands on a reference to the underlying object is to
1N/Ause the tied() function, so they might alternately have set clobber
1N/Ausing:
1N/A
1N/A tie %daemon_dots, 'daemon';
1N/A tied(%daemon_dots)->clobber(1);
1N/A
1N/AThe clobber method is simply:
1N/A
1N/A sub clobber {
1N/A my $self = shift;
1N/A $self->{CLOBBER} = @_ ? shift : 1;
1N/A }
1N/A
1N/A=item DELETE this, key
1N/A
1N/AThis method is triggered when we remove an element from the hash,
1N/Atypically by using the delete() function. Again, we'll
1N/Abe careful to check whether they really want to clobber files.
1N/A
1N/A sub DELETE {
1N/A carp &whowasi if $DEBUG;
1N/A
1N/A my $self = shift;
1N/A my $dot = shift;
1N/A my $file = $self->{HOME} . "/.$dot";
1N/A croak "@{[&whowasi]}: won't remove file $file"
1N/A unless $self->{CLOBBER};
1N/A delete $self->{LIST}->{$dot};
1N/A my $success = unlink($file);
1N/A carp "@{[&whowasi]}: can't unlink $file: $!" unless $success;
1N/A $success;
1N/A }
1N/A
1N/AThe value returned by DELETE becomes the return value of the call
1N/Ato delete(). If you want to emulate the normal behavior of delete(),
1N/Ayou should return whatever FETCH would have returned for this key.
1N/AIn this example, we have chosen instead to return a value which tells
1N/Athe caller whether the file was successfully deleted.
1N/A
1N/A=item CLEAR this
1N/A
1N/AThis method is triggered when the whole hash is to be cleared, usually by
1N/Aassigning the empty list to it.
1N/A
1N/AIn our example, that would remove all the user's dot files! It's such a
1N/Adangerous thing that they'll have to set CLOBBER to something higher than
1N/A1 to make it happen.
1N/A
1N/A sub CLEAR {
1N/A carp &whowasi if $DEBUG;
1N/A my $self = shift;
1N/A croak "@{[&whowasi]}: won't remove all dot files for $self->{USER}"
1N/A unless $self->{CLOBBER} > 1;
1N/A my $dot;
1N/A foreach $dot ( keys %{$self->{LIST}}) {
1N/A $self->DELETE($dot);
1N/A }
1N/A }
1N/A
1N/A=item EXISTS this, key
1N/A
1N/AThis method is triggered when the user uses the exists() function
1N/Aon a particular hash. In our example, we'll look at the C<{LIST}>
1N/Ahash element for this:
1N/A
1N/A sub EXISTS {
1N/A carp &whowasi if $DEBUG;
1N/A my $self = shift;
1N/A my $dot = shift;
1N/A return exists $self->{LIST}->{$dot};
1N/A }
1N/A
1N/A=item FIRSTKEY this
1N/A
1N/AThis method will be triggered when the user is going
1N/Ato iterate through the hash, such as via a keys() or each()
1N/Acall.
1N/A
1N/A sub FIRSTKEY {
1N/A carp &whowasi if $DEBUG;
1N/A my $self = shift;
1N/A my $a = keys %{$self->{LIST}}; # reset each() iterator
1N/A each %{$self->{LIST}}
1N/A }
1N/A
1N/A=item NEXTKEY this, lastkey
1N/A
1N/AThis method gets triggered during a keys() or each() iteration. It has a
1N/Asecond argument which is the last key that had been accessed. This is
1N/Auseful if you're carrying about ordering or calling the iterator from more
1N/Athan one sequence, or not really storing things in a hash anywhere.
1N/A
1N/AFor our example, we're using a real hash so we'll do just the simple
1N/Athing, but we'll have to go through the LIST field indirectly.
1N/A
1N/A sub NEXTKEY {
1N/A carp &whowasi if $DEBUG;
1N/A my $self = shift;
1N/A return each %{ $self->{LIST} }
1N/A }
1N/A
1N/A=item SCALAR this
1N/A
1N/AThis is called when the hash is evaluated in scalar context. In order
1N/Ato mimic the behaviour of untied hashes, this method should return a
1N/Afalse value when the tied hash is considered empty. If this method does
1N/Anot exist, perl will make some educated guesses and return true when
1N/Athe hash is inside an iteration. If this isn't the case, FIRSTKEY is
1N/Acalled, and the result will be a false value if FIRSTKEY returns the empty
1N/Alist, true otherwise.
1N/A
1N/AHowever, you should B<not> blindly rely on perl always doing the right
1N/Athing. Particularly, perl will mistakenly return true when you clear the
1N/Ahash by repeatedly calling DELETE until it is empty. You are therefore
1N/Aadvised to supply your own SCALAR method when you want to be absolutely
1N/Asure that your hash behaves nicely in scalar context.
1N/A
1N/AIn our example we can just call C<scalar> on the underlying hash
1N/Areferenced by C<$self-E<gt>{LIST}>:
1N/A
1N/A sub SCALAR {
1N/A carp &whowasi if $DEBUG;
1N/A my $self = shift;
1N/A return scalar %{ $self->{LIST} }
1N/A }
1N/A
1N/A=item UNTIE this
1N/A
1N/AThis is called when C<untie> occurs. See L<The C<untie> Gotcha> below.
1N/A
1N/A=item DESTROY this
1N/A
1N/AThis method is triggered when a tied hash is about to go out of
1N/Ascope. You don't really need it unless you're trying to add debugging
1N/Aor have auxiliary state to clean up. Here's a very simple function:
1N/A
1N/A sub DESTROY {
1N/A carp &whowasi if $DEBUG;
1N/A }
1N/A
1N/A=back
1N/A
1N/ANote that functions such as keys() and values() may return huge lists
1N/Awhen used on large objects, like DBM files. You may prefer to use the
1N/Aeach() function to iterate over such. Example:
1N/A
1N/A # print out history file offsets
1N/A use NDBM_File;
1N/A tie(%HIST, 'NDBM_File', '/usr/lib/news/history', 1, 0);
1N/A while (($key,$val) = each %HIST) {
1N/A print $key, ' = ', unpack('L',$val), "\n";
1N/A }
1N/A untie(%HIST);
1N/A
1N/A=head2 Tying FileHandles
1N/A
1N/AThis is partially implemented now.
1N/A
1N/AA class implementing a tied filehandle should define the following
1N/Amethods: TIEHANDLE, at least one of PRINT, PRINTF, WRITE, READLINE, GETC,
1N/AREAD, and possibly CLOSE, UNTIE and DESTROY. The class can also provide: BINMODE,
1N/AOPEN, EOF, FILENO, SEEK, TELL - if the corresponding perl operators are
1N/Aused on the handle.
1N/A
1N/AWhen STDERR is tied, its PRINT method will be called to issue warnings
1N/Aand error messages. This feature is temporarily disabled during the call,
1N/Awhich means you can use C<warn()> inside PRINT without starting a recursive
1N/Aloop. And just like C<__WARN__> and C<__DIE__> handlers, STDERR's PRINT
1N/Amethod may be called to report parser errors, so the caveats mentioned under
1N/AL<perlvar/%SIG> apply.
1N/A
1N/AAll of this is especially useful when perl is embedded in some other
1N/Aprogram, where output to STDOUT and STDERR may have to be redirected
1N/Ain some special way. See nvi and the Apache module for examples.
1N/A
1N/AIn our example we're going to create a shouting handle.
1N/A
1N/A package Shout;
1N/A
1N/A=over 4
1N/A
1N/A=item TIEHANDLE classname, LIST
1N/A
1N/AThis is the constructor for the class. That means it is expected to
1N/Areturn a blessed reference of some sort. The reference can be used to
1N/Ahold some internal information.
1N/A
1N/A sub TIEHANDLE { print "<shout>\n"; my $i; bless \$i, shift }
1N/A
1N/A=item WRITE this, LIST
1N/A
1N/AThis method will be called when the handle is written to via the
1N/AC<syswrite> function.
1N/A
1N/A sub WRITE {
1N/A $r = shift;
1N/A my($buf,$len,$offset) = @_;
1N/A print "WRITE called, \$buf=$buf, \$len=$len, \$offset=$offset";
1N/A }
1N/A
1N/A=item PRINT this, LIST
1N/A
1N/AThis method will be triggered every time the tied handle is printed to
1N/Awith the C<print()> function.
1N/ABeyond its self reference it also expects the list that was passed to
1N/Athe print function.
1N/A
1N/A sub PRINT { $r = shift; $$r++; print join($,,map(uc($_),@_)),$\ }
1N/A
1N/A=item PRINTF this, LIST
1N/A
1N/AThis method will be triggered every time the tied handle is printed to
1N/Awith the C<printf()> function.
1N/ABeyond its self reference it also expects the format and list that was
1N/Apassed to the printf function.
1N/A
1N/A sub PRINTF {
1N/A shift;
1N/A my $fmt = shift;
1N/A print sprintf($fmt, @_)."\n";
1N/A }
1N/A
1N/A=item READ this, LIST
1N/A
1N/AThis method will be called when the handle is read from via the C<read>
1N/Aor C<sysread> functions.
1N/A
1N/A sub READ {
1N/A my $self = shift;
1N/A my $bufref = \$_[0];
1N/A my(undef,$len,$offset) = @_;
1N/A print "READ called, \$buf=$bufref, \$len=$len, \$offset=$offset";
1N/A # add to $$bufref, set $len to number of characters read
1N/A $len;
1N/A }
1N/A
1N/A=item READLINE this
1N/A
1N/AThis method will be called when the handle is read from via <HANDLE>.
1N/AThe method should return undef when there is no more data.
1N/A
1N/A sub READLINE { $r = shift; "READLINE called $$r times\n"; }
1N/A
1N/A=item GETC this
1N/A
1N/AThis method will be called when the C<getc> function is called.
1N/A
1N/A sub GETC { print "Don't GETC, Get Perl"; return "a"; }
1N/A
1N/A=item CLOSE this
1N/A
1N/AThis method will be called when the handle is closed via the C<close>
1N/Afunction.
1N/A
1N/A sub CLOSE { print "CLOSE called.\n" }
1N/A
1N/A=item UNTIE this
1N/A
1N/AAs with the other types of ties, this method will be called when C<untie> happens.
1N/AIt may be appropriate to "auto CLOSE" when this occurs. See
1N/AL<The C<untie> Gotcha> below.
1N/A
1N/A=item DESTROY this
1N/A
1N/AAs with the other types of ties, this method will be called when the
1N/Atied handle is about to be destroyed. This is useful for debugging and
1N/Apossibly cleaning up.
1N/A
1N/A sub DESTROY { print "</shout>\n" }
1N/A
1N/A=back
1N/A
1N/AHere's how to use our little example:
1N/A
1N/A tie(*FOO,'Shout');
1N/A print FOO "hello\n";
1N/A $a = 4; $b = 6;
1N/A print FOO $a, " plus ", $b, " equals ", $a + $b, "\n";
1N/A print <FOO>;
1N/A
1N/A=head2 UNTIE this
1N/A
1N/AYou can define for all tie types an UNTIE method that will be called
1N/Aat untie(). See L<The C<untie> Gotcha> below.
1N/A
1N/A=head2 The C<untie> Gotcha
1N/A
1N/AIf you intend making use of the object returned from either tie() or
1N/Atied(), and if the tie's target class defines a destructor, there is a
1N/Asubtle gotcha you I<must> guard against.
1N/A
1N/AAs setup, consider this (admittedly rather contrived) example of a
1N/Atie; all it does is use a file to keep a log of the values assigned to
1N/Aa scalar.
1N/A
1N/A package Remember;
1N/A
1N/A use strict;
1N/A use warnings;
1N/A use IO::File;
1N/A
1N/A sub TIESCALAR {
1N/A my $class = shift;
1N/A my $filename = shift;
1N/A my $handle = new IO::File "> $filename"
1N/A or die "Cannot open $filename: $!\n";
1N/A
1N/A print $handle "The Start\n";
1N/A bless {FH => $handle, Value => 0}, $class;
1N/A }
1N/A
1N/A sub FETCH {
1N/A my $self = shift;
1N/A return $self->{Value};
1N/A }
1N/A
1N/A sub STORE {
1N/A my $self = shift;
1N/A my $value = shift;
1N/A my $handle = $self->{FH};
1N/A print $handle "$value\n";
1N/A $self->{Value} = $value;
1N/A }
1N/A
1N/A sub DESTROY {
1N/A my $self = shift;
1N/A my $handle = $self->{FH};
1N/A print $handle "The End\n";
1N/A close $handle;
1N/A }
1N/A
1N/A 1;
1N/A
1N/AHere is an example that makes use of this tie:
1N/A
1N/A use strict;
1N/A use Remember;
1N/A
1N/A my $fred;
1N/A tie $fred, 'Remember', 'myfile.txt';
1N/A $fred = 1;
1N/A $fred = 4;
1N/A $fred = 5;
1N/A untie $fred;
1N/A system "cat myfile.txt";
1N/A
1N/AThis is the output when it is executed:
1N/A
1N/A The Start
1N/A 1
1N/A 4
1N/A 5
1N/A The End
1N/A
1N/ASo far so good. Those of you who have been paying attention will have
1N/Aspotted that the tied object hasn't been used so far. So lets add an
1N/Aextra method to the Remember class to allow comments to be included in
1N/Athe file -- say, something like this:
1N/A
1N/A sub comment {
1N/A my $self = shift;
1N/A my $text = shift;
1N/A my $handle = $self->{FH};
1N/A print $handle $text, "\n";
1N/A }
1N/A
1N/AAnd here is the previous example modified to use the C<comment> method
1N/A(which requires the tied object):
1N/A
1N/A use strict;
1N/A use Remember;
1N/A
1N/A my ($fred, $x);
1N/A $x = tie $fred, 'Remember', 'myfile.txt';
1N/A $fred = 1;
1N/A $fred = 4;
1N/A comment $x "changing...";
1N/A $fred = 5;
1N/A untie $fred;
1N/A system "cat myfile.txt";
1N/A
1N/AWhen this code is executed there is no output. Here's why:
1N/A
1N/AWhen a variable is tied, it is associated with the object which is the
1N/Areturn value of the TIESCALAR, TIEARRAY, or TIEHASH function. This
1N/Aobject normally has only one reference, namely, the implicit reference
1N/Afrom the tied variable. When untie() is called, that reference is
1N/Adestroyed. Then, as in the first example above, the object's
1N/Adestructor (DESTROY) is called, which is normal for objects that have
1N/Ano more valid references; and thus the file is closed.
1N/A
1N/AIn the second example, however, we have stored another reference to
1N/Athe tied object in $x. That means that when untie() gets called
1N/Athere will still be a valid reference to the object in existence, so
1N/Athe destructor is not called at that time, and thus the file is not
1N/Aclosed. The reason there is no output is because the file buffers
1N/Ahave not been flushed to disk.
1N/A
1N/ANow that you know what the problem is, what can you do to avoid it?
1N/APrior to the introduction of the optional UNTIE method the only way
1N/Awas the good old C<-w> flag. Which will spot any instances where you call
1N/Auntie() and there are still valid references to the tied object. If
1N/Athe second script above this near the top C<use warnings 'untie'>
1N/Aor was run with the C<-w> flag, Perl prints this
1N/Awarning message:
1N/A
1N/A untie attempted while 1 inner references still exist
1N/A
1N/ATo get the script to work properly and silence the warning make sure
1N/Athere are no valid references to the tied object I<before> untie() is
1N/Acalled:
1N/A
1N/A undef $x;
1N/A untie $fred;
1N/A
1N/ANow that UNTIE exists the class designer can decide which parts of the
1N/Aclass functionality are really associated with C<untie> and which with
1N/Athe object being destroyed. What makes sense for a given class depends
1N/Aon whether the inner references are being kept so that non-tie-related
1N/Amethods can be called on the object. But in most cases it probably makes
1N/Asense to move the functionality that would have been in DESTROY to the UNTIE
1N/Amethod.
1N/A
1N/AIf the UNTIE method exists then the warning above does not occur. Instead the
1N/AUNTIE method is passed the count of "extra" references and can issue its own
1N/Awarning if appropriate. e.g. to replicate the no UNTIE case this method can
1N/Abe used:
1N/A
1N/A sub UNTIE
1N/A {
1N/A my ($obj,$count) = @_;
1N/A carp "untie attempted while $count inner references still exist" if $count;
1N/A }
1N/A
1N/A=head1 SEE ALSO
1N/A
1N/ASee L<DB_File> or L<Config> for some interesting tie() implementations.
1N/AA good starting point for many tie() implementations is with one of the
1N/Amodules L<Tie::Scalar>, L<Tie::Array>, L<Tie::Hash>, or L<Tie::Handle>.
1N/A
1N/A=head1 BUGS
1N/A
1N/AThe bucket usage information provided by C<scalar(%hash)> is not
1N/Aavailable. What this means is that using %tied_hash in boolean
1N/Acontext doesn't work right (currently this always tests false,
1N/Aregardless of whether the hash is empty or hash elements).
1N/A
1N/ALocalizing tied arrays or hashes does not work. After exiting the
1N/Ascope the arrays or the hashes are not restored.
1N/A
1N/ACounting the number of entries in a hash via C<scalar(keys(%hash))>
1N/Aor C<scalar(values(%hash)>) is inefficient since it needs to iterate
1N/Athrough all the entries with FIRSTKEY/NEXTKEY.
1N/A
1N/ATied hash/array slices cause multiple FETCH/STORE pairs, there are no
1N/Atie methods for slice operations.
1N/A
1N/AYou cannot easily tie a multilevel data structure (such as a hash of
1N/Ahashes) to a dbm file. The first problem is that all but GDBM and
1N/ABerkeley DB have size limitations, but beyond that, you also have problems
1N/Awith how references are to be represented on disk. One experimental
1N/Amodule that does attempt to address this need partially is the MLDBM
1N/Amodule. Check your nearest CPAN site as described in L<perlmodlib> for
1N/Asource code to MLDBM.
1N/A
1N/ATied filehandles are still incomplete. sysopen(), truncate(),
1N/Aflock(), fcntl(), stat() and -X can't currently be trapped.
1N/A
1N/A=head1 AUTHOR
1N/A
1N/ATom Christiansen
1N/A
1N/ATIEHANDLE by Sven Verdoolaege <F<skimo@dns.ufsia.ac.be>> and Doug MacEachern <F<dougm@osf.org>>
1N/A
1N/AUNTIE by Nick Ing-Simmons <F<nick@ing-simmons.net>>
1N/A
1N/ASCALAR by Tassilo von Parseval <F<tassilo.von.parseval@rwth-aachen.de>>
1N/A
1N/ATying Arrays by Casey West <F<casey@geeknest.com>>