4 use Sub::Exporter -setup => {
5 exports => [qw(eval_closure)],
6 groups => { default => [qw(eval_closure)] },
8 # ABSTRACT: safely and cleanly create closures via string eval
11 use Devel::Hints qw(cop_file cop_line);
14 use Scalar::Util qw(reftype);
17 use constant USE_DEVEL_HINTS => ($] >= 5.010);
23 my $code = eval_closure(
24 source => 'sub { $foo++ }',
33 my $code2 = eval_closure(
34 source => 'sub { $code->() }',
35 ); # dies, $code isn't in scope
39 String eval is often used for dynamic code generation. For instance, C<Moose>
40 uses it heavily, to generate inlined versions of accessors and constructors,
41 which speeds code up at runtime by a significant amount. String eval is not
42 without its issues however - it's difficult to control the scope it's used in
43 (which determines which variables are in scope inside the eval), and it can be
44 quite slow, especially if doing a large number of evals.
46 This module attempts to solve both of those problems. It provides an
47 C<eval_closure> function, which evals a string in a clean environment, other
48 than a fixed list of specified variables. It also caches the result of the
49 eval, so that doing repeated evals of the same source, even with a different
50 environment, will be much faster (but note that the description is part of the
51 string to be evaled, so it must also be the same (or non-existent) if caching
56 =func eval_closure(%args)
58 This function provides the main functionality of this module. It is exported by
59 default. It takes a hash of parameters, with these keys being valid:
65 The string to be evaled. It should end by returning a code reference. It can
66 access any variable declared in the C<environment> parameter (and only those
67 variables). It can be either a string, or an arrayref of lines (which will be
68 joined with newlines to produce the string).
72 The environment to provide to the eval. This should be a hashref, mapping
73 variable names (including sigils) to references of the appropriate type. For
74 instance, a valid value for environment would be C<< { '@foo' => [] } >> (which
75 would allow the generated function to use an array named C<@foo>). Generally,
76 this is used to allow the generated function to access externally defined
77 variables (so you would pass in a reference to a variable that already exists).
81 This lets you provide a bit more information in backtraces. Normally, when a
82 function that was generated through string eval is called, that stack frame
83 will show up as "(eval n)", where 'n' is a sequential identifier for every
84 string eval that has happened so far in the program. Passing a C<description>
85 parameter lets you override that to something more useful (for instance,
86 L<Moose> overrides the description for accessors to something like "accessor
87 foo at MyClass.pm, like 123").
96 $args{source} = _canonicalize_source($args{source});
97 _validate_env($args{environment} ||= {});
99 if (!USE_DEVEL_HINTS) {
100 $args{source} = _line_directive($args{description}) . $args{source}
101 if defined $args{description};
104 my ($code, $e) = _clean_eval_closure(@args{qw(source environment)});
106 croak("Failed to compile source: $e\n\nsource:\n$args{source}")
109 if (USE_DEVEL_HINTS) {
110 if (defined $args{description}) {
111 cop_file($code, $args{description});
119 sub _canonicalize_source {
122 if (defined($source)) {
124 if (reftype($source) eq 'ARRAY'
125 || overload::Method($source, '@{}')) {
126 return join "\n", @$source;
128 elsif (overload::Method($source, '""')) {
132 croak("The 'source' parameter to eval_closure must be a "
133 . "string or array reference");
141 croak("The 'source' parameter to eval_closure is required");
148 croak("The 'environment' parameter must be a hashref")
149 unless reftype($env) eq 'HASH';
151 for my $var (keys %$env) {
152 croak("Environment key '$var' should start with \@, \%, or \$")
153 unless $var =~ /^([\@\%\$])/;
154 croak("Environment values must be references, not $env->{$var}")
155 unless ref($env->{$var});
159 sub _line_directive {
160 my ($description) = @_;
162 return qq{#line 0 "$description"\n};
165 sub _clean_eval_closure {
166 my ($source, $captures) = @_;
168 if ($ENV{EVAL_CLOSURE_PRINT_SOURCE}) {
169 _dump_source(_make_compiler_source(@_));
172 my @capture_keys = sort keys %$captures;
173 my ($compiler, $e) = _make_compiler($source, @capture_keys);
175 if (defined $compiler) {
176 $code = $compiler->(@$captures{@capture_keys});
179 if (defined($code) && (!ref($code) || ref($code) ne 'CODE')) {
180 $e = "The 'source' parameter must return a subroutine reference, "
191 my $compiler = eval _make_compiler_source(@_);
193 return ($compiler, $e);
195 memoize('_make_compiler');
197 sub _make_compiler_source {
198 my ($source, @capture_keys) = @_;
203 'my ' . $_ . ' = ' . substr($_, 0, 1) . '{$_[' . $i++ . ']};'
214 if (try { require Perl::Tidy }) {
215 Perl::Tidy::perltidy(
217 destination => \$output,
231 Please report any bugs through RT: email
232 C<bug-eval-closure at rt.cpan.org>, or browse to
233 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Eval-Closure>.
239 =item * L<Class::MOP::Method::Accessor>
241 This module is a factoring out of code that used to live here
247 You can find this documentation for this module with the perldoc command.
249 perldoc Eval::Closure
251 You can also look for information at:
255 =item * AnnoCPAN: Annotated CPAN documentation
257 L<http://annocpan.org/dist/Eval-Closure>
261 L<http://cpanratings.perl.org/d/Eval-Closure>
263 =item * RT: CPAN's request tracker
265 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Eval-Closure>
269 L<http://search.cpan.org/dist/Eval-Closure>
275 Jesse Luehrs <doy at tozt dot net>
277 Based on code from L<Class::MOP::Method::Accessor>, by Stevan Little and the