From: Chris Prather <cprather@hdpublishing.com>
Date: Wed, 15 Apr 2009 00:27:01 +0000 (-0400)
Subject: make it so you can override the role metaclass just like the attribute metaclass... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5ed3b694540c8b2490e5683f5ef969824e723c38;p=gitmo%2FMoose.git

make it so you can override the role metaclass just like the attribute metaclass and the method metaclass
---

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index ceec428..5d93a16 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -41,17 +41,24 @@ __PACKAGE__->meta->add_attribute('error_class' => (
     default  => 'Moose::Error::Default',
 ));
 
+__PACKAGE__->meta->add_attribute('role_metaclass' => (
+    accessor => 'role_metaclass',
+    default => 'Moose::Meta::Role',
+));
+
 
 sub initialize {
     my $class = shift;
     my $pkg   = shift;
-    return Class::MOP::get_metaclass_by_name($pkg) 
-        || $class->SUPER::initialize($pkg,
+    if (my $meta = Class::MOP::get_metaclass_by_name($pkg)) {
+        return $meta;
+    }
+    return $class->SUPER::initialize($pkg,
                 'attribute_metaclass' => 'Moose::Meta::Attribute',
                 'method_metaclass'    => 'Moose::Meta::Method',
                 'instance_metaclass'  => 'Moose::Meta::Instance',
                 @_
-            );    
+            );
 }
 
 sub create {
diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm
index 2ca0c91..0a38454 100644
--- a/lib/Moose/Meta/Role.pm
+++ b/lib/Moose/Meta/Role.pm
@@ -119,6 +119,15 @@ foreach my $action (
 
 ## some things don't always fit, so they go here ...
 
+sub initialize {
+    my $class = shift;
+    my $pkg   = shift;
+    if (my $meta = Class::MOP::get_metaclass_by_name($pkg)) {
+        return $meta;
+    }
+    return $class->SUPER::initialize($pkg, @_);
+}
+
 sub add_attribute {
     my $self = shift;
     my $name = shift;
diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm
index e98b1b3..62defbb 100644
--- a/lib/Moose/Role.pm
+++ b/lib/Moose/Role.pm
@@ -139,6 +139,19 @@ sub init_meta {
     my $meta;
     if ($role->can('meta')) {
         $meta = $role->meta();
+        # we might have had metaclass called on us
+
+        if (blessed($meta) && $meta->isa('Moose::Meta::Class')) {
+            $metaclass = $meta->{'role_metaclass'} || $metaclass;
+            Class::MOP::remove_metaclass_by_name($role);
+            $meta = $metaclass->initialize($role);
+            $meta->add_method(
+                'meta' => sub {
+                    # re-initialize so it inherits properly
+                    $metaclass->initialize( ref($_[0]) || $_[0] );
+                }
+            );
+        }
 
         unless ( blessed($meta) && $meta->isa('Moose::Meta::Role') ) {
             require Moose;
@@ -147,7 +160,6 @@ sub init_meta {
     }
     else {
         $meta = $metaclass->initialize($role);
-
         $meta->add_method(
             'meta' => sub {
                 # re-initialize so it inherits properly
diff --git a/t/030_roles/038_role_metaclass.t b/t/030_roles/038_role_metaclass.t
new file mode 100644
index 0000000..bb9c0c2
--- /dev/null
+++ b/t/030_roles/038_role_metaclass.t
@@ -0,0 +1,34 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 1;
+use Moose ();
+
+BEGIN {
+
+    package My::Meta::Role;
+    use Moose;
+    extends 'Moose::Meta::Role';
+
+    has test_serial => (
+        is      => 'ro',
+        isa     => 'Int',
+        default => 1,
+    );
+    no Moose;
+
+}
+{
+
+    package MyRole;
+    use metaclass 'Moose::Meta::Class' =>
+        ( role_metaclass => 'My::Meta::Role' );
+    use Moose::Role;
+
+    no Moose::Role;
+};
+
+isa_ok( MyRole->meta, 'My::Meta::Role' );
+
+# my $role = MyRole->meta->create_anon_role;
+# is( $role->test_serial, 1, "default value for the serial attribute" );