Filename | /Users/ap13/perl5/lib/perl5/darwin-2level/Moose/Util.pm |
Statements | Executed 907 statements in 7.29ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
185 | 2 | 2 | 1.68ms | 1.68ms | _caller_info | Moose::Util::
4 | 1 | 1 | 195µs | 62.1ms | _apply_all_roles | Moose::Util::
22 | 2 | 2 | 130µs | 8.28ms | _load_user_class (recurses: max depth 1, inclusive time 96µs) | Moose::Util::
4 | 1 | 1 | 35µs | 62.2ms | apply_all_roles | Moose::Util::
1 | 1 | 1 | 33µs | 118µs | BEGIN@12 | Moose::Util::
1 | 1 | 1 | 24µs | 86µs | BEGIN@7 | Moose::Util::
1 | 1 | 1 | 21µs | 44µs | BEGIN@4 | Moose::Util::
1 | 1 | 1 | 20µs | 514µs | add_method_modifier | Moose::Util::
4 | 1 | 1 | 18µs | 32µs | find_meta | Moose::Util::
1 | 1 | 1 | 17µs | 63µs | BEGIN@11 | Moose::Util::
1 | 1 | 1 | 16µs | 251µs | BEGIN@10 | Moose::Util::
1 | 1 | 1 | 15µs | 65µs | BEGIN@14 | Moose::Util::
1 | 1 | 1 | 15µs | 23µs | BEGIN@8 | Moose::Util::
1 | 1 | 1 | 14µs | 54µs | BEGIN@9 | Moose::Util::
1 | 1 | 1 | 13µs | 21µs | BEGIN@5 | Moose::Util::
1 | 1 | 1 | 6µs | 6µs | BEGIN@13 | Moose::Util::
0 | 0 | 0 | 0s | 0s | _STRINGLIKE0 | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:109] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:136] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:327] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:411] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:430] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:449] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:499] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:501] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:503] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:515] | Moose::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:69] | Moose::Util::
0 | 0 | 0 | 0s | 0s | _build_alias_package_name | Moose::Util::
0 | 0 | 0 | 0s | 0s | _classes_differ_by_roles_only | Moose::Util::
0 | 0 | 0 | 0s | 0s | _create_alias | Moose::Util::
0 | 0 | 0 | 0s | 0s | _english_list | Moose::Util::
0 | 0 | 0 | 0s | 0s | _english_list_and | Moose::Util::
0 | 0 | 0 | 0s | 0s | _english_list_or | Moose::Util::
0 | 0 | 0 | 0s | 0s | _find_common_base | Moose::Util::
0 | 0 | 0 | 0s | 0s | _get_ancestors_until | Moose::Util::
0 | 0 | 0 | 0s | 0s | _is_package_loaded | Moose::Util::
0 | 0 | 0 | 0s | 0s | _is_role_only_subclass | Moose::Util::
0 | 0 | 0 | 0s | 0s | _reconcile_roles_for_metaclass | Moose::Util::
0 | 0 | 0 | 0s | 0s | _role_differences | Moose::Util::
0 | 0 | 0 | 0s | 0s | does_role | Moose::Util::
0 | 0 | 0 | 0s | 0s | english_list | Moose::Util::
0 | 0 | 0 | 0s | 0s | ensure_all_roles | Moose::Util::
0 | 0 | 0 | 0s | 0s | get_all_attribute_values | Moose::Util::
0 | 0 | 0 | 0s | 0s | get_all_init_args | Moose::Util::
0 | 0 | 0 | 0s | 0s | is_role | Moose::Util::
0 | 0 | 0 | 0s | 0s | meta_attribute_alias | Moose::Util::
0 | 0 | 0 | 0s | 0s | meta_class_alias | Moose::Util::
0 | 0 | 0 | 0s | 0s | resolve_metaclass_alias | Moose::Util::
0 | 0 | 0 | 0s | 0s | resolve_metatrait_alias | Moose::Util::
0 | 0 | 0 | 0s | 0s | search_class_by_role | Moose::Util::
0 | 0 | 0 | 0s | 0s | throw_exception | Moose::Util::
0 | 0 | 0 | 0s | 0s | with_traits | Moose::Util::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Moose::Util; | ||||
2 | 1 | 2µs | our $VERSION = '2.1403'; | ||
3 | |||||
4 | 2 | 40µs | 2 | 66µs | # spent 44µs (21+22) within Moose::Util::BEGIN@4 which was called:
# once (21µs+22µs) by Moose::Util::MetaRole::BEGIN@10 at line 4 # spent 44µs making 1 call to Moose::Util::BEGIN@4
# spent 22µs making 1 call to strict::import |
5 | 2 | 61µs | 2 | 28µs | # spent 21µs (13+7) within Moose::Util::BEGIN@5 which was called:
# once (13µs+7µs) by Moose::Util::MetaRole::BEGIN@10 at line 5 # spent 21µs making 1 call to Moose::Util::BEGIN@5
# spent 7µs making 1 call to warnings::import |
6 | |||||
7 | 3 | 70µs | 3 | 149µs | # spent 86µs (24+62) within Moose::Util::BEGIN@7 which was called:
# once (24µs+62µs) by Moose::Util::MetaRole::BEGIN@10 at line 7 # spent 86µs making 1 call to Moose::Util::BEGIN@7
# spent 46µs making 1 call to Module::Runtime::import
# spent 17µs making 1 call to UNIVERSAL::VERSION |
8 | 2 | 44µs | 2 | 31µs | # spent 23µs (15+8) within Moose::Util::BEGIN@8 which was called:
# once (15µs+8µs) by Moose::Util::MetaRole::BEGIN@10 at line 8 # spent 23µs making 1 call to Moose::Util::BEGIN@8
# spent 8µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:284] |
9 | 2 | 39µs | 2 | 94µs | # spent 54µs (14+40) within Moose::Util::BEGIN@9 which was called:
# once (14µs+40µs) by Moose::Util::MetaRole::BEGIN@10 at line 9 # spent 54µs making 1 call to Moose::Util::BEGIN@9
# spent 40µs making 1 call to Exporter::import |
10 | 2 | 174µs | 2 | 486µs | # spent 251µs (16+235) within Moose::Util::BEGIN@10 which was called:
# once (16µs+235µs) by Moose::Util::MetaRole::BEGIN@10 at line 10 # spent 251µs making 1 call to Moose::Util::BEGIN@10
# spent 235µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:337] |
11 | 2 | 56µs | 2 | 110µs | # spent 63µs (17+46) within Moose::Util::BEGIN@11 which was called:
# once (17µs+46µs) by Moose::Util::MetaRole::BEGIN@10 at line 11 # spent 63µs making 1 call to Moose::Util::BEGIN@11
# spent 46µs making 1 call to Exporter::import |
12 | 3 | 76µs | 3 | 154µs | # spent 118µs (33+85) within Moose::Util::BEGIN@12 which was called:
# once (33µs+85µs) by Moose::Util::MetaRole::BEGIN@10 at line 12 # spent 118µs making 1 call to Moose::Util::BEGIN@12
# spent 21µs making 1 call to UNIVERSAL::VERSION
# spent 15µs making 1 call to List::Util::import |
13 | 2 | 44µs | 1 | 6µs | # spent 6µs within Moose::Util::BEGIN@13 which was called:
# once (6µs+0s) by Moose::Util::MetaRole::BEGIN@10 at line 13 # spent 6µs making 1 call to Moose::Util::BEGIN@13 |
14 | 2 | 4.50ms | 2 | 114µs | # spent 65µs (15+49) within Moose::Util::BEGIN@14 which was called:
# once (15µs+49µs) by Moose::Util::MetaRole::BEGIN@10 at line 14 # spent 65µs making 1 call to Moose::Util::BEGIN@14
# spent 49µs making 1 call to Exporter::import |
15 | |||||
16 | |||||
17 | 1 | 9µs | my @exports = qw[ | ||
18 | find_meta | ||||
19 | is_role | ||||
20 | does_role | ||||
21 | search_class_by_role | ||||
22 | ensure_all_roles | ||||
23 | apply_all_roles | ||||
24 | with_traits | ||||
25 | get_all_init_args | ||||
26 | get_all_attribute_values | ||||
27 | resolve_metatrait_alias | ||||
28 | resolve_metaclass_alias | ||||
29 | add_method_modifier | ||||
30 | english_list | ||||
31 | meta_attribute_alias | ||||
32 | meta_class_alias | ||||
33 | throw_exception | ||||
34 | ]; | ||||
35 | |||||
36 | 1 | 14µs | 1 | 599µs | Sub::Exporter::setup_exporter({ # spent 599µs making 1 call to Sub::Exporter::setup_exporter |
37 | exports => \@exports, | ||||
38 | groups => { all => \@exports } | ||||
39 | }); | ||||
40 | |||||
41 | # Things that need to ->import from Moose::Util | ||||
42 | # should be loaded after Moose::Util defines ->import | ||||
43 | 1 | 1µs | require Class::MOP; | ||
44 | |||||
45 | sub throw_exception { | ||||
46 | my ($class_name, @args_to_exception) = @_; | ||||
47 | my $class = "Moose::Exception::$class_name"; | ||||
48 | _load_user_class( $class ); | ||||
49 | die $class->new( @args_to_exception ); | ||||
50 | } | ||||
51 | |||||
52 | ## some utils for the utils ... | ||||
53 | |||||
54 | 4 | 12µs | 4 | 14µs | # spent 32µs (18+14) within Moose::Util::find_meta which was called 4 times, avg 8µs/call:
# 4 times (18µs+14µs) by Moose::Util::_apply_all_roles at line 148, avg 8µs/call # spent 14µs making 4 calls to Class::MOP::class_of, avg 4µs/call |
55 | |||||
56 | ## the functions ... | ||||
57 | |||||
58 | sub is_role { | ||||
59 | my $package_or_obj = shift; | ||||
60 | |||||
61 | my $meta = find_meta($package_or_obj); | ||||
62 | return if not $meta; | ||||
63 | return $meta->isa('Moose::Meta::Role'); | ||||
64 | } | ||||
65 | |||||
66 | sub does_role { | ||||
67 | my ($class_or_obj, $role) = @_; | ||||
68 | |||||
69 | if (try { $class_or_obj->isa('Moose::Object') }) { | ||||
70 | return $class_or_obj->does($role); | ||||
71 | } | ||||
72 | |||||
73 | my $meta = find_meta($class_or_obj); | ||||
74 | |||||
75 | return unless defined $meta; | ||||
76 | return unless $meta->can('does_role'); | ||||
77 | return 1 if $meta->does_role($role); | ||||
78 | return; | ||||
79 | } | ||||
80 | |||||
81 | sub search_class_by_role { | ||||
82 | my ($class_or_obj, $role) = @_; | ||||
83 | |||||
84 | my $meta = find_meta($class_or_obj); | ||||
85 | |||||
86 | return unless defined $meta; | ||||
87 | |||||
88 | my $role_name = blessed $role ? $role->name : $role; | ||||
89 | |||||
90 | foreach my $class ($meta->class_precedence_list) { | ||||
91 | |||||
92 | my $_meta = find_meta($class); | ||||
93 | |||||
94 | next unless defined $_meta; | ||||
95 | |||||
96 | foreach my $role (@{ $_meta->roles || [] }) { | ||||
97 | return $class if $role->name eq $role_name; | ||||
98 | } | ||||
99 | } | ||||
100 | |||||
101 | return; | ||||
102 | } | ||||
103 | |||||
104 | # this can possibly behave in unexpected ways because the roles being composed | ||||
105 | # before being applied could differ from call to call; I'm not sure if or how | ||||
106 | # to document this possible quirk. | ||||
107 | sub ensure_all_roles { | ||||
108 | my $applicant = shift; | ||||
109 | _apply_all_roles($applicant, sub { !does_role($applicant, $_) }, @_); | ||||
110 | } | ||||
111 | |||||
112 | # spent 62.2ms (35µs+62.1) within Moose::Util::apply_all_roles which was called 4 times, avg 15.5ms/call:
# 4 times (35µs+62.1ms) by Moose::with at line 59 of Moose.pm, avg 15.5ms/call | ||||
113 | 8 | 25µs | my $applicant = shift; | ||
114 | 4 | 62.1ms | _apply_all_roles($applicant, undef, @_); # spent 62.1ms making 4 calls to Moose::Util::_apply_all_roles, avg 15.5ms/call | ||
115 | } | ||||
116 | |||||
117 | # spent 62.1ms (195µs+61.9) within Moose::Util::_apply_all_roles which was called 4 times, avg 15.5ms/call:
# 4 times (195µs+61.9ms) by Moose::Util::apply_all_roles at line 114, avg 15.5ms/call | ||||
118 | 76 | 204µs | my $applicant = shift; | ||
119 | my $role_filter = shift; | ||||
120 | |||||
121 | unless (@_) { | ||||
122 | require Moose; | ||||
123 | throw_exception( MustSpecifyAtleastOneRoleToApplicant => applicant => $applicant ); | ||||
124 | } | ||||
125 | |||||
126 | # If @_ contains role meta objects, mkopt will think that they're values, | ||||
127 | # because they're references. In other words (roleobj1, roleobj2, | ||||
128 | # roleobj3) will become [ [ roleobj1, roleobj2 ], [ roleobj3, undef ] ] | ||||
129 | # -- this is no good. We'll preprocess @_ first to eliminate the potential | ||||
130 | # bug. | ||||
131 | # -- rjbs, 2011-04-08 | ||||
132 | my $roles = Data::OptList::mkopt( [@_], { | ||||
133 | moniker => 'role', | ||||
134 | name_test => sub { | ||||
135 | ! ref $_[0] or blessed($_[0]) && $_[0]->isa('Moose::Meta::Role') | ||||
136 | } | ||||
137 | 4 | 82µs | }); # spent 82µs making 4 calls to Data::OptList::mkopt, avg 21µs/call | ||
138 | |||||
139 | my @role_metas; | ||||
140 | foreach my $role (@$roles) { | ||||
141 | my $meta; | ||||
142 | |||||
143 | 4 | 4µs | if ( blessed $role->[0] ) { # spent 4µs making 4 calls to Scalar::Util::blessed, avg 900ns/call | ||
144 | $meta = $role->[0]; | ||||
145 | } | ||||
146 | else { | ||||
147 | 4 | 20.7ms | &use_module($role->[0], $role->[1] && $role->[1]{-version} ? $role->[1]{-version} : ()); # spent 20.7ms making 4 calls to Module::Runtime::use_module, avg 5.17ms/call | ||
148 | 4 | 32µs | $meta = find_meta( $role->[0] ); # spent 32µs making 4 calls to Moose::Util::find_meta, avg 8µs/call | ||
149 | } | ||||
150 | |||||
151 | 4 | 4µs | unless ($meta && $meta->isa('Moose::Meta::Role') ) { # spent 4µs making 4 calls to UNIVERSAL::isa, avg 950ns/call | ||
152 | throw_exception( CanOnlyConsumeRole => role_name => $role->[0] ); | ||||
153 | } | ||||
154 | |||||
155 | push @role_metas, [ $meta, $role->[1] ]; | ||||
156 | } | ||||
157 | |||||
158 | if ( defined $role_filter ) { | ||||
159 | @role_metas = grep { local $_ = $_->[0]; $role_filter->() } @role_metas; | ||||
160 | } | ||||
161 | |||||
162 | return unless @role_metas; | ||||
163 | |||||
164 | 4 | 6µs | _load_user_class($applicant) # spent 6µs making 4 calls to Scalar::Util::blessed, avg 2µs/call | ||
165 | unless blessed($applicant) | ||||
166 | || Class::MOP::class_of($applicant); | ||||
167 | |||||
168 | 4 | 2µs | my $meta = ( blessed $applicant ? $applicant : Moose::Meta::Class->initialize($applicant) ); # spent 2µs making 4 calls to Scalar::Util::blessed, avg 625ns/call | ||
169 | |||||
170 | if ( scalar @role_metas == 1 ) { | ||||
171 | my ( $role, $params ) = @{ $role_metas[0] }; | ||||
172 | 4 | 41.1ms | $role->apply( $meta, ( defined $params ? %$params : () ) ); # spent 41.1ms making 4 calls to Moose::Meta::Role::apply, avg 10.3ms/call | ||
173 | } | ||||
174 | else { | ||||
175 | Moose::Meta::Role->combine(@role_metas)->apply($meta); | ||||
176 | } | ||||
177 | } | ||||
178 | |||||
179 | sub with_traits { | ||||
180 | my ($class, @roles) = @_; | ||||
181 | return $class unless @roles; | ||||
182 | return Moose::Meta::Class->create_anon_class( | ||||
183 | superclasses => [$class], | ||||
184 | roles => \@roles, | ||||
185 | cache => 1, | ||||
186 | )->name; | ||||
187 | } | ||||
188 | |||||
189 | # instance deconstruction ... | ||||
190 | |||||
191 | sub get_all_attribute_values { | ||||
192 | my ($class, $instance) = @_; | ||||
193 | return +{ | ||||
194 | map { $_->name => $_->get_value($instance) } | ||||
195 | grep { $_->has_value($instance) } | ||||
196 | $class->get_all_attributes | ||||
197 | }; | ||||
198 | } | ||||
199 | |||||
200 | sub get_all_init_args { | ||||
201 | my ($class, $instance) = @_; | ||||
202 | return +{ | ||||
203 | map { $_->init_arg => $_->get_value($instance) } | ||||
204 | grep { $_->has_value($instance) } | ||||
205 | grep { defined($_->init_arg) } | ||||
206 | $class->get_all_attributes | ||||
207 | }; | ||||
208 | } | ||||
209 | |||||
210 | sub resolve_metatrait_alias { | ||||
211 | return resolve_metaclass_alias( @_, trait => 1 ); | ||||
212 | } | ||||
213 | |||||
214 | sub _build_alias_package_name { | ||||
215 | my ($type, $name, $trait) = @_; | ||||
216 | return 'Moose::Meta::' | ||||
217 | . $type | ||||
218 | . '::Custom::' | ||||
219 | . ( $trait ? 'Trait::' : '' ) | ||||
220 | . $name; | ||||
221 | } | ||||
222 | |||||
223 | { | ||||
224 | 2 | 900ns | my %cache; | ||
225 | |||||
226 | sub resolve_metaclass_alias { | ||||
227 | my ( $type, $metaclass_name, %options ) = @_; | ||||
228 | |||||
229 | my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' ); | ||||
230 | return $cache{$cache_key}{$metaclass_name} | ||||
231 | if $cache{$cache_key}{$metaclass_name}; | ||||
232 | |||||
233 | my $possible_full_name = _build_alias_package_name( | ||||
234 | $type, $metaclass_name, $options{trait} | ||||
235 | ); | ||||
236 | |||||
237 | my @possible = ($possible_full_name, $metaclass_name); | ||||
238 | for my $package (@possible) { | ||||
239 | use_package_optimistically($package); | ||||
240 | if ($package->can('register_implementation')) { | ||||
241 | return $cache{$cache_key}{$metaclass_name} = | ||||
242 | $package->register_implementation; | ||||
243 | } | ||||
244 | elsif (find_meta($package)) { | ||||
245 | return $cache{$cache_key}{$metaclass_name} = $package; | ||||
246 | } | ||||
247 | } | ||||
248 | |||||
249 | throw_exception( CannotLocatePackageInINC => possible_packages => _english_list_or(@possible), | ||||
250 | INC => \@INC, | ||||
251 | type => $type, | ||||
252 | metaclass_name => $metaclass_name, | ||||
253 | params => \%options | ||||
254 | ); | ||||
255 | } | ||||
256 | } | ||||
257 | |||||
258 | # spent 514µs (20+494) within Moose::Util::add_method_modifier which was called:
# once (20µs+494µs) by Moose::before at line 80 of Moose.pm | ||||
259 | 6 | 26µs | my ( $class_or_obj, $modifier_name, $args ) = @_; | ||
260 | 1 | 7µs | my $meta # spent 7µs making 1 call to UNIVERSAL::can | ||
261 | = $class_or_obj->can('add_before_method_modifier') | ||||
262 | ? $class_or_obj | ||||
263 | : find_meta($class_or_obj); | ||||
264 | my $code = pop @{$args}; | ||||
265 | my $add_modifier_method = 'add_' . $modifier_name . '_method_modifier'; | ||||
266 | if ( my $method_modifier_type = ref( @{$args}[0] ) ) { | ||||
267 | if ( $method_modifier_type eq 'Regexp' ) { | ||||
268 | my @all_methods = $meta->get_all_methods; | ||||
269 | my @matched_methods | ||||
270 | = grep { $_->name =~ @{$args}[0] } @all_methods; | ||||
271 | $meta->$add_modifier_method( $_->name, $code ) | ||||
272 | for @matched_methods; | ||||
273 | } | ||||
274 | elsif ($method_modifier_type eq 'ARRAY') { | ||||
275 | $meta->$add_modifier_method( $_, $code ) for @{$args->[0]}; | ||||
276 | } | ||||
277 | else { | ||||
278 | throw_exception( IllegalMethodTypeToAddMethodModifier => class_or_object => $class_or_obj, | ||||
279 | modifier_name => $modifier_name, | ||||
280 | params => $args | ||||
281 | ); | ||||
282 | } | ||||
283 | } | ||||
284 | else { | ||||
285 | 1 | 488µs | $meta->$add_modifier_method( $_, $code ) for @{$args}; # spent 488µs making 1 call to Class::MOP::Class::add_before_method_modifier | ||
286 | } | ||||
287 | } | ||||
288 | |||||
289 | sub english_list { | ||||
290 | _english_list_and(@_); | ||||
291 | } | ||||
292 | |||||
293 | sub _english_list_and { | ||||
294 | _english_list('and', \@_); | ||||
295 | } | ||||
296 | |||||
297 | sub _english_list_or { | ||||
298 | _english_list('or', \@_); | ||||
299 | } | ||||
300 | |||||
301 | sub _english_list { | ||||
302 | my ($conjunction, $items) = @_; | ||||
303 | |||||
304 | my @items = sort @$items; | ||||
305 | |||||
306 | return $items[0] if @items == 1; | ||||
307 | return "$items[0] $conjunction $items[1]" if @items == 2; | ||||
308 | |||||
309 | my $tail = pop @items; | ||||
310 | my $list = join ', ', @items; | ||||
311 | $list .= ", $conjunction " . $tail; | ||||
312 | |||||
313 | return $list; | ||||
314 | } | ||||
315 | |||||
316 | # spent 1.68ms within Moose::Util::_caller_info which was called 185 times, avg 9µs/call:
# 172 times (1.59ms+0s) by Moose::has at line 71 of Moose.pm, avg 9µs/call
# 13 times (92µs+0s) by Moose::Role::has at line 47 of Moose/Role.pm, avg 7µs/call | ||||
317 | 740 | 1.76ms | my $level = @_ ? ($_[0] + 1) : 2; | ||
318 | my %info; | ||||
319 | @info{qw(package file line)} = caller($level); | ||||
320 | return %info; | ||||
321 | } | ||||
322 | |||||
323 | sub _create_alias { | ||||
324 | my ($type, $name, $trait, $for) = @_; | ||||
325 | my $package = _build_alias_package_name($type, $name, $trait); | ||||
326 | Class::MOP::Class->initialize($package)->add_method( | ||||
327 | register_implementation => sub { $for } | ||||
328 | ); | ||||
329 | } | ||||
330 | |||||
331 | sub meta_attribute_alias { | ||||
332 | my ($to, $from) = @_; | ||||
333 | $from ||= caller; | ||||
334 | my $meta = Class::MOP::class_of($from); | ||||
335 | my $trait = $meta->isa('Moose::Meta::Role'); | ||||
336 | _create_alias('Attribute', $to, $trait, $from); | ||||
337 | } | ||||
338 | |||||
339 | sub meta_class_alias { | ||||
340 | my ($to, $from) = @_; | ||||
341 | $from ||= caller; | ||||
342 | my $meta = Class::MOP::class_of($from); | ||||
343 | my $trait = $meta->isa('Moose::Meta::Role'); | ||||
344 | _create_alias('Class', $to, $trait, $from); | ||||
345 | } | ||||
346 | |||||
347 | # spent 8.28ms (130µs+8.15) within Moose::Util::_load_user_class which was called 22 times, avg 376µs/call:
# 18 times (108µs+7.92ms) by Moose::Meta::Class::superclasses at line 557 of Moose/Meta/Class.pm, avg 446µs/call
# 4 times (22µs+237µs) by Moose::Meta::Role::apply at line 461 of Moose/Meta/Role.pm, avg 65µs/call | ||||
348 | 44 | 107µs | my ($class, $opts) = @_; | ||
349 | 22 | 8.16ms | &use_package_optimistically( # spent 8.25ms making 22 calls to Module::Runtime::use_package_optimistically, avg 375µs/call, recursion: max depth 1, sum of overlapping time 87µs | ||
350 | $class, | ||||
351 | $opts && $opts->{-version} ? $opts->{-version} : () | ||||
352 | ); | ||||
353 | } | ||||
354 | |||||
355 | # XXX - this should be added to Params::Util | ||||
356 | sub _STRINGLIKE0 ($) { | ||||
357 | return 1 if _STRING( $_[0] ); | ||||
358 | if ( blessed $_[0] ) { | ||||
359 | return overload::Method( $_[0], q{""} ); | ||||
360 | } | ||||
361 | |||||
362 | return 1 if defined $_[0] && $_[0] eq q{}; | ||||
363 | |||||
364 | return 0; | ||||
365 | } | ||||
366 | |||||
367 | sub _reconcile_roles_for_metaclass { | ||||
368 | my ($class_meta_name, $super_meta_name) = @_; | ||||
369 | |||||
370 | my @role_differences = _role_differences( | ||||
371 | $class_meta_name, $super_meta_name, | ||||
372 | ); | ||||
373 | |||||
374 | # handle the case where we need to fix compatibility between a class and | ||||
375 | # its parent, but all roles in the class are already also done by the | ||||
376 | # parent | ||||
377 | # see t/metaclasses/metaclass_compat_no_fixing_bug.t | ||||
378 | return $super_meta_name | ||||
379 | unless @role_differences; | ||||
380 | |||||
381 | return Moose::Meta::Class->create_anon_class( | ||||
382 | superclasses => [$super_meta_name], | ||||
383 | roles => [map { $_->name } @role_differences], | ||||
384 | cache => 1, | ||||
385 | )->name; | ||||
386 | } | ||||
387 | |||||
388 | sub _role_differences { | ||||
389 | my ($class_meta_name, $super_meta_name) = @_; | ||||
390 | my @super_role_metas = map { | ||||
391 | $_->isa('Moose::Meta::Role::Composite') | ||||
392 | ? (@{ $_->get_roles }) | ||||
393 | : ($_) | ||||
394 | } $super_meta_name->meta->can('_roles_with_inheritance') | ||||
395 | ? $super_meta_name->meta->_roles_with_inheritance | ||||
396 | : $super_meta_name->meta->can('roles') | ||||
397 | ? @{ $super_meta_name->meta->roles } | ||||
398 | : (); | ||||
399 | my @role_metas = map { | ||||
400 | $_->isa('Moose::Meta::Role::Composite') | ||||
401 | ? (@{ $_->get_roles }) | ||||
402 | : ($_) | ||||
403 | } $class_meta_name->meta->can('_roles_with_inheritance') | ||||
404 | ? $class_meta_name->meta->_roles_with_inheritance | ||||
405 | : $class_meta_name->meta->can('roles') | ||||
406 | ? @{ $class_meta_name->meta->roles } | ||||
407 | : (); | ||||
408 | my @differences; | ||||
409 | for my $role_meta (@role_metas) { | ||||
410 | push @differences, $role_meta | ||||
411 | unless any { $_->name eq $role_meta->name } @super_role_metas; | ||||
412 | } | ||||
413 | return @differences; | ||||
414 | } | ||||
415 | |||||
416 | sub _classes_differ_by_roles_only { | ||||
417 | my ( $self_meta_name, $super_meta_name ) = @_; | ||||
418 | |||||
419 | my $common_base_name | ||||
420 | = _find_common_base( $self_meta_name, $super_meta_name ); | ||||
421 | |||||
422 | return unless defined $common_base_name; | ||||
423 | |||||
424 | my @super_meta_name_ancestor_names | ||||
425 | = _get_ancestors_until( $super_meta_name, $common_base_name ); | ||||
426 | my @class_meta_name_ancestor_names | ||||
427 | = _get_ancestors_until( $self_meta_name, $common_base_name ); | ||||
428 | |||||
429 | return | ||||
430 | unless all { _is_role_only_subclass($_) } | ||||
431 | @super_meta_name_ancestor_names, | ||||
432 | @class_meta_name_ancestor_names; | ||||
433 | |||||
434 | return 1; | ||||
435 | } | ||||
436 | |||||
437 | sub _find_common_base { | ||||
438 | my ($meta1, $meta2) = map { Class::MOP::class_of($_) } @_; | ||||
439 | return unless defined $meta1 && defined $meta2; | ||||
440 | |||||
441 | # FIXME? This doesn't account for multiple inheritance (not sure | ||||
442 | # if it needs to though). For example, if somewhere in $meta1's | ||||
443 | # history it inherits from both ClassA and ClassB, and $meta2 | ||||
444 | # inherits from ClassB & ClassA, does it matter? And what crazy | ||||
445 | # fool would do that anyway? | ||||
446 | |||||
447 | my %meta1_parents = map { $_ => 1 } $meta1->linearized_isa; | ||||
448 | |||||
449 | return first { $meta1_parents{$_} } $meta2->linearized_isa; | ||||
450 | } | ||||
451 | |||||
452 | sub _get_ancestors_until { | ||||
453 | my ($start_name, $until_name) = @_; | ||||
454 | |||||
455 | my @ancestor_names; | ||||
456 | for my $ancestor_name (Class::MOP::class_of($start_name)->linearized_isa) { | ||||
457 | last if $ancestor_name eq $until_name; | ||||
458 | push @ancestor_names, $ancestor_name; | ||||
459 | } | ||||
460 | return @ancestor_names; | ||||
461 | } | ||||
462 | |||||
463 | sub _is_role_only_subclass { | ||||
464 | my ($meta_name) = @_; | ||||
465 | my $meta = Class::MOP::Class->initialize($meta_name); | ||||
466 | my @parent_names = $meta->superclasses; | ||||
467 | |||||
468 | # XXX: don't feel like messing with multiple inheritance here... what would | ||||
469 | # that even do? | ||||
470 | return unless @parent_names == 1; | ||||
471 | my ($parent_name) = @parent_names; | ||||
472 | my $parent_meta = Class::MOP::Class->initialize($parent_name); | ||||
473 | |||||
474 | # only get the roles attached to this particular class, don't look at | ||||
475 | # superclasses | ||||
476 | my @roles = $meta->can('calculate_all_roles') | ||||
477 | ? $meta->calculate_all_roles | ||||
478 | : (); | ||||
479 | |||||
480 | # it's obviously not a role-only subclass if it doesn't do any roles | ||||
481 | return unless @roles; | ||||
482 | |||||
483 | # loop over all methods that are a part of the current class | ||||
484 | # (not inherited) | ||||
485 | for my $method ( $meta->_get_local_methods ) { | ||||
486 | # always ignore meta | ||||
487 | next if $method->isa('Class::MOP::Method::Meta'); | ||||
488 | # we'll deal with attributes below | ||||
489 | next if $method->can('associated_attribute'); | ||||
490 | # if the method comes from a role we consumed, ignore it | ||||
491 | next if $meta->can('does_role') | ||||
492 | && $meta->does_role($method->original_package_name); | ||||
493 | # FIXME - this really isn't right. Just because a modifier is | ||||
494 | # defined in a role doesn't mean it isn't _also_ defined in the | ||||
495 | # subclass. | ||||
496 | next if $method->isa('Class::MOP::Method::Wrapped') | ||||
497 | && ( | ||||
498 | (!scalar($method->around_modifiers) | ||||
499 | || any { $_->has_around_method_modifiers($method->name) } @roles) | ||||
500 | && (!scalar($method->before_modifiers) | ||||
501 | || any { $_->has_before_method_modifiers($method->name) } @roles) | ||||
502 | && (!scalar($method->after_modifiers) | ||||
503 | || any { $_->has_after_method_modifiers($method->name) } @roles) | ||||
504 | ); | ||||
505 | |||||
506 | return 0; | ||||
507 | } | ||||
508 | |||||
509 | # loop over all attributes that are a part of the current class | ||||
510 | # (not inherited) | ||||
511 | # FIXME - this really isn't right. Just because an attribute is | ||||
512 | # defined in a role doesn't mean it isn't _also_ defined in the | ||||
513 | # subclass. | ||||
514 | for my $attr (map { $meta->get_attribute($_) } $meta->get_attribute_list) { | ||||
515 | next if any { $_->has_attribute($attr->name) } @roles; | ||||
516 | |||||
517 | return 0; | ||||
518 | } | ||||
519 | |||||
520 | return 1; | ||||
521 | } | ||||
522 | |||||
523 | sub _is_package_loaded { | ||||
524 | my ($package) = @_; | ||||
525 | defined $INC{module_notional_filename($package)}; | ||||
526 | } | ||||
527 | |||||
528 | 1 | 30µs | 1; | ||
529 | |||||
530 | # ABSTRACT: Utilities for working with Moose classes | ||||
531 | |||||
532 | __END__ |