1 package Moose::Util::MetaRole;
5 use Scalar::Util 'blessed';
8 $VERSION = eval $VERSION;
9 our $AUTHORITY = 'cpan:STEVAN';
11 use List::MoreUtils qw( all );
12 use List::Util qw( first );
13 use Moose::Deprecated;
15 sub apply_metaclass_roles {
16 Moose::Deprecated::deprecated(
17 feature => 'pre-0.94 MetaRole API',
19 'The old Moose::Util::MetaRole API (before version 0.94) has been deprecated'
22 goto &apply_metaroles;
28 _fixup_old_style_args(\%args);
29 Carp::cluck('applying') if $::D;
33 : Class::MOP::class_of( $args{for} );
35 if ( $for->isa('Moose::Meta::Role') ) {
36 return _make_new_metaclass( $for, $args{role_metaroles}, 'role' );
39 return _make_new_metaclass( $for, $args{class_metaroles}, 'class' );
43 sub _fixup_old_style_args {
46 return if $args->{class_metaroles} || $args->{role_metaroles};
48 Moose::Deprecated::deprecated(
49 feature => 'pre-0.94 MetaRole API',
51 'The old Moose::Util::MetaRole API (before version 0.94) has been deprecated'
54 $args->{for} = delete $args->{for_class}
55 if exists $args->{for_class};
58 attribute_metaclass_roles
59 method_metaclass_roles
60 wrapped_method_metaclass_roles
61 instance_metaclass_roles
62 constructor_class_roles
63 destructor_class_roles
66 application_to_class_class_roles
67 application_to_role_class_roles
68 application_to_instance_class_roles
69 application_role_summation_class_roles
73 = blessed $args->{for}
75 : Class::MOP::class_of( $args->{for} );
78 if ( $for->isa('Moose::Meta::Class') ) {
79 $top_key = 'class_metaroles';
81 $args->{class_metaroles}{class} = delete $args->{metaclass_roles}
82 if exists $args->{metaclass_roles};
85 $top_key = 'role_metaroles';
87 $args->{role_metaroles}{role} = delete $args->{metaclass_roles}
88 if exists $args->{metaclass_roles};
91 for my $old_key (@old_keys) {
92 my ($new_key) = $old_key =~ /^(.+)_(?:class|metaclass)_roles$/;
94 $args->{$top_key}{$new_key} = delete $args->{$old_key}
95 if exists $args->{$old_key};
101 sub _make_new_metaclass {
106 return $for unless keys %{$roles};
109 = exists $roles->{$primary}
110 ? _make_new_class( ref $for, $roles->{$primary} )
115 for my $key ( grep { $_ ne $primary } keys %{$roles} ) {
116 my $attr = first {$_}
117 map { $for->meta->find_attribute_by_name($_) } (
122 my $reader = $attr->get_read_method;
124 $classes{ $attr->init_arg }
125 = _make_new_class( $for->$reader(), $roles->{$key} );
128 my $new_meta = $new_metaclass->reinitialize( $for, %classes );
133 sub apply_base_class_roles {
136 my $for = $args{for} || $args{for_class};
138 my $meta = Class::MOP::class_of($for);
140 my $new_base = _make_new_class(
143 [ $meta->superclasses() ],
146 $meta->superclasses($new_base)
147 if $new_base ne $meta->name();
150 sub _make_new_class {
151 my $existing_class = shift;
153 my $superclasses = shift || [$existing_class];
155 return $existing_class unless $roles;
157 my $meta = Class::MOP::Class->initialize($existing_class);
159 return $existing_class
160 if $meta->can('does_role') && all { $meta->does_role($_) }
161 grep { !ref $_ } @{$roles};
163 return Moose::Meta::Class->create_anon_class(
164 superclasses => $superclasses,
176 Moose::Util::MetaRole - Apply roles to any metaclass, as well as the object base class
180 package MyApp::Moose;
184 use Moose::Util::MetaRole;
186 use MyApp::Role::Meta::Class;
187 use MyApp::Role::Meta::Method::Constructor;
188 use MyApp::Role::Object;
190 Moose::Exporter->setup_import_methods( also => 'Moose' );
196 Moose->init_meta(%args);
198 Moose::Util::MetaRole::apply_metaroles(
199 for => $args{for_class},
201 class => => ['MyApp::Role::Meta::Class'],
202 constructor => ['MyApp::Role::Meta::Method::Constructor'],
206 Moose::Util::MetaRole::apply_base_class_roles(
207 for => $args{for_class},
208 roles => ['MyApp::Role::Object'],
211 return $args{for_class}->meta();
216 This utility module is designed to help authors of Moose extensions
217 write extensions that are able to cooperate with other Moose
218 extensions. To do this, you must write your extensions as roles, which
219 can then be dynamically applied to the caller's metaclasses.
221 This module makes sure to preserve any existing superclasses and roles
222 already set for the meta objects, which means that any number of
223 extensions can apply roles in any order.
227 B<It is very important that you only call this module's functions when
228 your module is imported by the caller>. The process of applying roles
229 to the metaclass reinitializes the metaclass object, which wipes out
230 any existing attributes already defined. However, as long as you do
231 this when your module is imported, the caller should not have any
232 attributes defined yet.
234 The easiest way to ensure that this happens is to use
235 L<Moose::Exporter>, which can generate the appropriate C<init_meta>
236 method for you, and make sure it is called when imported.
240 This module provides two functions.
242 =head2 apply_metaroles( ... )
244 This function will apply roles to one or more metaclasses for the specified
245 class. It will return a new metaclass object for the class or role passed in
248 It accepts the following parameters:
254 This specifies the class or for which to alter the meta classes. This can be a
255 package name, or an appropriate meta-object (a L<Moose::Meta::Class> or
256 L<Moose::Meta::Role>).
258 =item * class_metaroles => \%roles
260 This is a hash reference specifying which metaroles will be applied to the
261 class metaclass and its contained metaclasses and helper classes.
263 Each key should in turn point to an array reference of role names.
265 It accepts the following keys:
287 =item * role_metaroles => \%roles
289 This is a hash reference specifying which metaroles will be applied to the
290 role metaclass and its contained metaclasses and helper classes.
292 It accepts the following keys:
302 =item required_method
304 =item conflicting_method
306 =item application_to_class
308 =item application_to_role
310 =item application_to_instance
312 =item application_role_summation
318 =head2 apply_base_class_roles( for => $class, roles => \@roles )
320 This function will apply the specified roles to the object's base class.
324 See L<Moose/BUGS> for details on reporting bugs.
328 Dave Rolsky E<lt>autarch@urth.orgE<gt>
330 =head1 COPYRIGHT AND LICENSE
332 Copyright 2009 by Infinity Interactive, Inc.
334 L<http://www.iinteractive.com>
336 This library is free software; you can redistribute it and/or modify
337 it under the same terms as Perl itself.