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