Commit | Line | Data |
0395308e |
1 | package Devel::BeginLift; |
2 | |
3 | use strict; |
4 | use warnings; |
1594b447 |
5 | use 5.008001; |
0395308e |
6 | |
52ad1fb3 |
7 | our $VERSION = 0.001002; |
0395308e |
8 | |
1594b447 |
9 | use vars qw(%lift); |
10 | use base qw(DynaLoader); |
5e5bdebb |
11 | use B::Hooks::OP::Check::EntersubForCV; |
0395308e |
12 | |
1594b447 |
13 | bootstrap Devel::BeginLift; |
0395308e |
14 | |
15 | sub import { |
16 | my ($class, @args) = @_; |
17 | my $target = caller; |
18 | $class->setup_for($target => \@args); |
19 | } |
20 | |
21 | sub unimport { |
22 | my ($class) = @_; |
23 | my $target = caller; |
24 | $class->teardown_for($target); |
25 | } |
26 | |
27 | sub setup_for { |
28 | my ($class, $target, $args) = @_; |
5e5bdebb |
29 | $lift{$target} ||= []; |
30 | push @{ $lift{$target} }, map { |
eeee00df |
31 | $class->setup_for_cv($_); |
5e5bdebb |
32 | } map { |
33 | ref $_ eq 'CODE' |
34 | ? $_ |
35 | : \&{ "${target}::${_}" } |
36 | } @{ $args }; |
0395308e |
37 | } |
38 | |
39 | sub teardown_for { |
40 | my ($class, $target) = @_; |
eeee00df |
41 | $class->teardown_for_cv($_) for @{ $lift{$target} }; |
0395308e |
42 | delete $lift{$target}; |
0395308e |
43 | } |
44 | |
79eec0c9 |
45 | =head1 NAME |
46 | |
47 | Devel::BeginLift - make selected sub calls evaluate at compile time |
48 | |
49 | =head1 SYNOPSIS |
50 | |
51 | use Devel::BeginLift qw(foo baz); |
52 | |
53 | use vars qw($i); |
54 | |
55 | BEGIN { $i = 0 } |
56 | |
57 | sub foo { "foo: $_[0]\n"; } |
58 | |
59 | sub bar { "bar: $_[0]\n"; } |
60 | |
61 | for (1 .. 3) { |
62 | print foo($i++); |
63 | print bar($i++); |
64 | } |
65 | |
66 | no Devel::BeginLift; |
67 | |
68 | print foo($i++); |
69 | |
70 | outputs - |
71 | |
72 | foo: 0 |
73 | bar: 1 |
74 | foo: 0 |
75 | bar: 2 |
76 | foo: 0 |
77 | bar: 3 |
78 | foo: 4 |
79 | |
80 | =head1 DESCRIPTION |
81 | |
82 | Devel::BeginLift 'lifts' arbitrary sub calls to running at compile time |
83 | - sort of a souped up version of "use constant". It does this via some |
84 | slightly insane perlguts magic. |
85 | |
86 | =head2 import |
87 | |
88 | use Devel::BeginLift qw(list of subs); |
89 | |
90 | Calls Devel::BeginLift->setup_for(__PACKAGE__ => \@list_of_subs); |
91 | |
92 | =head2 unimport |
93 | |
94 | no Devel::BeginLift; |
95 | |
96 | Calls Devel::BeginLift->teardown_for(__PACKAGE__); |
97 | |
98 | =head2 setup_for |
99 | |
100 | Devel::BeginLift->setup_for($package => \@subnames); |
101 | |
102 | Installs begin lifting magic (unless already installed) and registers |
103 | "${package}::$name" for each member of @subnames to be executed when parsed |
104 | and replaced with its output rather than left for runtime. |
105 | |
106 | =head2 teardown_for |
107 | |
108 | Devel::BeginLift->teardown_for($package); |
109 | |
110 | Deregisters all subs currently registered for $package and uninstalls begin |
111 | lifting magic is number of teardown_for calls matches number of setup_for |
112 | calls. |
113 | |
6eebbfa7 |
114 | =head2 setup_for_cv |
115 | |
116 | $id = Devel::BeginLift->setup_for_cv(\&code); |
117 | |
118 | Same as C<setup_for>, but only registers begin lifting magic for one code |
119 | reference. Returns an id to be used in C<teardown_for_cv>. |
120 | |
121 | =head2 teardown_for_cv |
122 | |
123 | Devel::BeginLift->teardown_for_cv($id); |
124 | |
125 | Deregisters begin lifting magic referred to by C<$id>. |
126 | |
79eec0c9 |
127 | =head1 AUTHOR |
128 | |
129 | Matt S Trout - <mst@shadowcatsystems.co.uk> |
130 | |
131 | Company: http://www.shadowcatsystems.co.uk/ |
132 | Blog: http://chainsawblues.vox.com/ |
133 | |
134 | =head1 LICENSE |
135 | |
136 | This library is free software under the same terms as perl itself |
137 | |
138 | =cut |
139 | |
0395308e |
140 | 1; |