2 use Sub::Exporter -setup => {
3 exports => [qw(eval_closure)],
4 groups => { default => [qw(eval_closure)] },
9 use Scalar::Util qw(reftype);
14 $args{source} = _canonicalize_source($args{source});
16 my ($code, $e) = _clean_eval_closure(@args{qw(source environment name)});
18 croak("Failed to compile source: $e\n\nsource:\n$args{source}")
24 sub _canonicalize_source {
27 if (defined($source)) {
29 if (reftype($source) eq 'ARRAY'
30 || overload::Method($source, '@{}')) {
31 return join "\n", @$source;
33 elsif (overload::Method($source, '""')) {
37 croak("The 'source' parameter to eval_closure must be a "
38 . "string or array reference");
46 croak("The 'source' parameter to eval_closure is required");
50 sub _clean_eval_closure {
51 # my ($source, $__captures, $name) = @_
52 my $__captures = $_[1];
57 if ($ENV{EVAL_CLOSURE_PRINT_SOURCE}) {
58 _dump_source(_make_source(@_), $_[2]);
61 my $code = eval _make_source(@_);
64 if (!ref($code) || ref($code) ne 'CODE') {
65 $e = "The 'source' parameter must return a subroutine reference, "
74 my ($source, $__captures) = @_;
77 die "Capture key should start with \@, \% or \$: $_"
79 'my ' . $_ . ' = ' . $1 . '{$__captures->{\'' . $_ . '\'}};';
86 my ($source, $name) = @_;
89 if (try { require Perl::Tidy }) {
92 destination => \$output,
99 $name = defined($name) ? $name : "__ANON__";
100 warn $name . ":\n" . $output . "\n";