Commit | Line | Data |
eae82931 |
1 | package Sub::Defer; |
2 | |
3 | use strictures 1; |
4 | use base qw(Exporter); |
b1eebd55 |
5 | use Moo::_Utils; |
eae82931 |
6 | |
a165a07f |
7 | our @EXPORT = qw(defer_sub undefer_sub); |
eae82931 |
8 | |
9 | our %DEFERRED; |
10 | |
a165a07f |
11 | sub undefer_sub { |
eae82931 |
12 | my ($deferred) = @_; |
13 | my ($target, $maker, $undeferred_ref) = @{ |
14 | $DEFERRED{$deferred}||return $deferred |
15 | }; |
16 | ${$undeferred_ref} = my $made = $maker->(); |
a165a07f |
17 | if (defined($target)) { |
18 | no warnings 'redefine'; |
19 | *{_getglob($target)} = $made; |
20 | } |
eae82931 |
21 | return $made; |
22 | } |
23 | |
a165a07f |
24 | sub defer_sub { |
eae82931 |
25 | my ($target, $maker) = @_; |
26 | my $undeferred; |
27 | my $deferred_string; |
9187b862 |
28 | my $deferred = sub { |
a165a07f |
29 | goto &{$undeferred ||= undefer_sub($deferred_string)}; |
9187b862 |
30 | }; |
eae82931 |
31 | $deferred_string = "$deferred"; |
32 | $DEFERRED{$deferred} = [ $target, $maker, \$undeferred ]; |
a165a07f |
33 | *{_getglob $target} = $deferred if defined($target); |
eae82931 |
34 | return $deferred; |
35 | } |
36 | |
37 | 1; |
8213644a |
38 | |
39 | =pod |
40 | |
41 | =head1 SYNOPSIS |
42 | |
43 | use Sub::Defer; |
44 | |
45 | my $deferred = defer_sub 'Logger::time_since_first_log' => sub { |
46 | my $t = time; |
47 | sub { time - $t }; |
48 | }; |
49 | |
50 | What the above does is set the Logger::time_since_first_log subroutine to be |
51 | the codref that was passed to it, but then after it gets run once, it becomes |
52 | the returned coderef. |
53 | |
54 | =head1 DESCRIPTION |
55 | |
56 | These subroutines provide the user with a convenient way to defer create of |
57 | subroutines and methods until they are first called. |
58 | |
59 | =head1 SUBROUTINES |
60 | |
61 | =head2 defer_sub |
62 | |
63 | my $coderef = defer_sub $name => sub { ... }; |
64 | |
65 | RIBASUSHI FIX ME PLEASE!!!! |
66 | |
67 | Given name to install a subroutine into and a coderef that returns a coderef, |
68 | this function will set up the subroutine such that when it is first called it |
69 | will be replaced with the returned coderef. |
70 | |
71 | =head2 undefer_sub |
72 | |
73 | my $coderef = undefer_sub \&Foo::name; |
74 | |
75 | If the passed coderef has been L<deferred|/defer_sub> this will "undefer" it. |
76 | If the passed coderef has not been deferred, this will just return it. |
77 | |
78 | If this is confusing, take a look at the example in the L</SYNOPSIS>. |