=head1 TIECLASS
Name: POP::Hash
Desc: Implements a tied hash which contains a list of persistent objects,
lazily, so that it at first just contains the objects' pids, but goes
out and restores the object when it is accessed.
=cut
package POP::Hash;
$VERSION = do{my(@r)=q$Revision: 1.4 $=~/d+/g;sprintf '%d.'.'%02d'x$#r,@r};
use strict;
use Carp;
use Devel::WeakRef;
use vars qw/$VERSION/;
=head2 METHOD
Name: POP::Hash::TIEHASH
Desc: The tied hash constructor; takes the name of this collection in our
parent, our parent and a hashref containing initial values.
=cut
sub TIEHASH {
my($type, $name, $parent, $hash) = @_;
return bless {'name' => $name,
'parent' => Devel::WeakRef::->new($parent),
'hash' => {%$hash}}, $type;
}
=head2 METHOD
Name: POP::Hash::FETCH
Desc: Called whenever an element of the tied hash is accessed, this
will restore the object if it hasn't already been, and then
return it.
=cut
sub FETCH {
my($this, $key) = @_;
return $this->{'hash'}{$key};
}
=head2 METHOD
Name: POP::Hash::STORE
Desc: Called whenever an element in the hash is set; Tells our parent to
update persistence
=cut
sub STORE {
my($this, $key, $value) = @_;
$this->{'hash'}{$key} = $value;
if (my $p = $this->{'parent'}->deref) {
(tied %$p)->STORE($this->{'name'}, undef, $key); # $key, $value, $subkey
} else {
croak "Parent gone when STORE called!?";
}
}
=head2 METHOD
Name: POP::Hash::EXISTS
Desc: Called to see if a key exists in the hash.
=cut
sub EXISTS {
my($this, $key) = @_;
exists $this->{'hash'}{$key};
}
=head2 METHOD
Name: POP::Hash::DELETE
Desc: Called to delete one key/value pair in the hash.
=cut
sub DELETE {
my($this, $key) = @_;
delete $this->{'hash'}{$key};
if (my $p = $this->{'parent'}->deref) {
(tied %$p)->STORE($this->{'name'}, undef, $key); # $key, $value, $subkey
} else {
croak "Parent gone when STORE called!?";
}
}
=head2 METHOD
Name: POP::Hash::CLEAR
Desc: Called to delete all key/value pairs in the hash.
=cut
sub CLEAR {
my($this) = @_;
$this->{'hash'} = {};
}
=head2 METHOD
Name: POP::Hash::FIRSTKEY
Desc: Called when first iterating through the hash.
=cut
sub FIRSTKEY {
my($this) = @_;
my $a = keys %{$this->{'hash'}}; # reset iterator
each %{$this->{'hash'}};
}
=head2 METHOD
Name: POP::Hash::NEXTKEY
Desc: Called when iterating through the hash.
=cut
sub NEXTKEY {
my($this) = @_;
each %{$this->{'hash'}};
}
$VERSION = $VERSION;