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 =cut
  15
  16 sub _replace {
  17     my ($self) = @_;
  18     untie %{$self->[0]};
  19     %{$self->[0]} = %{ $self->[1]->() };
  20 }
  21
  22 sub TIEHASH {
  23     my ($class, $hash, $source) = @_;
  24     return bless [$hash, $source], $class;
  25 }
  26
  27 sub FETCH {
  28     my ($self, $key) = @_;
  29     $self->_replace;
  30     return ${$self->[0]}{$key};
  31 }
  32
  33 sub STORE {
  34     my ($self, $key, $value) = @_;
  35     $self->_replace;
  36     return ${$self->[0]}{$key} = $value;
  37 }
  38
  39 sub DELETE {
  40     my ($self, $key) = @_;
  41     $self->_replace;
  42     return delete ${$self->[0]}{key};
  43 }
  44
  45 sub CLEAR {
  46     my ($self) = @_;
  47     $self->_replace;
  48     return %{$self->[0]};
  49 }
  50
  51 sub EXISTS {
  52     my ($self, $key) = @_;
  53     $self->_replace;
  54     return exists ${$self->[0]}{key};
  55 }
  56
  57 sub FIRSTKEY {
  58     my ($self) = @_;
  59     $self->_replace;
  60     return exists ${$self->[0]}{key};
  61 }
  62
  63 sub NEXTKEY {
  64     my ($self) = @_;
  65     $self->_replace;
  66     return each %$$self;
  67 }
  68
  69 sub UNTIE   { }
  70 sub DESTORY { }
  71
  72 1;
  73