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     %{ $self->[0] } = %{ $self->[1]->() };
  21 }
  22
  23 sub TIEHASH {
  24     my ($class, $hash, $source) = @_;
  25     return bless [ $hash, $source ], $class;
  26 }
  27
  28 sub FETCH {
  29     my ($self, $key) = @_;
  30     $self->_replace;
  31     return ${ $self->[0] }{$key};
  32 }
  33
  34 sub STORE {
  35     my ($self, $key, $value) = @_;
  36     $self->_replace;
  37     return ${ $self->[0] }{$key} = $value;
  38 }
  39
  40 sub DELETE {
  41     my ($self, $key) = @_;
  42     $self->_replace;
  43     return delete ${ $self->[0] }{$key};
  44 }
  45
  46 sub CLEAR {
  47     my ($self) = @_;
  48     $self->_replace;
  49     return %{ $self->[0] };
  50 }
  51
  52 sub EXISTS {
  53     my ($self, $key) = @_;
  54     $self->_replace;
  55     return exists ${ $self->[0] }{$key};
  56 }
  57
  58 sub FIRSTKEY {
  59     my ($self) = @_;
  60     $self->_replace;
  61     return 'PLPdummy';
  62 }
  63
  64 sub NEXTKEY {
  65     my ($self) = @_;
  66     # Let's hope this never happens. (It's shouldn't.)
  67     return undef;
  68 }
  69
  70 sub UNTIE   { }
  71 sub DESTROY { }
  72
  73 1;
  74