← Index
NYTProf Performance Profile   « line view »
For fastest.pl
  Run on Fri Jan 31 20:48:16 2014
Reported on Fri Jan 31 20:49:41 2014

Filename/opt/perl-5.18.1/lib/site_perl/5.18.1/darwin-thread-multi-2level/Moose/Util.pm
StatementsExecuted 37 statements in 3.46ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11120µs54µsMoose::Util::::BEGIN@17Moose::Util::BEGIN@17
11119µs76µsMoose::Util::::BEGIN@12Moose::Util::BEGIN@12
11111µs11µsMoose::Util::::BEGIN@2Moose::Util::BEGIN@2
11111µs11µsMoose::Util::::_caller_infoMoose::Util::_caller_info
11110µs14µsMoose::Util::::BEGIN@13Moose::Util::BEGIN@13
1119µs44µsMoose::Util::::BEGIN@20Moose::Util::BEGIN@20
1119µs38µsMoose::Util::::BEGIN@14Moose::Util::BEGIN@14
1119µs14µsMoose::Util::::BEGIN@10Moose::Util::BEGIN@10
1119µs140µsMoose::Util::::BEGIN@15Moose::Util::BEGIN@15
1119µs38µsMoose::Util::::BEGIN@16Moose::Util::BEGIN@16
1119µs37µsMoose::Util::::BEGIN@18Moose::Util::BEGIN@18
1118µs24µsMoose::Util::::BEGIN@9Moose::Util::BEGIN@9
1114µs4µsMoose::Util::::BEGIN@21Moose::Util::BEGIN@21
1114µs4µsMoose::Util::::BEGIN@19Moose::Util::BEGIN@19
0000s0sMoose::Util::::_STRINGLIKE0Moose::Util::_STRINGLIKE0
0000s0sMoose::Util::::__ANON__[:121]Moose::Util::__ANON__[:121]
0000s0sMoose::Util::::__ANON__[:295]Moose::Util::__ANON__[:295]
0000s0sMoose::Util::::__ANON__[:371]Moose::Util::__ANON__[:371]
0000s0sMoose::Util::::__ANON__[:390]Moose::Util::__ANON__[:390]
0000s0sMoose::Util::::__ANON__[:409]Moose::Util::__ANON__[:409]
0000s0sMoose::Util::::__ANON__[:459]Moose::Util::__ANON__[:459]
0000s0sMoose::Util::::__ANON__[:461]Moose::Util::__ANON__[:461]
0000s0sMoose::Util::::__ANON__[:463]Moose::Util::__ANON__[:463]
0000s0sMoose::Util::::__ANON__[:475]Moose::Util::__ANON__[:475]
0000s0sMoose::Util::::__ANON__[:54]Moose::Util::__ANON__[:54]
0000s0sMoose::Util::::__ANON__[:94]Moose::Util::__ANON__[:94]
0000s0sMoose::Util::::_apply_all_rolesMoose::Util::_apply_all_roles
0000s0sMoose::Util::::_build_alias_package_nameMoose::Util::_build_alias_package_name
0000s0sMoose::Util::::_classes_differ_by_roles_onlyMoose::Util::_classes_differ_by_roles_only
0000s0sMoose::Util::::_create_aliasMoose::Util::_create_alias
0000s0sMoose::Util::::_find_common_baseMoose::Util::_find_common_base
0000s0sMoose::Util::::_get_ancestors_untilMoose::Util::_get_ancestors_until
0000s0sMoose::Util::::_is_role_only_subclassMoose::Util::_is_role_only_subclass
0000s0sMoose::Util::::_reconcile_roles_for_metaclassMoose::Util::_reconcile_roles_for_metaclass
0000s0sMoose::Util::::_role_differencesMoose::Util::_role_differences
0000s0sMoose::Util::::add_method_modifierMoose::Util::add_method_modifier
0000s0sMoose::Util::::apply_all_rolesMoose::Util::apply_all_roles
0000s0sMoose::Util::::does_roleMoose::Util::does_role
0000s0sMoose::Util::::english_listMoose::Util::english_list
0000s0sMoose::Util::::ensure_all_rolesMoose::Util::ensure_all_roles
0000s0sMoose::Util::::find_metaMoose::Util::find_meta
0000s0sMoose::Util::::get_all_attribute_valuesMoose::Util::get_all_attribute_values
0000s0sMoose::Util::::get_all_init_argsMoose::Util::get_all_init_args
0000s0sMoose::Util::::meta_attribute_aliasMoose::Util::meta_attribute_alias
0000s0sMoose::Util::::meta_class_aliasMoose::Util::meta_class_alias
0000s0sMoose::Util::::resolve_metaclass_aliasMoose::Util::resolve_metaclass_alias
0000s0sMoose::Util::::resolve_metatrait_aliasMoose::Util::resolve_metatrait_alias
0000s0sMoose::Util::::search_class_by_roleMoose::Util::search_class_by_role
0000s0sMoose::Util::::with_traitsMoose::Util::with_traits
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Moose::Util;
2
# spent 11µs within Moose::Util::BEGIN@2 which was called: # once (11µs+0s) by Moose::Meta::Class::BEGIN@28 at line 4
BEGIN {
316µs $Moose::Util::AUTHORITY = 'cpan:STEVAN';
4147µs111µs}
# spent 11µs making 1 call to Moose::Util::BEGIN@2
5{
621µs $Moose::Util::VERSION = '2.1005';
7}
8
9230µs240µs
# spent 24µs (8+16) within Moose::Util::BEGIN@9 which was called: # once (8µs+16µs) by Moose::Meta::Class::BEGIN@28 at line 9
use strict;
# spent 24µs making 1 call to Moose::Util::BEGIN@9 # spent 16µs making 1 call to strict::import
10238µs218µs
# spent 14µs (9+5) within Moose::Util::BEGIN@10 which was called: # once (9µs+5µs) by Moose::Meta::Class::BEGIN@28 at line 10
use warnings;
# spent 14µs making 1 call to Moose::Util::BEGIN@10 # spent 4µs making 1 call to warnings::import
11
12366µs3132µs
# spent 76µs (19+57) within Moose::Util::BEGIN@12 which was called: # once (19µs+57µs) by Moose::Meta::Class::BEGIN@28 at line 12
use Class::Load 0.07 qw(load_class load_first_existing_class);
# spent 76µs making 1 call to Moose::Util::BEGIN@12 # spent 35µs making 1 call to Exporter::import # spent 21µs making 1 call to UNIVERSAL::VERSION
13237µs217µs
# spent 14µs (10+4) within Moose::Util::BEGIN@13 which was called: # once (10µs+4µs) by Moose::Meta::Class::BEGIN@28 at line 13
use Data::OptList;
# spent 14µs making 1 call to Moose::Util::BEGIN@13 # spent 4µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:171]
14231µs266µs
# spent 38µs (9+29) within Moose::Util::BEGIN@14 which was called: # once (9µs+29µs) by Moose::Meta::Class::BEGIN@28 at line 14
use Params::Util qw( _STRING );
# spent 38µs making 1 call to Moose::Util::BEGIN@14 # spent 29µs making 1 call to Exporter::import
15238µs2272µs
# spent 140µs (9+132) within Moose::Util::BEGIN@15 which was called: # once (9µs+132µs) by Moose::Meta::Class::BEGIN@28 at line 15
use Sub::Exporter;
# spent 140µs making 1 call to Moose::Util::BEGIN@15 # spent 132µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:337]
16234µs266µs
# spent 38µs (9+29) within Moose::Util::BEGIN@16 which was called: # once (9µs+29µs) by Moose::Meta::Class::BEGIN@28 at line 16
use Scalar::Util 'blessed';
# spent 38µs making 1 call to Moose::Util::BEGIN@16 # spent 29µs making 1 call to Exporter::import
17239µs261µs
# spent 54µs (20+34) within Moose::Util::BEGIN@17 which was called: # once (20µs+34µs) by Moose::Meta::Class::BEGIN@28 at line 17
use List::Util qw(first);
# spent 54µs making 1 call to Moose::Util::BEGIN@17 # spent 7µs making 1 call to List::Util::import
18240µs266µs
# spent 37µs (9+29) within Moose::Util::BEGIN@18 which was called: # once (9µs+29µs) by Moose::Meta::Class::BEGIN@28 at line 18
use List::MoreUtils qw(any all);
# spent 37µs making 1 call to Moose::Util::BEGIN@18 # spent 29µs making 1 call to Exporter::import
19234µs14µs
# spent 4µs within Moose::Util::BEGIN@19 which was called: # once (4µs+0s) by Moose::Meta::Class::BEGIN@28 at line 19
use overload ();
# spent 4µs making 1 call to Moose::Util::BEGIN@19
20231µs280µs
# spent 44µs (9+35) within Moose::Util::BEGIN@20 which was called: # once (9µs+35µs) by Moose::Meta::Class::BEGIN@28 at line 20
use Try::Tiny;
# spent 44µs making 1 call to Moose::Util::BEGIN@20 # spent 35µs making 1 call to Exporter::import
2122.95ms14µs
# spent 4µs within Moose::Util::BEGIN@21 which was called: # once (4µs+0s) by Moose::Meta::Class::BEGIN@28 at line 21
use Class::MOP;
# spent 4µs making 1 call to Moose::Util::BEGIN@21
22
2313µsmy @exports = qw[
24 find_meta
25 does_role
26 search_class_by_role
27 ensure_all_roles
28 apply_all_roles
29 with_traits
30 get_all_init_args
31 get_all_attribute_values
32 resolve_metatrait_alias
33 resolve_metaclass_alias
34 add_method_modifier
35 english_list
36 meta_attribute_alias
37 meta_class_alias
38];
39
4016µs1328µsSub::Exporter::setup_exporter({
# spent 328µs making 1 call to Sub::Exporter::setup_exporter
41 exports => \@exports,
42 groups => { all => \@exports }
43});
44
45## some utils for the utils ...
46
47sub find_meta { Class::MOP::class_of(@_) }
48
49## the functions ...
50
51sub does_role {
52 my ($class_or_obj, $role) = @_;
53
54 if (try { $class_or_obj->isa('Moose::Object') }) {
55 return $class_or_obj->does($role);
56 }
57
58 my $meta = find_meta($class_or_obj);
59
60 return unless defined $meta;
61 return unless $meta->can('does_role');
62 return 1 if $meta->does_role($role);
63 return;
64}
65
66sub search_class_by_role {
67 my ($class_or_obj, $role) = @_;
68
69 my $meta = find_meta($class_or_obj);
70
71 return unless defined $meta;
72
73 my $role_name = blessed $role ? $role->name : $role;
74
75 foreach my $class ($meta->class_precedence_list) {
76
77 my $_meta = find_meta($class);
78
79 next unless defined $_meta;
80
81 foreach my $role (@{ $_meta->roles || [] }) {
82 return $class if $role->name eq $role_name;
83 }
84 }
85
86 return;
87}
88
89# this can possibly behave in unexpected ways because the roles being composed
90# before being applied could differ from call to call; I'm not sure if or how
91# to document this possible quirk.
92sub ensure_all_roles {
93 my $applicant = shift;
94 _apply_all_roles($applicant, sub { !does_role($applicant, $_) }, @_);
95}
96
97sub apply_all_roles {
98 my $applicant = shift;
99 _apply_all_roles($applicant, undef, @_);
100}
101
102sub _apply_all_roles {
103 my $applicant = shift;
104 my $role_filter = shift;
105
106 unless (@_) {
107 require Moose;
108 Moose->throw_error("Must specify at least one role to apply to $applicant");
109 }
110
111 # If @_ contains role meta objects, mkopt will think that they're values,
112 # because they're references. In other words (roleobj1, roleobj2,
113 # roleobj3) will become [ [ roleobj1, roleobj2 ], [ roleobj3, undef ] ]
114 # -- this is no good. We'll preprocess @_ first to eliminate the potential
115 # bug.
116 # -- rjbs, 2011-04-08
117 my $roles = Data::OptList::mkopt( [@_], {
118 moniker => 'role',
119 name_test => sub {
120 ! ref $_[0] or blessed($_[0]) && $_[0]->isa('Moose::Meta::Role')
121 }
122 });
123
124 my @role_metas;
125 foreach my $role (@$roles) {
126 my $meta;
127
128 if ( blessed $role->[0] ) {
129 $meta = $role->[0];
130 }
131 else {
132 load_class( $role->[0] , $role->[1] );
133 $meta = find_meta( $role->[0] );
134 }
135
136 unless ($meta && $meta->isa('Moose::Meta::Role') ) {
137 require Moose;
138 Moose->throw_error( "You can only consume roles, "
139 . $role->[0]
140 . " is not a Moose role" );
141 }
142
143 push @role_metas, [ $meta, $role->[1] ];
144 }
145
146 if ( defined $role_filter ) {
147 @role_metas = grep { local $_ = $_->[0]; $role_filter->() } @role_metas;
148 }
149
150 return unless @role_metas;
151
152 load_class($applicant)
153 unless blessed($applicant)
154 || Class::MOP::class_of($applicant);
155
156 my $meta = ( blessed $applicant ? $applicant : Moose::Meta::Class->initialize($applicant) );
157
158 if ( scalar @role_metas == 1 ) {
159 my ( $role, $params ) = @{ $role_metas[0] };
160 $role->apply( $meta, ( defined $params ? %$params : () ) );
161 }
162 else {
163 Moose::Meta::Role->combine(@role_metas)->apply($meta);
164 }
165}
166
167sub with_traits {
168 my ($class, @roles) = @_;
169 return $class unless @roles;
170 return Moose::Meta::Class->create_anon_class(
171 superclasses => [$class],
172 roles => \@roles,
173 cache => 1,
174 )->name;
175}
176
177# instance deconstruction ...
178
179sub get_all_attribute_values {
180 my ($class, $instance) = @_;
181 return +{
182 map { $_->name => $_->get_value($instance) }
183 grep { $_->has_value($instance) }
184 $class->get_all_attributes
185 };
186}
187
188sub get_all_init_args {
189 my ($class, $instance) = @_;
190 return +{
191 map { $_->init_arg => $_->get_value($instance) }
192 grep { $_->has_value($instance) }
193 grep { defined($_->init_arg) }
194 $class->get_all_attributes
195 };
196}
197
198sub resolve_metatrait_alias {
199 return resolve_metaclass_alias( @_, trait => 1 );
200}
201
202sub _build_alias_package_name {
203 my ($type, $name, $trait) = @_;
204 return 'Moose::Meta::'
205 . $type
206 . '::Custom::'
207 . ( $trait ? 'Trait::' : '' )
208 . $name;
209}
210
211{
2122500ns my %cache;
213
214 sub resolve_metaclass_alias {
215 my ( $type, $metaclass_name, %options ) = @_;
216
217 my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' );
218 return $cache{$cache_key}{$metaclass_name}
219 if $cache{$cache_key}{$metaclass_name};
220
221 my $possible_full_name = _build_alias_package_name(
222 $type, $metaclass_name, $options{trait}
223 );
224
225 my $loaded_class = load_first_existing_class(
226 $possible_full_name,
227 $metaclass_name
228 );
229
230 return $cache{$cache_key}{$metaclass_name}
231 = $loaded_class->can('register_implementation')
232 ? $loaded_class->register_implementation
233 : $loaded_class;
234 }
235}
236
237sub add_method_modifier {
238 my ( $class_or_obj, $modifier_name, $args ) = @_;
239 my $meta
240 = $class_or_obj->can('add_before_method_modifier')
241 ? $class_or_obj
242 : find_meta($class_or_obj);
243 my $code = pop @{$args};
244 my $add_modifier_method = 'add_' . $modifier_name . '_method_modifier';
245 if ( my $method_modifier_type = ref( @{$args}[0] ) ) {
246 if ( $method_modifier_type eq 'Regexp' ) {
247 my @all_methods = $meta->get_all_methods;
248 my @matched_methods
249 = grep { $_->name =~ @{$args}[0] } @all_methods;
250 $meta->$add_modifier_method( $_->name, $code )
251 for @matched_methods;
252 }
253 elsif ($method_modifier_type eq 'ARRAY') {
254 $meta->$add_modifier_method( $_, $code ) for @{$args->[0]};
255 }
256 else {
257 $meta->throw_error(
258 sprintf(
259 "Methods passed to %s must be provided as a list, arrayref or regex, not %s",
260 $modifier_name,
261 $method_modifier_type,
262 )
263 );
264 }
265 }
266 else {
267 $meta->$add_modifier_method( $_, $code ) for @{$args};
268 }
269}
270
271sub english_list {
272 my @items = sort @_;
273
274 return $items[0] if @items == 1;
275 return "$items[0] and $items[1]" if @items == 2;
276
277 my $tail = pop @items;
278 my $list = join ', ', @items;
279 $list .= ', and ' . $tail;
280
281 return $list;
282}
283
284
# spent 11µs within Moose::Util::_caller_info which was called: # once (11µs+0s) by Moose::has at line 76 of Moose.pm
sub _caller_info {
2851600ns my $level = @_ ? ($_[0] + 1) : 2;
2861200ns my %info;
28716µs @info{qw(package file line)} = caller($level);
28817µs return %info;
289}
290
291sub _create_alias {
292 my ($type, $name, $trait, $for) = @_;
293 my $package = _build_alias_package_name($type, $name, $trait);
294 Class::MOP::Class->initialize($package)->add_method(
295 register_implementation => sub { $for }
296 );
297}
298
299sub meta_attribute_alias {
300 my ($to, $from) = @_;
301 $from ||= caller;
302 my $meta = Class::MOP::class_of($from);
303 my $trait = $meta->isa('Moose::Meta::Role');
304 _create_alias('Attribute', $to, $trait, $from);
305}
306
307sub meta_class_alias {
308 my ($to, $from) = @_;
309 $from ||= caller;
310 my $meta = Class::MOP::class_of($from);
311 my $trait = $meta->isa('Moose::Meta::Role');
312 _create_alias('Class', $to, $trait, $from);
313}
314
315# XXX - this should be added to Params::Util
316sub _STRINGLIKE0 ($) {
317 return 1 if _STRING( $_[0] );
318 if ( blessed $_[0] ) {
319 return overload::Method( $_[0], q{""} );
320 }
321
322 return 1 if defined $_[0] && $_[0] eq q{};
323
324 return 0;
325}
326
327sub _reconcile_roles_for_metaclass {
328 my ($class_meta_name, $super_meta_name) = @_;
329
330 my @role_differences = _role_differences(
331 $class_meta_name, $super_meta_name,
332 );
333
334 # handle the case where we need to fix compatibility between a class and
335 # its parent, but all roles in the class are already also done by the
336 # parent
337 # see t/metaclasses/metaclass_compat_no_fixing_bug.t
338 return $super_meta_name
339 unless @role_differences;
340
341 return Moose::Meta::Class->create_anon_class(
342 superclasses => [$super_meta_name],
343 roles => [map { $_->name } @role_differences],
344 cache => 1,
345 )->name;
346}
347
348sub _role_differences {
349 my ($class_meta_name, $super_meta_name) = @_;
350 my @super_role_metas = map {
351 $_->isa('Moose::Meta::Role::Composite')
352 ? (@{ $_->get_roles })
353 : ($_)
354 } $super_meta_name->meta->can('_roles_with_inheritance')
355 ? $super_meta_name->meta->_roles_with_inheritance
356 : $super_meta_name->meta->can('roles')
357 ? @{ $super_meta_name->meta->roles }
358 : ();
359 my @role_metas = map {
360 $_->isa('Moose::Meta::Role::Composite')
361 ? (@{ $_->get_roles })
362 : ($_)
363 } $class_meta_name->meta->can('_roles_with_inheritance')
364 ? $class_meta_name->meta->_roles_with_inheritance
365 : $class_meta_name->meta->can('roles')
366 ? @{ $class_meta_name->meta->roles }
367 : ();
368 my @differences;
369 for my $role_meta (@role_metas) {
370 push @differences, $role_meta
371 unless any { $_->name eq $role_meta->name } @super_role_metas;
372 }
373 return @differences;
374}
375
376sub _classes_differ_by_roles_only {
377 my ( $self_meta_name, $super_meta_name ) = @_;
378
379 my $common_base_name
380 = _find_common_base( $self_meta_name, $super_meta_name );
381
382 return unless defined $common_base_name;
383
384 my @super_meta_name_ancestor_names
385 = _get_ancestors_until( $super_meta_name, $common_base_name );
386 my @class_meta_name_ancestor_names
387 = _get_ancestors_until( $self_meta_name, $common_base_name );
388
389 return
390 unless all { _is_role_only_subclass($_) }
391 @super_meta_name_ancestor_names,
392 @class_meta_name_ancestor_names;
393
394 return 1;
395}
396
397sub _find_common_base {
398 my ($meta1, $meta2) = map { Class::MOP::class_of($_) } @_;
399 return unless defined $meta1 && defined $meta2;
400
401 # FIXME? This doesn't account for multiple inheritance (not sure
402 # if it needs to though). For example, if somewhere in $meta1's
403 # history it inherits from both ClassA and ClassB, and $meta2
404 # inherits from ClassB & ClassA, does it matter? And what crazy
405 # fool would do that anyway?
406
407 my %meta1_parents = map { $_ => 1 } $meta1->linearized_isa;
408
409 return first { $meta1_parents{$_} } $meta2->linearized_isa;
410}
411
412sub _get_ancestors_until {
413 my ($start_name, $until_name) = @_;
414
415 my @ancestor_names;
416 for my $ancestor_name (Class::MOP::class_of($start_name)->linearized_isa) {
417 last if $ancestor_name eq $until_name;
418 push @ancestor_names, $ancestor_name;
419 }
420 return @ancestor_names;
421}
422
423sub _is_role_only_subclass {
424 my ($meta_name) = @_;
425 my $meta = Class::MOP::Class->initialize($meta_name);
426 my @parent_names = $meta->superclasses;
427
428 # XXX: don't feel like messing with multiple inheritance here... what would
429 # that even do?
430 return unless @parent_names == 1;
431 my ($parent_name) = @parent_names;
432 my $parent_meta = Class::MOP::Class->initialize($parent_name);
433
434 # only get the roles attached to this particular class, don't look at
435 # superclasses
436 my @roles = $meta->can('calculate_all_roles')
437 ? $meta->calculate_all_roles
438 : ();
439
440 # it's obviously not a role-only subclass if it doesn't do any roles
441 return unless @roles;
442
443 # loop over all methods that are a part of the current class
444 # (not inherited)
445 for my $method ( $meta->_get_local_methods ) {
446 # always ignore meta
447 next if $method->isa('Class::MOP::Method::Meta');
448 # we'll deal with attributes below
449 next if $method->can('associated_attribute');
450 # if the method comes from a role we consumed, ignore it
451 next if $meta->can('does_role')
452 && $meta->does_role($method->original_package_name);
453 # FIXME - this really isn't right. Just because a modifier is
454 # defined in a role doesn't mean it isn't _also_ defined in the
455 # subclass.
456 next if $method->isa('Class::MOP::Method::Wrapped')
457 && (
458 (!scalar($method->around_modifiers)
459 || any { $_->has_around_method_modifiers($method->name) } @roles)
460 && (!scalar($method->before_modifiers)
461 || any { $_->has_before_method_modifiers($method->name) } @roles)
462 && (!scalar($method->after_modifiers)
463 || any { $_->has_after_method_modifiers($method->name) } @roles)
464 );
465
466 return 0;
467 }
468
469 # loop over all attributes that are a part of the current class
470 # (not inherited)
471 # FIXME - this really isn't right. Just because an attribute is
472 # defined in a role doesn't mean it isn't _also_ defined in the
473 # subclass.
474 for my $attr (map { $meta->get_attribute($_) } $meta->get_attribute_list) {
475 next if any { $_->has_attribute($attr->name) } @roles;
476
477 return 0;
478 }
479
480 return 1;
481}
482
483110µs1;
484
485# ABSTRACT: Utilities for working with Moose classes
486
487__END__