X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMethod%2FGenerate%2FAccessor.pm;h=d0ab97061a2654ea7cb7aa931bc0d2d3df78e169;hb=HEAD;hp=185de2c9fba310add72d4794a6b356e67799ae07;hpb=71f309e1fa1952d60c15525c01dfd12c8d10c392;p=gitmo%2FMoo.git diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm index 185de2c..d0ab970 100644 --- a/lib/Method/Generate/Accessor.pm +++ b/lib/Method/Generate/Accessor.pm @@ -21,9 +21,14 @@ BEGIN { sub _SIGDIE { our ($CurrentAttribute, $OrigSigDie); - $OrigSigDie ||= sub { die $_[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 @@ -53,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; } @@ -167,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" ; } @@ -245,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}}"; @@ -262,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); @@ -322,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); @@ -361,7 +378,7 @@ sub _generate_coerce { $self->_generate_call_code($name, 'coerce', "${value}", $coerce) ); } - + sub generate_trigger { my $self = shift; $self->{captures} = {}; @@ -443,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