← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:12 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Role/Tiny.pm
StatementsExecuted 2661 statements in 8.67ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
15213.81ms6.03msRole::Tiny::::_load_module Role::Tiny::_load_module (recurses: max depth 1, inclusive time 1.63ms)
31211.14ms2.92msRole::Tiny::::_install_methods Role::Tiny::_install_methods
6731812µs955µsRole::Tiny::::_concrete_methods_of Role::Tiny::_concrete_methods_of
1822685µs10.5msRole::Tiny::::apply_roles_to_package Role::Tiny::apply_roles_to_package (recurses: max depth 1, inclusive time 2.19ms)
3111594µs897µsRole::Tiny::::_install_does Role::Tiny::_install_does
16761534µs534µsRole::Tiny::::_getglob Role::Tiny::_getglob
101010479µs829µsRole::Tiny::::import Role::Tiny::import
1311374µs5.43msRole::Tiny::::_composite_info_for Role::Tiny::_composite_info_for
11841279µs279µsRole::Tiny::::_getstash Role::Tiny::_getstash
3121145µs166µsRole::Tiny::::_check_requires Role::Tiny::_check_requires
511119µs2.79msRole::Tiny::::apply_single_role_to_package Role::Tiny::apply_single_role_to_package (recurses: max depth 1, inclusive time 760µs)
312198µs98µsRole::Tiny::::_copy_applied_list Role::Tiny::_copy_applied_list
463194µs94µsRole::Tiny::::is_role Role::Tiny::is_role
922168µs68µsRole::Tiny::::CORE:match Role::Tiny::CORE:match (opcode)
151163µs63µsRole::Tiny::::CORE:subst Role::Tiny::CORE:subst (opcode)
312158µs58µsRole::Tiny::::_install_modifiers Role::Tiny::_install_modifiers
182133µs33µsRole::Tiny::::role_application_steps Role::Tiny::role_application_steps
44423µs2.22msRole::Tiny::::__ANON__[:67] Role::Tiny::__ANON__[:67]
51118µs2.81msRole::Tiny::::apply_role_to_package Role::Tiny::apply_role_to_package (recurses: max depth 1, inclusive time 765µs)
131116µs16µsRole::Tiny::::CORE:sort Role::Tiny::CORE:sort (opcode)
44414µs14µsRole::Tiny::::__ANON__[:63] Role::Tiny::__ANON__[:63]
11112µs28µsRole::Tiny::::BEGIN@6 Role::Tiny::BEGIN@6
1119µs22µsRole::Tiny::::BEGIN@366 Role::Tiny::BEGIN@366
1119µs17µsRole::Tiny::::BEGIN@432 Role::Tiny::BEGIN@432
1118µs20µsRole::Tiny::::BEGIN@290 Role::Tiny::BEGIN@290
1116µs10µsRole::Tiny::::BEGIN@7 Role::Tiny::BEGIN@7
1116µs6µsRole::Tiny::::BEGIN@20 Role::Tiny::BEGIN@20
0000s0sRole::Tiny::::__ANON__[:413] Role::Tiny::__ANON__[:413]
0000s0sRole::Tiny::::__ANON__[:431] Role::Tiny::__ANON__[:431]
0000s0sRole::Tiny::::__ANON__[:58] Role::Tiny::__ANON__[:58]
0000s0sRole::Tiny::__GUARD__::::DESTROYRole::Tiny::__GUARD__::DESTROY
0000s0sRole::Tiny::::_composable_package_for Role::Tiny::_composable_package_for
0000s0sRole::Tiny::::_composite_name Role::Tiny::_composite_name
0000s0sRole::Tiny::::_install_single_modifier Role::Tiny::_install_single_modifier
0000s0sRole::Tiny::::apply_roles_to_object Role::Tiny::apply_roles_to_object
0000s0sRole::Tiny::::create_class_with_roles Role::Tiny::create_class_with_roles
0000s0sRole::Tiny::::does_role Role::Tiny::does_role
0000s0sRole::Tiny::::methods_provided_by Role::Tiny::methods_provided_by
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Role::Tiny;
2
3167676µs
# spent 534µs within Role::Tiny::_getglob which was called 167 times, avg 3µs/call: # 89 times (348µs+0s) by Role::Tiny::_install_methods at line 367, avg 4µs/call # 30 times (79µs+0s) by Role::Tiny::import at line 58, avg 3µs/call # 14 times (30µs+0s) by Role::Tiny::_install_does at line 422, avg 2µs/call # 14 times (21µs+0s) by Role::Tiny::_install_does at line 433, avg 2µs/call # 10 times (29µs+0s) by Role::Tiny::import at line 67, avg 3µs/call # 10 times (26µs+0s) by Role::Tiny::import at line 63, avg 3µs/call
sub _getglob { \*{$_[0]} }
4118390µs
# spent 279µs within Role::Tiny::_getstash which was called 118 times, avg 2µs/call: # 67 times (143µs+0s) by Role::Tiny::_concrete_methods_of at line 329, avg 2µs/call # 31 times (54µs+0s) by Role::Tiny::_install_methods at line 356, avg 2µs/call # 10 times (48µs+0s) by Role::Tiny::_load_module at line 35, avg 5µs/call # 10 times (34µs+0s) by Role::Tiny::import at line 51, avg 3µs/call
sub _getstash { \%{"$_[0]::"} }
5
6219µs244µs
# spent 28µs (12+16) within Role::Tiny::BEGIN@6 which was called: # once (12µs+16µs) by Role::Tiny::With::BEGIN@9 at line 6
use strict;
# spent 28µs making 1 call to Role::Tiny::BEGIN@6 # spent 16µs making 1 call to strict::import
72113µs213µs
# spent 10µs (6+3) within Role::Tiny::BEGIN@7 which was called: # once (6µs+3µs) by Role::Tiny::With::BEGIN@9 at line 7
use warnings;
# spent 10µs making 1 call to Role::Tiny::BEGIN@7 # spent 3µs making 1 call to warnings::import
8
91600nsour $VERSION = '2.000001';
10113µs$VERSION = eval $VERSION;
# spent 2µs executing statements in string eval
11
121200nsour %INFO;
1310sour %APPLIED_TO;
1410sour %COMPOSED;
1510sour %COMPOSITE_INFO;
1610sour @ON_ROLE_CREATE;
17
18# Module state workaround totally stolen from Zefram's Module::Runtime.
19
20
# spent 6µs within Role::Tiny::BEGIN@20 which was called: # once (6µs+0s) by Role::Tiny::With::BEGIN@9 at line 23
BEGIN {
2112µs *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0};
2215µs *_MRO_MODULE = "$]" < 5.010 ? sub(){"MRO/Compat.pm"} : sub(){"mro.pm"};
2311.25ms16µs}
# spent 6µs making 1 call to Role::Tiny::BEGIN@20
24
25sub Role::Tiny::__GUARD__::DESTROY {
26 delete $INC{$_[0]->[0]} if @{$_[0]};
27}
28
29
# spent 6.03ms (3.81+2.22) within Role::Tiny::_load_module which was called 15 times, avg 402µs/call: # 10 times (2.36ms+2.44ms) by Role::Tiny::_composite_info_for at line 263, avg 480µs/call # 5 times (1.45ms+-222µs) by Role::Tiny::apply_single_role_to_package at line 86, avg 245µs/call
sub _load_module {
3015106µs1563µs (my $proto = $_[0]) =~ s/::/\//g;
# spent 63µs making 15 calls to Role::Tiny::CORE:subst, avg 4µs/call
31153µs $proto .= '.pm';
321519µs return 1 if $INC{$proto};
33 # can't just ->can('can') because a sub-package Foo::Bar::Baz
34 # creates a 'Baz::' key in Foo::Bar's symbol table
351033µs1351µs return 1 if grep !/::$/, keys %{_getstash($_[0])||{}};
# spent 48µs making 10 calls to Role::Tiny::_getstash, avg 5µs/call # spent 3µs making 3 calls to Role::Tiny::CORE:match, avg 1µs/call
36102µs my $guard = _WORK_AROUND_BROKEN_MODULE_STATE
37 && bless([ $proto ], 'Role::Tiny::__GUARD__');
3810608µs require $proto;
39 pop @$guard if _WORK_AROUND_BROKEN_MODULE_STATE;
401029µs return 1;
41}
42
43
# spent 829µs (479+350) within Role::Tiny::import which was called 10 times, avg 83µs/call: # once (67µs+54µs) by Path::IsDev::Role::Matcher::Child::Exists::Any::Dir::BEGIN@24 at line 24 of Path/IsDev/Role/Matcher/Child/Exists/Any/Dir.pm # once (52µs+34µs) by Path::IsDev::Role::Matcher::Child::Exists::Any::BEGIN@12 at line 12 of Path/IsDev/Role/Matcher/Child/Exists/Any.pm # once (50µs+35µs) by Path::IsDev::Role::HeuristicSet::Simple::BEGIN@44 at line 44 of Path/IsDev/Role/HeuristicSet/Simple.pm # once (52µs+32µs) by Path::IsDev::Role::Heuristic::BEGIN@14 at line 14 of Path/IsDev/Role/Heuristic.pm # once (44µs+34µs) by Path::IsDev::Role::Matcher::FullPath::Is::Any::BEGIN@18 at line 18 of Path/IsDev/Role/Matcher/FullPath/Is/Any.pm # once (43µs+35µs) by Path::IsDev::Role::Matcher::Child::BaseName::MatchRegexp::File::BEGIN@12 at line 12 of Path/IsDev/Role/Matcher/Child/BaseName/MatchRegexp/File.pm # once (47µs+30µs) by Path::IsDev::Role::HeuristicSet::BEGIN@28 at line 28 of Path/IsDev/Role/HeuristicSet.pm # once (44µs+33µs) by Path::IsDev::Role::NegativeHeuristic::BEGIN@14 at line 14 of Path/IsDev/Role/NegativeHeuristic.pm # once (40µs+32µs) by Path::IsDev::Role::Matcher::Child::Exists::Any::File::BEGIN@24 at line 24 of Path/IsDev/Role/Matcher/Child/Exists/Any/File.pm # once (40µs+31µs) by Path::IsDev::Role::Matcher::Child::BaseName::MatchRegexp::BEGIN@23 at line 23 of Path/IsDev/Role/Matcher/Child/BaseName/MatchRegexp.pm
sub import {
44107µs my $target = caller;
45103µs my $me = shift;
461010µs10108µs strict->import;
# spent 108µs making 10 calls to strict::import, avg 11µs/call
471012µs1051µs warnings->import;
# spent 51µs making 10 calls to warnings::import, avg 5µs/call
481014µs1022µs return if $me->is_role($target); # already exported into this package
# spent 22µs making 10 calls to Role::Tiny::is_role, avg 2µs/call
491014µs $INFO{$target}{is_role} = 1;
50 # get symbol table reference
511012µs1034µs my $stash = _getstash($target);
# spent 34µs making 10 calls to Role::Tiny::_getstash, avg 3µs/call
52 # install before/after/around subs
53105µs foreach my $type (qw(before after around)) {
54 *{_getglob "${target}::${type}"} = sub {
55 require Class::Method::Modifiers;
56 push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
57 return;
5830106µs3079µs };
# spent 79µs making 30 calls to Role::Tiny::_getglob, avg 3µs/call
59 }
60
# spent 14µs within Role::Tiny::__ANON__[/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Role/Tiny.pm:63] which was called 4 times, avg 3µs/call: # once (4µs+0s) by Role::Tiny::_load_module at line 79 of Path/IsDev/Role/Heuristic.pm # once (4µs+0s) by Role::Tiny::_load_module at line 36 of Path/IsDev/Role/HeuristicSet.pm # once (4µs+0s) by Role::Tiny::_load_module at line 79 of Path/IsDev/Role/NegativeHeuristic.pm # once (2µs+0s) by Role::Tiny::_load_module at line 47 of Path/IsDev/Role/HeuristicSet/Simple.pm
*{_getglob "${target}::requires"} = sub {
6147µs push @{$INFO{$target}{requires}||=[]}, @_;
62416µs return;
631032µs1026µs };
# spent 26µs making 10 calls to Role::Tiny::_getglob, avg 3µs/call
64
# spent 2.22ms (23µs+2.19) within Role::Tiny::__ANON__[/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Role/Tiny.pm:67] which was called 4 times, avg 554µs/call: # once (6µs+772µs) by Role::Tiny::_load_module at line 46 of Path/IsDev/Role/HeuristicSet/Simple.pm # once (5µs+645µs) by Role::Tiny::_load_module at line 25 of Path/IsDev/Role/Matcher/Child/Exists/Any/File.pm # once (5µs+608µs) by Role::Tiny::_load_module at line 13 of Path/IsDev/Role/Matcher/Child/BaseName/MatchRegexp/File.pm # once (8µs+167µs) by Role::Tiny::_load_module at line 25 of Path/IsDev/Role/Matcher/Child/Exists/Any/Dir.pm
*{_getglob "${target}::with"} = sub {
65412µs40s $me->apply_roles_to_package($target, @_);
# spent 2.19ms making 4 calls to Role::Tiny::apply_roles_to_package, avg 548µs/call, recursion: max depth 1, sum of overlapping time 2.19ms
66414µs return;
671025µs1029µs };
# spent 29µs making 10 calls to Role::Tiny::_getglob, avg 3µs/call
68 # grab all *non-constant* (stash slot is not a scalarref) subs present
69 # in the symbol table and store their refaddrs (no need to forcibly
70 # inflate constant subs into real subs) with a map to the coderefs in
71 # case of copying or re-use
721044µs my @not_methods = (map { *$_{CODE}||() } grep !ref($_), values %$stash);
731047µs @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods;
74 # a role does itself
75109µs $APPLIED_TO{$target} = { $target => undef };
761060µs $_->($target) for @ON_ROLE_CREATE;
77}
78
79
# spent 33µs within Role::Tiny::role_application_steps which was called 18 times, avg 2µs/call: # 13 times (24µs+0s) by Role::Tiny::apply_roles_to_package at line 250, avg 2µs/call # 5 times (9µs+0s) by Role::Tiny::apply_single_role_to_package at line 91, avg 2µs/call
sub role_application_steps {
801851µs qw(_install_methods _check_requires _install_modifiers _copy_applied_list);
81}
82
83
# spent 2.79ms (119µs+2.67) within Role::Tiny::apply_single_role_to_package which was called 5 times, avg 559µs/call: # 5 times (119µs+2.67ms) by Role::Tiny::apply_role_to_package at line 196, avg 559µs/call
sub apply_single_role_to_package {
8453µs my ($me, $to, $role) = @_;
85
8655µs51.23ms _load_module($role);
# spent 2.85ms making 5 calls to Role::Tiny::_load_module, avg 570µs/call, recursion: max depth 1, sum of overlapping time 1.63ms
87
885900ns die "This is apply_role_to_package" if ref($to);
89510µs516µs die "${role} is not a Role::Tiny" unless $me->is_role($role);
# spent 16µs making 5 calls to Role::Tiny::is_role, avg 3µs/call
90
91519µs59µs foreach my $step ($me->role_application_steps) {
# spent 9µs making 5 calls to Role::Tiny::role_application_steps, avg 2µs/call
922036µs20557µs $me->$step($to, $role);
# spent 496µs making 5 calls to Role::Tiny::_install_methods, avg 99µs/call # spent 34µs making 5 calls to Role::Tiny::_check_requires, avg 7µs/call # spent 16µs making 5 calls to Role::Tiny::_copy_applied_list, avg 3µs/call # spent 11µs making 5 calls to Role::Tiny::_install_modifiers, avg 2µs/call
93 }
94}
95
96
# spent 98µs within Role::Tiny::_copy_applied_list which was called 31 times, avg 3µs/call: # 26 times (82µs+0s) by Role::Tiny::apply_roles_to_package at line 252, avg 3µs/call # 5 times (16µs+0s) by Role::Tiny::apply_single_role_to_package at line 92, avg 3µs/call
sub _copy_applied_list {
97319µs my ($me, $to, $role) = @_;
98 # copy our role list into the target's
9931116µs @{$APPLIED_TO{$to}||={}}{keys %{$APPLIED_TO{$role}}} = ();
100}
101
102sub apply_roles_to_object {
103 my ($me, $object, @roles) = @_;
104 die "No roles supplied!" unless @roles;
105 my $class = ref($object);
106 # on perl < 5.8.9, magic isn't copied to all ref copies. bless the parameter
107 # directly, so at least the variable passed to us will get any magic applied
108 bless($_[1], $me->create_class_with_roles($class, @roles));
109}
110
1111400nsmy $role_suffix = 'A000';
112sub _composite_name {
113 my ($me, $superclass, @roles) = @_;
114
115 my $new_name = join(
116 '__WITH__', $superclass, my $compose_name = join '__AND__', @roles
117 );
118
119 if (length($new_name) > 252) {
120 $new_name = $COMPOSED{abbrev}{$new_name} ||= do {
121 my $abbrev = substr $new_name, 0, 250 - length $role_suffix;
122 $abbrev =~ s/(?<!:):$//;
123 $abbrev.'__'.$role_suffix++;
124 };
125 }
126 return wantarray ? ($new_name, $compose_name) : $new_name;
127}
128
129sub create_class_with_roles {
130 my ($me, $superclass, @roles) = @_;
131
132 die "No roles supplied!" unless @roles;
133
134 _load_module($superclass);
135 {
136 my %seen;
137 $seen{$_}++ for @roles;
138 if (my @dupes = grep $seen{$_} > 1, @roles) {
139 die "Duplicated roles: ".join(', ', @dupes);
140 }
141 }
142
143 my ($new_name, $compose_name) = $me->_composite_name($superclass, @roles);
144
145 return $new_name if $COMPOSED{class}{$new_name};
146
147 foreach my $role (@roles) {
148 _load_module($role);
149 die "${role} is not a Role::Tiny" unless $me->is_role($role);
150 }
151
152 require(_MRO_MODULE);
153
154 my $composite_info = $me->_composite_info_for(@roles);
155 my %conflicts = %{$composite_info->{conflicts}};
156 if (keys %conflicts) {
157 my $fail =
158 join "\n",
159 map {
160 "Method name conflict for '$_' between roles "
161 ."'".join(' and ', sort values %{$conflicts{$_}})."'"
162 .", cannot apply these simultaneously to an object."
163 } keys %conflicts;
164 die $fail;
165 }
166
167 my @composable = map $me->_composable_package_for($_), reverse @roles;
168
169 # some methods may not exist in the role, but get generated by
170 # _composable_package_for (Moose accessors via Moo). filter out anything
171 # provided by the composable packages, excluding the subs we generated to
172 # make modifiers work.
173 my @requires = grep {
174 my $method = $_;
175 !grep $_->can($method) && !$COMPOSED{role}{$_}{modifiers_only}{$method},
176 @composable
177 } @{$composite_info->{requires}};
178
179 $me->_check_requires(
180 $superclass, $compose_name, \@requires
181 );
182
183 *{_getglob("${new_name}::ISA")} = [ @composable, $superclass ];
184
185 @{$APPLIED_TO{$new_name}||={}}{
186 map keys %{$APPLIED_TO{$_}}, @roles
187 } = ();
188
189 $COMPOSED{class}{$new_name} = 1;
190 return $new_name;
191}
192
193# preserved for compat, and apply_roles_to_package calls it to allow an
194# updated Role::Tiny to use a non-updated Moo::Role
195
196515µs52.79ms
# spent 2.81ms (18µs+2.79) within Role::Tiny::apply_role_to_package which was called 5 times, avg 561µs/call: # 5 times (18µs+2.79ms) by Role::Tiny::apply_roles_to_package at line 201, avg 561µs/call
sub apply_role_to_package { shift->apply_single_role_to_package(@_) }
# spent 3.55ms making 5 calls to Role::Tiny::apply_single_role_to_package, avg 710µs/call, recursion: max depth 1, sum of overlapping time 760µs
197
198
# spent 10.5ms (685µs+9.82) within Role::Tiny::apply_roles_to_package which was called 18 times, avg 584µs/call: # 14 times (661µs+9.84ms) by Role::Tiny::With::with at line 16 of Role/Tiny/With.pm, avg 750µs/call # 4 times (23µs+-23µs) by Role::Tiny::__ANON__[/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Role/Tiny.pm:67] at line 65, avg 0s/call
sub apply_roles_to_package {
1991821µs my ($me, $to, @roles) = @_;
200
2011828µs52.81ms return $me->apply_role_to_package($to, $roles[0]) if @roles == 1;
# spent 3.57ms making 5 calls to Role::Tiny::apply_role_to_package, avg 714µs/call, recursion: max depth 1, sum of overlapping time 765µs
202
2031329µs135.43ms my %conflicts = %{$me->_composite_info_for(@roles)->{conflicts}};
# spent 5.43ms making 13 calls to Role::Tiny::_composite_info_for, avg 418µs/call
204136µs my @have = grep $to->can($_), keys %conflicts;
205134µs delete @conflicts{@have};
206
207133µs if (keys %conflicts) {
208 my $fail =
209 join "\n",
210 map {
211 "Due to a method name conflict between roles "
212 ."'".join(' and ', sort values %{$conflicts{$_}})."'"
213 .", the method '$_' must be implemented by '${to}'"
214 } keys %conflicts;
215 die $fail;
216 }
217
218 # conflicting methods are supposed to be treated as required by the
219 # composed role. we don't have an actual composed role, but because
220 # we know the target class already provides them, we can instead
221 # pretend that the roles don't do for the duration of application.
2221354µs26302µs my @role_methods = map $me->_concrete_methods_of($_), @roles;
# spent 302µs making 26 calls to Role::Tiny::_concrete_methods_of, avg 12µs/call
223 # separate loops, since local ..., delete ... for ...; creates a scope
2241324µs local @{$_}{@have} for @role_methods;
2251311µs delete @{$_}{@have} for @role_methods;
226
227 # the if guard here is essential since otherwise we accidentally create
228 # a $INFO for something that isn't a Role::Tiny (or Moo::Role) because
229 # autovivification hates us and wants us to die()
230133µs if ($INFO{$to}) {
231 delete $INFO{$to}{methods}; # reset since we're about to add methods
232 }
233
234 # backcompat: allow subclasses to use apply_single_role_to_package
235 # to apply changes. set a local var so ours does nothing.
236132µs our %BACKCOMPAT_HACK;
2371312µs if($me ne __PACKAGE__
238 and exists $BACKCOMPAT_HACK{$me} ? $BACKCOMPAT_HACK{$me} :
239 $BACKCOMPAT_HACK{$me} =
240 $me->can('role_application_steps')
241 == \&role_application_steps
242 && $me->can('apply_single_role_to_package')
243 != \&apply_single_role_to_package
244 ) {
245 foreach my $role (@roles) {
246 $me->apply_single_role_to_package($to, $role);
247 }
248 }
249 else {
2501324µs1324µs foreach my $step ($me->role_application_steps) {
# spent 24µs making 13 calls to Role::Tiny::role_application_steps, avg 2µs/call
2515229µs foreach my $role (@roles) {
252104180µs1042.68ms $me->$step($to, $role);
# spent 2.42ms making 26 calls to Role::Tiny::_install_methods, avg 93µs/call # spent 132µs making 26 calls to Role::Tiny::_check_requires, avg 5µs/call # spent 82µs making 26 calls to Role::Tiny::_copy_applied_list, avg 3µs/call # spent 47µs making 26 calls to Role::Tiny::_install_modifiers, avg 2µs/call
253 }
254 }
255 }
2561353µs $APPLIED_TO{$to}{join('|',@roles)} = 1;
257}
258
259
# spent 5.43ms (374µs+5.06) within Role::Tiny::_composite_info_for which was called 13 times, avg 418µs/call: # 13 times (374µs+5.06ms) by Role::Tiny::apply_roles_to_package at line 203, avg 418µs/call
sub _composite_info_for {
2601310µs my ($me, @roles) = @_;
26113113µs1316µs $COMPOSITE_INFO{join('|', sort @roles)} ||= do {
# spent 16µs making 13 calls to Role::Tiny::CORE:sort, avg 1µs/call
26253µs foreach my $role (@roles) {
2631016µs104.80ms _load_module($role);
# spent 4.80ms making 10 calls to Role::Tiny::_load_module, avg 480µs/call
264 }
26551µs my %methods;
26653µs foreach my $role (@roles) {
2671023µs10241µs my $this_methods = $me->_concrete_methods_of($role);
# spent 241µs making 10 calls to Role::Tiny::_concrete_methods_of, avg 24µs/call
2681076µs $methods{$_}{$this_methods->{$_}} = $role for keys %$this_methods;
269 }
2705700ns my %requires;
271515µs @requires{map @{$INFO{$_}{requires}||[]}, @roles} = ();
272525µs delete $requires{$_} for keys %methods;
273565µs delete $methods{$_} for grep keys(%{$methods{$_}}) == 1, keys %methods;
274511µs +{ conflicts => \%methods, requires => [keys %requires] }
275 };
276}
277
278sub _composable_package_for {
279 my ($me, $role) = @_;
280 my $composed_name = 'Role::Tiny::_COMPOSABLE::'.$role;
281 return $composed_name if $COMPOSED{role}{$composed_name};
282 $me->_install_methods($composed_name, $role);
283 my $base_name = $composed_name.'::_BASE';
284 # force stash to exist so ->can doesn't complain
285 _getstash($base_name);
286 # Not using _getglob, since setting @ISA via the typeglob breaks
287 # inheritance on 5.10.0 if the stash has previously been accessed an
288 # then a method called on the class (in that order!), which
289 # ->_install_methods (with the help of ->_install_does) ends up doing.
2902483µs232µs
# spent 20µs (8+12) within Role::Tiny::BEGIN@290 which was called: # once (8µs+12µs) by Role::Tiny::With::BEGIN@9 at line 290
{ no strict 'refs'; @{"${composed_name}::ISA"} = ( $base_name ); }
# spent 20µs making 1 call to Role::Tiny::BEGIN@290 # spent 12µs making 1 call to strict::unimport
291 my $modifiers = $INFO{$role}{modifiers}||[];
292 my @mod_base;
293 my @modifiers = grep !$composed_name->can($_),
294 do { my %h; @h{map @{$_}[1..$#$_-1], @$modifiers} = (); keys %h };
295 foreach my $modified (@modifiers) {
296 push @mod_base, "sub ${modified} { shift->next::method(\@_) }";
297 }
298 my $e;
299 {
300 local $@;
301 eval(my $code = join "\n", "package ${base_name};", @mod_base);
302 $e = "Evaling failed: $@\nTrying to eval:\n${code}" if $@;
303 }
304 die $e if $e;
305 $me->_install_modifiers($composed_name, $role);
306 $COMPOSED{role}{$composed_name} = {
307 modifiers_only => { map { $_ => 1 } @modifiers },
308 };
309 return $composed_name;
310}
311
312
# spent 166µs (145+21) within Role::Tiny::_check_requires which was called 31 times, avg 5µs/call: # 26 times (115µs+17µs) by Role::Tiny::apply_roles_to_package at line 252, avg 5µs/call # 5 times (30µs+4µs) by Role::Tiny::apply_single_role_to_package at line 92, avg 7µs/call
sub _check_requires {
3133113µs my ($me, $to, $name, $requires) = @_;
3143169µs return unless my @requires = @{$requires||$INFO{$name}{requires}||[]};
31515106µs1621µs if (my @requires_fail = grep !$to->can($_), @requires) {
# spent 21µs making 16 calls to UNIVERSAL::can, avg 1µs/call
316 # role -> role, add to requires, role -> class, error out
317 if (my $to_info = $INFO{$to}) {
318 push @{$to_info->{requires}||=[]}, @requires_fail;
319 } else {
320 die "Can't apply ${name} to ${to} - missing ".join(', ', @requires_fail);
321 }
322 }
323}
324
325
# spent 955µs (812+143) within Role::Tiny::_concrete_methods_of which was called 67 times, avg 14µs/call: # 31 times (347µs+64µs) by Role::Tiny::_install_methods at line 353, avg 13µs/call # 26 times (249µs+54µs) by Role::Tiny::apply_roles_to_package at line 222, avg 12µs/call # 10 times (216µs+25µs) by Role::Tiny::_composite_info_for at line 267, avg 24µs/call
sub _concrete_methods_of {
3266719µs my ($me, $role) = @_;
3276724µs my $info = $INFO{$role};
328 # grab role symbol table
3296761µs67143µs my $stash = _getstash($role);
# spent 143µs making 67 calls to Role::Tiny::_getstash, avg 2µs/call
330 # reverse so our keys become the values (captured coderefs) in case
331 # they got copied or re-used since
33267236µs my $not_methods = { reverse %{$info->{not_methods}||{}} };
333 $info->{methods} ||= +{
334 # grab all code entries that aren't in the not_methods list
335 map {
336188349µs my $code = *{$stash->{$_}}{CODE};
33712157µs ( ! $code or exists $not_methods->{$code} ) ? () : ($_ => $code)
338 } grep !ref($stash->{$_}), keys %$stash
339 };
340}
341
342sub methods_provided_by {
343 my ($me, $role) = @_;
344 die "${role} is not a Role::Tiny" unless $me->is_role($role);
345 (keys %{$me->_concrete_methods_of($role)}, @{$INFO{$role}->{requires}||[]});
346}
347
348
# spent 2.92ms (1.14+1.78) within Role::Tiny::_install_methods which was called 31 times, avg 94µs/call: # 26 times (942µs+1.48ms) by Role::Tiny::apply_roles_to_package at line 252, avg 93µs/call # 5 times (201µs+295µs) by Role::Tiny::apply_single_role_to_package at line 92, avg 99µs/call
sub _install_methods {
3493112µs my ($me, $to, $role) = @_;
350
3513112µs my $info = $INFO{$role};
352
3533140µs31412µs my $methods = $me->_concrete_methods_of($role);
# spent 412µs making 31 calls to Role::Tiny::_concrete_methods_of, avg 13µs/call
354
355 # grab target symbol table
3563134µs3154µs my $stash = _getstash($to);
# spent 54µs making 31 calls to Role::Tiny::_getstash, avg 2µs/call
357
358 # determine already extant methods of target
359314µs my %has_methods;
360 @has_methods{grep
36131252µs +(ref($stash->{$_}) || *{$stash->{$_}}{CODE}),
362 keys %$stash
363 } = ();
364
36531117µs foreach my $i (grep !exists $has_methods{$_}, keys %$methods) {
3662348µs235µs
# spent 22µs (9+13) within Role::Tiny::BEGIN@366 which was called: # once (9µs+13µs) by Role::Tiny::With::BEGIN@9 at line 366
no warnings 'once';
# spent 22µs making 1 call to Role::Tiny::BEGIN@366 # spent 13µs making 1 call to warnings::unimport
36789126µs89348µs my $glob = _getglob "${to}::${i}";
# spent 348µs making 89 calls to Role::Tiny::_getglob, avg 4µs/call
3688967µs *$glob = $methods->{$i};
369
370 # overloads using method names have the method stored in the scalar slot
371 # and &overload::nil in the code slot.
372 next
37389226µs8965µs unless $i =~ /^\(/
# spent 65µs making 89 calls to Role::Tiny::CORE:match, avg 727ns/call
374 && ((defined &overload::nil && $methods->{$i} == \&overload::nil)
375 || (defined &overload::_nil && $methods->{$i} == \&overload::_nil));
376
377 my $overload = ${ *{_getglob "${role}::${i}"}{SCALAR} };
378 next
379 unless defined $overload;
380
381 *$glob = \$overload;
382 }
383
38431113µs31897µs $me->_install_does($to);
# spent 897µs making 31 calls to Role::Tiny::_install_does, avg 29µs/call
385}
386
387
# spent 58µs within Role::Tiny::_install_modifiers which was called 31 times, avg 2µs/call: # 26 times (47µs+0s) by Role::Tiny::apply_roles_to_package at line 252, avg 2µs/call # 5 times (11µs+0s) by Role::Tiny::apply_single_role_to_package at line 92, avg 2µs/call
sub _install_modifiers {
3883110µs my ($me, $to, $name) = @_;
3893173µs return unless my $modifiers = $INFO{$name}{modifiers};
390 if (my $info = $INFO{$to}) {
391 push @{$info->{modifiers}}, @{$modifiers||[]};
392 } else {
393 foreach my $modifier (@{$modifiers||[]}) {
394 $me->_install_single_modifier($to, @$modifier);
395 }
396 }
397}
398
39910smy $vcheck_error;
400
401sub _install_single_modifier {
402 my ($me, @args) = @_;
403 defined($vcheck_error) or $vcheck_error = do {
404 local $@;
405 eval { Class::Method::Modifiers->VERSION(1.05); 1 }
406 ? 0
407 : $@
408 };
409 $vcheck_error and die $vcheck_error;
410 Class::Method::Modifiers::install_modifier(@args);
411}
412
41311µsmy $FALLBACK = sub { 0 };
414
# spent 897µs (594+303) within Role::Tiny::_install_does which was called 31 times, avg 29µs/call: # 31 times (594µs+303µs) by Role::Tiny::_install_methods at line 384, avg 29µs/call
sub _install_does {
415319µs my ($me, $to) = @_;
416
417 # only add does() method to classes
4183141µs3155µs return if $me->is_role($to);
# spent 55µs making 31 calls to Role::Tiny::is_role, avg 2µs/call
419
4202798µs2738µs my $does = $me->can('does_role');
# spent 38µs making 27 calls to UNIVERSAL::can, avg 1µs/call
421 # add does() only if they don't have one
42227173µs4176µs *{_getglob "${to}::does"} = $does unless $to->can('does');
# spent 46µs making 27 calls to UNIVERSAL::can, avg 2µs/call # spent 30µs making 14 calls to Role::Tiny::_getglob, avg 2µs/call
423
424 return
42527278µs8198µs if $to->can('DOES') and $to->can('DOES') != (UNIVERSAL->can('DOES') || 0);
# spent 98µs making 81 calls to UNIVERSAL::can, avg 1µs/call
426
4271443µs1414µs my $existing = $to->can('DOES') || $to->can('isa') || $FALLBACK;
# spent 14µs making 14 calls to UNIVERSAL::can, avg 1µs/call
428 my $new_sub = sub {
429 my ($proto, $role) = @_;
430 $proto->$does($role) or $proto->$existing($role);
4311430µs };
4322127µs226µs
# spent 17µs (9+9) within Role::Tiny::BEGIN@432 which was called: # once (9µs+9µs) by Role::Tiny::With::BEGIN@9 at line 432
no warnings 'redefine';
# spent 17µs making 1 call to Role::Tiny::BEGIN@432 # spent 9µs making 1 call to warnings::unimport
4331452µs1421µs return *{_getglob "${to}::DOES"} = $new_sub;
# spent 21µs making 14 calls to Role::Tiny::_getglob, avg 2µs/call
434}
435
436sub does_role {
437 my ($proto, $role) = @_;
438 require(_MRO_MODULE);
439 foreach my $class (@{mro::get_linear_isa(ref($proto)||$proto)}) {
440 return 1 if exists $APPLIED_TO{$class}{$role};
441 }
442 return 0;
443}
444
445
# spent 94µs within Role::Tiny::is_role which was called 46 times, avg 2µs/call: # 31 times (55µs+0s) by Role::Tiny::_install_does at line 418, avg 2µs/call # 10 times (22µs+0s) by Role::Tiny::import at line 48, avg 2µs/call # 5 times (16µs+0s) by Role::Tiny::apply_single_role_to_package at line 89, avg 3µs/call
sub is_role {
4464613µs my ($me, $role) = @_;
44746125µs return !!($INFO{$role} && $INFO{$role}{is_role});
448}
449
45013µs1;
451__END__
 
# spent 68µs within Role::Tiny::CORE:match which was called 92 times, avg 740ns/call: # 89 times (65µs+0s) by Role::Tiny::_install_methods at line 373, avg 727ns/call # 3 times (3µs+0s) by Role::Tiny::_load_module at line 35, avg 1µs/call
sub Role::Tiny::CORE:match; # opcode
# spent 16µs within Role::Tiny::CORE:sort which was called 13 times, avg 1µs/call: # 13 times (16µs+0s) by Role::Tiny::_composite_info_for at line 261, avg 1µs/call
sub Role::Tiny::CORE:sort; # opcode
# spent 63µs within Role::Tiny::CORE:subst which was called 15 times, avg 4µs/call: # 15 times (63µs+0s) by Role::Tiny::_load_module at line 30, avg 4µs/call
sub Role::Tiny::CORE:subst; # opcode