lib/Sub/Defer.pm

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