From: Dave Rolsky <autarch@urth.org>
Date: Fri, 17 Sep 2010 23:19:50 +0000 (-0500)
Subject: Add some "bridge code" to keep old and new native traits all working
X-Git-Tag: 1.15~144
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ffc2e25f14e354132f1c4b93702ed016779493c6;p=gitmo%2FMoose.git

Add some "bridge code" to keep old and new native traits all working

Doing this so I can profile just the arrayref changes.
---

diff --git a/lib/Moose/Meta/Attribute/Native/Trait.pm b/lib/Moose/Meta/Attribute/Native/Trait.pm
index c3b9212..2a77fca 100644
--- 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,10 +83,10 @@ 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,
@@ -93,6 +94,7 @@ around '_make_delegation_method' => sub {
             curried_arguments => \@curried_args,
         );
     }
+    # XXX - bridge code
     else {
         my $method_constructors = $self->method_constructors;
 
@@ -113,10 +115,13 @@ around '_make_delegation_method' => sub {
     }
 };
 
-sub _native_accessor_class_root {
-    my $self = shift;
+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' => (