X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMethod%2FGenerate%2FAccessor.pm;h=d0ab97061a2654ea7cb7aa931bc0d2d3df78e169;hb=42865691a20eb4d33df037c9677b9766126c98ec;hp=1291bcdd7338ed4d9ea4d7c467d633182038f067;hpb=ee03ad214f8ef311fb4fa39d761e2e7b09b7f4fc;p=gitmo%2FMoo.git

diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index 1291bcd..d0ab970 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -18,6 +18,19 @@ BEGIN {
   ;
 }
 
+sub _SIGDIE
+{
+  our ($CurrentAttribute, $OrigSigDie);
+  my $sigdie = $OrigSigDie && $OrigSigDie != \&_SIGDIE
+    ? $OrigSigDie
+    : sub { die $_[0] };
+
+  return $sigdie->(@_) if ref($_[0]);
+
+  my $attr_desc = _attr_desc(@$CurrentAttribute{qw(name init_arg)});
+  $sigdie->("$CurrentAttribute->{step} for $attr_desc failed: $_[0]");
+}
+
 sub _die_overwrite
 {
   my ($pkg, $method, $type) = @_;
@@ -45,10 +58,8 @@ sub generate_method {
   }
   if (exists $spec->{builder}) {
     if(ref $spec->{builder}) {
-      die "Invalid builder for $into->$name - not a method name, coderef or"
-        . " code-convertible object"
-        unless ref $spec->{builder} eq 'CODE'
-        or (blessed($spec->{builder}) and eval { \&{$spec->{builder}} });
+      $self->_validate_codulatable('builder', $spec->{builder},
+        "$into->$name", 'or a method name');
       $spec->{builder_sub} = $spec->{builder};
       $spec->{builder} = 1;
     }
@@ -159,7 +170,7 @@ sub generate_method {
     _die_overwrite($into, $cl, 'a clearer')
       if !$spec->{allow_overwrite} && *{_getglob("${into}::${cl}")}{CODE};
     $methods{$cl} =
-      quote_sub "${into}::${cl}" => 
+      quote_sub "${into}::${cl}" =>
         $self->_generate_simple_clear('$_[0]', $name, $spec)."\n"
       ;
   }
@@ -237,6 +248,13 @@ sub _generate_get {
   }
 }
 
+sub generate_simple_has {
+  my $self = shift;
+  $self->{captures} = {};
+  my $code = $self->_generate_simple_has(@_);
+  ($code, delete $self->{captures});
+}
+
 sub _generate_simple_has {
   my ($self, $me, $name) = @_;
   "exists ${me}->{${\perlstring $name}}";
@@ -254,6 +272,13 @@ sub generate_get_default {
   ($code, delete $self->{captures});
 }
 
+sub generate_use_default {
+  my $self = shift;
+  $self->{captures} = {};
+  my $code = $self->_generate_use_default(@_);
+  ($code, delete $self->{captures});
+}
+
 sub _generate_use_default {
   my ($self, $me, $name, $spec, $test) = @_;
   my $get_value = $self->_generate_get_default($me, $name, $spec);
@@ -314,7 +339,7 @@ sub _generate_set {
       $code = "do { my \$self = shift;\n";
     }
     if ($isa_check) {
-      $code .= 
+      $code .=
         "        ".$self->_generate_isa_check($name, $value_store, $isa_check).";\n";
     }
     my $simple = $self->_generate_simple_set('$self', $name, $spec, $value_store);
@@ -353,7 +378,7 @@ sub _generate_coerce {
     $self->_generate_call_code($name, 'coerce', "${value}", $coerce)
   );
 }
- 
+
 sub generate_trigger {
   my $self = shift;
   $self->{captures} = {};
@@ -374,29 +399,15 @@ sub generate_isa_check {
 }
 
 sub _generate_die_prefix {
-  my ($self, $name, $prefix, $init_arg, $inside) = @_;
-  
-  $self->{captures}{'$__DIE__'} ||= \ sub {
-    our ($CurrentArgument, $CurrentAttribute, $CurrentStep, $OrigSigDie);
-    $OrigSigDie ||= sub { die $_[0] };
-    
-    $OrigSigDie->(
-      qq[$CurrentStep for "$CurrentAttribute"]
-      . ($CurrentArgument && ($CurrentArgument ne $CurrentAttribute)
-        ? qq[ (constructor argument: "$CurrentArgument")]
-        : "")
-      . qq[ failed: $_[0]]
-    );
-  };
-  
+  my ($self, $name, $prefix, $arg, $inside) = @_;
   "do {\n"
-  ."  local \$Method::Generate::Accessor::CurrentArgument = "
-    ."${\B::perlstring($init_arg)};\n"
-  ."  local \$Method::Generate::Accessor::CurrentAttribute = "
-    ."${\B::perlstring($name)};\n"
-  ."  local \$Method::Generate::Accessor::CurrentStep = q[$prefix];\n"
+  .'  local $Method::Generate::Accessor::CurrentAttribute = {'
+  .'    init_arg => '.(defined $arg ? B::perlstring($arg) : 'undef') . ",\n"
+  .'    name     => '.B::perlstring($name).",\n"
+  .'    step     => '.B::perlstring($prefix).",\n"
+  ."  };\n"
   .'  local $Method::Generate::Accessor::OrigSigDie = $SIG{__DIE__};'."\n"
-  .'  local $SIG{__DIE__} = $__DIE__;'."\n"
+  .'  local $SIG{__DIE__} = \&Method::Generate::Accessor::_SIGDIE;'."\n"
   .$inside
   ."}\n"
 }
@@ -449,9 +460,9 @@ sub _generate_populate_set {
   if ($self->has_eager_default($name, $spec)) {
     my $get_indent = ' ' x ($spec->{isa} ? 6 : 4);
     my $get_default = $self->_generate_get_default(
-                        '$new', $_, $spec
+                        '$new', $name, $spec
                       );
-    my $get_value = 
+    my $get_value =
       defined($spec->{init_arg})
         ? "(\n${get_indent}  ${test}\n${get_indent}   ? ${source}\n${get_indent}   : "
             .$get_default