PLP/Tie/Delay.pm

   1 #--------------------------#
   2   package PLP::Tie::Delay;
   3 #--------------------------#
   4 use strict;
   5 no strict 'refs';
   6
   7 =head1 PLP::Tie::Delay
   8
   9 Delays hash generation. Unties the hash on first access, and replaces it by the generated one.
  10 Uses symbolic references, because circular ties make Perl go nuts :)
  11
  12     tie %Some::hash, 'PLP::Tie::Delay', 'Some::hash', sub { \%generated_hash };
  13
  14 This module is part of the PLP internals and probably not of any use to others.
  15
  16 =cut
  17
  18 sub _replace {
  19     my ($self) = @_;
  20     untie %{$self->[0]};
  21     %{$self->[0]} = %{ $self->[1]->() };
  22 }
  23
  24 sub TIEHASH {
  25     my ($class, $hash, $source) = @_;
  26     return bless [$hash, $source], $class;
  27 }
  28
  29 sub FETCH {
  30     my ($self, $key) = @_;
  31     $self->_replace;
  32     return ${$self->[0]}{$key};
  33 }
  34
  35 sub STORE {
  36     my ($self, $key, $value) = @_;
  37     $self->_replace;
  38     return ${$self->[0]}{$key} = $value;
  39 }
  40
  41 sub DELETE {
  42     my ($self, $key) = @_;
  43     $self->_replace;
  44     return delete ${$self->[0]}{key};
  45 }
  46
  47 sub CLEAR {
  48     my ($self) = @_;
  49     $self->_replace;
  50     return %{$self->[0]};
  51 }
  52
  53 sub EXISTS {
  54     my ($self, $key) = @_;
  55     $self->_replace;
  56     return exists ${$self->[0]}{key};
  57 }
  58
  59 sub FIRSTKEY {
  60     my ($self) = @_;
  61     $self->_replace;
  62     return exists ${$self->[0]}{key};
  63 }
  64
  65 sub NEXTKEY {
  66     my ($self) = @_;
  67     $self->_replace;
  68     return each %$$self;
  69 }
  70
  71 sub UNTIE   { }
  72 sub DESTORY { }
  73
  74 1;
  75