eh, name isn't that useful

[gitmo/Eval-Closure.git] / lib / Eval / Closure.pm

diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm
index 719701d..680399a 100644 (file)
--- a/lib/Eval/Closure.pm
+++ b/lib/Eval/Closure.pm
@@ -1,4 +1,6 @@
 package Eval::Closure;
+use strict;
+use warnings;
 use Sub::Exporter -setup => {
     exports => [qw(eval_closure)],
     groups  => { default => [qw(eval_closure)] },
@@ -15,7 +17,10 @@ sub eval_closure {
     $args{source} = _canonicalize_source($args{source});
     _validate_env($args{environment} ||= {});
 
-    my ($code, $e) = _clean_eval_closure(@args{qw(source environment name)});
+    $args{source} = _line_directive($args{description}) . $args{source}
+        if defined $args{description};
+
+    my ($code, $e) = _clean_eval_closure(@args{qw(source environment)});
 
     croak("Failed to compile source: $e\n\nsource:\n$args{source}")
         unless $code;
@@ -56,22 +61,28 @@ sub _validate_env {
         unless reftype($env) eq 'HASH';
 
     for my $var (keys %$env) {
-        croak("Environment key '$_' should start with \@, \%, or \$")
+        croak("Environment key '$var' should start with \@, \%, or \$")
             unless $var =~ /^([\@\%\$])/;
         croak("Environment values must be references, not $env->{$var}")
             unless ref($env->{$var});
     }
 }
 
+sub _line_directive {
+    my ($description) = @_;
+
+    return qq{#line 1 "$description"\n};
+}
+
 sub _clean_eval_closure {
-    # my ($source, $__captures, $name) = @_
+    # my ($source, $__captures) = @_
     my $__captures = $_[1];
 
     local $@;
     local $SIG{__DIE__};
 
     if ($ENV{EVAL_CLOSURE_PRINT_SOURCE}) {
-        _dump_source(_make_source(@_), $_[2]);
+        _dump_source(_make_source(@_));
     }
 
     my $code = eval _make_source(@_);
@@ -98,7 +109,7 @@ sub _make_source {
 }
 
 sub _dump_source {
-    my ($source, $name) = @_;
+    my ($source) = @_;
 
     my $output;
     if (try { require Perl::Tidy }) {
@@ -111,8 +122,7 @@ sub _dump_source {
         $output = $source;
     }
 
-    $name = defined($name) ? $name : "__ANON__";
-    warn $name . ":\n" . $output . "\n";
+    warn "$output\n";
 }
 
 1;