Commit | Line | Data |
eae82931 |
1 | package Sub::Defer; |
2 | |
3 | use strictures 1; |
4 | use base qw(Exporter); |
6c74d087 |
5 | use Class::Tiny::_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; |
28 | my $deferred = bless(sub { |
a165a07f |
29 | goto &{$undeferred ||= undefer_sub($deferred_string)}; |
eae82931 |
30 | }, 'Sub::Defer::Deferred'); |
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; |