Rename all MX::CA::Role::Meta packages to MX::CA::Trait, which is shorter and less...
[gitmo/MooseX-ClassAttribute.git] / lib / MooseX / ClassAttribute / Trait / Application / ToRole.pm
diff --git a/lib/MooseX/ClassAttribute/Trait/Application/ToRole.pm b/lib/MooseX/ClassAttribute/Trait/Application/ToRole.pm
new file mode 100644 (file)
index 0000000..b750f42
--- /dev/null
@@ -0,0 +1,53 @@
+package MooseX::ClassAttribute::Trait::Application::ToRole;
+
+use strict;
+use warnings;
+
+use Moose::Util::MetaRole;
+use MooseX::ClassAttribute::Trait::Application::ToClass;
+use MooseX::ClassAttribute::Trait::Application::ToInstance;
+
+use namespace::autoclean;
+use Moose::Role;
+
+with 'MooseX::ClassAttribute::Trait::Application';
+
+sub apply_class_attributes {
+    my $self  = shift;
+    my $role1 = shift;
+    my $role2 = shift;
+
+    $role2 = Moose::Util::MetaRole::apply_metaclass_roles(
+        for            => $role2,
+        role_metaroles => {
+            role => ['MooseX::ClassAttribute::Trait::Role'],
+            application_to_class =>
+                ['MooseX::ClassAttribute::Trait::Application::ToClass'],
+            application_to_role =>
+                ['MooseX::ClassAttribute::Trait::Application::ToRole'],
+            application_to_instance => [
+                'MooseX::ClassAttribute::Trait::Application::ToInstance'
+            ],
+        },
+    );
+
+    foreach my $attribute_name ( $role1->get_class_attribute_list() ) {
+        if (   $role2->has_class_attribute($attribute_name)
+            && $role2->get_class_attribute($attribute_name)
+            != $role1->get_class_attribute($attribute_name) ) {
+
+            require Moose;
+            Moose->throw_error( "Role '"
+                    . $role1->name()
+                    . "' has encountered a class attribute conflict "
+                    . "during composition. This is fatal error and cannot be disambiguated."
+            );
+        }
+        else {
+            $role2->add_class_attribute(
+                $role1->get_class_attribute($attribute_name)->clone() );
+        }
+    }
+}
+
+1;