stub docs
[gitmo/Eval-Closure.git] / lib / Eval / Closure.pm
index c2a4387..f344939 100644 (file)
@@ -5,19 +5,34 @@ use Sub::Exporter -setup => {
     exports => [qw(eval_closure)],
     groups  => { default => [qw(eval_closure)] },
 };
+# ABSTRACT: safely and cleanly create closures via string eval
 
 use Carp;
 use overload ();
+use Memoize;
 use Scalar::Util qw(reftype);
 use Try::Tiny;
 
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=cut
+
+=func eval_closure(%args)
+
+=cut
+
 sub eval_closure {
     my (%args) = @_;
 
     $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;
@@ -65,19 +80,25 @@ sub _validate_env {
     }
 }
 
-sub _clean_eval_closure {
-    # my ($source, $__captures, $name) = @_
-    my $__captures = $_[1];
+sub _line_directive {
+    my ($description) = @_;
 
-    local $@;
-    local $SIG{__DIE__};
+    return qq{#line 1 "$description"\n};
+}
+
+sub _clean_eval_closure {
+     my ($source, $captures) = @_;
 
     if ($ENV{EVAL_CLOSURE_PRINT_SOURCE}) {
-        _dump_source(_make_source(@_), $_[2]);
+        _dump_source(_make_compiler_source(@_));
     }
 
-    my $code = eval _make_source(@_);
-    my $e = $@;
+    my @capture_keys = sort keys %$captures;
+    my ($compiler, $e) = _make_compiler($source, @capture_keys);
+    my $code;
+    if (defined $compiler) {
+        $code = $compiler->(@$captures{@capture_keys});
+    }
 
     if (defined($code) && (!ref($code) || ref($code) ne 'CODE')) {
         $e = "The 'source' parameter must return a subroutine reference, "
@@ -88,19 +109,30 @@ sub _clean_eval_closure {
     return ($code, $e);
 }
 
-sub _make_source {
-    my ($source, $__captures) = @_;
+sub _make_compiler {
+    local $@;
+    local $SIG{__DIE__};
+    my $compiler = eval _make_compiler_source(@_);
+    my $e = $@;
+    return ($compiler, $e);
+}
+memoize('_make_compiler');
+
+sub _make_compiler_source {
+    my ($source, @capture_keys) = @_;
+    my $i = 0;
     return join "\n", (
+        'sub {',
         (map {
-            'my ' . $_ . ' = '
-                . substr($_, 0, 1) . '{$__captures->{\'' . $_ . '\'}};'
-         } keys %$__captures),
+            'my ' . $_ . ' = ' . substr($_, 0, 1) . '{$_[' . $i++ . ']};'
+         } @capture_keys),
         $source,
+        '}',
     );
 }
 
 sub _dump_source {
-    my ($source, $name) = @_;
+    my ($source) = @_;
 
     my $output;
     if (try { require Perl::Tidy }) {
@@ -113,8 +145,62 @@ sub _dump_source {
         $output = $source;
     }
 
-    $name = defined($name) ? $name : "__ANON__";
-    warn $name . ":\n" . $output . "\n";
+    warn "$output\n";
 }
 
+=head1 BUGS
+
+No known bugs.
+
+Please report any bugs through RT: email
+C<bug-eval-closure at rt.cpan.org>, or browse to
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Eval-Closure>.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item * L<Class::MOP::Method::Accessor>
+
+This module is a factoring out of code that used to live here
+
+=back
+
+=head1 SUPPORT
+
+You can find this documentation for this module with the perldoc command.
+
+    perldoc Eval::Closure
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Eval-Closure>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Eval-Closure>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Eval-Closure>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Eval-Closure>
+
+=back
+
+=head1 AUTHOR
+
+Jesse Luehrs <doy at tozt dot net>
+
+Based on code from L<Class::MOP::Method::Accessor>, by Stevan Little and the
+Moose Cabal.
+
+=cut
+
 1;