make use of definition_context
Yuval Kogman [Mon, 12 Jan 2009 05:53:32 +0000 (05:53 +0000)]
lib/Moose.pm
lib/Moose/Meta/Attribute.pm
lib/Moose/Meta/Method/Accessor.pm

index 504096a..cae4f54 100644 (file)
@@ -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;
 }
index abb3dec..2e61cdb 100644 (file)
@@ -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 }
index fa7a2b7..1525412 100644 (file)
@@ -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 {