X-Git-Url: http://git.shiar.net/perl/plp/.git/blobdiff_plain/0f5e78a789961923b45cae1a881c655fff9e7283..a5521fb1820cc67ab3d7c0fe728ef36b0b379a3f:/PLP/Tie/Delay.pm diff --git a/PLP/Tie/Delay.pm b/PLP/Tie/Delay.pm index 022f424..bf7a7a7 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]->() }; + my ($self) = @_; + 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}; + my ($self, $key) = @_; + $self->_replace; + return $self->[0]->{$key}; } sub STORE { - my ($self, $key, $value) = @_; - $self->_replace; - return ${$self->[0]}{$key} = $value; + my ($self, $key, $value) = @_; + $self->_replace; + return $self->[0]->{$key} = $value; } sub DELETE { - my ($self, $key) = @_; - $self->_replace; - return delete ${$self->[0]}{key}; + my ($self, $key) = @_; + $self->_replace; + return delete $self->[0]->{$key}; } sub CLEAR { - my ($self) = @_; - $self->_replace; - return %{$self->[0]}; + my ($self) = @_; + $self->_replace; + return %{ $self->[0] }; } sub EXISTS { - my ($self, $key) = @_; - $self->_replace; - return exists ${$self->[0]}{key}; + my ($self, $key) = @_; + $self->_replace; + return exists $self->[0]->{$key}; } sub FIRSTKEY { - my ($self) = @_; - $self->_replace; - return exists ${$self->[0]}{key}; + my ($self) = @_; + $self->_replace; + 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;