lib/Sub/Defer.pm

   1 package Sub::Defer;
   2
   3 use strictures 1;
   4 use base qw(Exporter);
   5 use Moo::_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 = sub {
  29     goto &{$undeferred ||= undefer_sub($deferred_string)};
  30   };
  31   $deferred_string = "$deferred";
  32   $DEFERRED{$deferred} = [ $target, $maker, \$undeferred ];
  33   *{_getglob $target} = $deferred if defined($target);
  34   return $deferred;
  35 }
  36
  37 1;
  38
  39 =head1 NAME
  40
  41 Sub::Defer - defer generation of subroutines until they are first called
  42
  43 =head1 SYNOPSIS
  44
  45  use Sub::Defer;
  46
  47  my $deferred = defer_sub 'Logger::time_since_first_log' => sub {
  48     my $t = time;
  49     sub { time - $t };
  50  };
  51
  52   Logger->time_since_first_log; # returns 0 and replaces itself
  53   Logger->time_since_first_log; # returns time - $t
  54
  55 =head1 DESCRIPTION
  56
  57 These subroutines provide the user with a convenient way to defer creation of
  58 subroutines and methods until they are first called.
  59
  60 =head1 SUBROUTINES
  61
  62 =head2 defer_sub
  63
  64  my $coderef = defer_sub $name => sub { ... };
  65
  66 This subroutine returns a coderef that encapsulates the provided sub - when
  67 it is first called, the provided sub is called and is -itself- expected to
  68 return a subroutine which will be goto'ed to on subsequent calls.
  69
  70 If a name is provided, this also installs the sub as that name - and when
  71 the subroutine is undeferred will re-install the final version for speed.
  72
  73 =head2 undefer_sub
  74
  75  my $coderef = undefer_sub \&Foo::name;
  76
  77 If the passed coderef has been L<deferred|/defer_sub> this will "undefer" it.
  78 If the passed coderef has not been deferred, this will just return it.
  79
  80 If this is confusing, take a look at the example in the L</SYNOPSIS>.