PLP/Tie/Delay.pm

   1 package PLP::Tie::Delay;
   2
   3 use strict;
   4 no strict 'refs';
   5
   6 =head1 PLP::Tie::Delay
   7
   8 Delays hash generation. Unties the hash on first access, and replaces it by the generated one.
   9 Uses symbolic references, because circular ties make Perl go nuts :)
  10
  11     tie %Some::hash, 'PLP::Tie::Delay', 'Some::hash', sub { \%generated_hash };
  12
  13 This module is part of the PLP internals and probably not of any use to others.
  14
  15 =cut
  16
  17 sub _replace {
  18     my ($self) = @_;
  19     untie %{ $self->[0] };
  20
  21     # I'd like to use *{ $self->[0] } = $self->[1]->(); here,
  22     # but that causes all sorts of problems. The hash is accessible from
  23     # within this sub, but not where its creation was triggered.
  24     # Immediately after the triggering statement, the hash becomes available
  25     # to all: even the scope where the previous access attempt failed.
  26
  27     %{ $self->[0] } = %{ $self->[1]->() }
  28 }
  29
  30 sub TIEHASH {
  31     # my ($class, $hash, $source) = @_;
  32     return bless [ @_[1, 2] ], $_[0];
  33 }
  34
  35 sub FETCH {
  36     my ($self, $key) = @_;
  37     $self->_replace;
  38     return $self->[0]->{$key};
  39 }
  40
  41 sub STORE {
  42     my ($self, $key, $value) = @_;
  43     $self->_replace;
  44     return $self->[0]->{$key} = $value;
  45 }
  46
  47 sub DELETE {
  48     my ($self, $key) = @_;
  49     $self->_replace;
  50     return delete $self->[0]->{$key};
  51 }
  52
  53 sub CLEAR {
  54     my ($self) = @_;
  55     $self->_replace;
  56     return %{ $self->[0] };
  57 }
  58
  59 sub EXISTS {
  60     my ($self, $key) = @_;
  61     $self->_replace;
  62     return exists $self->[0]->{$key};
  63 }
  64
  65 sub FIRSTKEY {
  66     my ($self) = @_;
  67     $self->_replace;
  68     return 'PLPdummy';
  69 }
  70
  71 sub NEXTKEY {
  72     # Let's hope this never happens. (It's shouldn't.)
  73     return undef;
  74 }
  75
  76 sub UNTIE   { }
  77
  78 sub DESTROY { }
  79
  80 1;
  81