package Eval::Closure;
use Sub::Exporter -setup => {
exports => [qw(eval_closure)],
+ groups => { default => [qw(eval_closure)] },
};
use Carp;
sub eval_closure {
my (%args) = @_;
+
$args{source} = _canonicalize_source($args{source});
+ _validate_env($args{environment} ||= {});
my ($code, $e) = _clean_eval_closure(@args{qw(source environment name)});
}
}
+sub _validate_env {
+ my ($env) = @_;
+
+ croak("The 'environment' parameter must be a hashref")
+ unless reftype($env) eq 'HASH';
+
+ for my $var (keys %$env) {
+ croak("Environment key '$_' 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, $name) = @_
my $__captures = $_[1];
}
my $code = eval _make_source(@_);
- ($code, $@);
+ my $e = $@;
+
+ if (!ref($code) || ref($code) ne 'CODE') {
+ $e = "The 'source' parameter must return a subroutine reference, "
+ . "not $code";
+ undef $code;
+ }
+
+ return ($code, $e);
}
sub _make_source {
my ($source, $__captures) = @_;
return join "\n", (
(map {
- die "Capture key should start with \@, \% or \$: $_"
- unless /^([\@\%\$])/;
- 'my ' . $_ . ' = ' . $1 . '{$__captures->{\'' . $_ . '\'}};';
- } keys %$__captures),
+ 'my ' . $_ . ' = '
+ . substr($_, 0, 1) . '{$__captures->{\'' . $_ . '\'}};'
+ } keys %$__captures),
$source,
);
}