From: Yuval Kogman Date: Mon, 12 Jan 2009 05:53:32 +0000 (+0000) Subject: make use of definition_context X-Git-Tag: 0.65~22 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5f06098eee2cfb99c34241ec54b642d46e1d76c9;p=gitmo%2FMoose.git make use of definition_context --- diff --git a/lib/Moose.pm b/lib/Moose.pm index 504096a..cae4f54 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -36,6 +36,13 @@ use Moose::Meta::Role::Application::ToInstance; use Moose::Util::TypeConstraints; use Moose::Util (); +sub _caller_info { + my $level = @_ ? ($_[0] + 1) : 2; + my %info; + @info{qw(package file line)} = caller($level); + return \%info; +} + sub throw_error { # FIXME This shift; @@ -74,7 +81,7 @@ sub has { my $class = shift; my $name = shift; croak 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1; - my %options = @_; + my %options = ( definition_context => _caller_info(), @_ ); my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ]; Class::MOP::Class->initialize($class)->add_attribute( $_, %options ) for @$attrs; } diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index abb3dec..2e61cdb 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -145,6 +145,7 @@ my @legal_options_for_inheritance = qw( default coerce required documentation lazy handles builder type_constraint + definition_context ); sub legal_options_for_inheritance { @legal_options_for_inheritance } diff --git a/lib/Moose/Meta/Method/Accessor.pm b/lib/Moose/Meta/Method/Accessor.pm index fa7a2b7..1525412 100644 --- a/lib/Moose/Meta/Method/Accessor.pm +++ b/lib/Moose/Meta/Method/Accessor.pm @@ -23,7 +23,7 @@ sub _eval_code { # set up the environment my $attr = $self->associated_attribute; my $attr_name = $attr->name; - my $meta = $self, + my $meta = $self; my $type_constraint_obj = $attr->type_constraint; my $type_constraint_name = $type_constraint_obj && $type_constraint_obj->name; @@ -32,10 +32,8 @@ sub _eval_code { : undef; #warn "code for $attr_name =>\n" . $code . "\n"; - my $sub = eval $code; - $self->throw_error("Could not create writer for '$attr_name' because $@ \n code: $code", error => $@, data => $code ) if $@; - return $sub; - + eval $self->_prepare_code( code => $code ) + or $self->throw_error("Could not create writer for '$attr_name' because $@ \n code: $code", error => $@, data => $code ); } sub generate_accessor_method_inline {