X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FEval%2FClosure.pm;h=680399a9fb7a3920221f7e27d5f6b7f3f4e14338;hb=409b8f4169b1febda0f36fa7eb66abd79624ada7;hp=963de517055d900954a098dfd74cb690f18e4c68;hpb=efb592ef997e1772dc8bc03724d40ba3efe27717;p=gitmo%2FEval-Closure.git

diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm
index 963de51..680399a 100644
--- a/lib/Eval/Closure.pm
+++ b/lib/Eval/Closure.pm
@@ -1,6 +1,9 @@
 package Eval::Closure;
+use strict;
+use warnings;
 use Sub::Exporter -setup => {
     exports => [qw(eval_closure)],
+    groups  => { default => [qw(eval_closure)] },
 };
 
 use Carp;
@@ -10,9 +13,14 @@ use Try::Tiny;
 
 sub eval_closure {
     my (%args) = @_;
+
     $args{source} = _canonicalize_source($args{source});
+    _validate_env($args{environment} ||= {});
+
+    $args{source} = _line_directive($args{description}) . $args{source}
+        if defined $args{description};
 
-    my ($code, $e) = _clean_eval_closure(@args{qw(source environment name)});
+    my ($code, $e) = _clean_eval_closure(@args{qw(source environment)});
 
     croak("Failed to compile source: $e\n\nsource:\n$args{source}")
         unless $code;
@@ -46,36 +54,62 @@ sub _canonicalize_source {
     }
 }
 
+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 '$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) = @_
     my $__captures = $_[1];
 
-    do {
-        local $@;
-        local $SIG{__DIE__};
+    local $@;
+    local $SIG{__DIE__};
 
-        if ($ENV{EVAL_CLOSURE_PRINT_SOURCE}) {
-            _dump_source(_make_source(@_), $_[2]);
-        }
+    if ($ENV{EVAL_CLOSURE_PRINT_SOURCE}) {
+        _dump_source(_make_source(@_));
+    }
 
-        my $code = eval _make_source(@_);
-        ($code, $@);
-    };
+    my $code = eval _make_source(@_);
+    my $e = $@;
+
+    if (defined($code) && (!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,
     );
 }
 
 sub _dump_source {
-    my ($source, $name) = @_;
+    my ($source) = @_;
 
     my $output;
     if (try { require Perl::Tidy }) {
@@ -88,8 +122,7 @@ sub _dump_source {
         $output = $source;
     }
 
-    $name = defined($name) ? $name : "__ANON__";
-    warn $name . ":\n" . $output . "\n";
+    warn "$output\n";
 }
 
 1;