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

   1 package MooseX::ClassAttribute::Trait::Application::ToInstance;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Class::MOP;
   7
   8 use namespace::autoclean;
   9 use Moose::Role;
  10
  11 after apply => sub {
  12     shift->apply_class_attributes(@_);
  13 };
  14
  15 sub apply_class_attributes {
  16     my $self   = shift;
  17     my $role   = shift;
  18     my $object = shift;
  19
  20     my $class = Moose::Util::MetaRole::apply_metaclass_roles(
  21         for             => ref $object,
  22         class_metaroles => {
  23             class => ['MooseX::ClassAttribute::Trait::Class'],
  24         },
  25     );
  26
  27     my $attr_metaclass = $class->attribute_metaclass();
  28
  29     foreach my $attribute_name ( $role->get_class_attribute_list() ) {
  30         if (   $class->has_class_attribute($attribute_name)
  31             && $class->get_class_attribute($attribute_name)
  32             != $role->get_class_attribute($attribute_name) ) {
  33             next;
  34         }
  35         else {
  36             $class->add_class_attribute(
  37                 $role->get_class_attribute($attribute_name)
  38                     ->attribute_for_class($attr_metaclass) );
  39         }
  40     }
  41 }
  42
  43 1;
  44
  45 __END__
  46
  47 =pod
  48
  49 =head1 NAME
  50
  51 MooseX::ClassAttribute::Trait::Application::ToClass - A trait that supports applying class attributes to instances
  52
  53 =head1 DESCRIPTION
  54
  55 This trait is used to allow the application of roles containing class
  56 attributes to object instances.
  57
  58 =head1 AUTHOR
  59
  60 Dave Rolsky, C<< <autarch@urth.org> >>
  61
  62 =head1 BUGS
  63
  64 See L<MooseX::ClassAttribute> for details.
  65
  66 =head1 COPYRIGHT & LICENSE
  67
  68 Copyright 2007-2008 Dave Rolsky, All Rights Reserved.
  69
  70 This program is free software; you can redistribute it and/or modify
  71 it under the same terms as Perl itself.
  72
  73 =cut