From e18489a1f13ca6ee9adfe9791a0a05e90feafb0f Mon Sep 17 00:00:00 2001 From: Olivier Mengué Date: Wed, 30 Mar 2016 23:13:17 +0200 Subject: Use index() instead of regexp --- lib/Eval/Closure.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm index e129c53..868e4a8 100644 --- a/lib/Eval/Closure.pm +++ b/lib/Eval/Closure.pm @@ -171,11 +171,11 @@ sub _validate_env { for my $var (keys %$env) { if (HAS_LEXICAL_SUBS) { croak("Environment key '$var' should start with \@, \%, \$, or \&") - unless $var =~ /^([\@\%\$\&])/; + if index('$@%&', substr($var, 0, 1)) < 0; } else { croak("Environment key '$var' should start with \@, \%, or \$") - unless $var =~ /^([\@\%\$])/; + if index('$@%', substr($var, 0, 1)) < 0; } croak("Environment values must be references, not $env->{$var}") unless ref($env->{$var}); -- cgit v1.2.3-54-g00ecf From accdae76a26f699f093f02e6591df8b3ab99042f Mon Sep 17 00:00:00 2001 From: Olivier Mengué Date: Wed, 30 Mar 2016 23:22:55 +0200 Subject: Use index() instead of regexp --- lib/Eval/Closure.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm index 868e4a8..8f5da16 100644 --- a/lib/Eval/Closure.pm +++ b/lib/Eval/Closure.pm @@ -214,7 +214,7 @@ sub _clean_eval_closure { if ($alias) { require Devel::LexAlias; Devel::LexAlias::lexalias($code, $_, $captures->{$_}) - for grep !/^\&/, keys %$captures; + for grep index($_, '&')==-1, keys %$captures; } return ($code, $e); -- cgit v1.2.3-54-g00ecf From a3aa0aeca8fd616f9875cf9befa48e6053caf108 Mon Sep 17 00:00:00 2001 From: Olivier Mengué Date: Thu, 31 Mar 2016 22:06:28 +0200 Subject: Reuse @capture_keys instead of querying keys one more time --- lib/Eval/Closure.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm index 8f5da16..dbe6ea1 100644 --- a/lib/Eval/Closure.pm +++ b/lib/Eval/Closure.pm @@ -214,7 +214,7 @@ sub _clean_eval_closure { if ($alias) { require Devel::LexAlias; Devel::LexAlias::lexalias($code, $_, $captures->{$_}) - for grep index($_, '&')==-1, keys %$captures; + for grep index($_, '&')==-1, @capture_keys; } return ($code, $e); -- cgit v1.2.3-54-g00ecf From 6f1ed77258bb2e868db9f4bc877f120ea8d814f6 Mon Sep 17 00:00:00 2001 From: Olivier Mengué Date: Thu, 31 Mar 2016 22:13:05 +0200 Subject: Remove unneeded sort We don't need to sort capture keys as long as we keep the same order during the whole process which is the case with the @capture_keys variable. --- lib/Eval/Closure.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm index dbe6ea1..51a6c00 100644 --- a/lib/Eval/Closure.pm +++ b/lib/Eval/Closure.pm @@ -193,7 +193,7 @@ sub _line_directive { sub _clean_eval_closure { my ($source, $captures, $alias) = @_; - my @capture_keys = sort keys %$captures; + my @capture_keys = keys %$captures; if ($ENV{EVAL_CLOSURE_PRINT_SOURCE}) { _dump_source(_make_compiler_source($source, $alias, @capture_keys)); -- cgit v1.2.3-54-g00ecf From e4485b5c3bd9de9ad7d5caacbc36164479696def Mon Sep 17 00:00:00 2001 From: Olivier Mengué Date: Thu, 31 Mar 2016 22:53:06 +0200 Subject: Return early in case of invalid $source ... to avoid calling lexalias with undef instead of a coderef. --- lib/Eval/Closure.pm | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm index 51a6c00..3b7c0ee 100644 --- a/lib/Eval/Closure.pm +++ b/lib/Eval/Closure.pm @@ -200,15 +200,23 @@ sub _clean_eval_closure { } my ($compiler, $e) = _make_compiler($source, $alias, @capture_keys); - my $code; - if (defined $compiler) { - $code = $compiler->(@$captures{@capture_keys}); - } + return (undef, $e) unless defined $compiler; + + my $code = $compiler->(@$captures{@capture_keys}); - if (defined($code) && (!ref($code) || ref($code) ne 'CODE')) { - $e = "The 'source' parameter must return a subroutine reference, " - . "not $code"; - undef $code; + if (!defined $code) { + return ( + undef, + "The 'source' parameter must return a subroutine reference, " + . "not undef" + ) + } + if (!ref($code) || ref($code) ne 'CODE') { + return ( + undef, + "The 'source' parameter must return a subroutine reference, not " + . ref($code) + ) } if ($alias) { -- cgit v1.2.3-54-g00ecf From 94e23936f40b45d8e22189e34c1b7d34b0829194 Mon Sep 17 00:00:00 2001 From: Olivier Mengué Date: Thu, 31 Mar 2016 23:34:39 +0200 Subject: _clean_eval: return a list instead of a short lived array ref --- lib/Eval/Closure.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm index 3b7c0ee..1b90308 100644 --- a/lib/Eval/Closure.pm +++ b/lib/Eval/Closure.pm @@ -231,7 +231,7 @@ sub _clean_eval_closure { sub _make_compiler { my $source = _make_compiler_source(@_); - return @{ _clean_eval($source) }; + _clean_eval($source) } sub _clean_eval { @@ -239,7 +239,7 @@ sub _clean_eval { local $SIG{__DIE__}; my $compiler = eval $_[0]; my $e = $@; - [ $compiler, $e ]; + ( $compiler, $e ) } $Eval::Closure::SANDBOX_ID = 0; -- cgit v1.2.3-54-g00ecf From f8e3dd4db20c5ef34c6ca0064e74b42dca809eb2 Mon Sep 17 00:00:00 2001 From: Olivier Mengué Date: Thu, 31 Mar 2016 23:44:07 +0200 Subject: Drop minor use of Try::Tiny Try::Tiny was used just to conditionally use Perl::Tiny when $ENV{EVAL_CLOSURE_PRINT_SOURCE} is set (which is mostly for debugging). A plain eval-block is good enough for that case. This removes a dependency and an import. --- lib/Eval/Closure.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm index 1b90308..3021d68 100644 --- a/lib/Eval/Closure.pm +++ b/lib/Eval/Closure.pm @@ -9,7 +9,6 @@ use Exporter 'import'; use Carp; use overload (); use Scalar::Util qw(reftype); -use Try::Tiny; use constant HAS_LEXICAL_SUBS => $] >= 5.018; @@ -280,7 +279,8 @@ sub _dump_source { my ($source) = @_; my $output; - if (try { require Perl::Tidy }) { + local $@; + if (eval { require Perl::Tidy; 1 }) { Perl::Tidy::perltidy( source => \$source, destination => \$output, -- cgit v1.2.3-54-g00ecf