| 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 | Moose::Util::_caller_info |
| 4 | 1 | 1 | 195µs | 62.1ms | Moose::Util::_apply_all_roles |
| 22 | 2 | 2 | 130µs | 8.28ms | Moose::Util::_load_user_class (recurses: max depth 1, inclusive time 96µs) |
| 4 | 1 | 1 | 35µs | 62.2ms | Moose::Util::apply_all_roles |
| 1 | 1 | 1 | 33µs | 118µs | Moose::Util::BEGIN@12 |
| 1 | 1 | 1 | 24µs | 86µs | Moose::Util::BEGIN@7 |
| 1 | 1 | 1 | 21µs | 44µs | Moose::Util::BEGIN@4 |
| 1 | 1 | 1 | 20µs | 514µs | Moose::Util::add_method_modifier |
| 4 | 1 | 1 | 18µs | 32µs | Moose::Util::find_meta |
| 1 | 1 | 1 | 17µs | 63µs | Moose::Util::BEGIN@11 |
| 1 | 1 | 1 | 16µs | 251µs | Moose::Util::BEGIN@10 |
| 1 | 1 | 1 | 15µs | 65µs | Moose::Util::BEGIN@14 |
| 1 | 1 | 1 | 15µs | 23µs | Moose::Util::BEGIN@8 |
| 1 | 1 | 1 | 14µs | 54µs | Moose::Util::BEGIN@9 |
| 1 | 1 | 1 | 13µs | 21µs | Moose::Util::BEGIN@5 |
| 1 | 1 | 1 | 6µs | 6µs | Moose::Util::BEGIN@13 |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::_STRINGLIKE0 |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::__ANON__[:109] |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::__ANON__[:136] |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::__ANON__[:327] |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::__ANON__[:411] |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::__ANON__[:430] |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::__ANON__[:449] |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::__ANON__[:499] |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::__ANON__[:501] |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::__ANON__[:503] |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::__ANON__[:515] |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::__ANON__[:69] |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::_build_alias_package_name |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::_classes_differ_by_roles_only |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::_create_alias |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::_english_list |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::_english_list_and |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::_english_list_or |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::_find_common_base |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::_get_ancestors_until |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::_is_package_loaded |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::_is_role_only_subclass |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::_reconcile_roles_for_metaclass |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::_role_differences |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::does_role |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::english_list |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::ensure_all_roles |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::get_all_attribute_values |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::get_all_init_args |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::is_role |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::meta_attribute_alias |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::meta_class_alias |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::resolve_metaclass_alias |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::resolve_metatrait_alias |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::search_class_by_role |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::throw_exception |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::with_traits |
| 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__ |