really fix MetaRole API use
[gitmo/MooseX-ClassAttribute.git] / lib / MooseX / ClassAttribute / Trait / Application / ToRole.pm
1 package MooseX::ClassAttribute::Trait::Application::ToRole;
2
3 use strict;
4 use warnings;
5
6 use Moose::Util::MetaRole;
7 use MooseX::ClassAttribute::Trait::Application::ToClass;
8
9 use namespace::autoclean;
10 use Moose::Role;
11
12 with 'MooseX::ClassAttribute::Trait::Application';
13
14 sub _apply_class_attributes {
15     my $self  = shift;
16     my $role1 = shift;
17     my $role2 = shift;
18
19     $role2 = Moose::Util::MetaRole::apply_metaroles(
20         for            => $role2,
21         role_metaroles => {
22             role => ['MooseX::ClassAttribute::Trait::Role'],
23             application_to_class =>
24                 ['MooseX::ClassAttribute::Trait::Application::ToClass'],
25             application_to_role =>
26                 ['MooseX::ClassAttribute::Trait::Application::ToRole'],
27         },
28     );
29
30     foreach my $attribute_name ( $role1->get_class_attribute_list() ) {
31         if (   $role2->has_class_attribute($attribute_name)
32             && $role2->get_class_attribute($attribute_name)
33             != $role1->get_class_attribute($attribute_name) ) {
34
35             require Moose;
36             Moose->throw_error( "Role '"
37                     . $role1->name()
38                     . "' has encountered a class attribute conflict "
39                     . "during composition. This is fatal error and cannot be disambiguated."
40             );
41         }
42         else {
43             $role2->add_class_attribute(
44                 $role1->get_class_attribute($attribute_name)->clone() );
45         }
46     }
47 }
48
49 1;
50
51 # ABSTRACT: A trait that supports applying class attributes to roles
52
53 __END__
54
55 =pod
56
57 =head1 DESCRIPTION
58
59 This trait is used to allow the application of roles containing class
60 attributes to roles.
61
62 =head1 BUGS
63
64 See L<MooseX::ClassAttribute> for details.
65
66 =cut