From: Jesse Luehrs Date: Fri, 17 Jun 2011 22:42:56 +0000 (-0500) Subject: move eval_environment for accessors to the attribute metaclass X-Git-Tag: 2.0102~6 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f7db8e3557183a77d28f7adb54e018c99c16bdb0;p=gitmo%2FMoose.git move eval_environment for accessors to the attribute metaclass --- diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index db8b1e7..0b348d2 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -746,6 +746,44 @@ sub _inline_trigger { return '$trigger->(' . $instance . ', ' . $value . ', ' . $old . ');'; } +sub _eval_environment { + my $self = shift; + + my $env = { }; + + $env->{'$trigger'} = \($self->trigger) + if $self->has_trigger; + $env->{'$attr_default'} = \($self->default) + if $self->has_default; + + if ($self->has_type_constraint) { + my $tc_obj = $self->type_constraint; + + $env->{'$type_constraint'} = \( + $tc_obj->_compiled_type_constraint + ) unless $tc_obj->can_be_inlined; + # these two could probably get inlined versions too + $env->{'$type_coercion'} = \( + $tc_obj->coercion->_compiled_type_coercion + ) if $tc_obj->has_coercion; + $env->{'$type_message'} = \( + $tc_obj->has_message ? $tc_obj->message : $tc_obj->_default_message + ); + + $env = { %$env, %{ $tc_obj->inline_environment } }; + } + + # XXX ugh, fix these + $env->{'$attr'} = \$self + if $self->has_initializer && $self->is_lazy; + # pretty sure this is only going to be closed over if you use a custom + # error class at this point, but we should still get rid of this + # at some point + $env->{'$meta'} = \($self->associated_class); + + return $env; +} + sub _weaken_value { my ( $self, $instance ) = @_; diff --git a/lib/Moose/Meta/Method/Accessor.pm b/lib/Moose/Meta/Method/Accessor.pm index e5da1f6..f6ec575 100644 --- a/lib/Moose/Meta/Method/Accessor.pm +++ b/lib/Moose/Meta/Method/Accessor.pm @@ -43,42 +43,7 @@ sub _compile_code { sub _eval_environment { my $self = shift; - - my $env = { }; - - my $attr = $self->associated_attribute; - - $env->{'$trigger'} = \($attr->trigger) - if $attr->has_trigger; - $env->{'$attr_default'} = \($attr->default) - if $attr->has_default; - - if ($attr->has_type_constraint) { - my $tc_obj = $attr->type_constraint; - - $env->{'$type_constraint'} = \( - $tc_obj->_compiled_type_constraint - ) unless $tc_obj->can_be_inlined; - # these two could probably get inlined versions too - $env->{'$type_coercion'} = \( - $tc_obj->coercion->_compiled_type_coercion - ) if $tc_obj->has_coercion; - $env->{'$type_message'} = \( - $tc_obj->has_message ? $tc_obj->message : $tc_obj->_default_message - ); - - $env = { %$env, %{ $tc_obj->inline_environment } }; - } - - # XXX ugh, fix these - $env->{'$attr'} = \$attr - if $attr->has_initializer && $attr->is_lazy; - # pretty sure this is only going to be closed over if you use a custom - # error class at this point, but we should still get rid of this - # at some point - $env->{'$meta'} = \($self->associated_metaclass); - - return $env; + return $self->associated_attribute->_eval_environment; } sub _instance_is_inlinable {