local $self->{captures} = {};
my $body = do {
if ($is eq 'ro') {
- $self->_generate_get($name)
+ $self->_generate_get($name, $spec)
} elsif ($is eq 'rw') {
$self->_generate_getset($name, $spec)
} else {
}
sub _generate_get {
- my ($self, $name) = @_;
- $self->_generate_simple_get('$_[0]', $name);
+ my ($self, $name, $spec) = @_;
+ my $simple = $self->_generate_simple_get('$_[0]', $name);
+ my ($lazy, $default, $builder) = @{$spec}{qw(lazy default builder)};
+ return $simple unless $lazy and ($default or $builder);
+ 'do { '.$self->_generate_use_default(
+ '$_[0]', $name, $spec,
+ $self->_generate_simple_has('$_[0]', $name),
+ ).'; '.$simple.' }';
+}
+
+sub _generate_simple_has {
+ my ($self, $me, $name) = @_;
+ "exists ${me}->{${\perlstring $name}}";
+}
+
+sub generate_get_default {
+ my $self = shift;
+ local $self->{captures} = {};
+ my $code = $self->_generate_get_default(@_);
+ return ($code, $self->{captures});
+}
+
+sub _generate_use_default {
+ my ($self, $me, $name, $spec, $test) = @_;
+ $self->_generate_simple_set(
+ $me, $name, $self->_generate_get_default($me, $name, $spec)
+ ).' unless '.$test;
+}
+
+sub _generate_get_default {
+ my ($self, $me, $name, $spec) = @_;
+ $spec->{default}
+ ? $self->_generate_call_code($name, 'default', $me, $spec->{default})
+ : "${me}->${\$spec->{builder}}"
}
sub generate_simple_get {
sub _generate_set {
my ($self, $name, $value, $spec) = @_;
- my $simple = $self->_generate_simple_set($name, $value);
- if (my $trigger = $spec->{trigger}) {
- my $value = '$value';
+ my $simple = $self->_generate_simple_set('$_[0]', $name, $value);
+ my ($trigger, $isa_check) = @{$spec}{qw(trigger isa)};
+ return $simple unless $trigger or $isa_check;
+ my $code = 'do {';
+ if ($isa_check) {
+ $code .= ' '.$self->_generate_isa_check($name, '$_[1]', $isa_check).';';
+ }
+ if ($trigger) {
my $fire = $self->_generate_trigger($name, '$_[0]', '$value', $trigger);
- return 'do { '
- .'my $value = '.$simple.'; '.$fire.'; '
- .'$value }'
- ;
+ $code .=
+ ' my $value = '.$simple.'; '.$fire.'; '
+ .'$value';
+ } else {
+ $code .= ' '.$simple;
}
- return $simple;
+ $code .= ' }';
+ return $code;
}
sub generate_trigger {
sub _generate_trigger {
my ($self, $name, $obj, $value, $trigger) = @_;
- if (my $quoted = quoted_from_sub($trigger)) {
+ $self->_generate_call_code($name, 'trigger', "${obj}, ${value}", $trigger);
+}
+
+sub generate_isa_check {
+ my $self = shift;
+ local $self->{captures} = {};
+ my $code = $self->_generate_isa_check(@_);
+ return ($code, $self->{captures});
+}
+
+sub _generate_isa_check {
+ my ($self, $name, $value, $check) = @_;
+ $self->_generate_call_code($name, 'isa_check', $value, $check);
+}
+
+sub _generate_call_code {
+ my ($self, $name, $type, $values, $sub) = @_;
+ if (my $quoted = quoted_from_sub($sub)) {
my $code = $quoted->[1];
- my $at_ = 'local @_ = ('.join(', ', $obj, $value).');';
+ my $at_ = 'local @_ = ('.$values.');';
if (my $captures = $quoted->[2]) {
- my $cap_name = qq{\$trigger_captures_for_${name}};
+ my $cap_name = qq{\$${type}_captures_for_${name}};
$self->{captures}->{$cap_name} = \$captures;
return "do {\n".' '.$at_."\n"
.Sub::Quote::capture_unroll($cap_name, $captures, 6)
." ${code}\n }";
}
- return 'do { local @_ = ('.join(', ', $obj, $value).'); '.$code.' }';
+ return 'do { local @_ = ('.$values.'); '.$code.' }';
}
- my $cap_name = qq{\$trigger_for_${name}};
- $self->{captures}->{$cap_name} = \$trigger;
- return "${cap_name}->(${obj}, ${value})";
+ my $cap_name = qq{\$${type}_for_${name}};
+ $self->{captures}->{$cap_name} = \$sub;
+ return "${cap_name}->(${values})";
+}
+
+sub generate_simple_set {
+ my $self = shift;
+ local $self->{captures} = {};
+ my $code = $self->_generate_simple_set(@_);
+ return ($code, $self->{captures});
}
sub _generate_simple_set {
- my ($self, $name, $value) = @_;
+ my ($self, $me, $name, $value) = @_;
my $name_str = perlstring $name;
- "\$_[0]->{${name_str}} = ${value}";
+ "${me}->{${name_str}} = ${value}";
}
sub _generate_getset {