lib/MooseX/ClassAttribute/Trait/CompositeRole.pm

   1 package MooseX::ClassAttribute::Trait::CompositeRole;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Moose::Util::MetaRole;
   7 use Moose::Util qw(does_role);
   8
   9 use namespace::autoclean;
  10 use Moose::Role;
  11
  12 with 'MooseX::ClassAttribute::Trait::Role';
  13
  14 sub _merge_class_attributes {
  15     my $self = shift;
  16
  17     my @all_attributes;
  18     foreach my $role ( @{ $self->get_roles } ) {
  19         if ( does_role( $role, 'MooseX::ClassAttribute::Trait::Role' ) ) {
  20             push @all_attributes,
  21                 map { $role->get_class_attribute($_) }
  22                 $role->get_class_attribute_list;
  23         }
  24     }
  25
  26     my %seen;
  27
  28     foreach my $attribute (@all_attributes) {
  29         my $name = $attribute->name;
  30         if ( exists $seen{$name} ) {
  31             next if $seen{$name} == $attribute;
  32
  33             require Moose;
  34             Moose->throw_error( "Role '"
  35                     . $self->name()
  36                     . "' has encountered a class attribute conflict "
  37                     . "during composition. This is fatal error and cannot be disambiguated."
  38             );
  39         }
  40         $seen{$name} = $attribute;
  41     }
  42     foreach my $attribute (@all_attributes) {
  43         $self->add_class_attribute( $attribute->clone() );
  44     }
  45
  46     return keys %seen;
  47 }
  48
  49 around apply_params => sub {
  50     my ( $orig, $self, @args ) = @_;
  51
  52     my $metarole = Moose::Util::MetaRole::apply_metaroles(
  53         for            => $self->$orig(@args),
  54         role_metaroles => {
  55             application_to_class =>
  56                 ['MooseX::ClassAttribute::Trait::Application::ToClass'],
  57             application_to_role =>
  58                 ['MooseX::ClassAttribute::Trait::Application::ToRole'],
  59         },
  60     );
  61     $metarole->_merge_class_attributes;
  62     return $metarole;
  63 };
  64
  65 1;
  66
  67 # ABSTRACT: A trait that supports applying multiple roles at once
  68
  69 __END__
  70
  71 =pod
  72
  73 =head1 DESCRIPTION
  74
  75 This trait is used to allow the application of multiple roles (one
  76 or more of which contain class attributes) to a class or role.
  77
  78 =head1 BUGS
  79
  80 See L<MooseX::ClassAttribute> for details.
  81
  82 =cut