lib/MooseX/ClassAttribute/Trait/Role/Composite.pm

   1 package MooseX::ClassAttribute::Trait::Role::Composite;
   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
  31         if ( exists $seen{$name} ) {
  32             next if $seen{$name} == $attribute;
  33
  34             require Moose;
  35             Moose->throw_error( "Role '"
  36                     . $self->name()
  37                     . "' has encountered a class attribute conflict "
  38                     . "during composition. This is fatal error and cannot be disambiguated."
  39             );
  40         }
  41
  42         $seen{$name} = $attribute;
  43     }
  44
  45     foreach my $attribute (@all_attributes) {
  46         $self->add_class_attribute( $attribute->clone() );
  47     }
  48
  49     return keys %seen;
  50 }
  51
  52 around apply_params => sub {
  53     my $orig = shift;
  54     my $self = shift;
  55
  56     $self->$orig(@_);
  57
  58     $self = Moose::Util::MetaRole::apply_metaroles(
  59         for            => $self,
  60         role_metaroles => {
  61             application_to_class =>
  62                 ['MooseX::ClassAttribute::Trait::Application::ToClass'],
  63             application_to_role =>
  64                 ['MooseX::ClassAttribute::Trait::Application::ToRole'],
  65         },
  66     );
  67
  68     $self->_merge_class_attributes();
  69
  70     return $self;
  71 };
  72
  73 1;
  74
  75 # ABSTRACT: A trait that supports applying multiple roles at once
  76
  77 __END__
  78
  79 =pod
  80
  81 =head1 DESCRIPTION
  82
  83 This trait is used to allow the application of multiple roles (one
  84 or more of which contain class attributes) to a class or role.
  85
  86 =head1 BUGS
  87
  88 See L<MooseX::ClassAttribute> for details.
  89
  90 =cut