refactoring nested ifs
[gitmo/Moo.git] / lib / Method / Generate / Accessor.pm
index b01ab04..87f70eb 100644 (file)
@@ -17,6 +17,7 @@ BEGIN {
 
 sub generate_method {
   my ($self, $into, $name, $spec, $quote_opts) = @_;
+  $name =~ s/^\+//;
   die "Must have an is" unless my $is = $spec->{is};
   if ($is eq 'ro') {
     $spec->{reader} = $name unless exists $spec->{reader};
@@ -42,6 +43,20 @@ sub generate_method {
   if (($spec->{trigger}||0) eq 1) {
     $spec->{trigger} = quote_sub('shift->_trigger_'.$name.'(@_)');
   }
+  if (exists $spec->{default}) {
+    my $default = $spec->{default};
+    require Scalar::Util;
+    unless (
+      ref $default
+      and (
+        Scalar::Util::reftype $default eq 'CODE'
+        or Scalar::Util::blessed $default and $default->can('(&{}')
+      )
+    ) {
+      die "Invalid default $default";
+    }
+  }
+
   my %methods;
   if (my $reader = $spec->{reader}) {
     if (our $CAN_HAZ_XS && $self->is_simple_get($name, $spec)) {
@@ -399,9 +414,10 @@ sub _generate_core_set {
 sub _generate_simple_set {
   my ($self, $me, $name, $spec, $value) = @_;
   my $name_str = perlstring $name;
-  my $simple = $self->_generate_core_set($me, $name, $spec, $value);
 
   if ($spec->{weak_ref}) {
+    $value = '$preserve = '.$value;
+    my $simple = $self->_generate_core_set($me, $name, $spec, $value);
     require Scalar::Util;
 
     # Perl < 5.8.3 can't weaken refs to readonly vars
@@ -413,8 +429,10 @@ sub _generate_simple_set {
     #
     # but requires XS and is just too damn crazy
     # so simply throw a better exception
-    Moo::_Utils::lt_5_8_3() ? <<"EOC" : "Scalar::Util::weaken(${simple})";
+    my $weak_simple = "my \$preserve; Scalar::Util::weaken(${simple})";
+    Moo::_Utils::lt_5_8_3() ? <<"EOC" : $weak_simple;
 
+      my \$preserve;
       eval { Scalar::Util::weaken($simple); 1 } or do {
         if( \$@ =~ /Modification of a read-only value attempted/) {
           require Carp;
@@ -428,7 +446,7 @@ sub _generate_simple_set {
       };
 EOC
   } else {
-    $simple;
+    $self->_generate_core_set($me, $name, $spec, $value);
   }
 }
 
@@ -457,7 +475,8 @@ sub _generate_xs {
   my ($self, $type, $into, $name, $slot) = @_;
   Class::XSAccessor->import(
     class => $into,
-    $type => { $name => $slot }
+    $type => { $name => $slot },
+    replace => 1,
   );
   $into->can($name);
 }