X-Git-Url: http://git.shiar.nl/perl/plp/.git/blobdiff_plain/7509565253b19493771cfc2e13ab166f1a8cc5f8..a5521fb1820cc67ab3d7c0fe728ef36b0b379a3f:/PLP/Tie/Delay.pm diff --git a/PLP/Tie/Delay.pm b/PLP/Tie/Delay.pm index ea136b8..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'; @@ -16,60 +15,67 @@ 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 'PLPdummy'; + my ($self) = @_; + $self->_replace; + return 'PLPdummy'; } sub NEXTKEY { - my ($self) = @_; - # Let's hope this never happens. (It's shouldn't.) - return undef; + # Let's hope this never happens. (It's shouldn't.) + return undef; } sub UNTIE { } -sub DESTORY { } + +sub DESTROY { } 1;