Commit | Line | Data |
231be3be |
1 | package Moose::Util::MetaRole; |
2 | |
3 | use strict; |
4 | use warnings; |
114134a5 |
5 | use Scalar::Util 'blessed'; |
231be3be |
6 | |
7 | use List::MoreUtils qw( all ); |
f785aad8 |
8 | use List::Util qw( first ); |
3b400403 |
9 | use Moose::Deprecated; |
8f05895e |
10 | |
231be3be |
11 | sub apply_metaclass_roles { |
3b400403 |
12 | Moose::Deprecated::deprecated( |
13 | feature => 'pre-0.94 MetaRole API', |
14 | message => |
15 | 'The old Moose::Util::MetaRole API (before version 0.94) has been deprecated' |
16 | ); |
17 | |
f785aad8 |
18 | goto &apply_metaroles; |
19 | } |
20 | |
21 | sub apply_metaroles { |
22 | my %args = @_; |
23 | |
24 | _fixup_old_style_args(\%args); |
39e7855c |
25 | |
f785aad8 |
26 | my $for |
27 | = blessed $args{for} |
28 | ? $args{for} |
29 | : Class::MOP::class_of( $args{for} ); |
30 | |
31 | if ( $for->isa('Moose::Meta::Role') ) { |
32 | return _make_new_metaclass( $for, $args{role_metaroles}, 'role' ); |
33 | } |
34 | else { |
35 | return _make_new_metaclass( $for, $args{class_metaroles}, 'class' ); |
231be3be |
36 | } |
f785aad8 |
37 | } |
38 | |
39 | sub _fixup_old_style_args { |
40 | my $args = shift; |
41 | |
3b400403 |
42 | return if $args->{class_metaroles} || $args->{role_metaroles}; |
43 | |
44 | Moose::Deprecated::deprecated( |
45 | feature => 'pre-0.94 MetaRole API', |
46 | message => |
47 | 'The old Moose::Util::MetaRole API (before version 0.94) has been deprecated' |
48 | ); |
f785aad8 |
49 | |
50 | $args->{for} = delete $args->{for_class} |
51 | if exists $args->{for_class}; |
52 | |
53 | my @old_keys = qw( |
54 | attribute_metaclass_roles |
55 | method_metaclass_roles |
56 | wrapped_method_metaclass_roles |
57 | instance_metaclass_roles |
58 | constructor_class_roles |
59 | destructor_class_roles |
60 | error_class_roles |
61 | |
62 | application_to_class_class_roles |
63 | application_to_role_class_roles |
64 | application_to_instance_class_roles |
65 | application_role_summation_class_roles |
66 | ); |
231be3be |
67 | |
f785aad8 |
68 | my $for |
69 | = blessed $args->{for} |
70 | ? $args->{for} |
71 | : Class::MOP::class_of( $args->{for} ); |
72 | |
73 | my $top_key; |
74 | if ( $for->isa('Moose::Meta::Class') ) { |
75 | $top_key = 'class_metaroles'; |
76 | |
77 | $args->{class_metaroles}{class} = delete $args->{metaclass_roles} |
78 | if exists $args->{metaclass_roles}; |
79 | } |
80 | else { |
81 | $top_key = 'role_metaroles'; |
82 | |
83 | $args->{role_metaroles}{role} = delete $args->{metaclass_roles} |
84 | if exists $args->{metaclass_roles}; |
85 | } |
86 | |
87 | for my $old_key (@old_keys) { |
88 | my ($new_key) = $old_key =~ /^(.+)_(?:class|metaclass)_roles$/; |
89 | |
90 | $args->{$top_key}{$new_key} = delete $args->{$old_key} |
91 | if exists $args->{$old_key}; |
92 | } |
93 | |
94 | return; |
231be3be |
95 | } |
96 | |
97 | sub _make_new_metaclass { |
98 | my $for = shift; |
f785aad8 |
99 | my $roles = shift; |
100 | my $primary = shift; |
101 | |
102 | return $for unless keys %{$roles}; |
231be3be |
103 | |
104 | my $new_metaclass |
f785aad8 |
105 | = exists $roles->{$primary} |
106 | ? _make_new_class( ref $for, $roles->{$primary} ) |
107 | : blessed $for; |
231be3be |
108 | |
f785aad8 |
109 | my %classes; |
110 | |
111 | for my $key ( grep { $_ ne $primary } keys %{$roles} ) { |
112 | my $attr = first {$_} |
113 | map { $for->meta->find_attribute_by_name($_) } ( |
114 | $key . '_metaclass', |
115 | $key . '_class' |
116 | ); |
117 | |
118 | my $reader = $attr->get_read_method; |
119 | |
120 | $classes{ $attr->init_arg } |
121 | = _make_new_class( $for->$reader(), $roles->{$key} ); |
122 | } |
123 | |
124 | my $new_meta = $new_metaclass->reinitialize( $for, %classes ); |
125 | |
126 | return $new_meta; |
231be3be |
127 | } |
128 | |
129 | sub apply_base_class_roles { |
f785aad8 |
130 | my %args = @_; |
231be3be |
131 | |
f785aad8 |
132 | my $for = $args{for} || $args{for_class}; |
231be3be |
133 | |
95f64261 |
134 | my $meta = Class::MOP::class_of($for); |
231be3be |
135 | |
136 | my $new_base = _make_new_class( |
137 | $for, |
f785aad8 |
138 | $args{roles}, |
231be3be |
139 | [ $meta->superclasses() ], |
140 | ); |
141 | |
142 | $meta->superclasses($new_base) |
143 | if $new_base ne $meta->name(); |
144 | } |
145 | |
146 | sub _make_new_class { |
147 | my $existing_class = shift; |
148 | my $roles = shift; |
149 | my $superclasses = shift || [$existing_class]; |
150 | |
151 | return $existing_class unless $roles; |
152 | |
8f05895e |
153 | my $meta = Class::MOP::Class->initialize($existing_class); |
231be3be |
154 | |
155 | return $existing_class |
386c056b |
156 | if $meta->can('does_role') && all { $meta->does_role($_) } |
157 | grep { !ref $_ } @{$roles}; |
231be3be |
158 | |
159 | return Moose::Meta::Class->create_anon_class( |
160 | superclasses => $superclasses, |
161 | roles => $roles, |
162 | cache => 1, |
163 | )->name(); |
164 | } |
165 | |
166 | 1; |
c59bc009 |
167 | |
ad46f524 |
168 | # ABSTRACT: Apply roles to any metaclass, as well as the object base class |
c59bc009 |
169 | |
ad46f524 |
170 | __END__ |
c59bc009 |
171 | |
172 | =head1 SYNOPSIS |
173 | |
174 | package MyApp::Moose; |
175 | |
c59bc009 |
176 | use Moose (); |
177 | use Moose::Exporter; |
49a86a99 |
178 | use Moose::Util::MetaRole; |
c59bc009 |
179 | |
180 | use MyApp::Role::Meta::Class; |
181 | use MyApp::Role::Meta::Method::Constructor; |
182 | use MyApp::Role::Object; |
183 | |
184 | Moose::Exporter->setup_import_methods( also => 'Moose' ); |
185 | |
186 | sub init_meta { |
187 | shift; |
f785aad8 |
188 | my %args = @_; |
c59bc009 |
189 | |
f785aad8 |
190 | Moose->init_meta(%args); |
c59bc009 |
191 | |
f785aad8 |
192 | Moose::Util::MetaRole::apply_metaroles( |
193 | for => $args{for_class}, |
194 | class_metaroles => { |
195 | class => => ['MyApp::Role::Meta::Class'], |
196 | constructor => ['MyApp::Role::Meta::Method::Constructor'], |
197 | }, |
c59bc009 |
198 | ); |
199 | |
200 | Moose::Util::MetaRole::apply_base_class_roles( |
f785aad8 |
201 | for => $args{for_class}, |
202 | roles => ['MyApp::Role::Object'], |
c59bc009 |
203 | ); |
204 | |
f785aad8 |
205 | return $args{for_class}->meta(); |
c59bc009 |
206 | } |
207 | |
208 | =head1 DESCRIPTION |
209 | |
210 | This utility module is designed to help authors of Moose extensions |
211 | write extensions that are able to cooperate with other Moose |
212 | extensions. To do this, you must write your extensions as roles, which |
52a919fe |
213 | can then be dynamically applied to the caller's metaclasses. |
c59bc009 |
214 | |
215 | This module makes sure to preserve any existing superclasses and roles |
216 | already set for the meta objects, which means that any number of |
217 | extensions can apply roles in any order. |
218 | |
219 | =head1 USAGE |
220 | |
110bb412 |
221 | The easiest way to use this module is through L<Moose::Exporter>, which can |
222 | generate the appropriate C<init_meta> method for you, and make sure it is |
223 | called when imported. |
c59bc009 |
224 | |
225 | =head1 FUNCTIONS |
226 | |
227 | This module provides two functions. |
228 | |
f785aad8 |
229 | =head2 apply_metaroles( ... ) |
c59bc009 |
230 | |
8f6b08fd |
231 | This function will apply roles to one or more metaclasses for the specified |
232 | class. It will return a new metaclass object for the class or role passed in |
233 | the "for" parameter. |
234 | |
235 | It accepts the following parameters: |
c59bc009 |
236 | |
237 | =over 4 |
238 | |
f785aad8 |
239 | =item * for => $name |
240 | |
241 | This specifies the class or for which to alter the meta classes. This can be a |
242 | package name, or an appropriate meta-object (a L<Moose::Meta::Class> or |
243 | L<Moose::Meta::Role>). |
c59bc009 |
244 | |
f785aad8 |
245 | =item * class_metaroles => \%roles |
c59bc009 |
246 | |
f785aad8 |
247 | This is a hash reference specifying which metaroles will be applied to the |
248 | class metaclass and its contained metaclasses and helper classes. |
c59bc009 |
249 | |
f785aad8 |
250 | Each key should in turn point to an array reference of role names. |
c59bc009 |
251 | |
f785aad8 |
252 | It accepts the following keys: |
c59bc009 |
253 | |
f785aad8 |
254 | =over 8 |
8286fcd6 |
255 | |
f785aad8 |
256 | =item class |
c59bc009 |
257 | |
f785aad8 |
258 | =item attribute |
c59bc009 |
259 | |
f785aad8 |
260 | =item method |
c59bc009 |
261 | |
f785aad8 |
262 | =item wrapped_method |
263 | |
264 | =item instance |
265 | |
266 | =item constructor |
267 | |
268 | =item destructor |
269 | |
270 | =item error |
271 | |
272 | =back |
d401dc20 |
273 | |
f785aad8 |
274 | =item * role_metaroles => \%roles |
d401dc20 |
275 | |
f785aad8 |
276 | This is a hash reference specifying which metaroles will be applied to the |
277 | role metaclass and its contained metaclasses and helper classes. |
d401dc20 |
278 | |
f785aad8 |
279 | It accepts the following keys: |
280 | |
281 | =over 8 |
282 | |
283 | =item role |
284 | |
285 | =item attribute |
286 | |
287 | =item method |
288 | |
289 | =item required_method |
290 | |
291 | =item conflicting_method |
292 | |
293 | =item application_to_class |
294 | |
295 | =item application_to_role |
296 | |
297 | =item application_to_instance |
298 | |
299 | =item application_role_summation |
300 | |
301 | =back |
c59bc009 |
302 | |
303 | =back |
304 | |
f785aad8 |
305 | =head2 apply_base_class_roles( for => $class, roles => \@roles ) |
c59bc009 |
306 | |
307 | This function will apply the specified roles to the object's base class. |
308 | |
c5fc2c21 |
309 | =head1 BUGS |
310 | |
311 | See L<Moose/BUGS> for details on reporting bugs. |
312 | |
c59bc009 |
313 | =cut |