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