1 package Moose::Util::MetaRole;
6 use List::MoreUtils qw( all );
8 sub apply_metaclass_roles {
11 my $for = $options{for_class};
13 my $meta = _make_new_metaclass( $for, \%options );
15 for my $tor_class ( grep { $options{ $_ . '_roles' } }
16 qw( constructor_class destructor_class ) ) {
18 my $class = _make_new_class(
20 $options{ $tor_class . '_roles' }
23 $meta->$tor_class($class);
29 sub _make_new_metaclass {
34 unless grep { exists $options->{ $_ . '_roles' } }
43 = _make_new_class( ref $for->meta(), $options->{metaclass_roles} );
45 my $old_meta = $for->meta();
47 Class::MOP::remove_metaclass_by_name($for);
50 $_ => _make_new_class( $old_meta->$_(), $options->{ $_ . '_roles' } )
57 return $new_metaclass->reinitialize( $for, %classes );
60 sub apply_base_class_roles {
63 my $for = $options{for_class};
65 my $meta = $for->meta();
67 my $new_base = _make_new_class(
70 [ $meta->superclasses() ],
73 $meta->superclasses($new_base)
74 if $new_base ne $meta->name();
78 my $existing_class = shift;
80 my $superclasses = shift || [$existing_class];
82 return $existing_class unless $roles;
84 my $meta = $existing_class->meta();
86 return $existing_class
87 if $meta->can('does_role') && all { $meta->does_role($_) } @{$roles};
89 return Moose::Meta::Class->create_anon_class(
90 superclasses => $superclasses,