From: Jesse Luehrs <doy@tozt.net>
Date: Sun, 11 Mar 2012 01:06:41 +0000 (-0600)
Subject: move metarole application from init_meta to the end of import
X-Git-Tag: 2.0500~30
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=19ac4f065d22b4b61870c1968ccba160bc08eecb;p=gitmo%2FMoose.git

move metarole application from init_meta to the end of import

this should fix RT51561
---

diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm
index 46dc92b..8d41838 100644
--- a/lib/Moose/Exporter.pm
+++ b/lib/Moose/Exporter.pm
@@ -446,6 +446,18 @@ sub _make_import_sub {
             $did_init_meta = 1;
         }
 
+        {
+            # The metaroles will use Moose::Role, which in turn uses
+            # Moose::Exporter, which in turn sets $CALLER, so we need
+            # to protect against that.
+            local $CALLER = $CALLER;
+            _apply_metaroles(
+                $CALLER,
+                [$class, @$exports_from],
+                $meta_lookup
+            );
+        }
+
         if ( $did_init_meta && @{$traits} ) {
 
             # The traits will use Moose::Role, which in turn uses
@@ -512,6 +524,90 @@ sub _strip_meta_name {
     return ( $meta_name, @_ );
 }
 
+sub _apply_metaroles {
+    my ($class, $exports_from, $meta_lookup) = @_;
+
+    my $metaroles = _collect_metaroles($exports_from);
+    my $base_class_roles = delete $metaroles->{base_class_roles};
+
+    my $meta = $meta_lookup->($class);
+    # for instance, Moose.pm uses Moose::Util::TypeConstraints
+    return unless $meta;
+
+    Moose::Util::MetaRole::apply_metaroles(
+        for => $meta,
+        %$metaroles,
+    ) if keys %$metaroles;
+
+    Moose::Util::MetaRole::apply_base_class_roles(
+        for   => $meta,
+        roles => $base_class_roles,
+    ) if $meta->isa('Class::MOP::Class')
+      && $base_class_roles && @$base_class_roles;
+}
+
+sub _collect_metaroles {
+    my ($exports_from) = @_;
+
+    my @old_style_role_types = map { "${_}_roles" } qw(
+        metaclass
+        attribute_metaclass
+        method_metaclass
+        wrapped_method_metaclass
+        instance_metaclass
+        constructor_class
+        destructor_class
+        error_class
+    );
+
+    my %class_metaroles;
+    my %role_metaroles;
+    my @base_class_roles;
+    my %old_style_roles;
+
+    for my $exporter (@$exports_from) {
+        my $data = $EXPORT_SPEC{$exporter};
+
+        if (exists $data->{class_metaroles}) {
+            for my $type (keys %{ $data->{class_metaroles} }) {
+                push @{ $class_metaroles{$type} ||= [] },
+                     @{ $data->{class_metaroles}{$type} };
+            }
+        }
+
+        if (exists $data->{role_metaroles}) {
+            for my $type (keys %{ $data->{role_metaroles} }) {
+                push @{ $role_metaroles{$type} ||= [] },
+                     @{ $data->{role_metaroles}{$type} };
+            }
+        }
+
+        if (exists $data->{base_class_roles}) {
+            push @base_class_roles, @{ $data->{base_class_roles} };
+        }
+
+        for my $type (@old_style_role_types) {
+            if (exists $data->{$type}) {
+                push @{ $old_style_roles{$type} ||= [] },
+                     @{ $data->{$type} };
+            }
+        }
+    }
+
+    return {
+        (keys(%class_metaroles)
+            ? (class_metaroles  => \%class_metaroles)
+            : ()),
+        (keys(%role_metaroles)
+            ? (role_metaroles   => \%role_metaroles)
+            : ()),
+        (@base_class_roles
+            ? (base_class_roles => \@base_class_roles)
+            : ()),
+        %old_style_roles,
+    };
+}
+
 sub _apply_meta_traits {
     my ( $class, $traits, $meta_lookup ) = @_;
 
@@ -605,6 +701,9 @@ sub _remove_keywords {
     }
 }
 
+# maintain this for now for backcompat
+# make sure to return a sub to install in the same circumstances as previously
+# but this functionality now happens at the end of ->import
 sub _make_init_meta {
     shift;
     my $class          = shift;
@@ -638,29 +737,7 @@ sub _make_init_meta {
 
     return unless %new_style_roles || %old_style_roles || %base_class_roles;
 
-    return sub {
-        shift;
-        my %options = @_;
-
-        return unless $meta_lookup->( $options{for_class} );
-
-        if ( %new_style_roles || %old_style_roles ) {
-            Moose::Util::MetaRole::apply_metaroles(
-                for => $options{for_class},
-                %new_style_roles,
-                %old_style_roles,
-            );
-        }
-
-        Moose::Util::MetaRole::apply_base_class_roles(
-            for_class => $options{for_class},
-            %base_class_roles,
-            )
-            if $meta_lookup->( $options{for_class} )
-                ->isa('Moose::Meta::Class');
-
-        return $meta_lookup->( $options{for_class} );
-    };
+    return sub { };
 }
 
 sub import {
diff --git a/t/metaclasses/exporter_also_with_trait.t b/t/metaclasses/exporter_also_with_trait.t
new file mode 100644
index 0000000..42435e2
--- /dev/null
+++ b/t/metaclasses/exporter_also_with_trait.t
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Moose;
+
+BEGIN {
+    package My::Meta::Role;
+    use Moose::Role;
+    $INC{'My/Meta/Role.pm'} = __FILE__;
+}
+
+BEGIN {
+    package My::Exporter;
+    use Moose::Exporter;
+
+    Moose::Exporter->setup_import_methods(
+        also => ['Moose'],
+        class_metaroles => {
+            class => ['My::Meta::Role'],
+        },
+    );
+    $INC{'My/Exporter.pm'} = __FILE__;
+}
+
+{
+    package My::Class;
+    use My::Exporter;
+}
+
+{
+    my $meta = My::Class->meta;
+    isa_ok($meta, 'Moose::Meta::Class');
+    does_ok($meta, 'My::Meta::Role');
+}
+
+done_testing;