package Eval::Closure;
use strict;
use warnings;
-use Sub::Exporter -setup => {
- exports => [qw(eval_closure)],
- groups => { default => [qw(eval_closure)] },
-};
# ABSTRACT: safely and cleanly create closures via string eval
+use Exporter 'import';
+@Eval::Closure::EXPORT = @Eval::Closure::EXPORT_OK = 'eval_closure';
+
use Carp;
use overload ();
use Scalar::Util qw(reftype);
use Try::Tiny;
+use constant HAS_LEXICAL_SUBS => $] >= 5.018;
+
=head1 SYNOPSIS
use Eval::Closure;
uses it heavily, to generate inlined versions of accessors and constructors,
which speeds code up at runtime by a significant amount. String eval is not
without its issues however - it's difficult to control the scope it's used in
-(which determines which variables are in scope inside the eval), and it can be
-quite slow, especially if doing a large number of evals.
+(which determines which variables are in scope inside the eval), and it's easy
+to miss compilation errors, since eval catches them and sticks them in $@
+instead.
-This module attempts to solve both of those problems. It provides an
-C<eval_closure> function, which evals a string in a clean environment, other
-than a fixed list of specified variables. It also caches the result of the
-eval, so that doing repeated evals of the same source, even with a different
-environment, will be much faster (but note that the description is part of the
-string to be evaled, so it must also be the same (or non-existent) if caching
-is to work properly).
+This module attempts to solve these problems. It provides an C<eval_closure>
+function, which evals a string in a clean environment, other than a fixed list
+of specified variables. Compilation errors are rethrown automatically.
=cut
this is used to allow the generated function to access externally defined
variables (so you would pass in a reference to a variable that already exists).
+In perl 5.18 and greater, the environment hash can contain variables with a
+sigil of C<&>. This will create a lexical sub in the evaluated code (see
+L<feature/The 'lexical_subs' feature>). Using a C<&> sigil on perl versions
+before lexical subs were available will throw an error.
+
=item description
This lets you provide a bit more information in backtraces. Normally, when a
unless reftype($env) eq 'HASH';
for my $var (keys %$env) {
- croak("Environment key '$var' should start with \@, \%, or \$")
- unless $var =~ /^([\@\%\$])/;
+ if (HAS_LEXICAL_SUBS) {
+ croak("Environment key '$var' should start with \@, \%, \$, or \&")
+ unless $var =~ /^([\@\%\$\&])/;
+ }
+ else {
+ croak("Environment key '$var' should start with \@, \%, or \$")
+ unless $var =~ /^([\@\%\$])/;
+ }
croak("Environment values must be references, not $env->{$var}")
unless ref($env->{$var});
}
}
sub _clean_eval_closure {
- my ($source, $captures) = @_;
+ my ($source, $captures) = @_;
my @capture_keys = sort keys %$captures;
return ($code, $e);
}
-{
- my %compiler_cache;
-
- sub _make_compiler {
- my $source = _make_compiler_source(@_);
+sub _make_compiler {
+ my $source = _make_compiler_source(@_);
- unless (exists $compiler_cache{$source}) {
- local $@;
- local $SIG{__DIE__};
- my $compiler = eval $source;
- my $e = $@;
- $compiler_cache{$source} = [ $compiler, $e ];
- }
+ return @{ _clean_eval($source) };
+}
- return @{ $compiler_cache{$source} };
- }
+sub _clean_eval {
+ local $@;
+ local $SIG{__DIE__};
+ my $compiler = eval $_[0];
+ my $e = $@;
+ [ $compiler, $e ];
}
+$Eval::Closure::SANDBOX_ID = 0;
+
sub _make_compiler_source {
my ($source, @capture_keys) = @_;
+ $Eval::Closure::SANDBOX_ID++;
my $i = 0;
return join "\n", (
+ "package Eval::Closure::Sandbox_$Eval::Closure::SANDBOX_ID;",
'sub {',
- (map {
- 'my ' . $_ . ' = ' . substr($_, 0, 1) . '{$_[' . $i++ . ']};'
- } @capture_keys),
- $source,
+ (map { _make_lexical_assignment($_, $i++) } @capture_keys),
+ $source,
'}',
);
}
+sub _make_lexical_assignment {
+ my ($key, $index) = @_;
+ my $sigil = substr($key, 0, 1);
+ my $name = substr($key, 1);
+ if (HAS_LEXICAL_SUBS && $sigil eq '&') {
+ my $tmpname = '$__' . $name . '__' . $index;
+ return 'use feature "lexical_subs"; '
+ . 'no warnings "experimental::lexical_subs"; '
+ . 'my ' . $tmpname . ' = $_[' . $index . ']; '
+ . 'my sub ' . $name . ' { goto ' . $tmpname . ' }';
+ }
+ else {
+ return 'my ' . $key . ' = ' . $sigil . '{$_[' . $index . ']};';
+ }
+}
+
sub _dump_source {
my ($source) = @_;
No known bugs.
-Please report any bugs through RT: email
-C<bug-eval-closure at rt.cpan.org>, or browse to
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Eval-Closure>.
+Please report any bugs to GitHub Issues at L<https://github.com/doy/eval-closure/issues>.
=head1 SEE ALSO
=over 4
-=item * AnnoCPAN: Annotated CPAN documentation
+=item * MetaCPAN
-L<http://annocpan.org/dist/Eval-Closure>
+L<https://metacpan.org/release/Reply>
-=item * CPAN Ratings
+=item * Github
-L<http://cpanratings.perl.org/d/Eval-Closure>
+L<https://github.com/doy/reply>
=item * RT: CPAN's request tracker
-L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Eval-Closure>
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Reply>
-=item * Search CPAN
+=item * CPAN Ratings
-L<http://search.cpan.org/dist/Eval-Closure>
+L<http://cpanratings.perl.org/d/Reply>
=back
-=head1 AUTHOR
-
-Jesse Luehrs <doy at tozt dot net>
+=head1 NOTES
Based on code from L<Class::MOP::Method::Accessor>, by Stevan Little and the
Moose Cabal.
projects / gitmo/Eval-Closure.git / blobdiff