lib/Reaction/Role/Meta/Class.pm

   1 package Reaction::Role::Meta::Class;
   2
   3 use Moose::Role;
   4
   5 around initialize => sub {
   6     my $super = shift;
   7     my $class = shift;
   8     my $pkg   = shift;
   9     $super->($class, $pkg, 'attribute_metaclass' => 'Reaction::Meta::Attribute', @_ );
  10 };
  11
  12 around add_role => sub {
  13     my $orig = shift;
  14     my $self = shift;
  15     my ($role) = @_;
  16
  17     my @roles = grep { !$_->isa('Moose::Meta::Role::Composite') }
  18                      $role->calculate_all_roles;
  19     my @bad_roles = map { Moose::Util::does_role($_, 'MooseX::Role::Parameterized::Meta::Trait::Parameterized') ? $_->genitor->name : $_->name }
  20                     grep { $_->get_attribute_list > 0 }
  21                     grep { !Moose::Util::does_role($_->applied_attribute_metaclass, 'Reaction::Role::Meta::Attribute') }
  22                     @roles;
  23
  24     if (@bad_roles) {
  25         my $plural = @bad_roles > 1;
  26         warn "You are applying the role" . ($plural ? "s " : " ")
  27            . join(", ", @bad_roles)
  28            . " to the Reaction::Class " . $self->name
  29            . ", but " . ($plural ? "these roles do" : "that role does")
  30            . " not use Reaction::Role or"
  31            . " Reaction::Role::Parameterized. In Moose versions greater than"
  32            . " 2.0, this will cause the special behavior of Reaction"
  33            . " attributes to no longer be applied to attributes defined"
  34            . " in " . ($plural ? "these roles" : "this role")
  35            . ". You should replace 'use Moose::Role' with"
  36            . " 'use Reaction::Role' or 'use MooseX::Role::Parameterized' with"
  37            . " 'use Reaction::Role::Parameterized'.";
  38     }
  39
  40     $self->$orig(@_);
  41 } if Moose->VERSION >= 1.9900;
  42
  43 1;