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

   1 package MooseX::ClassAttribute::Trait::Application::ToClass;
   2
   3 use strict;
   4 use warnings;
   5
   6 use namespace::autoclean;
   7 use Moose::Role;
   8
   9 with 'MooseX::ClassAttribute::Trait::Application';
  10
  11 around apply => sub {
  12     my $orig  = shift;
  13     my $self  = shift;
  14     my $role  = shift;
  15     my $class = shift;
  16
  17     $class = Moose::Util::MetaRole::apply_metaroles(
  18         for             => $class,
  19         class_metaroles => {
  20             class => ['MooseX::ClassAttribute::Trait::Class'],
  21         },
  22     );
  23
  24     $self->$orig( $role, $class );
  25 };
  26
  27 sub _apply_class_attributes {
  28     my $self  = shift;
  29     my $role  = shift;
  30     my $class = shift;
  31
  32     my $attr_metaclass = $class->attribute_metaclass();
  33
  34     foreach my $attribute_name ( $role->get_class_attribute_list() ) {
  35         if (   $class->has_class_attribute($attribute_name)
  36             && $class->get_class_attribute($attribute_name)
  37             != $role->get_class_attribute($attribute_name) ) {
  38             next;
  39         }
  40         else {
  41             $class->add_class_attribute(
  42                 $role->get_class_attribute($attribute_name)
  43                     ->attribute_for_class($attr_metaclass) );
  44         }
  45     }
  46 }
  47
  48 1;
  49
  50 # ABSTRACT: A trait that supports applying class attributes to classes
  51
  52 __END__
  53
  54 =pod
  55
  56 =head1 DESCRIPTION
  57
  58 This trait is used to allow the application of roles containing class
  59 attributes to classes.
  60
  61 =head1 BUGS
  62
  63 See L<MooseX::ClassAttribute> for details.
  64
  65 =cut