A class implementing a tied hash should define eight
methods. TIEHASH
constructs new objects.
FETCH
and STORE
access the
key/value pairs. EXISTS
reports whether a key is
present in the hash, and DELETE
removes a key along
with its associated value.[2] CLEAR
empties the hash by deleting
all key/value pairs. FIRSTKEY
and
NEXTKEY
iterate over the key/value pairs when you
call keys
, values
, or
each
. And as usual, if you want to perform
particular actions when the object is deallocated, you may define a
DESTROY
method. (If this seems like a lot of
methods, you didn't read the last section on arrays attentively. In
any event, feel free to inherit the default methods from the standard
Tie::Hash
module, redefining only the interesting
ones. Again, Tie::StdHash
assumes the
implementation is also a hash.)
For example, suppose you want to create a hash where every time you assign a value to a key, instead of overwriting the previous contents, the new value is appended to an array of values. That way when you say:
$h{$k} = "one"; $h{$k} = "two";
It really does:
push @{ $h{$k} }, "one"; push @{ $h{$k} }, "two";
That's not a very complicated idea, so you should be able to use
a pretty simple module. Using Tie::StdHash
as a
base class, it is. Here's a Tie::AppendHash
that
does just that:
package Tie::AppendHash; use Tie::Hash; our @ISA = ("Tie::StdHash"); sub STORE { my ($self, $key, $value) = @_; push @{$self->{key}}, $value; } 1;
Here's an example of an interesting tied-hash class: it gives you a hash representing a particular user's dot files (that is, files whose names begin with a period, which is a naming convention for initialization files under Unix). You index into the hash with the name of the file (minus the period) and get back that dot file's contents. For example:
use DotFiles; tie %dot, "DotFiles"; if ( $dot{profile} =~ /MANPATH/ or $dot{login} =~ /MANPATH/ or $dot{cshrc} =~ /MANPATH/ ) { print "you seem to set your MANPATH "; }
Here's another way to use our tied class:
# Third argument is the name of a user whose dot files we will tie to. tie %him, "DotFiles", "daemon"; foreach $f (keys %him) { printf "daemon dot file %s is size %d ", $f, length $him{$f}; }
In our DotFiles
example we implement the
object as a regular hash containing several important fields, of
which only the {CONTENTS}
field will contain what
the user thinks of as the hash. Here are the object's actual
fields:
Field | Contents |
---|---|
USER | Whose dot files this object represents. |
HOME | Where those dot files live. |
CLOBBER | Whether we are allowed to change or remove those dot files. |
CONTENTS | The hash of dot file names and content mappings. |
Here's the start of DotFiles.pm:
package DotFiles; use Carp; sub whowasi { (caller(1))[3] . "()" } my $DEBUG = 0; sub debug { $DEBUG = @_ ? shift : 1 }
For our example, we want to be able to turn on debugging
output to help in tracing during development, so we set up
$DEBUG
for that. We also keep one convenience
function around internally to help print out warnings:
whowasi
returns the name of the function that
called the current function (whowasi
's
"grandparent" function).
Here are the methods for the DotFiles
tied
hash:
CLASSNAME
->TIEHASH(
LIST
)
Here's the DotFiles
constructor:
sub TIEHASH { my $self = shift; my $user = shift || $>; my $dotdir = shift || ""; croak "usage: @{[ &whowasi ]} [USER [DOTDIR]]" if @_; $user = getpwuid($user) if $user =~ /^d+$/; my $dir = (getpwnam($user))[7] or croak "@{ [&whowasi] }: no user $user"; $dir .= "/$dotdir" if $dotdir; my $node = { USER => $user, HOME => $dir, CONTENTS => {}, CLOBBER => 0, }; opendir DIR, $dir or croak "@{[&whowasi]}: can't opendir $dir: $!"; for my $dot ( grep /^./ && -f "$dir/$_", readdir(DIR)) { $dot =~ s/^.//; $node->{CONTENTS}{$dot} = undef; } closedir DIR; return bless $node, $self; }
It's probably worth mentioning that if you're going to
apply file tests to the values returned by the above
readdir
, you'd better prepend the directory
in question (as we do). Otherwise, since no
chdir
was done, you'd likely be testing the
wrong file.
SELF
->FETCH(
KEY
)
This method implements reading an element from the tied hash. It takes one argument after the object: the key whose value we're trying to fetch. The key is a string, and you can do anything you like with it (consistent with its being a string).
Here's the fetch for our DotFiles
example:
sub FETCH { carp &whowasi if $DEBUG; my $self = shift; my $dot = shift; my $dir = $self->{HOME}; my $file = "$dir/.$dot"; unless (exists $self->{CONTENTS}->{$dot} || -f $file) { carp "@{[&whowasi]}: no $dot file" if $DEBUG; return undef; } # Implement a cache. if (defined $self->{CONTENTS}->{$dot}) { return $self->{CONTENTS}->{$dot}; } else { return $self->{CONTENTS}->{$dot} = `cat $dir/.$dot`; } }
We cheated a little by running the Unix cat (1) command, but it would be more portable (and more efficient) to open the file ourselves. On the other hand, since dotfiles are a Unixy concept, we're not that concerned. Or shouldn't be. Or something...
SELF
->STORE(
KEY
,
VALUE
)
This method does the dirty work whenever an element in the tied hash is set (written). It takes two arguments after the object: the key under which we're storing the new value, and the value itself.
For our DotFiles
example, we won't
let users overwrite a file without first invoking the
clobber
method on the original object
returned by tie
:
sub STORE { carp &whowasi if $DEBUG; my $self = shift; my $dot = shift; my $value = shift; my $file = $self->{HOME} . "/.$dot"; croak "@{[&whowasi]}: $file not clobberable" unless $self->{CLOBBER}; open(F, "> $file") or croak "can't open $file: $!"; print F $value; close(F); }
If someone wants to clobber something, they can say:
$ob = tie %daemon_dots, "daemon"; $ob->clobber(1); $daemon_dots{signature} = "A true daemon ";
But they could alternatively set
{CLOBBER}
with
tied
:
tie %daemon_dots, "DotFiles", "daemon"; tied(%daemon_dots)->clobber(1);
or as one statement:
(tie %daemon_dots, "DotFiles", "daemon")->clobber(1);
The clobber
method is simply:
sub clobber { my $self = shift; $self->{CLOBBER} = @_ ? shift : 1; }
SELF
->DELETE(
KEY
)
This method handles requests to remove an element from
the hash. If your emulated hash uses a real hash somewhere,
you can just call the real delete
. Again,
we'll be careful to check whether the user really wants to
clobber files:
sub DELETE { carp &whowasi if $DEBUG; my $self = shift; my $dot = shift; my $file = $self->{HOME} . "/.$dot"; croak "@{[&whowasi]}: won't remove file $file" unless $self->{CLOBBER}; delete $self->{CONTENTS}->{$dot}; unlink $file or carp "@{[&whowasi]}: can't unlink $file: $!"; }
SELF
->CLEAR
This method is run when the whole hash needs to
be cleared, usually by assigning the empty list to it. In our
example, that would remove all the user's dot files! It's such
a dangerous thing that we'll require
CLOBBER
to be set higher than
1
before this can happen:
sub CLEAR { carp &whowasi if $DEBUG; my $self = shift; croak "@{[&whowasi]}: won't remove all dotfiles for $self->{USER}" unless $self->{CLOBBER} > 1; for my $dot ( keys %{$self->{CONTENTS}}) { $self->DELETE($dot); } }
SELF
->EXISTS(
KEY
)
This method runs when the user invokes the
exists
function on a particular hash. In
our example, we'll look at the {CONTENTS}
hash element to find the answer:
sub EXISTS { carp &whowasi if $DEBUG; my $self = shift; my $dot = shift; return exists $self->{CONTENTS}->{$dot}; }
SELF
->FIRSTKEY
This method is called when the user begins to
iterate through the hash, such as with a
keys
, values
, or
each
call. By calling
keys
in a scalar context, we reset its
internal state to ensure that the next each
used in the return
statement will get the
first key.
sub FIRSTKEY { carp &whowasi if $DEBUG; my $self = shift; my $temp = keys %{$self->{CONTENTS}}; return scalar each %{$self->{CONTENTS}}; }
SELF
->NEXTKEY(
PREVKEY
)
This method is the iterator for a
keys
, values
, or
each
function.
PREVKEY
is the last key accessed,
which Perl knows to supply. This is useful if the
NEXTKEY
method needs to know its previous
state to calculate the next state.
For our example, we are using a real hash to represent
the tied hash's data, except that this hash is stored in the
hash's CONTENTS
field instead of in the
hash itself. So we can just rely on Perl's
each
iterator:
sub NEXTKEY { carp &whowasi if $DEBUG; my $self = shift; return scalar each %{ $self->{CONTENTS} } }
SELF
->DESTROY
This method is triggered when a tied hash's object is about to be deallocated. You don't really need it except for debugging and extra cleanup. Here's a very simple version:
sub DESTROY { carp &whowasi if $DEBUG; }
Now that we've given you all those methods, your homework is
to go back and find the places we interpolated
@{[&whowasi]}
and replace them with a simple
tied scalar named $whowasi
that does the same
thing.
[2] Remember that Perl distinguishes between a key not existing
in the hash and a key existing in the hash but having a
corresponding value of undef
. The two
possibilities can be tested with exists
and
defined
, respectively.