X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMethod%2FGenerate%2FAccessor.pm;h=5636aac94edf82533b10adfd7add5df5f2a0173a;hb=ceea0e3806c6b5e700ff9ac8d4cfb36bc1c20af9;hp=204330b6ed150d8911828b94f4b391c061af57b3;hpb=673eb4988f20b57235a6e8b9ff7035b95ba98baa;p=gitmo%2FMoo.git

diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index 204330b..5636aac 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -23,13 +23,25 @@ sub generate_method {
   } elsif ($is eq 'rw') {
     $spec->{accessor} = $name unless exists $spec->{accessor};
   } elsif ($is eq 'lazy') {
-    $spec->{init_arg} = undef unless exists $spec->{init_arg};
     $spec->{reader} = $name unless exists $spec->{reader};
     $spec->{lazy} = 1;
     $spec->{builder} ||= '_build_'.$name unless $spec->{default};
+  } elsif ($is eq 'rwp') {
+    $spec->{reader} = $name unless exists $spec->{reader};
+    $spec->{writer} = "_set_${name}" unless exists $spec->{writer};
   } elsif ($is ne 'bare') {
     die "Unknown is ${is}";
   }
+  $spec->{builder} = '_build_'.$name if ($spec->{builder}||0) eq 1;
+  if (($spec->{predicate}||0) eq 1) {
+    $spec->{predicate} = $name =~ /^_/ ? "_has${name}" : "has_${name}";
+  }
+  if (($spec->{clearer}||0) eq 1) {
+    $spec->{clearer} = $name =~ /^_/ ? "_clear${name}" : "clear_${name}";
+  }
+  if (($spec->{trigger}||0) eq 1) {
+    $spec->{trigger} = quote_sub('shift->_trigger_'.$name.'(@_)');
+  }
   my %methods;
   if (my $reader = $spec->{reader}) {
     if (our $CAN_HAZ_XS && $self->is_simple_get($name, $spec)) {
@@ -84,13 +96,13 @@ sub generate_method {
   if (my $pred = $spec->{predicate}) {
     $methods{$pred} =
       quote_sub "${into}::${pred}" =>
-        '    '.$self->_generate_simple_has('$_[0]', $name)."\n"
+        '    '.$self->_generate_simple_has('$_[0]', $name, $spec)."\n"
       ;
   }
   if (my $cl = $spec->{clearer}) {
     $methods{$cl} =
       quote_sub "${into}::${cl}" => 
-        "    delete \$_[0]->{${\perlstring $name}}\n"
+        $self->_generate_simple_clear('$_[0]', $name, $spec)."\n"
       ;
   }
   if (my $hspec = $spec->{handles}) {
@@ -153,13 +165,13 @@ sub has_eager_default {
 
 sub _generate_get {
   my ($self, $name, $spec) = @_;
-  my $simple = $self->_generate_simple_get('$_[0]', $name);
+  my $simple = $self->_generate_simple_get('$_[0]', $name, $spec);
   if ($self->is_simple_get($name, $spec)) {
     $simple;
   } else {
     'do { '.$self->_generate_use_default(
       '$_[0]', $name, $spec,
-      $self->_generate_simple_has('$_[0]', $name),
+      $self->_generate_simple_has('$_[0]', $name, $spec),
     ).'; '.$simple.' }';
   }
 }
@@ -169,6 +181,11 @@ sub _generate_simple_has {
   "exists ${me}->{${\perlstring $name}}";
 }
 
+sub _generate_simple_clear {
+  my ($self, $me, $name) = @_;
+  "    delete ${me}->{${\perlstring $name}}\n"
+}
+
 sub generate_get_default {
   my $self = shift;
   $self->{captures} = {};
@@ -178,8 +195,15 @@ sub generate_get_default {
 
 sub _generate_use_default {
   my ($self, $me, $name, $spec, $test) = @_;
+  my $get_value = $self->_generate_get_default($me, $name, $spec);
+  if ($spec->{coerce}) {
+    $get_value = $self->_generate_coerce(
+      $name, $get_value,
+      $spec->{coerce}
+    )
+  }
   $self->_generate_simple_set(
-    $me, $name, $spec, $self->_generate_get_default($me, $name, $spec)
+    $me, $name, $spec, $get_value
   ).' unless '.$test;
 }
 
@@ -212,7 +236,7 @@ sub _generate_set {
     if ($coerce) {
       $code .=
         "        \$value = "
-        .$self->_generate_coerce($name, '$self', '$value', $coerce).";\n";
+        .$self->_generate_coerce($name, '$value', $coerce).";\n";
     }
     if ($isa_check) {
       $code .= 
@@ -239,7 +263,7 @@ sub generate_coerce {
 }
 
 sub _generate_coerce {
-  my ($self, $name, $obj, $value, $coerce) = @_;
+  my ($self, $name, $value, $coerce) = @_;
   $self->_generate_call_code($name, 'coerce', "${value}", $coerce);
 }
  
@@ -308,11 +332,11 @@ sub _generate_populate_set {
             .$get_default
             ."\n${get_indent})"
         : $get_default;
-    if ( $spec->{coerce} ) {
-        $get_value = $self->_generate_coerce(
-            $name, $me, $get_value,
-            $spec->{coerce}
-          )
+    if ($spec->{coerce}) {
+      $get_value = $self->_generate_coerce(
+        $name, $get_value,
+        $spec->{coerce}
+      )
     }
     ($spec->{isa}
       ? "    {\n      my \$value = ".$get_value.";\n      "
@@ -326,7 +350,7 @@ sub _generate_populate_set {
     .($spec->{trigger}
       ? '    '
         .$self->_generate_trigger(
-          $name, $me, $self->_generate_simple_get($me, $name),
+          $name, $me, $self->_generate_simple_get($me, $name, $spec),
           $spec->{trigger}
         )." if ${test};\n"
       : ''
@@ -336,7 +360,7 @@ sub _generate_populate_set {
       .($spec->{coerce}
         ? "      $source = "
           .$self->_generate_coerce(
-            $name, $me, $source,
+            $name, $source,
             $spec->{coerce}
           ).";\n"
         : ""
@@ -352,7 +376,7 @@ sub _generate_populate_set {
       .($spec->{trigger}
         ? "      "
           .$self->_generate_trigger(
-            $name, $me, $self->_generate_simple_get($me, $name),
+            $name, $me, $self->_generate_simple_get($me, $name, $spec),
             $spec->{trigger}
           ).";\n"
         : ""
@@ -372,7 +396,7 @@ sub _generate_simple_set {
   my $simple = "${me}->{${name_str}} = ${value}";
 
   if ($spec->{weak_ref}) {
-    { local $@; require Scalar::Util; }
+    require Scalar::Util;
 
     # Perl < 5.8.3 can't weaken refs to readonly vars
     # (e.g. string constants). This *can* be solved by:
@@ -387,7 +411,7 @@ sub _generate_simple_set {
 
       eval { Scalar::Util::weaken($simple); 1 } or do {
         if( \$@ =~ /Modification of a read-only value attempted/) {
-          { local \$@; require Carp; }
+          require Carp;
           Carp::croak( sprintf (
             'Reference to readonly value in "%s" can not be weakened on Perl < 5.8.3',
             $name_str,
@@ -432,4 +456,6 @@ sub _generate_xs {
   $into->can($name);
 }
 
+sub default_construction_string { '{}' }
+
 1;