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 around apply => sub {
  15     my $orig  = shift;
  16     my $self  = shift;
  17     my $role1 = shift;
  18     my $role2 = shift;
  19
  20     $role2 = Moose::Util::MetaRole::apply_metaroles(
  21         for            => $role2,
  22         role_metaroles => {
  23             role => ['MooseX::ClassAttribute::Trait::Role'],
  24             application_to_class =>
  25                 ['MooseX::ClassAttribute::Trait::Application::ToClass'],
  26             application_to_role =>
  27                 ['MooseX::ClassAttribute::Trait::Application::ToRole'],
  28         },
  29     );
  30
  31     $self->$orig( $role1, $role2 );
  32 };
  33
  34 sub _apply_class_attributes {
  35     my $self  = shift;
  36     my $role1 = shift;
  37     my $role2 = shift;
  38
  39     foreach my $attribute_name ( $role1->get_class_attribute_list() ) {
  40         if (   $role2->has_class_attribute($attribute_name)
  41             && $role2->get_class_attribute($attribute_name)
  42             != $role1->get_class_attribute($attribute_name) ) {
  43
  44             require Moose;
  45             Moose->throw_error( "Role '"
  46                     . $role1->name()
  47                     . "' has encountered a class attribute conflict "
  48                     . "during composition. This is fatal error and cannot be disambiguated."
  49             );
  50         }
  51         else {
  52             $role2->add_class_attribute(
  53                 $role1->get_class_attribute($attribute_name)->clone() );
  54         }
  55     }
  56 }
  57
  58 1;
  59
  60 # ABSTRACT: A trait that supports applying class attributes to roles
  61
  62 __END__
  63
  64 =pod
  65
  66 =head1 DESCRIPTION
  67
  68 This trait is used to allow the application of roles containing class
  69 attributes to roles.
  70
  71 =head1 BUGS
  72
  73 See L<MooseX::ClassAttribute> for details.
  74
  75 =cut