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.01';
   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
  23         if ($] >= 5.018) {
  24                 my $code = delete $self->[1] or return;
  25                 $self->[0] = $code->();
  26                 return 1;
  27         }
  28
  29         untie %{ $self->[0] };
  30         %{ $self->[0] } = %{ $self->[1]->() };  # *{ $self->[0] } = $self->[1]->();
  31         return;
  32 }
  33
  34 sub TIEHASH {
  35         # my ($class, $hash, $source) = @_;
  36         return bless [ @_[1, 2] ], $_[0];
  37 }
  38
  39 sub FETCH {
  40         my ($self, $key) = @_;
  41         $self->_replace;
  42         return $self->[0]->{$key};
  43 }
  44
  45 sub STORE {
  46         my ($self, $key, $value) = @_;
  47         $self->_replace;
  48         return $self->[0]->{$key} = $value;
  49 }
  50
  51 sub DELETE {
  52         my ($self, $key) = @_;
  53         $self->_replace;
  54         return delete $self->[0]->{$key};
  55 }
  56
  57 sub CLEAR {
  58         my ($self) = @_;
  59         $self->_replace;
  60         return %{ $self->[0] };
  61 }
  62
  63 sub EXISTS {
  64         my ($self, $key) = @_;
  65         $self->_replace;
  66         return exists $self->[0]->{$key};
  67 }
  68
  69 sub FIRSTKEY {
  70         my ($self) = @_;
  71         $self->_replace and return 'PLPdummy';
  72         return each %{$self->[0]};
  73 }
  74
  75 sub NEXTKEY {
  76         return each %{$_[0]->[0]};
  77 }
  78
  79 sub UNTIE   { }
  80
  81 sub DESTROY { }
  82
  83 1;
  84