Filename | /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Role/Tiny.pm |
Statements | Executed 2661 statements in 8.67ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
15 | 2 | 1 | 3.81ms | 6.03ms | _load_module (recurses: max depth 1, inclusive time 1.63ms) | Role::Tiny::
31 | 2 | 1 | 1.14ms | 2.92ms | _install_methods | Role::Tiny::
67 | 3 | 1 | 812µs | 955µs | _concrete_methods_of | Role::Tiny::
18 | 2 | 2 | 685µs | 10.5ms | apply_roles_to_package (recurses: max depth 1, inclusive time 2.19ms) | Role::Tiny::
31 | 1 | 1 | 594µs | 897µs | _install_does | Role::Tiny::
167 | 6 | 1 | 534µs | 534µs | _getglob | Role::Tiny::
10 | 10 | 10 | 479µs | 829µs | import | Role::Tiny::
13 | 1 | 1 | 374µs | 5.43ms | _composite_info_for | Role::Tiny::
118 | 4 | 1 | 279µs | 279µs | _getstash | Role::Tiny::
31 | 2 | 1 | 145µs | 166µs | _check_requires | Role::Tiny::
5 | 1 | 1 | 119µs | 2.79ms | apply_single_role_to_package (recurses: max depth 1, inclusive time 760µs) | Role::Tiny::
31 | 2 | 1 | 98µs | 98µs | _copy_applied_list | Role::Tiny::
46 | 3 | 1 | 94µs | 94µs | is_role | Role::Tiny::
92 | 2 | 1 | 68µs | 68µs | CORE:match (opcode) | Role::Tiny::
15 | 1 | 1 | 63µs | 63µs | CORE:subst (opcode) | Role::Tiny::
31 | 2 | 1 | 58µs | 58µs | _install_modifiers | Role::Tiny::
18 | 2 | 1 | 33µs | 33µs | role_application_steps | Role::Tiny::
4 | 4 | 4 | 23µs | 2.22ms | __ANON__[:67] | Role::Tiny::
5 | 1 | 1 | 18µs | 2.81ms | apply_role_to_package (recurses: max depth 1, inclusive time 765µs) | Role::Tiny::
13 | 1 | 1 | 16µs | 16µs | CORE:sort (opcode) | Role::Tiny::
4 | 4 | 4 | 14µs | 14µs | __ANON__[:63] | Role::Tiny::
1 | 1 | 1 | 12µs | 28µs | BEGIN@6 | Role::Tiny::
1 | 1 | 1 | 9µs | 22µs | BEGIN@366 | Role::Tiny::
1 | 1 | 1 | 9µs | 17µs | BEGIN@432 | Role::Tiny::
1 | 1 | 1 | 8µs | 20µs | BEGIN@290 | Role::Tiny::
1 | 1 | 1 | 6µs | 10µs | BEGIN@7 | Role::Tiny::
1 | 1 | 1 | 6µs | 6µs | BEGIN@20 | Role::Tiny::
0 | 0 | 0 | 0s | 0s | __ANON__[:413] | Role::Tiny::
0 | 0 | 0 | 0s | 0s | __ANON__[:431] | Role::Tiny::
0 | 0 | 0 | 0s | 0s | __ANON__[:58] | Role::Tiny::
0 | 0 | 0 | 0s | 0s | DESTROY | Role::Tiny::__GUARD__::
0 | 0 | 0 | 0s | 0s | _composable_package_for | Role::Tiny::
0 | 0 | 0 | 0s | 0s | _composite_name | Role::Tiny::
0 | 0 | 0 | 0s | 0s | _install_single_modifier | Role::Tiny::
0 | 0 | 0 | 0s | 0s | apply_roles_to_object | Role::Tiny::
0 | 0 | 0 | 0s | 0s | create_class_with_roles | Role::Tiny::
0 | 0 | 0 | 0s | 0s | does_role | Role::Tiny::
0 | 0 | 0 | 0s | 0s | methods_provided_by | Role::Tiny::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Role::Tiny; | ||||
2 | |||||
3 | 167 | 676µ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 | ||
4 | 118 | 390µ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 | ||
5 | |||||
6 | 2 | 19µs | 2 | 44µ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 # spent 28µs making 1 call to Role::Tiny::BEGIN@6
# spent 16µs making 1 call to strict::import |
7 | 2 | 113µs | 2 | 13µ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 # spent 10µs making 1 call to Role::Tiny::BEGIN@7
# spent 3µs making 1 call to warnings::import |
8 | |||||
9 | 1 | 600ns | our $VERSION = '2.000001'; | ||
10 | 1 | 13µs | $VERSION = eval $VERSION; # spent 2µs executing statements in string eval | ||
11 | |||||
12 | 1 | 200ns | our %INFO; | ||
13 | 1 | 0s | our %APPLIED_TO; | ||
14 | 1 | 0s | our %COMPOSED; | ||
15 | 1 | 0s | our %COMPOSITE_INFO; | ||
16 | 1 | 0s | our @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 | ||||
21 | 1 | 2µs | *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0}; | ||
22 | 1 | 5µs | *_MRO_MODULE = "$]" < 5.010 ? sub(){"MRO/Compat.pm"} : sub(){"mro.pm"}; | ||
23 | 1 | 1.25ms | 1 | 6µs | } # spent 6µs making 1 call to Role::Tiny::BEGIN@20 |
24 | |||||
25 | sub Role::Tiny::__GUARD__::DESTROY { | ||||
26 | delete $INC{$_[0]->[0]} if @{$_[0]}; | ||||
27 | } | ||||
28 | |||||
29 | sub _load_module { | ||||
30 | 15 | 106µs | 15 | 63µs | (my $proto = $_[0]) =~ s/::/\//g; # spent 63µs making 15 calls to Role::Tiny::CORE:subst, avg 4µs/call |
31 | 15 | 3µs | $proto .= '.pm'; | ||
32 | 15 | 19µ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 | ||||
35 | 10 | 33µs | 13 | 51µ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 |
36 | 10 | 2µs | my $guard = _WORK_AROUND_BROKEN_MODULE_STATE | ||
37 | && bless([ $proto ], 'Role::Tiny::__GUARD__'); | ||||
38 | 10 | 608µs | require $proto; | ||
39 | pop @$guard if _WORK_AROUND_BROKEN_MODULE_STATE; | ||||
40 | 10 | 29µ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 | ||||
44 | 10 | 7µs | my $target = caller; | ||
45 | 10 | 3µs | my $me = shift; | ||
46 | 10 | 10µs | 10 | 108µs | strict->import; # spent 108µs making 10 calls to strict::import, avg 11µs/call |
47 | 10 | 12µs | 10 | 51µs | warnings->import; # spent 51µs making 10 calls to warnings::import, avg 5µs/call |
48 | 10 | 14µs | 10 | 22µ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 |
49 | 10 | 14µs | $INFO{$target}{is_role} = 1; | ||
50 | # get symbol table reference | ||||
51 | 10 | 12µs | 10 | 34µ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 | ||||
53 | 10 | 5µ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; | ||||
58 | 30 | 106µs | 30 | 79µ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 | ||||
61 | 4 | 7µs | push @{$INFO{$target}{requires}||=[]}, @_; | ||
62 | 4 | 16µs | return; | ||
63 | 10 | 32µs | 10 | 26µ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 | ||||
65 | 4 | 12µs | 4 | 0s | $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 |
66 | 4 | 14µs | return; | ||
67 | 10 | 25µs | 10 | 29µ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 | ||||
72 | 10 | 44µs | my @not_methods = (map { *$_{CODE}||() } grep !ref($_), values %$stash); | ||
73 | 10 | 47µs | @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods; | ||
74 | # a role does itself | ||||
75 | 10 | 9µs | $APPLIED_TO{$target} = { $target => undef }; | ||
76 | 10 | 60µs | $_->($target) for @ON_ROLE_CREATE; | ||
77 | } | ||||
78 | |||||
79 | sub role_application_steps { | ||||
80 | 18 | 51µ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 | ||||
84 | 5 | 3µs | my ($me, $to, $role) = @_; | ||
85 | |||||
86 | 5 | 5µs | 5 | 1.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 | |||||
88 | 5 | 900ns | die "This is apply_role_to_package" if ref($to); | ||
89 | 5 | 10µs | 5 | 16µ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 | |||||
91 | 5 | 19µs | 5 | 9µs | foreach my $step ($me->role_application_steps) { # spent 9µs making 5 calls to Role::Tiny::role_application_steps, avg 2µs/call |
92 | 20 | 36µs | 20 | 557µ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 | sub _copy_applied_list { | ||||
97 | 31 | 9µs | my ($me, $to, $role) = @_; | ||
98 | # copy our role list into the target's | ||||
99 | 31 | 116µs | @{$APPLIED_TO{$to}||={}}{keys %{$APPLIED_TO{$role}}} = (); | ||
100 | } | ||||
101 | |||||
102 | sub 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 | |||||
111 | 1 | 400ns | my $role_suffix = 'A000'; | ||
112 | sub _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 | |||||
129 | sub 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 | |||||
196 | 5 | 15µs | 5 | 2.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 # 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 | ||||
199 | 18 | 21µs | my ($me, $to, @roles) = @_; | ||
200 | |||||
201 | 18 | 28µs | 5 | 2.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 | |||||
203 | 13 | 29µs | 13 | 5.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 |
204 | 13 | 6µs | my @have = grep $to->can($_), keys %conflicts; | ||
205 | 13 | 4µs | delete @conflicts{@have}; | ||
206 | |||||
207 | 13 | 3µ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. | ||||
222 | 13 | 54µs | 26 | 302µ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 | ||||
224 | 13 | 24µs | local @{$_}{@have} for @role_methods; | ||
225 | 13 | 11µ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() | ||||
230 | 13 | 3µ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. | ||||
236 | 13 | 2µs | our %BACKCOMPAT_HACK; | ||
237 | 13 | 12µ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 { | ||||
250 | 13 | 24µs | 13 | 24µs | foreach my $step ($me->role_application_steps) { # spent 24µs making 13 calls to Role::Tiny::role_application_steps, avg 2µs/call |
251 | 52 | 29µs | foreach my $role (@roles) { | ||
252 | 104 | 180µs | 104 | 2.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 | } | ||||
256 | 13 | 53µ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 | ||||
260 | 13 | 10µs | my ($me, @roles) = @_; | ||
261 | 13 | 113µs | 13 | 16µs | $COMPOSITE_INFO{join('|', sort @roles)} ||= do { # spent 16µs making 13 calls to Role::Tiny::CORE:sort, avg 1µs/call |
262 | 5 | 3µs | foreach my $role (@roles) { | ||
263 | 10 | 16µs | 10 | 4.80ms | _load_module($role); # spent 4.80ms making 10 calls to Role::Tiny::_load_module, avg 480µs/call |
264 | } | ||||
265 | 5 | 1µs | my %methods; | ||
266 | 5 | 3µs | foreach my $role (@roles) { | ||
267 | 10 | 23µs | 10 | 241µ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 |
268 | 10 | 76µs | $methods{$_}{$this_methods->{$_}} = $role for keys %$this_methods; | ||
269 | } | ||||
270 | 5 | 700ns | my %requires; | ||
271 | 5 | 15µs | @requires{map @{$INFO{$_}{requires}||[]}, @roles} = (); | ||
272 | 5 | 25µs | delete $requires{$_} for keys %methods; | ||
273 | 5 | 65µs | delete $methods{$_} for grep keys(%{$methods{$_}}) == 1, keys %methods; | ||
274 | 5 | 11µs | +{ conflicts => \%methods, requires => [keys %requires] } | ||
275 | }; | ||||
276 | } | ||||
277 | |||||
278 | sub _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. | ||||
290 | 2 | 483µs | 2 | 32µ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 # 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 | sub _check_requires { | ||||
313 | 31 | 13µs | my ($me, $to, $name, $requires) = @_; | ||
314 | 31 | 69µs | return unless my @requires = @{$requires||$INFO{$name}{requires}||[]}; | ||
315 | 15 | 106µs | 16 | 21µ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 | ||||
326 | 67 | 19µs | my ($me, $role) = @_; | ||
327 | 67 | 24µs | my $info = $INFO{$role}; | ||
328 | # grab role symbol table | ||||
329 | 67 | 61µs | 67 | 143µ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 | ||||
332 | 67 | 236µ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 { | ||||
336 | 188 | 349µs | my $code = *{$stash->{$_}}{CODE}; | ||
337 | 121 | 57µs | ( ! $code or exists $not_methods->{$code} ) ? () : ($_ => $code) | ||
338 | } grep !ref($stash->{$_}), keys %$stash | ||||
339 | }; | ||||
340 | } | ||||
341 | |||||
342 | sub 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 | sub _install_methods { | ||||
349 | 31 | 12µs | my ($me, $to, $role) = @_; | ||
350 | |||||
351 | 31 | 12µs | my $info = $INFO{$role}; | ||
352 | |||||
353 | 31 | 40µs | 31 | 412µ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 | ||||
356 | 31 | 34µs | 31 | 54µ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 | ||||
359 | 31 | 4µs | my %has_methods; | ||
360 | @has_methods{grep | ||||
361 | 31 | 252µs | +(ref($stash->{$_}) || *{$stash->{$_}}{CODE}), | ||
362 | keys %$stash | ||||
363 | } = (); | ||||
364 | |||||
365 | 31 | 117µs | foreach my $i (grep !exists $has_methods{$_}, keys %$methods) { | ||
366 | 2 | 348µs | 2 | 35µ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 # spent 22µs making 1 call to Role::Tiny::BEGIN@366
# spent 13µs making 1 call to warnings::unimport |
367 | 89 | 126µs | 89 | 348µs | my $glob = _getglob "${to}::${i}"; # spent 348µs making 89 calls to Role::Tiny::_getglob, avg 4µs/call |
368 | 89 | 67µ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 | ||||
373 | 89 | 226µs | 89 | 65µ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 | |||||
384 | 31 | 113µs | 31 | 897µs | $me->_install_does($to); # spent 897µs making 31 calls to Role::Tiny::_install_does, avg 29µs/call |
385 | } | ||||
386 | |||||
387 | sub _install_modifiers { | ||||
388 | 31 | 10µs | my ($me, $to, $name) = @_; | ||
389 | 31 | 73µ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 | |||||
399 | 1 | 0s | my $vcheck_error; | ||
400 | |||||
401 | sub _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 | |||||
413 | 1 | 1µs | my $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 | ||||
415 | 31 | 9µs | my ($me, $to) = @_; | ||
416 | |||||
417 | # only add does() method to classes | ||||
418 | 31 | 41µs | 31 | 55µs | return if $me->is_role($to); # spent 55µs making 31 calls to Role::Tiny::is_role, avg 2µs/call |
419 | |||||
420 | 27 | 98µs | 27 | 38µ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 | ||||
422 | 27 | 173µs | 41 | 76µ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 | ||||
425 | 27 | 278µs | 81 | 98µ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 | |||||
427 | 14 | 43µs | 14 | 14µ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); | ||||
431 | 14 | 30µs | }; | ||
432 | 2 | 127µs | 2 | 26µ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 # spent 17µs making 1 call to Role::Tiny::BEGIN@432
# spent 9µs making 1 call to warnings::unimport |
433 | 14 | 52µs | 14 | 21µs | return *{_getglob "${to}::DOES"} = $new_sub; # spent 21µs making 14 calls to Role::Tiny::_getglob, avg 2µs/call |
434 | } | ||||
435 | |||||
436 | sub 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 | ||||
446 | 46 | 13µs | my ($me, $role) = @_; | ||
447 | 46 | 125µs | return !!($INFO{$role} && $INFO{$role}{is_role}); | ||
448 | } | ||||
449 | |||||
450 | 1 | 3µs | 1; | ||
451 | __END__ | ||||
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 | |||||
# 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 |