X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FEval%2FClosure.pm;h=42c20dadad6feccc46abfdd5b48fa47f83f421bc;hb=794dc9df98d2aaf2f143f32ac7dfa42fa46ce07e;hp=6a1f41e585cbd7d6f2d2508d436ed9db5b8c0907;hpb=5617e9667fce453ffa66029ebc10c972a3066725;p=gitmo%2FEval-Closure.git

diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm
index 6a1f41e..42c20da 100644
--- a/lib/Eval/Closure.pm
+++ b/lib/Eval/Closure.pm
@@ -9,7 +9,6 @@ use Sub::Exporter -setup => {
 
 use Carp;
 use overload ();
-use Memoize;
 use Scalar::Util qw(reftype);
 use Try::Tiny;
 
@@ -83,6 +82,11 @@ parameter lets you override that to something more useful (for instance,
 L<Moose> overrides the description for accessors to something like "accessor
 foo at MyClass.pm, line 123").
 
+=item line
+
+This lets you override the particular line number that appears in backtraces,
+much like the C<description> option. The default is 1.
+
 =item terse_error
 
 Normally, this function appends the source code that failed to compile, and
@@ -99,8 +103,9 @@ sub eval_closure {
     $args{source} = _canonicalize_source($args{source});
     _validate_env($args{environment} ||= {});
 
-    $args{source} = _line_directive($args{description}) . $args{source}
-        if defined $args{description};
+    $args{source} = _line_directive(@args{qw(line description)})
+                  . $args{source}
+        if defined $args{description} && !($^P & 0x10);
 
     my ($code, $e) = _clean_eval_closure(@args{qw(source environment)});
 
@@ -157,19 +162,22 @@ sub _validate_env {
 }
 
 sub _line_directive {
-    my ($description) = @_;
+    my ($line, $description) = @_;
 
-    return qq{#line 1 "$description"\n};
+    $line = 1 unless defined($line);
+
+    return qq{#line $line "$description"\n};
 }
 
 sub _clean_eval_closure {
-     my ($source, $captures) = @_;
+    my ($source, $captures) = @_;
+
+    my @capture_keys = sort keys %$captures;
 
     if ($ENV{EVAL_CLOSURE_PRINT_SOURCE}) {
-        _dump_source(_make_compiler_source(@_));
+        _dump_source(_make_compiler_source($source, @capture_keys));
     }
 
-    my @capture_keys = sort keys %$captures;
     my ($compiler, $e) = _make_compiler($source, @capture_keys);
     my $code;
     if (defined $compiler) {
@@ -185,14 +193,33 @@ sub _clean_eval_closure {
     return ($code, $e);
 }
 
-sub _make_compiler {
-    local $@;
-    local $SIG{__DIE__};
-    my $compiler = eval _make_compiler_source(@_);
-    my $e = $@;
-    return ($compiler, $e);
+{
+    my %compiler_cache;
+
+    sub _make_compiler {
+        my $source = _make_compiler_source(@_);
+
+        unless (exists $compiler_cache{$source}) {
+            $compiler_cache{$source} = _clean_eval($source);
+        }
+
+        return @{ $compiler_cache{$source} };
+    }
+}
+
+$Eval::Closure::SANDBOX_ID = 0;
+
+sub _clean_eval {
+    $Eval::Closure::SANDBOX_ID++;
+    return eval <<EVAL;
+package Eval::Closure::Sandbox_$Eval::Closure::SANDBOX_ID;
+local \$@;
+local \$SIG{__DIE__};
+my \$compiler = eval \$_[0];
+my \$e = \$@;
+[ \$compiler, \$e ];
+EVAL
 }
-memoize('_make_compiler');
 
 sub _make_compiler_source {
     my ($source, @capture_keys) = @_;
@@ -215,6 +242,7 @@ sub _dump_source {
         Perl::Tidy::perltidy(
             source      => \$source,
             destination => \$output,
+            argv        => [],
         );
     }
     else {