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=7c3cf1f94484a9767169a974cb16f3f7087588b1;hpb=7754d2062ba80b30058d8815bb22e2abaa2b4dcc;p=gitmo%2FMoo.git diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm index 7c3cf1f..d0ab970 100644 --- a/lib/Method/Generate/Accessor.pm +++ b/lib/Method/Generate/Accessor.pm @@ -21,12 +21,14 @@ BEGIN { sub _SIGDIE { our ($CurrentAttribute, $OrigSigDie); - $OrigSigDie ||= sub { die $_[0] }; - - return $OrigSigDie->(@_) if ref($_[0]); - + my $sigdie = $OrigSigDie && $OrigSigDie != \&_SIGDIE + ? $OrigSigDie + : sub { die $_[0] }; + + return $sigdie->(@_) if ref($_[0]); + my $attr_desc = _attr_desc(@$CurrentAttribute{qw(name init_arg)}); - $OrigSigDie->("$CurrentAttribute->{step} for $attr_desc failed: $_[0]"); + $sigdie->("$CurrentAttribute->{step} for $attr_desc failed: $_[0]"); } sub _die_overwrite @@ -56,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; } @@ -170,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" ; } @@ -248,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}}"; @@ -265,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); @@ -325,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); @@ -364,7 +378,7 @@ sub _generate_coerce { $self->_generate_call_code($name, 'coerce', "${value}", $coerce) ); } - + sub generate_trigger { my $self = shift; $self->{captures} = {}; @@ -446,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