lib/Sub/Defer.pm

   1 package Sub::Defer;
   2
   3 use strictures 1;
   4 use base qw(Exporter);
   5
   6 our @EXPORT = qw(defer undefer);
   7
   8 our %DEFERRED;
   9
  10 sub _getglob { no strict 'refs'; \*{$_[0]} }
  11
  12 sub undefer {
  13   my ($deferred) = @_;
  14   my ($target, $maker, $undeferred_ref) = @{
  15     $DEFERRED{$deferred}||return $deferred
  16   };
  17   ${$undeferred_ref} = my $made = $maker->();
  18   { no warnings 'redefine'; *{_getglob($target)} = $made }
  19   return $made;
  20 }
  21
  22 sub defer {
  23   my ($target, $maker) = @_;
  24   my $undeferred;
  25   my $deferred_string;
  26   my $deferred = bless(sub {
  27     goto &{$undeferred ||= undefer($deferred_string)};
  28   }, 'Sub::Defer::Deferred');
  29   $deferred_string = "$deferred";
  30   $DEFERRED{$deferred} = [ $target, $maker, \$undeferred ];
  31   *{_getglob $target} = $deferred;
  32   return $deferred;
  33 }
  34
  35 1;