lib/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