lib/PLP/Tie/Delay.pm

   1 package PLP::Tie::Delay;
   2
   3 use strict;
   4 no strict 'refs';
   5 use warnings;
   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
  22         # I'd like to use *{ $self->[0] } = $self->[1]->(); here,
  23         # but that causes all sorts of problems. The hash is accessible from
  24         # within this sub, but not where its creation was triggered.
  25         # Immediately after the triggering statement, the hash becomes available
  26         # to all: even the scope where the previous access attempt failed.
  27
  28         %{ $self->[0] } = %{ $self->[1]->() }
  29 }
  30
  31 sub TIEHASH {
  32         # my ($class, $hash, $source) = @_;
  33         return bless [ @_[1, 2] ], $_[0];
  34 }
  35
  36 sub FETCH {
  37         my ($self, $key) = @_;
  38         $self->_replace;
  39         return $self->[0]->{$key};
  40 }
  41
  42 sub STORE {
  43         my ($self, $key, $value) = @_;
  44         $self->_replace;
  45         return $self->[0]->{$key} = $value;
  46 }
  47
  48 sub DELETE {
  49         my ($self, $key) = @_;
  50         $self->_replace;
  51         return delete $self->[0]->{$key};
  52 }
  53
  54 sub CLEAR {
  55         my ($self) = @_;
  56         $self->_replace;
  57         return %{ $self->[0] };
  58 }
  59
  60 sub EXISTS {
  61         my ($self, $key) = @_;
  62         $self->_replace;
  63         return exists $self->[0]->{$key};
  64 }
  65
  66 sub FIRSTKEY {
  67         my ($self) = @_;
  68         $self->_replace;
  69         return 'PLPdummy';
  70 }
  71
  72 sub NEXTKEY {
  73         # Let's hope this never happens. (It's shouldn't.)
  74         return undef;
  75 }
  76
  77 sub UNTIE   { }
  78
  79 sub DESTROY { }
  80
  81 1;
  82