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