X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSub%2FQuote.pm;h=8016b06f15886455912df4305a61337ebe7859ef;hb=350f2de6ebd85fd6fc5699c0773e6737756bac36;hp=3551aeb8afb9f16931342c0d5c206f1d9e92c528;hpb=1108b2e2131e2f72dbd1a43afe5e8940b9e85931;p=gitmo%2FMoo.git

diff --git a/lib/Sub/Quote.pm b/lib/Sub/Quote.pm
index 3551aeb..8016b06 100644
--- a/lib/Sub/Quote.pm
+++ b/lib/Sub/Quote.pm
@@ -9,6 +9,9 @@ use B 'perlstring';
 use Scalar::Util qw(weaken);
 use base qw(Exporter);
 
+our $VERSION = '1.003001';
+$VERSION = eval $VERSION;
+
 our @EXPORT = qw(quote_sub unquote_sub quoted_from_sub);
 
 our %QUOTED;
@@ -56,23 +59,22 @@ sub quote_sub {
     (ref($_[-1]) eq 'HASH' and ref($_[-2]) eq 'HASH')
       ? pop
       : {};
-  my $captures = pop if ref($_[-1]) eq 'HASH';
+  my $captures = ref($_[-1]) eq 'HASH' ? pop : undef;
   undef($captures) if $captures && !keys %$captures;
   my $code = pop;
   my $name = $_[0];
-  my $outstanding;
+  my $quoted_info;
   my $deferred = defer_sub +($options->{no_install} ? undef : $name) => sub {
-    unquote_sub($outstanding);
+    unquote_sub($quoted_info->[4]);
   };
-  $outstanding = "$deferred";
-  $QUOTED{$outstanding} = [ $name, $code, $captures ];
-  weaken($WEAK_REFS{$outstanding} = $deferred);
+  $quoted_info = [ $name, $code, $captures, undef, $deferred ];
+  weaken($QUOTED{$deferred} = $quoted_info);
   return $deferred;
 }
 
 sub quoted_from_sub {
   my ($sub) = @_;
-  $WEAK_REFS{$sub||''} and $QUOTED{$sub||''};
+  $QUOTED{$sub||''};
 }
 
 sub unquote_sub {
@@ -82,23 +84,22 @@ sub unquote_sub {
 
     my $make_sub = "{\n";
 
-    if (keys %$captures) {
-      $make_sub .= capture_unroll("\$_[1]", $captures, 2);
-    }
+    my %captures = $captures ? %$captures : ();
+    $captures{'$_QUOTED'} = \$QUOTED{$sub};
+    $make_sub .= capture_unroll("\$_[1]", \%captures, 2);
 
-    my $o_quoted = perlstring $sub;
     $make_sub .= (
       $name
           # disable the 'variable $x will not stay shared' warning since
           # we're not letting it escape from this scope anyway so there's
           # nothing trying to share it
         ? "  no warnings 'closure';\n  sub ${name} {\n"
-        : "  \$Sub::Quote::QUOTED{${o_quoted}}[3] = sub {\n"
+        : "  \$_QUOTED->[3] = sub {\n"
     );
     $make_sub .= $code;
     $make_sub .= "  }".($name ? '' : ';')."\n";
     if ($name) {
-      $make_sub .= "  \$Sub::Quote::QUOTED{${o_quoted}}[3] = \\&${name}\n";
+      $make_sub .= "  \$_QUOTED->[3] = \\&${name}\n";
     }
     $make_sub .= "}\n1;\n";
     $ENV{SUB_QUOTE_DEBUG} && warn $make_sub;
@@ -106,7 +107,7 @@ sub unquote_sub {
       local $@;
       no strict 'refs';
       local *{$name} if $name;
-      unless (_clean_eval $make_sub, $captures) {
+      unless (_clean_eval $make_sub, \%captures) {
         die "Eval went very, very wrong:\n\n${make_sub}\n\n$@";
       }
     }
@@ -114,7 +115,13 @@ sub unquote_sub {
   $QUOTED{$sub}[3];
 }
 
+sub CLONE {
+  %QUOTED = map { defined $_ ? ($_->[4] => $_) : () } values %QUOTED;
+  weaken($_) for values %QUOTED;
+}
+
 1;
+__END__
 
 =head1 NAME
 
@@ -161,7 +168,10 @@ C<$name> is the subroutine where the coderef will be installed.
 C<$code> is a string that will be turned into code.
 
 C<\%captures> is a hashref of variables that will be made available to the
-code.  See the L</SYNOPSIS>'s C<Silly::dagron> for an example using captures.
+code.  The keys should be the full name of the variable to be made available,
+including the sigil.  The values should be references to the values.  The
+variables will contain copies of the values.  See the L</SYNOPSIS>'s
+C<Silly::dagron> for an example using captures.
 
 =head3 options
 
@@ -281,3 +291,5 @@ See L<Moo> for authors.
 =head1 COPYRIGHT AND LICENSE
 
 See L<Moo> for the copyright and license.
+
+=cut