From: Florian Ragwitz <rafl@debian.org>
Date: Thu, 30 Jul 2009 12:19:36 +0000 (+0200)
Subject: Allow MetaRole to operate on metaclass instances, instead of just package names.
X-Git-Tag: 0.90~38
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=114134a5bc109d982f171e8458084b0d9e7de4c4;p=gitmo%2FMoose.git

Allow MetaRole to operate on metaclass instances, instead of just package names.
---

diff --git a/lib/Moose/Util/MetaRole.pm b/lib/Moose/Util/MetaRole.pm
index 9943785..b01c99c 100644
--- a/lib/Moose/Util/MetaRole.pm
+++ b/lib/Moose/Util/MetaRole.pm
@@ -2,6 +2,7 @@ package Moose::Util::MetaRole;
 
 use strict;
 use warnings;
+use Scalar::Util 'blessed';
 
 our $VERSION   = '0.89_02';
 $VERSION = eval $VERSION;
@@ -14,10 +15,12 @@ my @Classes = qw( constructor_class destructor_class error_class );
 sub apply_metaclass_roles {
     my %options = @_;
 
-    my $for = $options{for_class};
+    my $for = blessed $options{for_class}
+        ? $options{for_class}
+        : Class::MOP::class_of($options{for_class});
 
-    my %old_classes = map { $_ => Class::MOP::class_of($for)->$_ }
-                      grep { Class::MOP::class_of($for)->can($_) }
+    my %old_classes = map { $_ => $for->$_ }
+                      grep { $for->can($_) }
                       @Classes;
 
     my $meta = _make_new_metaclass( $for, \%options );
@@ -43,7 +46,7 @@ sub _make_new_metaclass {
     my $for     = shift;
     my $options = shift;
 
-    return Class::MOP::class_of($for)
+    return $for
         unless grep { exists $options->{ $_ . '_roles' } }
             qw(
             metaclass
@@ -56,15 +59,14 @@ sub _make_new_metaclass {
             application_to_instance_class
     );
 
-    my $old_meta = Class::MOP::class_of($for);
     my $new_metaclass
-        = _make_new_class( ref $old_meta, $options->{metaclass_roles} );
+        = _make_new_class( ref $for, $options->{metaclass_roles} );
 
     # This could get called for a Moose::Meta::Role as well as a Moose::Meta::Class
     my %classes = map {
-        $_ => _make_new_class( $old_meta->$_(), $options->{ $_ . '_roles' } )
+        $_ => _make_new_class( $for->$_(), $options->{ $_ . '_roles' } )
         }
-        grep { $old_meta->can($_) }
+        grep { $for->can($_) }
         qw(
         attribute_metaclass
         method_metaclass
diff --git a/t/050_metaclasses/015_metarole.t b/t/050_metaclasses/015_metarole.t
index 79833c3..aaa89e9 100644
--- a/t/050_metaclasses/015_metarole.t
+++ b/t/050_metaclasses/015_metarole.t
@@ -36,7 +36,7 @@ use Moose::Util::MetaRole;
 
 {
     Moose::Util::MetaRole::apply_metaclass_roles(
-        for_class       => 'My::Class',
+        for_class       => My::Class->meta,
         metaclass_roles => ['Role::Foo'],
     );