# clearer doesn't have to be listed because it doesn't
# affect whether defined/exists makes a difference
!grep $spec->{$_},
- qw(lazy default builder isa trigger predicate weak_ref);
+ qw(lazy default builder coerce isa trigger predicate weak_ref);
}
sub is_simple_get {
sub is_simple_set {
my ($self, $name, $spec) = @_;
- !grep $spec->{$_}, qw(isa trigger weak_ref);
+ !grep $spec->{$_}, qw(coerce isa trigger weak_ref);
}
sub has_eager_default {
if ($self->is_simple_set($name, $spec)) {
$self->_generate_simple_set('$_[0]', $name, $spec, '$_[1]');
} else {
- my ($trigger, $isa_check) = @{$spec}{qw(trigger isa)};
+ my ($coerce, $trigger, $isa_check) = @{$spec}{qw(coerce trigger isa)};
my $simple = $self->_generate_simple_set('$self', $name, $spec, '$value');
my $code = "do { my (\$self, \$value) = \@_;\n";
+ if ($coerce) {
+ $code .=
+ " \$value = "
+ .$self->_generate_coerce($name, '$self', '$value', $coerce).";\n";
+ }
if ($isa_check) {
$code .=
" ".$self->_generate_isa_check($name, '$value', $isa_check).";\n";
$code;
}
}
-
+
+sub generate_coerce {
+ my $self = shift;
+ $self->{captures} = {};
+ my $code = $self->_generate_coerce(@_);
+ ($code, delete $self->{captures});
+}
+
+sub _generate_coerce {
+ my ($self, $name, $obj, $value, $coerce) = @_;
+ $self->_generate_call_code($name, 'coerce', "${value}", $coerce);
+}
+
sub generate_trigger {
my $self = shift;
$self->{captures} = {};
);
} else {
" if (${test}) {\n"
+ .($spec->{coerce}
+ ? " $source = "
+ .$self->_generate_coerce(
+ $name, $me, $source,
+ $spec->{coerce}
+ ).";\n"
+ : ""
+ )
.($spec->{isa}
? " "
.$self->_generate_isa_check(