1 package Mouse::Util::MetaRole;
2 use Mouse::Util; # enables strict and warnings
4 our @Classes = qw(constructor_class destructor_class);
6 sub apply_metaclass_roles {
9 my $for = Scalar::Util::blessed($options{for_class})
11 : Mouse::Util::class_of($options{for_class});
13 my %old_classes = map { $for->can($_) ? ($_ => $for->$_) : () }
16 my $meta = _make_new_metaclass( $for, \%options );
18 for my $c ( grep { $meta->can($_) } @Classes ) {
19 if ( $options{ $c . '_roles' } ) {
20 my $class = _make_new_class(
22 $options{ $c . '_roles' }
27 elsif($meta->$c ne $old_classes{$c}){
28 $meta->$c( $old_classes{$c} );
35 sub apply_base_class_roles {
38 my $for = $options{for_class};
40 my $meta = Mouse::Util::class_of($for);
42 my $new_base = _make_new_class(
45 [ $meta->superclasses() ],
48 $meta->superclasses($new_base)
49 if $new_base ne $meta->name();
60 sub _make_new_metaclass {
61 my($for, $options) = @_;
64 if !grep { exists $options->{ $_ . '_roles' } } @Metaclasses;
67 = _make_new_class( ref $for, $options->{metaclass_roles} );
69 # This could get called for a Mouse::Meta::Role as well as a Mouse::Meta::Class
71 $_ => _make_new_class( $for->$_(), $options->{ $_ . '_roles' } )
72 } grep { $for->can($_) } @Metaclasses;
74 return $new_metaclass->reinitialize( $for, %classes );
79 my($existing_class, $roles, $superclasses) = @_;
81 return $existing_class if !$roles;
83 my $meta = Mouse::Meta::Class->initialize($existing_class);
85 return $existing_class
86 if !grep { !ref($_) && !$meta->does_role($_) } @{$roles};
88 return Mouse::Meta::Class->create_anon_class(
89 superclasses => $superclasses ? $superclasses : [$existing_class],
101 Mouse::Util::MetaRole - Apply roles to any metaclass, as well as the object base class
105 package MyApp::Mouse;
109 use Mouse::Util::MetaRole;
111 use MyApp::Role::Meta::Class;
112 use MyApp::Role::Meta::Method::Constructor;
113 use MyApp::Role::Object;
115 Mouse::Exporter->setup_import_methods( also => 'Mouse' );
121 Mouse->init_meta(%options);
123 Mouse::Util::MetaRole::apply_metaclass_roles(
124 for_class => $options{for_class},
125 metaclass_roles => ['MyApp::Role::Meta::Class'],
126 constructor_class_roles => ['MyApp::Role::Meta::Method::Constructor'],
129 Mouse::Util::MetaRole::apply_base_class_roles(
130 for_class => $options{for_class},
131 roles => ['MyApp::Role::Object'],
134 return $options{for_class}->meta();
139 This utility module is designed to help authors of Mouse extensions
140 write extensions that are able to cooperate with other Mouse
141 extensions. To do this, you must write your extensions as roles, which
142 can then be dynamically applied to the caller's metaclasses.
144 This module makes sure to preserve any existing superclasses and roles
145 already set for the meta objects, which means that any number of
146 extensions can apply roles in any order.
150 B<It is very important that you only call this module's functions when
151 your module is imported by the caller>. The process of applying roles
152 to the metaclass reinitializes the metaclass object, which wipes out
153 any existing attributes already defined. However, as long as you do
154 this when your module is imported, the caller should not have any
155 attributes defined yet.
157 The easiest way to ensure that this happens is to use
158 L<Mouse::Exporter>, which can generate the appropriate C<init_meta>
159 method for you, and make sure it is called when imported.
163 This module provides two functions.
165 =head2 apply_metaclass_roles( ... )
167 This function will apply roles to one or more metaclasses for the
168 specified class. It accepts the following parameters:
172 =item * for_class => $name
174 This specifies the class for which to alter the meta classes.
176 =item * metaclass_roles => \@roles
178 =item * attribute_metaclass_roles => \@roles
180 =item * method_metaclass_roles => \@roles
182 =item * constructor_class_roles => \@roles
184 =item * destructor_class_roles => \@roles
186 These parameter all specify one or more roles to be applied to the
187 specified metaclass. You can pass any or all of these parameters at
192 =head2 apply_base_class_roles( for_class => $class, roles => \@roles )
194 This function will apply the specified roles to the object's base class.
198 L<Moose::Util::MetaRole>