lib/Moose/Meta/Attribute/Trait/InRole.pm

   1 package Moose::Meta::Attribute::Trait::InRole;
   2
   3 use Moose::Role;
   4
   5 use Carp 'confess';
   6 use Scalar::Util 'blessed', 'weaken';
   7
   8 our $VERSION   = '0.93';
   9 our $AUTHORITY = 'cpan:STEVAN';
  10
  11 around attach_to_class => sub {
  12     shift;
  13     my ( $self, $class ) = @_;
  14
  15     ( blessed($class) && $class->isa('Moose::Meta::Role') )
  16         || confess
  17         "You must pass a Moose::Meta::Role instance (or a subclass)";
  18
  19     weaken( $self->{'associated_class'} = $class );
  20 };
  21
  22 # XXX - This is a no-op, since trying to add accessors to a role just blows
  23 # up. Ideally, we _would_ add accessors, or somehow make the role aware that
  24 # they exist for the purposes of method conflict checking, etc.
  25 around install_accessors => sub { };
  26
  27 around _check_associated_methods => sub { };
  28
  29 around clone => sub {
  30     my $orig = shift;
  31     my $self = shift;
  32
  33     my $meta = $self->meta;
  34
  35     my @supers = $meta->superclasses();
  36     my @traits_to_keep = grep { $_ ne __PACKAGE__ }
  37         map  { $_->name }
  38         grep { !$_->isa('Moose::Meta::Role::Composite') }
  39         $meta->calculate_all_roles;
  40
  41     my $new_class;
  42
  43     if ( @traits_to_keep || @supers > 1 ) {
  44         my $anon_class = Moose::Meta::Class->create_anon_class(
  45             superclasses => \@supers,
  46             roles        => \@traits_to_keep,
  47             cache        => 1,
  48         );
  49
  50         $new_class = $anon_class->name;
  51     }
  52     else {
  53         $new_class = $supers[0];
  54     }
  55
  56     return $self->$orig( @_, metaclass => $new_class );
  57 };
  58
  59 no Moose::Role;
  60
  61 1;