lib/PLP/Tie/Delay.pm

   1 package PLP::Tie::Delay;
   2
   3 use strict;
   4 no strict 'refs';
   5 use warnings;
   6
   7 our $VERSION = '1.00';
   8
   9 =head1 PLP::Tie::Delay
  10
  11 Delays hash generation. Unties the hash on first access, and replaces it by the generated one.
  12 Uses symbolic references, because circular ties make Perl go nuts :)
  13
  14     tie %Some::hash, 'PLP::Tie::Delay', 'Some::hash', sub { \%generated_hash };
  15
  16 This module is part of the PLP internals and probably not of any use to others.
  17
  18 =cut
  19
  20 sub _replace {
  21         my ($self) = @_;
  22         untie %{ $self->[0] };
  23
  24         # I'd like to use *{ $self->[0] } = $self->[1]->(); here,
  25         # but that causes all sorts of problems. The hash is accessible from
  26         # within this sub, but not where its creation was triggered.
  27         # Immediately after the triggering statement, the hash becomes available
  28         # to all: even the scope where the previous access attempt failed.
  29
  30         %{ $self->[0] } = %{ $self->[1]->() }
  31 }
  32
  33 sub TIEHASH {
  34         # my ($class, $hash, $source) = @_;
  35         return bless [ @_[1, 2] ], $_[0];
  36 }
  37
  38 sub FETCH {
  39         my ($self, $key) = @_;
  40         $self->_replace;
  41         return $self->[0]->{$key};
  42 }
  43
  44 sub STORE {
  45         my ($self, $key, $value) = @_;
  46         $self->_replace;
  47         return $self->[0]->{$key} = $value;
  48 }
  49
  50 sub DELETE {
  51         my ($self, $key) = @_;
  52         $self->_replace;
  53         return delete $self->[0]->{$key};
  54 }
  55
  56 sub CLEAR {
  57         my ($self) = @_;
  58         $self->_replace;
  59         return %{ $self->[0] };
  60 }
  61
  62 sub EXISTS {
  63         my ($self, $key) = @_;
  64         $self->_replace;
  65         return exists $self->[0]->{$key};
  66 }
  67
  68 sub FIRSTKEY {
  69         my ($self) = @_;
  70         $self->_replace;
  71         return 'PLPdummy';
  72 }
  73
  74 sub NEXTKEY {
  75         # Let's hope this never happens. (It's shouldn't.)
  76         return undef;
  77 }
  78
  79 sub UNTIE   { }
  80
  81 sub DESTROY { }
  82
  83 1;
  84