fix typo

[gitmo/Moo.git] / lib / Method / Generate / Accessor.pm

diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index f6093eb..76e2a54 100644 (file)
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -35,11 +35,11 @@ sub generate_method {
         getters => $into, $reader, $name
       );
     } else {
-      local $self->{captures} = {};
+      $self->{captures} = {};
       $methods{$reader} =
         quote_sub "${into}::${reader}"
           => $self->_generate_get($name, $spec)
-          => $self->{captures}
+          => delete $self->{captures}
         ;
     }
   }
@@ -53,11 +53,11 @@ sub generate_method {
         accessors => $into, $accessor, $name
       );
     } else {
-      local $self->{captures} = {};
+      $self->{captures} = {};
       $methods{$accessor} =
         quote_sub "${into}::${accessor}"
           => $self->_generate_getset($name, $spec)
-          => $self->{captures}
+          => delete $self->{captures}
         ;
     }
   }
@@ -70,11 +70,11 @@ sub generate_method {
         setters => $into, $writer, $name
       );
     } else {
-      local $self->{captures} = {};
+      $self->{captures} = {};
       $methods{$writer} =
         quote_sub "${into}::${writer}"
           => $self->_generate_set($name, $spec)
-          => $self->{captures}
+          => delete $self->{captures}
         ;
     }
   }
@@ -106,20 +106,20 @@ sub generate_method {
     };
     foreach my $spec (@specs) {
       my ($proxy, $target, @args) = @$spec;
-      local $self->{captures} = {};
+      $self->{captures} = {};
       $methods{$proxy} =
         quote_sub "${into}::${proxy}" =>
           $self->_generate_delegation($asserter, $target, \@args),
-          $self->{captures}
+          delete $self->{captures}
         ;
     }
   }
   if (my $asserter = $spec->{asserter}) {
-    local $self->{captures} = {};
+    $self->{captures} = {};
     $methods{$asserter} =
       quote_sub "${into}::${asserter}" =>
         'do { '.$self->_generate_get($name, $spec).qq! }||die "Attempted to access '${name}' but it is not set"!,
-        $self->{captures}
+        delete $self->{captures}
       ;
   }
   \%methods;
