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
13 use Scalar::Util qw(reftype);
22 =func eval_closure(%args)
29 $args{source} = _canonicalize_source($args{source});
30 _validate_env($args{environment} ||= {});
32 $args{source} = _line_directive($args{description}) . $args{source}
33 if defined $args{description};
35 my ($code, $e) = _clean_eval_closure(@args{qw(source environment)});
37 croak("Failed to compile source: $e\n\nsource:\n$args{source}")
43 sub _canonicalize_source {
46 if (defined($source)) {
48 if (reftype($source) eq 'ARRAY'
49 || overload::Method($source, '@{}')) {
50 return join "\n", @$source;
52 elsif (overload::Method($source, '""')) {
56 croak("The 'source' parameter to eval_closure must be a "
57 . "string or array reference");
65 croak("The 'source' parameter to eval_closure is required");
72 croak("The 'environment' parameter must be a hashref")
73 unless reftype($env) eq 'HASH';
75 for my $var (keys %$env) {
76 croak("Environment key '$var' should start with \@, \%, or \$")
77 unless $var =~ /^([\@\%\$])/;
78 croak("Environment values must be references, not $env->{$var}")
79 unless ref($env->{$var});
84 my ($description) = @_;
86 return qq{#line 1 "$description"\n};
89 sub _clean_eval_closure {
90 my ($source, $captures) = @_;
92 if ($ENV{EVAL_CLOSURE_PRINT_SOURCE}) {
93 _dump_source(_make_compiler_source(@_));
96 my @capture_keys = sort keys %$captures;
97 my ($compiler, $e) = _make_compiler($source, @capture_keys);
99 if (defined $compiler) {
100 $code = $compiler->(@$captures{@capture_keys});
103 if (defined($code) && (!ref($code) || ref($code) ne 'CODE')) {
104 $e = "The 'source' parameter must return a subroutine reference, "
115 my $compiler = eval _make_compiler_source(@_);
117 return ($compiler, $e);
119 memoize('_make_compiler');
121 sub _make_compiler_source {
122 my ($source, @capture_keys) = @_;
127 'my ' . $_ . ' = ' . substr($_, 0, 1) . '{$_[' . $i++ . ']};'
138 if (try { require Perl::Tidy }) {
139 Perl::Tidy::perltidy(
141 destination => \$output,
155 Please report any bugs through RT: email
156 C<bug-eval-closure at rt.cpan.org>, or browse to
157 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Eval-Closure>.
163 =item * L<Class::MOP::Method::Accessor>
165 This module is a factoring out of code that used to live here
171 You can find this documentation for this module with the perldoc command.
173 perldoc Eval::Closure
175 You can also look for information at:
179 =item * AnnoCPAN: Annotated CPAN documentation
181 L<http://annocpan.org/dist/Eval-Closure>
185 L<http://cpanratings.perl.org/d/Eval-Closure>
187 =item * RT: CPAN's request tracker
189 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Eval-Closure>
193 L<http://search.cpan.org/dist/Eval-Closure>
199 Jesse Luehrs <doy at tozt dot net>
201 Based on code from L<Class::MOP::Method::Accessor>, by Stevan Little and the