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
}
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;
}
_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"
;
}
}
}
+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}}";
($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);
$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);
$self->_generate_call_code($name, 'coerce', "${value}", $coerce)
);
}
-
+
sub generate_trigger {
my $self = shift;
$self->{captures} = {};
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