@@ -130,7 +130,7 @@ sub is_simple_attribute {
   # clearer doesn't have to be listed because it doesn't
   # affect whether defined/exists makes a difference
   !grep $spec->{$_},
-    qw(lazy default builder isa trigger predicate);
+    qw(lazy default builder isa trigger predicate weak_ref);
 }
 
 sub is_simple_get {
@@ -140,7 +140,12 @@ sub is_simple_get {
 
 sub is_simple_set {
   my ($self, $name, $spec) = @_;
-  !grep $spec->{$_}, qw(isa trigger);
+  !grep $spec->{$_}, qw(isa trigger weak_ref);
+}
+
+sub has_eager_default {
+  my ($self, $name, $spec) = @_;
+  (!$spec->{lazy} and ($spec->{default} or $spec->{builder}));
 }
 
 sub _generate_get {
@@ -163,15 +168,15 @@ sub _generate_simple_has {
 
 sub generate_get_default {
   my $self = shift;
-  local $self->{captures} = {};
+  $self->{captures} = {};
   my $code = $self->_generate_get_default(@_);
-  ($code, $self->{captures});
+  ($code, delete $self->{captures});
 }
 
 sub _generate_use_default {
   my ($self, $me, $name, $spec, $test) = @_;
   $self->_generate_simple_set(
-    $me, $name, $self->_generate_get_default($me, $name, $spec)
+    $me, $name, $spec, $self->_generate_get_default($me, $name, $spec)
   ).' unless '.$test;
 }
 
@@ -195,20 +200,20 @@ sub _generate_simple_get {
 
 sub _generate_set {
   my ($self, $name, $spec) = @_;
-  my $simple = $self->_generate_simple_set('$_[0]', $name, '$_[1]');
   if ($self->is_simple_set($name, $spec)) {
-    $simple;
+    $self->_generate_simple_set('$_[0]', $name, $spec, '$_[1]');
   } else {
     my ($trigger, $isa_check) = @{$spec}{qw(trigger isa)};
-    my $code = "do {\n";
+    my $simple = $self->_generate_simple_set('$self', $name, $spec, '$value');
+    my $code = "do { my (\$self, \$value) = \@_;\n";
     if ($isa_check) {
       $code .= 
-        "        ".$self->_generate_isa_check($name, '$_[1]', $isa_check).";\n";
+        "        ".$self->_generate_isa_check($name, '$value', $isa_check).";\n";
     }
     if ($trigger) {
-      my $fire = $self->_generate_trigger($name, '$_[0]', '$value', $trigger);
+      my $fire = $self->_generate_trigger($name, '$self', '$value', $trigger);
       $code .=
-        "        my \$value = ".$simple.";\n        ".$fire.";\n"
+        "        ".$simple.";\n        ".$fire.";\n"
         ."        \$value;\n";
     } else {
       $code .= "        ".$simple.";\n";
@@ -220,9 +225,9 @@ sub _generate_set {
   
 sub generate_trigger {
   my $self = shift;
-  local $self->{captures} = {};
+  $self->{captures} = {};
   my $code = $self->_generate_trigger(@_);
-  ($code, $self->{captures});
+  ($code, delete $self->{captures});
 }
 
 sub _generate_trigger {
@@ -232,9 +237,9 @@ sub _generate_trigger {
 
 sub generate_isa_check {
   my ($self, @args) = @_;
-  local $self->{captures} = {};
+  $self->{captures} = {};
   my $code = $self->_generate_isa_check(@args);
-  ($code, $self->{captures});
+  ($code, delete $self->{captures});
 }
 
 sub _generate_isa_check {
@@ -246,15 +251,16 @@ sub _generate_call_code {
   my ($self, $name, $type, $values, $sub) = @_;
   if (my $quoted = quoted_from_sub($sub)) {
     my $code = $quoted->[1];
-    my $at_ = 'local @_ = ('.$values.');';
+    my $at_ = '@_ = ('.$values.');';
     if (my $captures = $quoted->[2]) {
       my $cap_name = qq{\$${type}_captures_for_${name}};
       $self->{captures}->{$cap_name} = \$captures;
-      return "do {\n".'      '.$at_."\n"
-        .Sub::Quote::capture_unroll($cap_name, $captures, 6)
-        ."     ${code}\n    }";
+      Sub::Quote::inlinify(
+        $code, $values, Sub::Quote::capture_unroll($cap_name, $captures, 6)
+      );
+    } else {
+      Sub::Quote::inlinify($code, $values);
     }
-    'do { local @_ = ('.$values.'); '.$code.' }';
   } else {
     my $cap_name = qq{\$${type}_for_${name}};
     $self->{captures}->{$cap_name} = \$sub;
@@ -264,30 +270,32 @@ sub _generate_call_code {
 
 sub generate_populate_set {
   my $self = shift;
-  local $self->{captures} = {};
+  $self->{captures} = {};
   my $code = $self->_generate_populate_set(@_);
-  ($code, $self->{captures});
+  ($code, delete $self->{captures});
 }
 
 sub _generate_populate_set {
   my ($self, $me, $name, $spec, $source, $test) = @_;
-  if (!$spec->{lazy} and
-        ($spec->{default} or $spec->{builder})) {
+  if ($self->has_eager_default($name, $spec)) {
     my $get_indent = ' ' x ($spec->{isa} ? 6 : 4);
+    my $get_default = $self->_generate_get_default(
+                        '$new', $_, $spec
+                      );
     my $get_value = 
-      "(\n${get_indent}  ${test}\n${get_indent}   ? ${source}\n${get_indent}   : "
-        .$self->_generate_get_default(
-          '$new', $_, $spec
-        )
-        ."\n${get_indent})";
+      defined($spec->{init_arg})
+        ? "(\n${get_indent}  ${test}\n${get_indent}   ? ${source}\n${get_indent}   : "
+            .$get_default
+            ."\n${get_indent})"
+        : $get_default;
     ($spec->{isa}
       ? "    {\n      my \$value = ".$get_value.";\n      "
         .$self->_generate_isa_check(
           $name, '$value', $spec->{isa}
         ).";\n"
-        .'      '.$self->_generate_simple_set($me, $name, '$value').";\n"
+        .'      '.$self->_generate_simple_set($me, $name, $spec, '$value').";\n"
         ."    }\n"
-      : '    '.$self->_generate_simple_set($me, $name, $get_value).";\n"
+      : '    '.$self->_generate_simple_set($me, $name, $spec, $get_value).";\n"
     )
     .($spec->{trigger}
       ? '    '
@@ -306,7 +314,7 @@ sub _generate_populate_set {
           ).";\n"
         : ""
       )
-      ."      ".$self->_generate_simple_set($me, $name, $source).";\n"
+      ."      ".$self->_generate_simple_set($me, $name, $spec, $source).";\n"
       .($spec->{trigger}
         ? "      "
           .$self->_generate_trigger(
@@ -324,23 +332,22 @@ sub generate_multi_set {
   "\@{${me}}{qw(${\join ' ', @$to_set})} = $from";
 }
 
-sub generate_simple_set {
-  my $self = shift;
-  local $self->{captures} = {};
-  my $code = $self->_generate_simple_set(@_);
-  ($code, $self->{captures});
-}
-
 sub _generate_simple_set {
-  my ($self, $me, $name, $value) = @_;
+  my ($self, $me, $name, $spec, $value) = @_;
   my $name_str = perlstring $name;
-  "${me}->{${name_str}} = ${value}";
+  my $simple = "${me}->{${name_str}} = ${value}";
+  if ($spec->{weak_ref}) {
+    require Scalar::Util;
+    "Scalar::Util::weaken(${simple})";
+  } else {
+    $simple;
+  }
 }
 
 sub _generate_getset {
   my ($self, $name, $spec) = @_;
   q{(@_ > 1}."\n      ? ".$self->_generate_set($name, $spec)
-    ."\n      : ".$self->_generate_get($name)."\n    )";
+    ."\n      : ".$self->_generate_get($name, $spec)."\n    )";
 }
 
 sub _generate_delegation {