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