File | /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Moose/Util/MetaRole.pm |
Statements Executed | 75 |
Statement Execution Time | 797µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 57µs | 87µs | _fixup_old_style_args | Moose::Util::MetaRole::
1 | 1 | 1 | 43µs | 23.9ms | apply_metaroles | Moose::Util::MetaRole::
1 | 1 | 1 | 27µs | 23.7ms | _make_new_metaclass | Moose::Util::MetaRole::
11 | 1 | 2 | 24µs | 24µs | CORE:match (opcode) | Moose::Util::MetaRole::
1 | 1 | 1 | 23µs | 22.6ms | _make_new_class | Moose::Util::MetaRole::
1 | 1 | 1 | 15µs | 18µs | BEGIN@3 | Moose::Util::MetaRole::
1 | 1 | 1 | 10µs | 52µs | BEGIN@12 | Moose::Util::MetaRole::
1 | 1 | 1 | 7µs | 21µs | BEGIN@4 | Moose::Util::MetaRole::
1 | 1 | 1 | 7µs | 29µs | BEGIN@11 | Moose::Util::MetaRole::
1 | 1 | 1 | 7µs | 31µs | BEGIN@5 | Moose::Util::MetaRole::
1 | 1 | 1 | 4µs | 4µs | apply_metaclass_roles | Moose::Util::MetaRole::
0 | 0 | 0 | 0s | 0s | __ANON__[:103] | Moose::Util::MetaRole::
0 | 0 | 0 | 0s | 0s | __ANON__[:147] | Moose::Util::MetaRole::
0 | 0 | 0 | 0s | 0s | apply_base_class_roles | Moose::Util::MetaRole::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Moose::Util::MetaRole; | ||||
2 | |||||
3 | 3 | 21µs | 2 | 21µs | # spent 18µs (15+3) within Moose::Util::MetaRole::BEGIN@3 which was called
# once (15µs+3µs) by Moose::Exporter::BEGIN@13 at line 3 # spent 18µs making 1 call to Moose::Util::MetaRole::BEGIN@3
# spent 3µs making 1 call to strict::import |
4 | 3 | 21µs | 2 | 34µs | # spent 21µs (7+13) within Moose::Util::MetaRole::BEGIN@4 which was called
# once (7µs+13µs) by Moose::Exporter::BEGIN@13 at line 4 # spent 21µs making 1 call to Moose::Util::MetaRole::BEGIN@4
# spent 13µs making 1 call to warnings::import |
5 | 3 | 44µs | 2 | 55µs | # spent 31µs (7+24) within Moose::Util::MetaRole::BEGIN@5 which was called
# once (7µs+24µs) by Moose::Exporter::BEGIN@13 at line 5 # spent 31µs making 1 call to Moose::Util::MetaRole::BEGIN@5
# spent 24µs making 1 call to Exporter::import |
6 | |||||
7 | 1 | 700ns | our $VERSION = '0.98'; | ||
8 | 1 | 15µs | $VERSION = eval $VERSION; | ||
9 | 1 | 300ns | our $AUTHORITY = 'cpan:STEVAN'; | ||
10 | |||||
11 | 3 | 23µs | 2 | 51µs | # spent 29µs (7+22) within Moose::Util::MetaRole::BEGIN@11 which was called
# once (7µs+22µs) by Moose::Exporter::BEGIN@13 at line 11 # spent 29µs making 1 call to Moose::Util::MetaRole::BEGIN@11
# spent 22µs making 1 call to Exporter::import |
12 | 3 | 500µs | 2 | 94µs | # spent 52µs (10+42) within Moose::Util::MetaRole::BEGIN@12 which was called
# once (10µs+42µs) by Moose::Exporter::BEGIN@13 at line 12 # spent 52µs making 1 call to Moose::Util::MetaRole::BEGIN@12
# spent 42µs making 1 call to Exporter::import |
13 | |||||
14 | # spent 4µs within Moose::Util::MetaRole::apply_metaclass_roles which was called
# once (4µs+0s) by MooseX::ClassAttribute::init_meta at line 25 of MooseX/ClassAttribute.pm | ||||
15 | 1 | 8µs | 1 | 23.9ms | goto &apply_metaroles; # spent 23.9ms making 1 call to Moose::Util::MetaRole::apply_metaroles |
16 | } | ||||
17 | |||||
18 | # spent 23.9ms (43µs+23.9) within Moose::Util::MetaRole::apply_metaroles which was called
# once (43µs+23.9ms) by MooseX::ClassAttribute::init_meta at line 15 | ||||
19 | 6 | 24µs | my %args = @_; | ||
20 | |||||
21 | _fixup_old_style_args(\%args); # spent 87µs making 1 call to Moose::Util::MetaRole::_fixup_old_style_args | ||||
22 | Carp::cluck('applying') if $::D; | ||||
23 | my $for # spent 4µs making 1 call to Class::MOP::class_of
# spent 600ns making 1 call to Scalar::Util::blessed | ||||
24 | = blessed $args{for} | ||||
25 | ? $args{for} | ||||
26 | : Class::MOP::class_of( $args{for} ); | ||||
27 | |||||
28 | if ( $for->isa('Moose::Meta::Role') ) { # spent 2µs making 1 call to UNIVERSAL::isa | ||||
29 | return _make_new_metaclass( $for, $args{role_metaroles}, 'role' ); | ||||
30 | } | ||||
31 | else { | ||||
32 | return _make_new_metaclass( $for, $args{class_metaroles}, 'class' ); # spent 23.7ms making 1 call to Moose::Util::MetaRole::_make_new_metaclass | ||||
33 | } | ||||
34 | } | ||||
35 | |||||
36 | # spent 87µs (57+29) within Moose::Util::MetaRole::_fixup_old_style_args which was called
# once (57µs+29µs) by Moose::Util::MetaRole::apply_metaroles at line 21 | ||||
37 | 33 | 79µs | my $args = shift; | ||
38 | |||||
39 | return if $args->{class_metaroles} || $args->{roles_metaroles}; | ||||
40 | |||||
41 | $args->{for} = delete $args->{for_class} | ||||
42 | if exists $args->{for_class}; | ||||
43 | |||||
44 | my @old_keys = qw( | ||||
45 | attribute_metaclass_roles | ||||
46 | method_metaclass_roles | ||||
47 | wrapped_method_metaclass_roles | ||||
48 | instance_metaclass_roles | ||||
49 | constructor_class_roles | ||||
50 | destructor_class_roles | ||||
51 | error_class_roles | ||||
52 | |||||
53 | application_to_class_class_roles | ||||
54 | application_to_role_class_roles | ||||
55 | application_to_instance_class_roles | ||||
56 | application_role_summation_class_roles | ||||
57 | ); | ||||
58 | |||||
59 | my $for # spent 4µs making 1 call to Class::MOP::class_of
# spent 700ns making 1 call to Scalar::Util::blessed | ||||
60 | = blessed $args->{for} | ||||
61 | ? $args->{for} | ||||
62 | : Class::MOP::class_of( $args->{for} ); | ||||
63 | |||||
64 | my $top_key; | ||||
65 | if ( $for->isa('Moose::Meta::Class') ) { # spent 900ns making 1 call to UNIVERSAL::isa | ||||
66 | $top_key = 'class_metaroles'; | ||||
67 | |||||
68 | $args->{class_metaroles}{class} = delete $args->{metaclass_roles} | ||||
69 | if exists $args->{metaclass_roles}; | ||||
70 | } | ||||
71 | else { | ||||
72 | $top_key = 'role_metaroles'; | ||||
73 | |||||
74 | $args->{role_metaroles}{role} = delete $args->{metaclass_roles} | ||||
75 | if exists $args->{metaclass_roles}; | ||||
76 | } | ||||
77 | |||||
78 | for my $old_key (@old_keys) { | ||||
79 | my ($new_key) = $old_key =~ /^(.+)_(?:class|metaclass)_roles$/; # spent 24µs making 11 calls to Moose::Util::MetaRole::CORE:match, avg 2µs/call | ||||
80 | |||||
81 | $args->{$top_key}{$new_key} = delete $args->{$old_key} | ||||
82 | if exists $args->{$old_key}; | ||||
83 | } | ||||
84 | |||||
85 | return; | ||||
86 | } | ||||
87 | |||||
88 | # spent 23.7ms (27µs+23.7) within Moose::Util::MetaRole::_make_new_metaclass which was called
# once (27µs+23.7ms) by Moose::Util::MetaRole::apply_metaroles at line 32 | ||||
89 | 9 | 25µs | my $for = shift; | ||
90 | my $roles = shift; | ||||
91 | my $primary = shift; | ||||
92 | |||||
93 | return $for unless keys %{$roles}; | ||||
94 | |||||
95 | my $new_metaclass # spent 22.6ms making 1 call to Moose::Util::MetaRole::_make_new_class | ||||
96 | = exists $roles->{$primary} | ||||
97 | ? _make_new_class( ref $for, $roles->{$primary} ) | ||||
98 | : blessed $for; | ||||
99 | |||||
100 | my %classes; | ||||
101 | |||||
102 | for my $key ( grep { $_ ne $primary } keys %{$roles} ) { | ||||
103 | my $attr = first {$_} | ||||
104 | map { $for->meta->find_attribute_by_name($_) } ( | ||||
105 | $key . '_metaclass', | ||||
106 | $key . '_class' | ||||
107 | ); | ||||
108 | |||||
109 | my $reader = $attr->get_read_method; | ||||
110 | |||||
111 | $classes{ $attr->init_arg } | ||||
112 | = _make_new_class( $for->$reader(), $roles->{$key} ); | ||||
113 | } | ||||
114 | |||||
115 | my $new_meta = $new_metaclass->reinitialize( $for, %classes ); # spent 1.16ms making 1 call to Moose::Meta::Class::reinitialize | ||||
116 | |||||
117 | return $new_meta; | ||||
118 | } | ||||
119 | |||||
120 | sub apply_base_class_roles { | ||||
121 | my %args = @_; | ||||
122 | |||||
123 | my $for = $args{for} || $args{for_class}; | ||||
124 | |||||
125 | my $meta = Class::MOP::class_of($for); | ||||
126 | |||||
127 | my $new_base = _make_new_class( | ||||
128 | $for, | ||||
129 | $args{roles}, | ||||
130 | [ $meta->superclasses() ], | ||||
131 | ); | ||||
132 | |||||
133 | $meta->superclasses($new_base) | ||||
134 | if $new_base ne $meta->name(); | ||||
135 | } | ||||
136 | |||||
137 | # spent 22.6ms (23µs+22.5) within Moose::Util::MetaRole::_make_new_class which was called
# once (23µs+22.5ms) by Moose::Util::MetaRole::_make_new_metaclass at line 95 | ||||
138 | 7 | 33µs | my $existing_class = shift; | ||
139 | my $roles = shift; | ||||
140 | my $superclasses = shift || [$existing_class]; | ||||
141 | |||||
142 | return $existing_class unless $roles; | ||||
143 | |||||
144 | my $meta = Class::MOP::Class->initialize($existing_class); # spent 8µs making 1 call to Class::MOP::Class::initialize | ||||
145 | |||||
146 | return $existing_class | ||||
147 | if $meta->can('does_role') && all { $meta->does_role($_) } | ||||
148 | grep { !ref $_ } @{$roles}; # spent 10µs making 1 call to UNIVERSAL::can | ||||
149 | |||||
150 | return Moose::Meta::Class->create_anon_class( # spent 22.5ms making 1 call to Moose::Meta::Class::create_anon_class
# spent 1µs making 1 call to Class::MOP::Package::name | ||||
151 | superclasses => $superclasses, | ||||
152 | roles => $roles, | ||||
153 | cache => 1, | ||||
154 | )->name(); | ||||
155 | } | ||||
156 | |||||
157 | 1 | 4µs | 1; | ||
158 | |||||
159 | __END__ | ||||
160 | |||||
161 | =head1 NAME | ||||
162 | |||||
163 | Moose::Util::MetaRole - Apply roles to any metaclass, as well as the object base class | ||||
164 | |||||
165 | =head1 SYNOPSIS | ||||
166 | |||||
167 | package MyApp::Moose; | ||||
168 | |||||
169 | use Moose (); | ||||
170 | use Moose::Exporter; | ||||
171 | use Moose::Util::MetaRole; | ||||
172 | |||||
173 | use MyApp::Role::Meta::Class; | ||||
174 | use MyApp::Role::Meta::Method::Constructor; | ||||
175 | use MyApp::Role::Object; | ||||
176 | |||||
177 | Moose::Exporter->setup_import_methods( also => 'Moose' ); | ||||
178 | |||||
179 | sub init_meta { | ||||
180 | shift; | ||||
181 | my %args = @_; | ||||
182 | |||||
183 | Moose->init_meta(%args); | ||||
184 | |||||
185 | Moose::Util::MetaRole::apply_metaroles( | ||||
186 | for => $args{for_class}, | ||||
187 | class_metaroles => { | ||||
188 | class => => ['MyApp::Role::Meta::Class'], | ||||
189 | constructor => ['MyApp::Role::Meta::Method::Constructor'], | ||||
190 | }, | ||||
191 | ); | ||||
192 | |||||
193 | Moose::Util::MetaRole::apply_base_class_roles( | ||||
194 | for => $args{for_class}, | ||||
195 | roles => ['MyApp::Role::Object'], | ||||
196 | ); | ||||
197 | |||||
198 | return $args{for_class}->meta(); | ||||
199 | } | ||||
200 | |||||
201 | =head1 DESCRIPTION | ||||
202 | |||||
203 | This utility module is designed to help authors of Moose extensions | ||||
204 | write extensions that are able to cooperate with other Moose | ||||
205 | extensions. To do this, you must write your extensions as roles, which | ||||
206 | can then be dynamically applied to the caller's metaclasses. | ||||
207 | |||||
208 | This module makes sure to preserve any existing superclasses and roles | ||||
209 | already set for the meta objects, which means that any number of | ||||
210 | extensions can apply roles in any order. | ||||
211 | |||||
212 | =head1 USAGE | ||||
213 | |||||
214 | B<It is very important that you only call this module's functions when | ||||
215 | your module is imported by the caller>. The process of applying roles | ||||
216 | to the metaclass reinitializes the metaclass object, which wipes out | ||||
217 | any existing attributes already defined. However, as long as you do | ||||
218 | this when your module is imported, the caller should not have any | ||||
219 | attributes defined yet. | ||||
220 | |||||
221 | The easiest way to ensure that this happens is to use | ||||
222 | L<Moose::Exporter>, which can generate the appropriate C<init_meta> | ||||
223 | method for you, and make sure it is called when imported. | ||||
224 | |||||
225 | =head1 FUNCTIONS | ||||
226 | |||||
227 | This module provides two functions. | ||||
228 | |||||
229 | =head2 apply_metaroles( ... ) | ||||
230 | |||||
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: | ||||
236 | |||||
237 | =over 4 | ||||
238 | |||||
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>). | ||||
244 | |||||
245 | =item * class_metaroles => \%roles | ||||
246 | |||||
247 | This is a hash reference specifying which metaroles will be applied to the | ||||
248 | class metaclass and its contained metaclasses and helper classes. | ||||
249 | |||||
250 | Each key should in turn point to an array reference of role names. | ||||
251 | |||||
252 | It accepts the following keys: | ||||
253 | |||||
254 | =over 8 | ||||
255 | |||||
256 | =item class | ||||
257 | |||||
258 | =item attribute | ||||
259 | |||||
260 | =item method | ||||
261 | |||||
262 | =item wrapped_method | ||||
263 | |||||
264 | =item instance | ||||
265 | |||||
266 | =item constructor | ||||
267 | |||||
268 | =item destructor | ||||
269 | |||||
270 | =item error | ||||
271 | |||||
272 | =back | ||||
273 | |||||
274 | =item * role_metaroles => \%roles | ||||
275 | |||||
276 | This is a hash reference specifying which metaroles will be applied to the | ||||
277 | role metaclass and its contained metaclasses and helper classes. | ||||
278 | |||||
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 | ||||
302 | |||||
303 | =back | ||||
304 | |||||
305 | =head2 apply_base_class_roles( for => $class, roles => \@roles ) | ||||
306 | |||||
307 | This function will apply the specified roles to the object's base class. | ||||
308 | |||||
309 | =head1 BUGS | ||||
310 | |||||
311 | See L<Moose/BUGS> for details on reporting bugs. | ||||
312 | |||||
313 | =head1 AUTHOR | ||||
314 | |||||
315 | Dave Rolsky E<lt>autarch@urth.orgE<gt> | ||||
316 | |||||
317 | =head1 COPYRIGHT AND LICENSE | ||||
318 | |||||
319 | Copyright 2009 by Infinity Interactive, Inc. | ||||
320 | |||||
321 | L<http://www.iinteractive.com> | ||||
322 | |||||
323 | This library is free software; you can redistribute it and/or modify | ||||
324 | it under the same terms as Perl itself. | ||||
325 | |||||
326 | =cut | ||||
# spent 24µs within Moose::Util::MetaRole::CORE:match which was called 11 times, avg 2µs/call:
# 11 times (24µs+0s) by Moose::Util::MetaRole::_fixup_old_style_args at line 79 of Moose/Util/MetaRole.pm, avg 2µs/call |