X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FEval%2FClosure.pm;h=680399a9fb7a3920221f7e27d5f6b7f3f4e14338;hb=409b8f4169b1febda0f36fa7eb66abd79624ada7;hp=719701d2d0137ab178433fe6d6e0eb9d17f86a93;hpb=b86710e953dc6a4403be3f92ae7c1908f4584376;p=gitmo%2FEval-Closure.git diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm index 719701d..680399a 100644 --- 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;