← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:32 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/x86_64-linux/Moose/Util.pm
StatementsExecuted 164 statements in 2.60ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
411275µs110msMoose::Util::::_apply_all_rolesMoose::Util::_apply_all_roles
822118µs118µsMoose::Util::::_caller_infoMoose::Util::_caller_info
42233µs110msMoose::Util::::apply_all_rolesMoose::Util::apply_all_roles
41129µs60µsMoose::Util::::find_metaMoose::Util::find_meta
11113µs74µsMoose::Util::::BEGIN@12Moose::Util::BEGIN@12
1119µs173µsMoose::Util::::BEGIN@15Moose::Util::BEGIN@15
1118µs13µsMoose::Util::::BEGIN@13Moose::Util::BEGIN@13
1118µs33µsMoose::Util::::BEGIN@18Moose::Util::BEGIN@18
1118µs8µsMoose::Util::::BEGIN@2Moose::Util::BEGIN@2
1117µs27µsMoose::Util::::BEGIN@14Moose::Util::BEGIN@14
1117µs25µsMoose::Util::::BEGIN@17Moose::Util::BEGIN@17
1117µs28µsMoose::Util::::BEGIN@16Moose::Util::BEGIN@16
1117µs15µsMoose::Util::::BEGIN@10Moose::Util::BEGIN@10
1116µs39µsMoose::Util::::BEGIN@20Moose::Util::BEGIN@20
1116µs8µsMoose::Util::::BEGIN@9Moose::Util::BEGIN@9
1114µs4µsMoose::Util::::BEGIN@21Moose::Util::BEGIN@21
1113µs3µ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__[:367]Moose::Util::__ANON__[:367]
0000s0sMoose::Util::::__ANON__[:386]Moose::Util::__ANON__[:386]
0000s0sMoose::Util::::__ANON__[:405]Moose::Util::__ANON__[:405]
0000s0sMoose::Util::::__ANON__[:455]Moose::Util::__ANON__[:455]
0000s0sMoose::Util::::__ANON__[:457]Moose::Util::__ANON__[:457]
0000s0sMoose::Util::::__ANON__[:459]Moose::Util::__ANON__[:459]
0000s0sMoose::Util::::__ANON__[:471]Moose::Util::__ANON__[:471]
0000s0sMoose::Util::::__ANON__[:54]Moose::Util::__ANON__[:54]
0000s0sMoose::Util::::__ANON__[:94]Moose::Util::__ANON__[:94]
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::::does_roleMoose::Util::does_role
0000s0sMoose::Util::::english_listMoose::Util::english_list
0000s0sMoose::Util::::ensure_all_rolesMoose::Util::ensure_all_roles
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 8µs within Moose::Util::BEGIN@2 which was called: # once (8µs+0s) by Moose::Meta::Class::BEGIN@28 at line 4
BEGIN {
314µs $Moose::Util::AUTHORITY = 'cpan:STEVAN';
4121µs18µs}
# spent 8µs making 1 call to Moose::Util::BEGIN@2
5{
621µs $Moose::Util::VERSION = '2.0602';
7}
8
9319µs210µs
# spent 8µs (6+2) within Moose::Util::BEGIN@9 which was called: # once (6µs+2µs) by Moose::Meta::Class::BEGIN@28 at line 9
use strict;
# spent 8µs making 1 call to Moose::Util::BEGIN@9 # spent 2µs making 1 call to strict::import
10324µs223µs
# spent 15µs (7+8) within Moose::Util::BEGIN@10 which was called: # once (7µs+8µs) by Moose::Meta::Class::BEGIN@28 at line 10
use warnings;
# spent 15µs making 1 call to Moose::Util::BEGIN@10 # spent 8µs making 1 call to warnings::import
11
12352µs3134µs
# spent 74µs (13+61) within Moose::Util::BEGIN@12 which was called: # once (13µs+61µs) by Moose::Meta::Class::BEGIN@28 at line 12
use Class::Load 0.07 qw(load_class load_first_existing_class);
# spent 74µs making 1 call to Moose::Util::BEGIN@12 # spent 33µs making 1 call to Exporter::import # spent 28µs making 1 call to UNIVERSAL::VERSION
13319µs218µs
# spent 13µs (8+5) within Moose::Util::BEGIN@13 which was called: # once (8µs+5µs) by Moose::Meta::Class::BEGIN@28 at line 13
use Data::OptList;
# spent 13µs making 1 call to Moose::Util::BEGIN@13 # spent 5µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:284]
14317µs246µs
# spent 27µs (7+20) within Moose::Util::BEGIN@14 which was called: # once (7µs+20µs) by Moose::Meta::Class::BEGIN@28 at line 14
use Params::Util qw( _STRING );
# spent 27µs making 1 call to Moose::Util::BEGIN@14 # spent 20µs making 1 call to Exporter::import
15322µs2336µs
# spent 173µs (9+164) within Moose::Util::BEGIN@15 which was called: # once (9µs+164µs) by Moose::Meta::Class::BEGIN@28 at line 15
use Sub::Exporter;
# spent 173µs making 1 call to Moose::Util::BEGIN@15 # spent 164µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:756]
16318µs248µs
# spent 28µs (7+21) within Moose::Util::BEGIN@16 which was called: # once (7µs+21µs) by Moose::Meta::Class::BEGIN@28 at line 16
use Scalar::Util 'blessed';
# spent 28µs making 1 call to Moose::Util::BEGIN@16 # spent 21µs making 1 call to Exporter::import
17329µs243µs
# spent 25µs (7+18) within Moose::Util::BEGIN@17 which was called: # once (7µs+18µs) by Moose::Meta::Class::BEGIN@28 at line 17
use List::Util qw(first);
# spent 25µs making 1 call to Moose::Util::BEGIN@17 # spent 18µs making 1 call to Exporter::import
18317µs258µs
# spent 33µs (8+25) within Moose::Util::BEGIN@18 which was called: # once (8µs+25µs) by Moose::Meta::Class::BEGIN@28 at line 18
use List::MoreUtils qw(any all);
# spent 33µs making 1 call to Moose::Util::BEGIN@18 # spent 25µs making 1 call to Exporter::import
19319µs13µs
# spent 3µs within Moose::Util::BEGIN@19 which was called: # once (3µs+0s) by Moose::Meta::Class::BEGIN@28 at line 19
use overload ();
# spent 3µs making 1 call to Moose::Util::BEGIN@19
20316µs272µs
# spent 39µs (6+33) within Moose::Util::BEGIN@20 which was called: # once (6µs+33µs) by Moose::Meta::Class::BEGIN@28 at line 20
use Try::Tiny;
# spent 39µs making 1 call to Moose::Util::BEGIN@20 # spent 33µs making 1 call to Exporter::import
2131.84ms14µ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µs1329µsSub::Exporter::setup_exporter({
# spent 329µ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
47425µs431µs
# spent 60µs (29+31) within Moose::Util::find_meta which was called 4 times, avg 15µs/call: # 4 times (29µs+31µs) by Moose::Util::_apply_all_roles at line 133, avg 15µs/call
sub find_meta { Class::MOP::class_of(@_) }
# spent 31µs making 4 calls to Class::MOP::class_of, avg 8µs/call
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
97
# spent 110ms (33µs+110) within Moose::Util::apply_all_roles which was called 4 times, avg 27.5ms/call: # 3 times (24µs+107ms) by Moose::with at line 67 of Moose.pm, avg 35.8ms/call # once (9µs+2.46ms) by Moose::Meta::Class::create at line 104 of Moose/Meta/Class.pm
sub apply_all_roles {
9842µs my $applicant = shift;
99429µs4110ms _apply_all_roles($applicant, undef, @_);
# spent 110ms making 4 calls to Moose::Util::_apply_all_roles, avg 27.4ms/call
100}
101
102
# spent 110ms (275µs+110) within Moose::Util::_apply_all_roles which was called 4 times, avg 27.4ms/call: # 4 times (275µs+110ms) by Moose::Util::apply_all_roles at line 99, avg 27.4ms/call
sub _apply_all_roles {
10342µs my $applicant = shift;
10443µs my $role_filter = shift;
105
10642µs 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 }
122449µs4119µs });
# spent 119µs making 4 calls to Data::OptList::mkopt, avg 30µs/call
123
12442µs my @role_metas;
12547µs foreach my $role (@$roles) {
12641µs my $meta;
127
128424µs45µs if ( blessed $role->[0] ) {
# spent 5µs making 4 calls to Scalar::Util::blessed, avg 1µs/call
129 $meta = $role->[0];
130 }
131 else {
132414µs493.2ms load_class( $role->[0] , $role->[1] );
# spent 93.2ms making 4 calls to Class::Load::load_class, avg 23.3ms/call
133420µs460µs $meta = find_meta( $role->[0] );
# spent 60µs making 4 calls to Moose::Util::find_meta, avg 15µs/call
134 }
135
136429µs48µs unless ($meta && $meta->isa('Moose::Meta::Role') ) {
# spent 8µs making 4 calls to UNIVERSAL::isa, avg 2µs/call
137 require Moose;
138 Moose->throw_error( "You can only consume roles, "
139 . $role->[0]
140 . " is not a Moose role" );
141 }
142
143418µs push @role_metas, [ $meta, $role->[1] ];
144 }
145
14642µs if ( defined $role_filter ) {
147 @role_metas = grep { local $_ = $_->[0]; $role_filter->() } @role_metas;
148 }
149
15043µs return unless @role_metas;
151
152429µs410µs load_class($applicant)
# spent 10µs making 4 calls to Scalar::Util::blessed, avg 3µs/call
153 unless blessed($applicant)
154 || Class::MOP::class_of($applicant);
155
156423µs46µs my $meta = ( blessed $applicant ? $applicant : Moose::Meta::Class->initialize($applicant) );
# spent 6µs making 4 calls to Scalar::Util::blessed, avg 1µs/call
157
158432µs if ( scalar @role_metas == 1 ) {
15946µs my ( $role, $params ) = @{ $role_metas[0] };
160421µs416.1ms $role->apply( $meta, ( defined $params ? %$params : () ) );
# spent 16.1ms making 4 calls to Moose::Meta::Role::apply, avg 4.02ms/call
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{
2122800ns 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 118µs within Moose::Util::_caller_info which was called 8 times, avg 15µs/call: # 6 times (80µs+0s) by Moose::has at line 77 of Moose.pm, avg 13µs/call # 2 times (39µs+0s) by Moose::Role::has at line 48 of Moose/Role.pm, avg 19µs/call
sub _caller_info {
28586µs my $level = @_ ? ($_[0] + 1) : 2;
28683µs my %info;
287882µs @info{qw(package file line)} = caller($level);
288830µ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
351 = grep { !$_->isa('Moose::Meta::Role::Composite') }
352 $super_meta_name->meta->can('calculate_all_roles_with_inheritance')
353 ? $super_meta_name->meta->calculate_all_roles_with_inheritance
354 : $super_meta_name->meta->can('calculate_all_roles')
355 ? $super_meta_name->meta->calculate_all_roles
356 : ();
357 my @role_metas
358 = grep { !$_->isa('Moose::Meta::Role::Composite') }
359 $class_meta_name->meta->can('calculate_all_roles_with_inheritance')
360 ? $class_meta_name->meta->calculate_all_roles_with_inheritance
361 : $class_meta_name->meta->can('calculate_all_roles')
362 ? $class_meta_name->meta->calculate_all_roles
363 : ();
364 my @differences;
365 for my $role_meta (@role_metas) {
366 push @differences, $role_meta
367 unless any { $_->name eq $role_meta->name } @super_role_metas;
368 }
369 return @differences;
370}
371
372sub _classes_differ_by_roles_only {
373 my ( $self_meta_name, $super_meta_name ) = @_;
374
375 my $common_base_name
376 = _find_common_base( $self_meta_name, $super_meta_name );
377
378 return unless defined $common_base_name;
379
380 my @super_meta_name_ancestor_names
381 = _get_ancestors_until( $super_meta_name, $common_base_name );
382 my @class_meta_name_ancestor_names
383 = _get_ancestors_until( $self_meta_name, $common_base_name );
384
385 return
386 unless all { _is_role_only_subclass($_) }
387 @super_meta_name_ancestor_names,
388 @class_meta_name_ancestor_names;
389
390 return 1;
391}
392
393sub _find_common_base {
394 my ($meta1, $meta2) = map { Class::MOP::class_of($_) } @_;
395 return unless defined $meta1 && defined $meta2;
396
397 # FIXME? This doesn't account for multiple inheritance (not sure
398 # if it needs to though). For example, if somewhere in $meta1's
399 # history it inherits from both ClassA and ClassB, and $meta2
400 # inherits from ClassB & ClassA, does it matter? And what crazy
401 # fool would do that anyway?
402
403 my %meta1_parents = map { $_ => 1 } $meta1->linearized_isa;
404
405 return first { $meta1_parents{$_} } $meta2->linearized_isa;
406}
407
408sub _get_ancestors_until {
409 my ($start_name, $until_name) = @_;
410
411 my @ancestor_names;
412 for my $ancestor_name (Class::MOP::class_of($start_name)->linearized_isa) {
413 last if $ancestor_name eq $until_name;
414 push @ancestor_names, $ancestor_name;
415 }
416 return @ancestor_names;
417}
418
419sub _is_role_only_subclass {
420 my ($meta_name) = @_;
421 my $meta = Class::MOP::Class->initialize($meta_name);
422 my @parent_names = $meta->superclasses;
423
424 # XXX: don't feel like messing with multiple inheritance here... what would
425 # that even do?
426 return unless @parent_names == 1;
427 my ($parent_name) = @parent_names;
428 my $parent_meta = Class::MOP::Class->initialize($parent_name);
429
430 # only get the roles attached to this particular class, don't look at
431 # superclasses
432 my @roles = $meta->can('calculate_all_roles')
433 ? $meta->calculate_all_roles
434 : ();
435
436 # it's obviously not a role-only subclass if it doesn't do any roles
437 return unless @roles;
438
439 # loop over all methods that are a part of the current class
440 # (not inherited)
441 for my $method ( $meta->_get_local_methods ) {
442 # always ignore meta
443 next if $method->isa('Class::MOP::Method::Meta');
444 # we'll deal with attributes below
445 next if $method->can('associated_attribute');
446 # if the method comes from a role we consumed, ignore it
447 next if $meta->can('does_role')
448 && $meta->does_role($method->original_package_name);
449 # FIXME - this really isn't right. Just because a modifier is
450 # defined in a role doesn't mean it isn't _also_ defined in the
451 # subclass.
452 next if $method->isa('Class::MOP::Method::Wrapped')
453 && (
454 (!scalar($method->around_modifiers)
455 || any { $_->has_around_method_modifiers($method->name) } @roles)
456 && (!scalar($method->before_modifiers)
457 || any { $_->has_before_method_modifiers($method->name) } @roles)
458 && (!scalar($method->after_modifiers)
459 || any { $_->has_after_method_modifiers($method->name) } @roles)
460 );
461
462 return 0;
463 }
464
465 # loop over all attributes that are a part of the current class
466 # (not inherited)
467 # FIXME - this really isn't right. Just because an attribute is
468 # defined in a role doesn't mean it isn't _also_ defined in the
469 # subclass.
470 for my $attr (map { $meta->get_attribute($_) } $meta->get_attribute_list) {
471 next if any { $_->has_attribute($attr->name) } @roles;
472
473 return 0;
474 }
475
476 return 1;
477}
478
47917µs1;
480
481# ABSTRACT: Utilities for working with Moose classes
482
- -
485=pod
486
487=head1 NAME
488
489Moose::Util - Utilities for working with Moose classes
490
491=head1 VERSION
492
493version 2.0602
494
495=head1 SYNOPSIS
496
497 use Moose::Util qw/find_meta does_role search_class_by_role/;
498
499 my $meta = find_meta($object) || die "No metaclass found";
500
501 if (does_role($object, $role)) {
502 print "The object can do $role!\n";
503 }
504
505 my $class = search_class_by_role($object, 'FooRole');
506 print "Nearest class with 'FooRole' is $class\n";
507
508=head1 DESCRIPTION
509
510This module provides a set of utility functions. Many of these
511functions are intended for use in Moose itself or MooseX modules, but
512some of them may be useful for use in your own code.
513
514=head1 EXPORTED FUNCTIONS
515
516=over 4
517
518=item B<find_meta($class_or_obj)>
519
520This method takes a class name or object and attempts to find a
521metaclass for the class, if one exists. It will B<not> create one if it
522does not yet exist.
523
524=item B<does_role($class_or_obj, $role_or_obj)>
525
526Returns true if C<$class_or_obj> does the given C<$role_or_obj>. The role can
527be provided as a name or a L<Moose::Meta::Role> object.
528
529The class must already have a metaclass for this to work. If it doesn't, this
530function simply returns false.
531
532=item B<search_class_by_role($class_or_obj, $role_or_obj)>
533
534Returns the first class in the class's precedence list that does
535C<$role_or_obj>, if any. The role can be either a name or a
536L<Moose::Meta::Role> object.
537
538The class must already have a metaclass for this to work.
539
540=item B<apply_all_roles($applicant, @roles)>
541
542This function applies one or more roles to the given C<$applicant> The
543applicant can be a role name, class name, or object.
544
545The C<$applicant> must already have a metaclass object.
546
547The list of C<@roles> should a list of names or L<Moose::Meta::Role> objects,
548each of which can be followed by an optional hash reference of options
549(C<-excludes> and C<-alias>).
550
551=item B<ensure_all_roles($applicant, @roles)>
552
553This function is similar to C<apply_all_roles>, but only applies roles that
554C<$applicant> does not already consume.
555
556=item B<with_traits($class_name, @role_names)>
557
558This function creates a new class from C<$class_name> with each of
559C<@role_names> applied. It returns the name of the new class.
560
561=item B<get_all_attribute_values($meta, $instance)>
562
563Returns a hash reference containing all of the C<$instance>'s
564attributes. The keys are attribute names.
565
566=item B<get_all_init_args($meta, $instance)>
567
568Returns a hash reference containing all of the C<init_arg> values for
569the instance's attributes. The values are the associated attribute
570values. If an attribute does not have a defined C<init_arg>, it is
571skipped.
572
573This could be useful in cloning an object.
574
575=item B<resolve_metaclass_alias($category, $name, %options)>
576
577=item B<resolve_metatrait_alias($category, $name, %options)>
578
579Resolves a short name to a full class name. Short names are often used
580when specifying the C<metaclass> or C<traits> option for an attribute:
581
582 has foo => (
583 metaclass => "Bar",
584 );
585
586The name resolution mechanism is covered in
587L<Moose/Metaclass and Trait Name Resolution>.
588
589=item B<meta_class_alias($to[, $from])>
590
591=item B<meta_attribute_alias($to[, $from])>
592
593Create an alias from the class C<$from> (or the current package, if
594C<$from> is unspecified), so that
595L<Moose/Metaclass and Trait Name Resolution> works properly.
596
597=item B<english_list(@items)>
598
599Given a list of scalars, turns them into a proper list in English
600("one and two", "one, two, three, and four"). This is used to help us
601make nicer error messages.
602
603=back
604
605=head1 TODO
606
607Here is a list of possible functions to write
608
609=over 4
610
611=item discovering original method from modified method
612
613=item search for origin class of a method or attribute
614
615=back
616
617=head1 BUGS
618
619See L<Moose/BUGS> for details on reporting bugs.
620
621=head1 AUTHOR
622
623Moose is maintained by the Moose Cabal, along with the help of many contributors. See L<Moose/CABAL> and L<Moose/CONTRIBUTORS> for details.
624
625=head1 COPYRIGHT AND LICENSE
626
627This software is copyright (c) 2012 by Infinity Interactive, Inc..
628
629This is free software; you can redistribute it and/or modify it under
630the same terms as the Perl 5 programming language system itself.
631
632=cut
633
634
635__END__