stub docs

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

diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm
index 680399a..f344939 100644 (file)
--- a/lib/Eval/Closure.pm
+++ b/lib/Eval/Closure.pm
@@ -5,12 +5,24 @@ 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) = @_;
 
@@ -75,18 +87,18 @@ sub _line_directive {
 }
 
 sub _clean_eval_closure {
-    # my ($source, $__captures) = @_
-    my $__captures = $_[1];
-
-    local $@;
-    local $SIG{__DIE__};
+     my ($source, $captures) = @_;
 
     if ($ENV{EVAL_CLOSURE_PRINT_SOURCE}) {
-        _dump_source(_make_source(@_));
+        _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, "
@@ -97,14 +109,25 @@ 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,
+        '}',
     );
 }
 
@@ -125,4 +148,59 @@ sub _dump_source {
     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;