← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/pan_genome_post_analysis
  Run on Fri Mar 27 11:43:32 2015
Reported on Fri Mar 27 11:45:26 2015

Filename/Users/ap13/perl5/lib/perl5/darwin-2level/Moose/Util.pm
StatementsExecuted 907 statements in 7.29ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
185221.68ms1.68msMoose::Util::::_caller_infoMoose::Util::_caller_info
411195µs62.1msMoose::Util::::_apply_all_rolesMoose::Util::_apply_all_roles
2222130µs8.28msMoose::Util::::_load_user_classMoose::Util::_load_user_class (recurses: max depth 1, inclusive time 96µs)
41135µs62.2msMoose::Util::::apply_all_rolesMoose::Util::apply_all_roles
11133µs118µsMoose::Util::::BEGIN@12Moose::Util::BEGIN@12
11124µs86µsMoose::Util::::BEGIN@7Moose::Util::BEGIN@7
11121µs44µsMoose::Util::::BEGIN@4Moose::Util::BEGIN@4
11120µs514µsMoose::Util::::add_method_modifierMoose::Util::add_method_modifier
41118µs32µsMoose::Util::::find_metaMoose::Util::find_meta
11117µs63µsMoose::Util::::BEGIN@11Moose::Util::BEGIN@11
11116µs251µsMoose::Util::::BEGIN@10Moose::Util::BEGIN@10
11115µs65µsMoose::Util::::BEGIN@14Moose::Util::BEGIN@14
11115µs23µsMoose::Util::::BEGIN@8Moose::Util::BEGIN@8
11114µs54µsMoose::Util::::BEGIN@9Moose::Util::BEGIN@9
11113µs21µsMoose::Util::::BEGIN@5Moose::Util::BEGIN@5
1116µs6µsMoose::Util::::BEGIN@13Moose::Util::BEGIN@13
0000s0sMoose::Util::::_STRINGLIKE0Moose::Util::_STRINGLIKE0
0000s0sMoose::Util::::__ANON__[:109]Moose::Util::__ANON__[:109]
0000s0sMoose::Util::::__ANON__[:136]Moose::Util::__ANON__[:136]
0000s0sMoose::Util::::__ANON__[:327]Moose::Util::__ANON__[:327]
0000s0sMoose::Util::::__ANON__[:411]Moose::Util::__ANON__[:411]
0000s0sMoose::Util::::__ANON__[:430]Moose::Util::__ANON__[:430]
0000s0sMoose::Util::::__ANON__[:449]Moose::Util::__ANON__[:449]
0000s0sMoose::Util::::__ANON__[:499]Moose::Util::__ANON__[:499]
0000s0sMoose::Util::::__ANON__[:501]Moose::Util::__ANON__[:501]
0000s0sMoose::Util::::__ANON__[:503]Moose::Util::__ANON__[:503]
0000s0sMoose::Util::::__ANON__[:515]Moose::Util::__ANON__[:515]
0000s0sMoose::Util::::__ANON__[:69]Moose::Util::__ANON__[:69]
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::::_english_listMoose::Util::_english_list
0000s0sMoose::Util::::_english_list_andMoose::Util::_english_list_and
0000s0sMoose::Util::::_english_list_orMoose::Util::_english_list_or
0000s0sMoose::Util::::_find_common_baseMoose::Util::_find_common_base
0000s0sMoose::Util::::_get_ancestors_untilMoose::Util::_get_ancestors_until
0000s0sMoose::Util::::_is_package_loadedMoose::Util::_is_package_loaded
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::::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::::is_roleMoose::Util::is_role
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::::throw_exceptionMoose::Util::throw_exception
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;
212µsour $VERSION = '2.1403';
3
4240µs266µ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
use strict;
# spent 44µs making 1 call to Moose::Util::BEGIN@4 # spent 22µs making 1 call to strict::import
5261µs228µ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
use warnings;
# spent 21µs making 1 call to Moose::Util::BEGIN@5 # spent 7µs making 1 call to warnings::import
6
7370µs3149µ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
use Module::Runtime 0.014 'use_package_optimistically', 'use_module', 'module_notional_filename';
# 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
8244µs231µ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
use Data::OptList;
# 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]
9239µs294µ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
use Params::Util qw( _STRING );
# spent 54µs making 1 call to Moose::Util::BEGIN@9 # spent 40µs making 1 call to Exporter::import
102174µs2486µ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
use Sub::Exporter;
# 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]
11256µs2110µ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
use Scalar::Util 'blessed';
# spent 63µs making 1 call to Moose::Util::BEGIN@11 # spent 46µs making 1 call to Exporter::import
12376µs3154µ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
use List::Util 1.33 qw(first any all);
# 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
13244µs16µ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
use overload ();
# spent 6µs making 1 call to Moose::Util::BEGIN@13
1424.50ms2114µ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
use Try::Tiny;
# spent 65µs making 1 call to Moose::Util::BEGIN@14 # spent 49µs making 1 call to Exporter::import
15
16
1719µsmy @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
36114µs1599µsSub::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
4311µsrequire Class::MOP;
44
45sub 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
54412µs414µ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
sub find_meta { Class::MOP::class_of(@_) }
# spent 14µs making 4 calls to Class::MOP::class_of, avg 4µs/call
55
56## the functions ...
57
58sub 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
66sub 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
81sub 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.
107sub 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
sub apply_all_roles {
113825µs my $applicant = shift;
114462.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
sub _apply_all_roles {
11876204µ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 }
137482µ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
14344µ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 {
147420.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
148432µs $meta = find_meta( $role->[0] );
# spent 32µs making 4 calls to Moose::Util::find_meta, avg 8µs/call
149 }
150
15144µ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
16446µ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
16842µ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] };
172441.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
179sub 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
191sub 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
200sub 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
210sub resolve_metatrait_alias {
211 return resolve_metaclass_alias( @_, trait => 1 );
212}
213
214sub _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{
2242900ns 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
sub add_method_modifier {
259626µs my ( $class_or_obj, $modifier_name, $args ) = @_;
26017µ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 {
2851488µ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
289sub english_list {
290 _english_list_and(@_);
291}
292
293sub _english_list_and {
294 _english_list('and', \@_);
295}
296
297sub _english_list_or {
298 _english_list('or', \@_);
299}
300
301sub _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
sub _caller_info {
3177401.76ms my $level = @_ ? ($_[0] + 1) : 2;
318 my %info;
319 @info{qw(package file line)} = caller($level);
320 return %info;
321}
322
323sub _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
331sub 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
339sub 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
sub _load_user_class {
34844107µs my ($class, $opts) = @_;
349228.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
356sub _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
367sub _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
388sub _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
416sub _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
437sub _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
452sub _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
463sub _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
523sub _is_package_loaded {
524 my ($package) = @_;
525 defined $INC{module_notional_filename($package)};
526}
527
528130µs1;
529
530# ABSTRACT: Utilities for working with Moose classes
531
532__END__