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