Moved even more code up to Native/Writer

[gitmo/Moose.git] / lib / Moose / Meta / Attribute / Native / Trait.pm

diff --git a/lib/Moose/Meta/Attribute/Native/Trait.pm b/lib/Moose/Meta/Attribute/Native/Trait.pm
index c3b9212..6727e33 100644 (file)
--- a/lib/Moose/Meta/Attribute/Native/Trait.pm
+++ b/lib/Moose/Meta/Attribute/Native/Trait.pm
@@ -49,10 +49,11 @@ sub _check_handles_values {
     for my $original_method ( values %handles ) {
         my $name = $original_method->[0];
 
-        my $accessor_class
-            = $self->_native_accessor_class_root . '::' . $name;
+        my $accessor_class = $self->_native_accessor_class_for($name);
 
-        ( $accessor_class->can('new') || exists $method_constructors->{$name} )
+        # XXX - bridge code
+        ( ( $accessor_class && $accessor_class->can('new') )
+                || exists $method_constructors->{$name} )
             || confess "$name is an unsupported method type";
     }
 }
@@ -82,17 +83,19 @@ around '_make_delegation_method' => sub {
 
     my ( $name, @curried_args ) = @$method_to_call;
 
-    my $accessor_class
-        = $self->_native_accessor_class_root . '::' . $name;
+    my $accessor_class = $self->_native_accessor_class_for($name);
 
-    if ( $accessor_class->can('new') ) {
+    # XXX - bridge code
+    if ( $accessor_class && $accessor_class->can('new') ) {
         return $accessor_class->new(
             name              => $handle_name,
             package_name      => $self->associated_class->name,
             attribute         => $self,
             curried_arguments => \@curried_args,
+            root_types        => [ $self->_root_types ],
         );
     }
+    # XXX - bridge code
     else {
         my $method_constructors = $self->method_constructors;
 
@@ -113,10 +116,17 @@ around '_make_delegation_method' => sub {
     }
 };
 
-sub _native_accessor_class_root {
-    my $self = shift;
+sub _root_types {
+    return $_[0]->_helper_type;
+}
+
+sub _native_accessor_class_for {
+    my ( $self, $suffix ) = @_;
+
+    # XXX - bridge code
+    return unless $self->can('_native_type');
 
-    return 'Moose::Meta::Method::Accessor::Native::' . $self->_native_type;
+    return 'Moose::Meta::Method::Accessor::Native::' . $self->_native_type . '::' . $suffix;
 }
 
 has 'method_constructors' => (