Commit | Line | Data |
eae82931 |
1 | package Sub::Defer; |
2 | |
3 | use strictures 1; |
4 | use base qw(Exporter); |
b1eebd55 |
5 | use Moo::_Utils; |
c86c182d |
6 | use Scalar::Util qw(weaken); |
eae82931 |
7 | |
e1865995 |
8 | our $VERSION = '1.003001'; |
013a2be3 |
9 | $VERSION = eval $VERSION; |
10 | |
a165a07f |
11 | our @EXPORT = qw(defer_sub undefer_sub); |
eae82931 |
12 | |
13 | our %DEFERRED; |
14 | |
a165a07f |
15 | sub undefer_sub { |
eae82931 |
16 | my ($deferred) = @_; |
17 | my ($target, $maker, $undeferred_ref) = @{ |
18 | $DEFERRED{$deferred}||return $deferred |
19 | }; |
9e858450 |
20 | return ${$undeferred_ref} |
21 | if ${$undeferred_ref}; |
eae82931 |
22 | ${$undeferred_ref} = my $made = $maker->(); |
ba37527b |
23 | |
24 | # make sure the method slot has not changed since deferral time |
25 | if (defined($target) && $deferred eq *{_getglob($target)}{CODE}||'') { |
a165a07f |
26 | no warnings 'redefine'; |
575ba24c |
27 | |
28 | # I believe $maker already evals with the right package/name, so that |
29 | # _install_coderef calls are not necessary --ribasushi |
a165a07f |
30 | *{_getglob($target)} = $made; |
31 | } |
c86c182d |
32 | weaken($DEFERRED{$made} = $DEFERRED{$deferred}); |
ba37527b |
33 | |
eae82931 |
34 | return $made; |
35 | } |
36 | |
c4570291 |
37 | sub defer_info { |
38 | my ($deferred) = @_; |
39 | $DEFERRED{$deferred||''}; |
40 | } |
41 | |
a165a07f |
42 | sub defer_sub { |
eae82931 |
43 | my ($target, $maker) = @_; |
44 | my $undeferred; |
c86c182d |
45 | my $deferred_info; |
46 | my $deferred = sub { |
47 | $undeferred ||= undefer_sub($deferred_info->[3]); |
efdff87e |
48 | goto &$undeferred; |
9187b862 |
49 | }; |
c86c182d |
50 | $deferred_info = [ $target, $maker, \$undeferred, $deferred ]; |
51 | weaken($DEFERRED{$deferred} = $deferred_info); |
5cadba52 |
52 | _install_coderef($target => $deferred) if defined $target; |
eae82931 |
53 | return $deferred; |
54 | } |
55 | |
efdff87e |
56 | sub CLONE { |
c86c182d |
57 | %DEFERRED = map { defined $_ ? ($_->[3] => $_) : () } values %DEFERRED; |
58 | weaken($_) for values %DEFERRED; |
efdff87e |
59 | } |
60 | |
eae82931 |
61 | 1; |
c600e706 |
62 | __END__ |
8213644a |
63 | |
0b6e5fff |
64 | =head1 NAME |
65 | |
66 | Sub::Defer - defer generation of subroutines until they are first called |
67 | |
8213644a |
68 | =head1 SYNOPSIS |
69 | |
70 | use Sub::Defer; |
71 | |
72 | my $deferred = defer_sub 'Logger::time_since_first_log' => sub { |
73 | my $t = time; |
74 | sub { time - $t }; |
75 | }; |
76 | |
0b6e5fff |
77 | Logger->time_since_first_log; # returns 0 and replaces itself |
78 | Logger->time_since_first_log; # returns time - $t |
8213644a |
79 | |
80 | =head1 DESCRIPTION |
81 | |
0b6e5fff |
82 | These subroutines provide the user with a convenient way to defer creation of |
8213644a |
83 | subroutines and methods until they are first called. |
84 | |
85 | =head1 SUBROUTINES |
86 | |
87 | =head2 defer_sub |
88 | |
89 | my $coderef = defer_sub $name => sub { ... }; |
90 | |
0b6e5fff |
91 | This subroutine returns a coderef that encapsulates the provided sub - when |
92 | it is first called, the provided sub is called and is -itself- expected to |
93 | return a subroutine which will be goto'ed to on subsequent calls. |
8213644a |
94 | |
0b6e5fff |
95 | If a name is provided, this also installs the sub as that name - and when |
96 | the subroutine is undeferred will re-install the final version for speed. |
8213644a |
97 | |
98 | =head2 undefer_sub |
99 | |
100 | my $coderef = undefer_sub \&Foo::name; |
101 | |
102 | If the passed coderef has been L<deferred|/defer_sub> this will "undefer" it. |
103 | If the passed coderef has not been deferred, this will just return it. |
104 | |
105 | If this is confusing, take a look at the example in the L</SYNOPSIS>. |
072d158f |
106 | |
107 | =head1 SUPPORT |
108 | |
1108b2e2 |
109 | See L<Moo> for support and contact information. |
072d158f |
110 | |
111 | =head1 AUTHORS |
112 | |
113 | See L<Moo> for authors. |
114 | |
115 | =head1 COPYRIGHT AND LICENSE |
116 | |
117 | See L<Moo> for the copyright and license. |
c600e706 |
118 | |
119 | =cut |