← Index
NYTProf Performance Profile   « line view »
For -e
  Run on Thu Jun 30 16:16:00 2016
Reported on Thu Jun 30 16:16:08 2016

Filename/home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/site_perl/5.22.1/Role/Tiny.pm
StatementsExecuted 411 statements in 6.29ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1115.68ms24.5msRole::Tiny::::_load_module Role::Tiny::_load_module
111295µs636µsRole::Tiny::::_install_methods Role::Tiny::_install_methods
4061146µs146µsRole::Tiny::::_getglob Role::Tiny::_getglob
111116µs120µsRole::Tiny::::_concrete_methods_of Role::Tiny::_concrete_methods_of
111105µs157µsRole::Tiny::::_check_requires Role::Tiny::_check_requires
3922177µs77µsRole::Tiny::::__ANON__[:86] Role::Tiny::__ANON__[:86]
11158µs81µsRole::Tiny::::_install_does Role::Tiny::_install_does
11156µs25.4msRole::Tiny::::apply_single_role_to_package Role::Tiny::apply_single_role_to_package
11147µs133µsRole::Tiny::::import Role::Tiny::import
11145µs68µsRole::Tiny::::_install_subs Role::Tiny::_install_subs
11138µs42µsRole::Tiny::::BEGIN@6 Role::Tiny::BEGIN@6
342119µs19µsRole::Tiny::::CORE:match Role::Tiny::CORE:match (opcode)
11115µs32µsRole::Tiny::::BEGIN@379 Role::Tiny::BEGIN@379
11115µs30µsRole::Tiny::::BEGIN@453 Role::Tiny::BEGIN@453
44114µs14µsRole::Tiny::::is_role Role::Tiny::is_role
11114µs14µsRole::Tiny::::BEGIN@20 Role::Tiny::BEGIN@20
44113µs13µsRole::Tiny::::_getstash Role::Tiny::_getstash
11113µs43µsRole::Tiny::::BEGIN@303 Role::Tiny::BEGIN@303
11113µs37µsRole::Tiny::::BEGIN@27 Role::Tiny::BEGIN@27
11112µs21µsRole::Tiny::::BEGIN@7 Role::Tiny::BEGIN@7
1118µs25.4msRole::Tiny::::apply_roles_to_package Role::Tiny::apply_roles_to_package
1117µs7µsRole::Tiny::::_copy_applied_list Role::Tiny::_copy_applied_list
1115µs25.4msRole::Tiny::::apply_role_to_package Role::Tiny::apply_role_to_package
1115µs5µsRole::Tiny::::CORE:subst Role::Tiny::CORE:subst (opcode)
1114µs4µsRole::Tiny::::_install_modifiers Role::Tiny::_install_modifiers
1114µs4µsRole::Tiny::::role_application_steps Role::Tiny::role_application_steps
0000s0sRole::Tiny::::__ANON__[:434] Role::Tiny::__ANON__[:434]
0000s0sRole::Tiny::::__ANON__[:452] Role::Tiny::__ANON__[:452]
0000s0sRole::Tiny::::__ANON__[:81] Role::Tiny::__ANON__[:81]
0000s0sRole::Tiny::::__ANON__[:90] Role::Tiny::__ANON__[:90]
0000s0sRole::Tiny::__GUARD__::::DESTROYRole::Tiny::__GUARD__::DESTROY
0000s0sRole::Tiny::::_composable_package_for Role::Tiny::_composable_package_for
0000s0sRole::Tiny::::_composite_info_for Role::Tiny::_composite_info_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::::croak Role::Tiny::croak
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
340198µs
# spent 146µs within Role::Tiny::_getglob which was called 40 times, avg 4µs/call: # 33 times (121µs+0s) by Role::Tiny::_install_methods at line 380, avg 4µs/call # 3 times (13µs+0s) by Role::Tiny::_install_subs at line 81, avg 4µs/call # once (3µs+0s) by Role::Tiny::_install_subs at line 90 # once (3µs+0s) by Role::Tiny::_install_subs at line 86 # once (3µs+0s) by Role::Tiny::_install_does at line 443 # once (2µs+0s) by Role::Tiny::_install_does at line 454
sub _getglob { \*{$_[0]} }
4424µs
# spent 13µs within Role::Tiny::_getstash which was called 4 times, avg 3µs/call: # once (4µs+0s) by Role::Tiny::_concrete_methods_of at line 342 # once (4µs+0s) by Role::Tiny::_load_module at line 42 # once (3µs+0s) by Role::Tiny::_install_methods at line 369 # once (3µs+0s) by Role::Tiny::import at line 59
sub _getstash { \%{"$_[0]::"} }
5
6244µs247µs
# spent 42µs (38+5) within Role::Tiny::BEGIN@6 which was called: # once (38µs+5µs) by Role::Tiny::With::BEGIN@9 at line 6
use strict;
# spent 42µs making 1 call to Role::Tiny::BEGIN@6 # spent 5µs making 1 call to strict::import
72230µs230µs
# spent 21µs (12+9) within Role::Tiny::BEGIN@7 which was called: # once (12µs+9µs) by Role::Tiny::With::BEGIN@9 at line 7
use warnings;
# spent 21µs making 1 call to Role::Tiny::BEGIN@7 # spent 9µs making 1 call to warnings::import
8
91700nsour $VERSION = '2.000003';
10123µs$VERSION = eval $VERSION;
# spent 4µs executing statements in string eval
11
12our %INFO;
13our %APPLIED_TO;
14our %COMPOSED;
15our %COMPOSITE_INFO;
16our @ON_ROLE_CREATE;
17
18# Module state workaround totally stolen from Zefram's Module::Runtime.
19
20
# spent 14µs within Role::Tiny::BEGIN@20 which was called: # once (14µs+0s) by Role::Tiny::With::BEGIN@9 at line 23
BEGIN {
2116µs *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0};
2218µs *_MRO_MODULE = "$]" < 5.010 ? sub(){"MRO/Compat.pm"} : sub(){"mro.pm"};
23150µs114µs}
# spent 14µs making 1 call to Role::Tiny::BEGIN@20
24
25sub croak {
26 require Carp;
2722.54ms262µs
# spent 37µs (13+25) within Role::Tiny::BEGIN@27 which was called: # once (13µs+25µs) by Role::Tiny::With::BEGIN@9 at line 27
no warnings 'redefine';
# spent 37µs making 1 call to Role::Tiny::BEGIN@27 # spent 24µs making 1 call to warnings::unimport
28 *croak = \&Carp::croak;
29 goto &Carp::croak;
30}
31
32sub Role::Tiny::__GUARD__::DESTROY {
33 delete $INC{$_[0]->[0]} if @{$_[0]};
34}
35
36
# spent 24.5ms (5.68+18.8) within Role::Tiny::_load_module which was called: # once (5.68ms+18.8ms) by Role::Tiny::apply_single_role_to_package at line 100
sub _load_module {
37114µs15µs (my $proto = $_[0]) =~ s/::/\//g;
# spent 5µs making 1 call to Role::Tiny::CORE:subst
381700ns $proto .= '.pm';
391600ns return 1 if $INC{$proto};
40 # can't just ->can('can') because a sub-package Foo::Bar::Baz
41 # creates a 'Baz::' key in Foo::Bar's symbol table
42116µs27µs return 1 if grep !/::$/, keys %{_getstash($_[0])||{}};
# spent 4µs making 1 call to Role::Tiny::CORE:match # spent 4µs making 1 call to Role::Tiny::_getstash
431400ns my $guard = _WORK_AROUND_BROKEN_MODULE_STATE
44 && bless([ $proto ], 'Role::Tiny::__GUARD__');
451361µs require $proto;
46 pop @$guard if _WORK_AROUND_BROKEN_MODULE_STATE;
4716µs return 1;
48}
49
50
# spent 133µs (47+86) within Role::Tiny::import which was called: # once (47µs+86µs) by DateTime::Format::Alami::BEGIN@11 at line 11 of DateTime/Format/Alami.pm
sub import {
511900ns my $target = caller;
521400ns my $me = shift;
5311µs13µs strict->import;
# spent 3µs making 1 call to strict::import
5412µs111µs warnings->import;
# spent 11µs making 1 call to warnings::import
5512µs168µs $me->_install_subs($target);
# spent 68µs making 1 call to Role::Tiny::_install_subs
5612µs12µs return if $me->is_role($target); # already exported into this package
# spent 2µs making 1 call to Role::Tiny::is_role
5711µs $INFO{$target}{is_role} = 1;
58 # get symbol table reference
5912µs13µs my $stash = _getstash($target);
# spent 3µs making 1 call to Role::Tiny::_getstash
60 # grab all *non-constant* (stash slot is not a scalarref) subs present
61 # in the symbol table and store their refaddrs (no need to forcibly
62 # inflate constant subs into real subs) with a map to the coderefs in
63 # case of copying or re-use
6419µs my @not_methods = (map { *$_{CODE}||() } grep !ref($_), values %$stash);
6516µs @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods;
66 # a role does itself
6711µs $APPLIED_TO{$target} = { $target => undef };
6817µs foreach my $hook (@ON_ROLE_CREATE) {
69 $hook->($target);
70 }
71}
72
73
# spent 68µs (45+23) within Role::Tiny::_install_subs which was called: # once (45µs+23µs) by Role::Tiny::import at line 55
sub _install_subs {
7411µs my ($me, $target) = @_;
7512µs13µs return if $me->is_role($target);
# spent 3µs making 1 call to Role::Tiny::is_role
76 # install before/after/around subs
7711µs foreach my $type (qw(before after around)) {
78 *{_getglob "${target}::${type}"} = sub {
79 push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
80 return;
81317µs313µs };
# spent 13µs making 3 calls to Role::Tiny::_getglob, avg 4µs/call
82 }
83
# spent 77µs within Role::Tiny::__ANON__[/home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/site_perl/5.22.1/Role/Tiny.pm:86] which was called 39 times, avg 2µs/call: # 12 times (25µs+0s) by Role::Tiny::_load_module at line 27 of DateTime/Format/Alami.pm, avg 2µs/call # 7 times (13µs+0s) by Role::Tiny::_load_module at line 28 of DateTime/Format/Alami.pm, avg 2µs/call # once (7µs+0s) by Role::Tiny::_load_module at line 16 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 35 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 17 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 23 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 19 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 22 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 21 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 25 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 31 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 30 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 38 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 33 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 36 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 37 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 34 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 32 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 39 of DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 20 of DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 40 of DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 24 of DateTime/Format/Alami.pm
*{_getglob "${target}::requires"} = sub {
843935µs push @{$INFO{$target}{requires}||=[]}, @_;
8539138µs return;
8614µs13µs };
# spent 3µs making 1 call to Role::Tiny::_getglob
87 *{_getglob "${target}::with"} = sub {
88 $me->apply_roles_to_package($target, @_);
89 return;
9018µs13µs };
# spent 3µs making 1 call to Role::Tiny::_getglob
91}
92
93
# spent 4µs within Role::Tiny::role_application_steps which was called: # once (4µs+0s) by Role::Tiny::apply_single_role_to_package at line 105
sub role_application_steps {
9416µs qw(_install_methods _check_requires _install_modifiers _copy_applied_list);
95}
96
97
# spent 25.4ms (56µs+25.3) within Role::Tiny::apply_single_role_to_package which was called: # once (56µs+25.3ms) by Role::Tiny::apply_role_to_package at line 209
sub apply_single_role_to_package {
981700ns my ($me, $to, $role) = @_;
99
10012µs124.5ms _load_module($role);
# spent 24.5ms making 1 call to Role::Tiny::_load_module
101
1021600ns croak "This is apply_role_to_package" if ref($to);
10317µs16µs croak "${role} is not a Role::Tiny" unless $me->is_role($role);
# spent 6µs making 1 call to Role::Tiny::is_role
104
10518µs14µs foreach my $step ($me->role_application_steps) {
# spent 4µs making 1 call to Role::Tiny::role_application_steps
106423µs4804µs $me->$step($to, $role);
# spent 636µs making 1 call to Role::Tiny::_install_methods # spent 157µs making 1 call to Role::Tiny::_check_requires # spent 7µs making 1 call to Role::Tiny::_copy_applied_list # spent 4µs making 1 call to Role::Tiny::_install_modifiers
107 }
108}
109
110
# spent 7µs within Role::Tiny::_copy_applied_list which was called: # once (7µs+0s) by Role::Tiny::apply_single_role_to_package at line 106
sub _copy_applied_list {
1111700ns my ($me, $to, $role) = @_;
112 # copy our role list into the target's
11319µs @{$APPLIED_TO{$to}||={}}{keys %{$APPLIED_TO{$role}}} = ();
114}
115
116sub apply_roles_to_object {
117 my ($me, $object, @roles) = @_;
118 croak "No roles supplied!" unless @roles;
119 my $class = ref($object);
120 # on perl < 5.8.9, magic isn't copied to all ref copies. bless the parameter
121 # directly, so at least the variable passed to us will get any magic applied
122 bless($_[1], $me->create_class_with_roles($class, @roles));
123}
124
1251500nsmy $role_suffix = 'A000';
126sub _composite_name {
127 my ($me, $superclass, @roles) = @_;
128
129 my $new_name = join(
130 '__WITH__', $superclass, my $compose_name = join '__AND__', @roles
131 );
132
133 if (length($new_name) > 252) {
134 $new_name = $COMPOSED{abbrev}{$new_name} ||= do {
135 my $abbrev = substr $new_name, 0, 250 - length $role_suffix;
136 $abbrev =~ s/(?<!:):$//;
137 $abbrev.'__'.$role_suffix++;
138 };
139 }
140 return wantarray ? ($new_name, $compose_name) : $new_name;
141}
142
143sub create_class_with_roles {
144 my ($me, $superclass, @roles) = @_;
145
146 croak "No roles supplied!" unless @roles;
147
148 _load_module($superclass);
149 {
150 my %seen;
151 if (my @dupes = grep 1 == $seen{$_}++, @roles) {
152 croak "Duplicated roles: ".join(', ', @dupes);
153 }
154 }
155
156 my ($new_name, $compose_name) = $me->_composite_name($superclass, @roles);
157
158 return $new_name if $COMPOSED{class}{$new_name};
159
160 foreach my $role (@roles) {
161 _load_module($role);
162 croak "${role} is not a Role::Tiny" unless $me->is_role($role);
163 }
164
165 require(_MRO_MODULE);
166
167 my $composite_info = $me->_composite_info_for(@roles);
168 my %conflicts = %{$composite_info->{conflicts}};
169 if (keys %conflicts) {
170 my $fail =
171 join "\n",
172 map {
173 "Method name conflict for '$_' between roles "
174 ."'".join(' and ', sort values %{$conflicts{$_}})."'"
175 .", cannot apply these simultaneously to an object."
176 } keys %conflicts;
177 croak $fail;
178 }
179
180 my @composable = map $me->_composable_package_for($_), reverse @roles;
181
182 # some methods may not exist in the role, but get generated by
183 # _composable_package_for (Moose accessors via Moo). filter out anything
184 # provided by the composable packages, excluding the subs we generated to
185 # make modifiers work.
186 my @requires = grep {
187 my $method = $_;
188 !grep $_->can($method) && !$COMPOSED{role}{$_}{modifiers_only}{$method},
189 @composable
190 } @{$composite_info->{requires}};
191
192 $me->_check_requires(
193 $superclass, $compose_name, \@requires
194 );
195
196 *{_getglob("${new_name}::ISA")} = [ @composable, $superclass ];
197
198 @{$APPLIED_TO{$new_name}||={}}{
199 map keys %{$APPLIED_TO{$_}}, @roles
200 } = ();
201
202 $COMPOSED{class}{$new_name} = 1;
203 return $new_name;
204}
205
206# preserved for compat, and apply_roles_to_package calls it to allow an
207# updated Role::Tiny to use a non-updated Moo::Role
208
20915µs125.4ms
# spent 25.4ms (5µs+25.4) within Role::Tiny::apply_role_to_package which was called: # once (5µs+25.4ms) by Role::Tiny::apply_roles_to_package at line 214
sub apply_role_to_package { shift->apply_single_role_to_package(@_) }
# spent 25.4ms making 1 call to Role::Tiny::apply_single_role_to_package
210
211
# spent 25.4ms (8µs+25.4) within Role::Tiny::apply_roles_to_package which was called: # once (8µs+25.4ms) by Role::Tiny::With::with at line 16 of Role/Tiny/With.pm
sub apply_roles_to_package {
21212µs my ($me, $to, @roles) = @_;
213
21417µs125.4ms return $me->apply_role_to_package($to, $roles[0]) if @roles == 1;
# spent 25.4ms making 1 call to Role::Tiny::apply_role_to_package
215
216 my %conflicts = %{$me->_composite_info_for(@roles)->{conflicts}};
217 my @have = grep $to->can($_), keys %conflicts;
218 delete @conflicts{@have};
219
220 if (keys %conflicts) {
221 my $fail =
222 join "\n",
223 map {
224 "Due to a method name conflict between roles "
225 ."'".join(' and ', sort values %{$conflicts{$_}})."'"
226 .", the method '$_' must be implemented by '${to}'"
227 } keys %conflicts;
228 croak $fail;
229 }
230
231 # conflicting methods are supposed to be treated as required by the
232 # composed role. we don't have an actual composed role, but because
233 # we know the target class already provides them, we can instead
234 # pretend that the roles don't do for the duration of application.
235 my @role_methods = map $me->_concrete_methods_of($_), @roles;
236 # separate loops, since local ..., delete ... for ...; creates a scope
237 local @{$_}{@have} for @role_methods;
238 delete @{$_}{@have} for @role_methods;
239
240 # the if guard here is essential since otherwise we accidentally create
241 # a $INFO for something that isn't a Role::Tiny (or Moo::Role) because
242 # autovivification hates us and wants us to die()
243 if ($INFO{$to}) {
244 delete $INFO{$to}{methods}; # reset since we're about to add methods
245 }
246
247 # backcompat: allow subclasses to use apply_single_role_to_package
248 # to apply changes. set a local var so ours does nothing.
249 our %BACKCOMPAT_HACK;
250 if($me ne __PACKAGE__
251 and exists $BACKCOMPAT_HACK{$me} ? $BACKCOMPAT_HACK{$me} :
252 $BACKCOMPAT_HACK{$me} =
253 $me->can('role_application_steps')
254 == \&role_application_steps
255 && $me->can('apply_single_role_to_package')
256 != \&apply_single_role_to_package
257 ) {
258 foreach my $role (@roles) {
259 $me->apply_single_role_to_package($to, $role);
260 }
261 }
262 else {
263 foreach my $step ($me->role_application_steps) {
264 foreach my $role (@roles) {
265 $me->$step($to, $role);
266 }
267 }
268 }
269 $APPLIED_TO{$to}{join('|',@roles)} = 1;
270}
271
272sub _composite_info_for {
273 my ($me, @roles) = @_;
274 $COMPOSITE_INFO{join('|', sort @roles)} ||= do {
275 foreach my $role (@roles) {
276 _load_module($role);
277 }
278 my %methods;
279 foreach my $role (@roles) {
280 my $this_methods = $me->_concrete_methods_of($role);
281 $methods{$_}{$this_methods->{$_}} = $role for keys %$this_methods;
282 }
283 my %requires;
284 @requires{map @{$INFO{$_}{requires}||[]}, @roles} = ();
285 delete $requires{$_} for keys %methods;
286 delete $methods{$_} for grep keys(%{$methods{$_}}) == 1, keys %methods;
287 +{ conflicts => \%methods, requires => [keys %requires] }
288 };
289}
290
291sub _composable_package_for {
292 my ($me, $role) = @_;
293 my $composed_name = 'Role::Tiny::_COMPOSABLE::'.$role;
294 return $composed_name if $COMPOSED{role}{$composed_name};
295 $me->_install_methods($composed_name, $role);
296 my $base_name = $composed_name.'::_BASE';
297 # force stash to exist so ->can doesn't complain
298 _getstash($base_name);
299 # Not using _getglob, since setting @ISA via the typeglob breaks
300 # inheritance on 5.10.0 if the stash has previously been accessed an
301 # then a method called on the class (in that order!), which
302 # ->_install_methods (with the help of ->_install_does) ends up doing.
3032823µs274µs
# spent 43µs (13+30) within Role::Tiny::BEGIN@303 which was called: # once (13µs+30µs) by Role::Tiny::With::BEGIN@9 at line 303
{ no strict 'refs'; @{"${composed_name}::ISA"} = ( $base_name ); }
# spent 43µs making 1 call to Role::Tiny::BEGIN@303 # spent 30µs making 1 call to strict::unimport
304 my $modifiers = $INFO{$role}{modifiers}||[];
305 my @mod_base;
306 my @modifiers = grep !$composed_name->can($_),
307 do { my %h; @h{map @{$_}[1..$#$_-1], @$modifiers} = (); keys %h };
308 foreach my $modified (@modifiers) {
309 push @mod_base, "sub ${modified} { shift->next::method(\@_) }";
310 }
311 my $e;
312 {
313 local $@;
314 eval(my $code = join "\n", "package ${base_name};", @mod_base);
315 $e = "Evaling failed: $@\nTrying to eval:\n${code}" if $@;
316 }
317 die $e if $e;
318 $me->_install_modifiers($composed_name, $role);
319 $COMPOSED{role}{$composed_name} = {
320 modifiers_only => { map { $_ => 1 } @modifiers },
321 };
322 return $composed_name;
323}
324
325
# spent 157µs (105+51) within Role::Tiny::_check_requires which was called: # once (105µs+51µs) by Role::Tiny::apply_single_role_to_package at line 106
sub _check_requires {
32611µs my ($me, $to, $name, $requires) = @_;
32718µs return unless my @requires = @{$requires||$INFO{$name}{requires}||[]};
3281150µs3951µs if (my @requires_fail = grep !$to->can($_), @requires) {
# spent 51µs making 39 calls to UNIVERSAL::can, avg 1µs/call
329 # role -> role, add to requires, role -> class, error out
330 if (my $to_info = $INFO{$to}) {
331 push @{$to_info->{requires}||=[]}, @requires_fail;
332 } else {
333 croak "Can't apply ${name} to ${to} - missing ".join(', ', @requires_fail);
334 }
335 }
336}
337
338
# spent 120µs (116+4) within Role::Tiny::_concrete_methods_of which was called: # once (116µs+4µs) by Role::Tiny::_install_methods at line 366
sub _concrete_methods_of {
3391700ns my ($me, $role) = @_;
3401700ns my $info = $INFO{$role};
341 # grab role symbol table
34212µs14µs my $stash = _getstash($role);
# spent 4µs making 1 call to Role::Tiny::_getstash
343 # reverse so our keys become the values (captured coderefs) in case
344 # they got copied or re-used since
345114µs my $not_methods = { reverse %{$info->{not_methods}||{}} };
346 $info->{methods} ||= +{
347 # grab all code entries that aren't in the not_methods list
348 map {
3494720µs my $code = *{$stash->{$_}}{CODE};
3504734µs ( ! $code or exists $not_methods->{$code} ) ? () : ($_ => $code)
351145µs } grep !ref($stash->{$_}), keys %$stash
352 };
353}
354
355sub methods_provided_by {
356 my ($me, $role) = @_;
357 croak "${role} is not a Role::Tiny" unless $me->is_role($role);
358 (keys %{$me->_concrete_methods_of($role)}, @{$INFO{$role}->{requires}||[]});
359}
360
361
# spent 636µs (295+341) within Role::Tiny::_install_methods which was called: # once (295µs+341µs) by Role::Tiny::apply_single_role_to_package at line 106
sub _install_methods {
36211µs my ($me, $to, $role) = @_;
363
36411µs my $info = $INFO{$role};
365
36617µs1120µs my $methods = $me->_concrete_methods_of($role);
# spent 120µs making 1 call to Role::Tiny::_concrete_methods_of
367
368 # grab target symbol table
36912µs13µs my $stash = _getstash($to);
# spent 3µs making 1 call to Role::Tiny::_getstash
370
371 # determine already extant methods of target
3721300ns my %has_methods;
373 @has_methods{grep
374142µs +(ref($stash->{$_}) || *{$stash->{$_}}{CODE}),
375 keys %$stash
376 } = ();
377
378121µs foreach my $i (grep !exists $has_methods{$_}, keys %$methods) {
3792703µs248µs
# spent 32µs (15+16) within Role::Tiny::BEGIN@379 which was called: # once (15µs+16µs) by Role::Tiny::With::BEGIN@9 at line 379
no warnings 'once';
# spent 32µs making 1 call to Role::Tiny::BEGIN@379 # spent 16µs making 1 call to warnings::unimport
3803367µs33121µs my $glob = _getglob "${to}::${i}";
# spent 121µs making 33 calls to Role::Tiny::_getglob, avg 4µs/call
3813320µs *$glob = $methods->{$i};
382
383 # overloads using method names have the method stored in the scalar slot
384 # and &overload::nil in the code slot.
385 next
386 unless $i =~ /^\(/
387 && ((defined &overload::nil && $methods->{$i} == \&overload::nil)
3883396µs3315µs || (defined &overload::_nil && $methods->{$i} == \&overload::_nil));
# spent 15µs making 33 calls to Role::Tiny::CORE:match, avg 464ns/call
389
390 my $overload = ${ *{_getglob "${role}::${i}"}{SCALAR} };
391 next
392 unless defined $overload;
393
394 *$glob = \$overload;
395 }
396
397111µs181µs $me->_install_does($to);
# spent 81µs making 1 call to Role::Tiny::_install_does
398}
399
400
# spent 4µs within Role::Tiny::_install_modifiers which was called: # once (4µs+0s) by Role::Tiny::apply_single_role_to_package at line 106
sub _install_modifiers {
40111µs my ($me, $to, $name) = @_;
40216µs return unless my $modifiers = $INFO{$name}{modifiers};
403 my $info = $INFO{$to};
404 my $existing = ($info ? $info->{modifiers} : $COMPOSED{modifiers}{$to}) ||= [];
405 my @modifiers = grep {
406 my $modifier = $_;
407 !grep $_ == $modifier, @$existing;
408 } @{$modifiers||[]};
409 push @$existing, @modifiers;
410
411 if (!$info) {
412 foreach my $modifier (@modifiers) {
413 $me->_install_single_modifier($to, @$modifier);
414 }
415 }
416}
417
4181200nsmy $vcheck_error;
419
420sub _install_single_modifier {
421 my ($me, @args) = @_;
422 defined($vcheck_error) or $vcheck_error = do {
423 local $@;
424 eval {
425 require Class::Method::Modifiers;
426 Class::Method::Modifiers->VERSION(1.05);
427 1;
428 } ? 0 : $@;
429 };
430 $vcheck_error and die $vcheck_error;
431 Class::Method::Modifiers::install_modifier(@args);
432}
433
43413µsmy $FALLBACK = sub { 0 };
435
# spent 81µs (58+23) within Role::Tiny::_install_does which was called: # once (58µs+23µs) by Role::Tiny::_install_methods at line 397
sub _install_does {
43611µs my ($me, $to) = @_;
437
438 # only add does() method to classes
43912µs13µs return if $me->is_role($to);
# spent 3µs making 1 call to Role::Tiny::is_role
440
441116µs13µs my $does = $me->can('does_role');
# spent 3µs making 1 call to UNIVERSAL::can
442 # add does() only if they don't have one
443114µs27µs *{_getglob "${to}::does"} = $does unless $to->can('does');
# spent 4µs making 1 call to UNIVERSAL::can # spent 3µs making 1 call to Role::Tiny::_getglob
444
445 return
446116µs36µs if $to->can('DOES') and $to->can('DOES') != (UNIVERSAL->can('DOES') || 0);
# spent 6µs making 3 calls to UNIVERSAL::can, avg 2µs/call
447
44816µs12µs my $existing = $to->can('DOES') || $to->can('isa') || $FALLBACK;
# spent 2µs making 1 call to UNIVERSAL::can
449 my $new_sub = sub {
450 my ($proto, $role) = @_;
451 $proto->$does($role) or $proto->$existing($role);
45214µs };
4532282µs245µs
# spent 30µs (15+15) within Role::Tiny::BEGIN@453 which was called: # once (15µs+15µs) by Role::Tiny::With::BEGIN@9 at line 453
no warnings 'redefine';
# spent 30µs making 1 call to Role::Tiny::BEGIN@453 # spent 15µs making 1 call to warnings::unimport
45418µs12µs return *{_getglob "${to}::DOES"} = $new_sub;
# spent 2µs making 1 call to Role::Tiny::_getglob
455}
456
457sub does_role {
458 my ($proto, $role) = @_;
459 require(_MRO_MODULE);
460 foreach my $class (@{mro::get_linear_isa(ref($proto)||$proto)}) {
461 return 1 if exists $APPLIED_TO{$class}{$role};
462 }
463 return 0;
464}
465
466
# spent 14µs within Role::Tiny::is_role which was called 4 times, avg 4µs/call: # once (6µs+0s) by Role::Tiny::apply_single_role_to_package at line 103 # once (3µs+0s) by Role::Tiny::_install_subs at line 75 # once (3µs+0s) by Role::Tiny::_install_does at line 439 # once (2µs+0s) by Role::Tiny::import at line 56
sub is_role {
46743µs my ($me, $role) = @_;
468422µs return !!($INFO{$role} && ($INFO{$role}{is_role} || $INFO{$role}{not_methods}));
469}
470
47117µs1;
472__END__
 
# spent 19µs within Role::Tiny::CORE:match which was called 34 times, avg 559ns/call: # 33 times (15µs+0s) by Role::Tiny::_install_methods at line 388, avg 464ns/call # once (4µs+0s) by Role::Tiny::_load_module at line 42
sub Role::Tiny::CORE:match; # opcode
# spent 5µs within Role::Tiny::CORE:subst which was called: # once (5µs+0s) by Role::Tiny::_load_module at line 37
sub Role::Tiny::CORE:subst; # opcode