X-Git-Url: http://git.shiar.nl/perl/plp/.git/blobdiff_plain/0f5e78a789961923b45cae1a881c655fff9e7283..1376138c9392575534de671ce7b6fbb05a578e19:/PLP/Tie/Delay.pm diff --git a/PLP/Tie/Delay.pm b/PLP/Tie/Delay.pm index 022f424..423bfc8 100644 --- a/PLP/Tie/Delay.pm +++ b/PLP/Tie/Delay.pm @@ -1,6 +1,5 @@ -#--------------------------# - package PLP::Tie::Delay; -#--------------------------# +package PLP::Tie::Delay; + use strict; no strict 'refs'; @@ -11,63 +10,72 @@ Uses symbolic references, because circular ties make Perl go nuts :) tie %Some::hash, 'PLP::Tie::Delay', 'Some::hash', sub { \%generated_hash }; +This module is part of the PLP internals and probably not of any use to others. + =cut sub _replace { my ($self) = @_; - untie %{$self->[0]}; - %{$self->[0]} = %{ $self->[1]->() }; + untie %{ $self->[0] }; + + # I'd like to use *{ $self->[0] } = $self->[1]->(); here, + # but that causes all sorts of problems. The hash is accessible from + # within this sub, but not where its creation was triggered. + # Immediately after the triggering statement, the hash becomes available + # to all: even the scope where the previous access attempt failed. + + %{ $self->[0] } = %{ $self->[1]->() } } sub TIEHASH { - my ($class, $hash, $source) = @_; - return bless [$hash, $source], $class; + # my ($class, $hash, $source) = @_; + return bless [ @_[1, 2] ], $_[0]; } sub FETCH { my ($self, $key) = @_; $self->_replace; - return ${$self->[0]}{$key}; + return $self->[0]->{$key}; } sub STORE { my ($self, $key, $value) = @_; $self->_replace; - return ${$self->[0]}{$key} = $value; + return $self->[0]->{$key} = $value; } sub DELETE { my ($self, $key) = @_; $self->_replace; - return delete ${$self->[0]}{key}; + return delete $self->[0]->{$key}; } sub CLEAR { my ($self) = @_; $self->_replace; - return %{$self->[0]}; + return %{ $self->[0] }; } sub EXISTS { my ($self, $key) = @_; $self->_replace; - return exists ${$self->[0]}{key}; + return exists $self->[0]->{$key}; } sub FIRSTKEY { my ($self) = @_; $self->_replace; - return exists ${$self->[0]}{key}; + return 'PLPdummy'; } sub NEXTKEY { - my ($self) = @_; - $self->_replace; - return each %$$self; + # Let's hope this never happens. (It's shouldn't.) + return undef; } sub UNTIE { } -sub DESTORY { } + +sub DESTROY { } 1;