lib/MooseX/ClassAttribute/Trait/Application/ToRole.pm

   1 package MooseX::ClassAttribute::Trait::Application::ToRole;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION   = '0.11';
   7
   8 use Moose::Util::MetaRole;
   9 use MooseX::ClassAttribute::Trait::Application::ToClass;
  10
  11 use namespace::autoclean;
  12 use Moose::Role;
  13
  14 with 'MooseX::ClassAttribute::Trait::Application';
  15
  16 sub _apply_class_attributes {
  17     my $self  = shift;
  18     my $role1 = shift;
  19     my $role2 = shift;
  20
  21     $role2 = Moose::Util::MetaRole::apply_metaclass_roles(
  22         for            => $role2,
  23         role_metaroles => {
  24             role => ['MooseX::ClassAttribute::Trait::Role'],
  25             application_to_class =>
  26                 ['MooseX::ClassAttribute::Trait::Application::ToClass'],
  27             application_to_role =>
  28                 ['MooseX::ClassAttribute::Trait::Application::ToRole'],
  29         },
  30     );
  31
  32     foreach my $attribute_name ( $role1->get_class_attribute_list() ) {
  33         if (   $role2->has_class_attribute($attribute_name)
  34             && $role2->get_class_attribute($attribute_name)
  35             != $role1->get_class_attribute($attribute_name) ) {
  36
  37             require Moose;
  38             Moose->throw_error( "Role '"
  39                     . $role1->name()
  40                     . "' has encountered a class attribute conflict "
  41                     . "during composition. This is fatal error and cannot be disambiguated."
  42             );
  43         }
  44         else {
  45             $role2->add_class_attribute(
  46                 $role1->get_class_attribute($attribute_name)->clone() );
  47         }
  48     }
  49 }
  50
  51 1;
  52
  53 __END__
  54
  55 =pod
  56
  57 =head1 NAME
  58
  59 MooseX::ClassAttribute::Trait::Application::ToRole - A trait that supports applying class attributes to roles
  60
  61 =head1 DESCRIPTION
  62
  63 This trait is used to allow the application of roles containing class
  64 attributes to roles.
  65
  66 =head1 AUTHOR
  67
  68 Dave Rolsky, C<< <autarch@urth.org> >>
  69
  70 =head1 BUGS
  71
  72 See L<MooseX::ClassAttribute> for details.
  73
  74 =head1 COPYRIGHT & LICENSE
  75
  76 Copyright 2007-2010 Dave Rolsky, All Rights Reserved.
  77
  78 This program is free software; you can redistribute it and/or modify
  79 it under the same terms as Perl itself.
  80
  81 =cut