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_sub undefer_sub);
   8
   9 our %DEFERRED;
  10
  11 sub undefer_sub {
  12   my ($deferred) = @_;
  13   my ($target, $maker, $undeferred_ref) = @{
  14     $DEFERRED{$deferred}||return $deferred
  15   };
  16   ${$undeferred_ref} = my $made = $maker->();
  17   if (defined($target)) {
  18     no warnings 'redefine';
  19     *{_getglob($target)} = $made;
  20   }
  21   return $made;
  22 }
  23
  24 sub defer_sub {
  25   my ($target, $maker) = @_;
  26   my $undeferred;
  27   my $deferred_string;
  28   my $deferred = bless(sub {
  29     goto &{$undeferred ||= undefer_sub($deferred_string)};
  30   }, 'Sub::Defer::Deferred');
  31   $deferred_string = "$deferred";
  32   $DEFERRED{$deferred} = [ $target, $maker, \$undeferred ];
  33   *{_getglob $target} = $deferred if defined($target);
  34   return $deferred;
  35 }
  36
  37 1;