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

Filename/home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/site_perl/5.22.1/Role/Tiny.pm
StatementsExecuted 407 statements in 4.77ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1114.50ms18.7msRole::Tiny::::_load_module Role::Tiny::_load_module
111204µs434µsRole::Tiny::::_install_methods Role::Tiny::_install_methods
406195µs95µsRole::Tiny::::_getglob Role::Tiny::_getglob
11180µs84µsRole::Tiny::::_concrete_methods_of Role::Tiny::_concrete_methods_of
11169µs102µsRole::Tiny::::_check_requires Role::Tiny::_check_requires
3922153µs53µsRole::Tiny::::__ANON__[:86] Role::Tiny::__ANON__[:86]
11142µs58µsRole::Tiny::::_install_does Role::Tiny::_install_does
11139µs107µsRole::Tiny::::import Role::Tiny::import
11136µs19.3msRole::Tiny::::apply_single_role_to_package Role::Tiny::apply_single_role_to_package
11136µs54µsRole::Tiny::::_install_subs Role::Tiny::_install_subs
11129µs34µsRole::Tiny::::BEGIN@6 Role::Tiny::BEGIN@6
11114µs50µsRole::Tiny::::BEGIN@303 Role::Tiny::BEGIN@303
11113µs33µsRole::Tiny::::BEGIN@379 Role::Tiny::BEGIN@379
342113µs13µsRole::Tiny::::CORE:match Role::Tiny::CORE:match (opcode)
11112µs24µsRole::Tiny::::BEGIN@453 Role::Tiny::BEGIN@453
44111µs11µsRole::Tiny::::_getstash Role::Tiny::_getstash
11111µs11µsRole::Tiny::::BEGIN@20 Role::Tiny::BEGIN@20
44110µs10µsRole::Tiny::::is_role Role::Tiny::is_role
11110µs32µsRole::Tiny::::BEGIN@27 Role::Tiny::BEGIN@27
11110µs16µsRole::Tiny::::BEGIN@7 Role::Tiny::BEGIN@7
1117µs19.3msRole::Tiny::::apply_roles_to_package Role::Tiny::apply_roles_to_package
1115µs19.3msRole::Tiny::::apply_role_to_package Role::Tiny::apply_role_to_package
1115µs5µsRole::Tiny::::_copy_applied_list Role::Tiny::_copy_applied_list
1114µs4µsRole::Tiny::::CORE:subst Role::Tiny::CORE:subst (opcode)
1113µs3µsRole::Tiny::::_install_modifiers Role::Tiny::_install_modifiers
1112µs2µ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
340135µs
# spent 95µs within Role::Tiny::_getglob which was called 40 times, avg 2µs/call: # 33 times (76µs+0s) by Role::Tiny::_install_methods at line 380, avg 2µs/call # 3 times (10µs+0s) by Role::Tiny::_install_subs at line 81, avg 3µs/call # once (3µs+0s) by Role::Tiny::_install_subs at line 90 # once (2µs+0s) by Role::Tiny::_install_subs at line 86 # once (2µ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]} }
4418µs
# spent 11µ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 (3µs+0s) by Role::Tiny::_load_module at line 42 # once (2µs+0s) by Role::Tiny::_install_methods at line 369 # once (2µs+0s) by Role::Tiny::import at line 59
sub _getstash { \%{"$_[0]::"} }
5
6237µs238µs
# spent 34µs (29+5) within Role::Tiny::BEGIN@6 which was called: # once (29µs+5µs) by Role::Tiny::With::BEGIN@9 at line 6
use strict;
# spent 34µs making 1 call to Role::Tiny::BEGIN@6 # spent 5µs making 1 call to strict::import
72180µs223µs
# spent 16µs (10+7) within Role::Tiny::BEGIN@7 which was called: # once (10µs+7µs) by Role::Tiny::With::BEGIN@9 at line 7
use warnings;
# spent 16µs making 1 call to Role::Tiny::BEGIN@7 # spent 7µs making 1 call to warnings::import
8
91500nsour $VERSION = '2.000003';
10118µs$VERSION = eval $VERSION;
# spent 3µ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 11µs within Role::Tiny::BEGIN@20 which was called: # once (11µs+0s) by Role::Tiny::With::BEGIN@9 at line 23
BEGIN {
2115µs *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0};
2216µs *_MRO_MODULE = "$]" < 5.010 ? sub(){"MRO/Compat.pm"} : sub(){"mro.pm"};
23138µs111µs}
# spent 11µs making 1 call to Role::Tiny::BEGIN@20
24
25sub croak {
26 require Carp;
2721.98ms254µs
# spent 32µs (10+22) within Role::Tiny::BEGIN@27 which was called: # once (10µs+22µs) by Role::Tiny::With::BEGIN@9 at line 27
no warnings 'redefine';
# spent 32µs making 1 call to Role::Tiny::BEGIN@27 # spent 22µ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 18.7ms (4.50+14.2) within Role::Tiny::_load_module which was called: # once (4.50ms+14.2ms) by Role::Tiny::apply_single_role_to_package at line 100
sub _load_module {
37112µs14µs (my $proto = $_[0]) =~ s/::/\//g;
# spent 4µs making 1 call to Role::Tiny::CORE:subst
381700ns $proto .= '.pm';
391500ns 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
42114µs27µs return 1 if grep !/::$/, keys %{_getstash($_[0])||{}};
# spent 4µs making 1 call to Role::Tiny::CORE:match # spent 3µs making 1 call to Role::Tiny::_getstash
431300ns my $guard = _WORK_AROUND_BROKEN_MODULE_STATE
44 && bless([ $proto ], 'Role::Tiny::__GUARD__');
451265µs require $proto;
46 pop @$guard if _WORK_AROUND_BROKEN_MODULE_STATE;
4714µs return 1;
48}
49
50
# spent 107µs (39+68) within Role::Tiny::import which was called: # once (39µs+68µs) by DateTime::Format::Alami::BEGIN@11 at line 11 of lib/DateTime/Format/Alami.pm
sub import {
511800ns my $target = caller;
521400ns my $me = shift;
5311µs12µs strict->import;
# spent 2µs making 1 call to strict::import
5411µs18µs warnings->import;
# spent 8µs making 1 call to warnings::import
5512µs154µs $me->_install_subs($target);
# spent 54µ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
5911µs12µs my $stash = _getstash($target);
# spent 2µ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
6417µs my @not_methods = (map { *$_{CODE}||() } grep !ref($_), values %$stash);
6515µs @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods;
66 # a role does itself
6711µs $APPLIED_TO{$target} = { $target => undef };
6816µs foreach my $hook (@ON_ROLE_CREATE) {
69 $hook->($target);
70 }
71}
72
73
# spent 54µs (36+18) within Role::Tiny::_install_subs which was called: # once (36µs+18µs) by Role::Tiny::import at line 55
sub _install_subs {
7411µs my ($me, $target) = @_;
7512µs12µs return if $me->is_role($target);
# spent 2µ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;
81314µs310µs };
# spent 10µs making 3 calls to Role::Tiny::_getglob, avg 3µs/call
82 }
83
# spent 53µ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 1µs/call: # 12 times (16µs+0s) by Role::Tiny::_load_module at line 27 of lib/DateTime/Format/Alami.pm, avg 1µs/call # 7 times (8µs+0s) by Role::Tiny::_load_module at line 28 of lib/DateTime/Format/Alami.pm, avg 1µs/call # once (6µs+0s) by Role::Tiny::_load_module at line 16 of lib/DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 17 of lib/DateTime/Format/Alami.pm # once (2µs+0s) by Role::Tiny::_load_module at line 35 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 19 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 21 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 25 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 22 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 36 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 23 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 34 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 31 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 30 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 33 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 24 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 38 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 40 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 37 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 39 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 20 of lib/DateTime/Format/Alami.pm # once (1µs+0s) by Role::Tiny::_load_module at line 32 of lib/DateTime/Format/Alami.pm
*{_getglob "${target}::requires"} = sub {
843925µs push @{$INFO{$target}{requires}||=[]}, @_;
853991µs return;
8614µs12µs };
# spent 2µs making 1 call to Role::Tiny::_getglob
87 *{_getglob "${target}::with"} = sub {
88 $me->apply_roles_to_package($target, @_);
89 return;
9016µs13µs };
# spent 3µs making 1 call to Role::Tiny::_getglob
91}
92
93
# spent 2µs within Role::Tiny::role_application_steps which was called: # once (2µ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 19.3ms (36µs+19.3) within Role::Tiny::apply_single_role_to_package which was called: # once (36µs+19.3ms) by Role::Tiny::apply_role_to_package at line 209
sub apply_single_role_to_package {
981600ns my ($me, $to, $role) = @_;
99
10012µs118.7ms _load_module($role);
# spent 18.7ms making 1 call to Role::Tiny::_load_module
101
1021700ns croak "This is apply_role_to_package" if ref($to);
10313µs14µs croak "${role} is not a Role::Tiny" unless $me->is_role($role);
# spent 4µs making 1 call to Role::Tiny::is_role
104
10517µs12µs foreach my $step ($me->role_application_steps) {
# spent 2µs making 1 call to Role::Tiny::role_application_steps
106412µs4545µs $me->$step($to, $role);
# spent 434µs making 1 call to Role::Tiny::_install_methods # spent 102µs making 1 call to Role::Tiny::_check_requires # spent 5µs making 1 call to Role::Tiny::_copy_applied_list # spent 3µs making 1 call to Role::Tiny::_install_modifiers
107 }
108}
109
110
# spent 5µs within Role::Tiny::_copy_applied_list which was called: # once (5µs+0s) by Role::Tiny::apply_single_role_to_package at line 106
sub _copy_applied_list {
1111500ns my ($me, $to, $role) = @_;
112 # copy our role list into the target's
11316µ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
1251400nsmy $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µs119.3ms
# spent 19.3ms (5µs+19.3) within Role::Tiny::apply_role_to_package which was called: # once (5µs+19.3ms) by Role::Tiny::apply_roles_to_package at line 214
sub apply_role_to_package { shift->apply_single_role_to_package(@_) }
# spent 19.3ms making 1 call to Role::Tiny::apply_single_role_to_package
210
211
# spent 19.3ms (7µs+19.3) within Role::Tiny::apply_roles_to_package which was called: # once (7µs+19.3ms) by Role::Tiny::With::with at line 16 of Role/Tiny/With.pm
sub apply_roles_to_package {
21211µs my ($me, $to, @roles) = @_;
213
21416µs119.3ms return $me->apply_role_to_package($to, $roles[0]) if @roles == 1;
# spent 19.3ms 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.
3032630µs285µs
# spent 50µs (14+35) within Role::Tiny::BEGIN@303 which was called: # once (14µs+35µs) by Role::Tiny::With::BEGIN@9 at line 303
{ no strict 'refs'; @{"${composed_name}::ISA"} = ( $base_name ); }
# spent 50µs making 1 call to Role::Tiny::BEGIN@303 # spent 35µ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 102µs (69+33) within Role::Tiny::_check_requires which was called: # once (69µs+33µs) by Role::Tiny::apply_single_role_to_package at line 106
sub _check_requires {
3261700ns my ($me, $to, $name, $requires) = @_;
32716µs return unless my @requires = @{$requires||$INFO{$name}{requires}||[]};
328197µs3933µs if (my @requires_fail = grep !$to->can($_), @requires) {
# spent 33µs making 39 calls to UNIVERSAL::can, avg 854ns/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 84µs (80+4) within Role::Tiny::_concrete_methods_of which was called: # once (80µs+4µs) by Role::Tiny::_install_methods at line 366
sub _concrete_methods_of {
3391500ns my ($me, $role) = @_;
3401600ns 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
34515µ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 {
3494514µs my $code = *{$stash->{$_}}{CODE};
3504523µs ( ! $code or exists $not_methods->{$code} ) ? () : ($_ => $code)
351135µ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 434µs (204+230) within Role::Tiny::_install_methods which was called: # once (204µs+230µs) by Role::Tiny::apply_single_role_to_package at line 106
sub _install_methods {
3621800ns my ($me, $to, $role) = @_;
363
3641800ns my $info = $INFO{$role};
365
36615µs184µs my $methods = $me->_concrete_methods_of($role);
# spent 84µs making 1 call to Role::Tiny::_concrete_methods_of
367
368 # grab target symbol table
36912µs12µs my $stash = _getstash($to);
# spent 2µs making 1 call to Role::Tiny::_getstash
370
371 # determine already extant methods of target
3721300ns my %has_methods;
373 @has_methods{grep
374130µs +(ref($stash->{$_}) || *{$stash->{$_}}{CODE}),
375 keys %$stash
376 } = ();
377
378114µs foreach my $i (grep !exists $has_methods{$_}, keys %$methods) {
3792552µs253µs
# spent 33µs (13+20) within Role::Tiny::BEGIN@379 which was called: # once (13µs+20µs) by Role::Tiny::With::BEGIN@9 at line 379
no warnings 'once';
# spent 33µs making 1 call to Role::Tiny::BEGIN@379 # spent 20µs making 1 call to warnings::unimport
3803344µs3376µs my $glob = _getglob "${to}::${i}";
# spent 76µs making 33 calls to Role::Tiny::_getglob, avg 2µs/call
3813313µ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)
3883363µs339µs || (defined &overload::_nil && $methods->{$i} == \&overload::_nil));
# spent 9µs making 33 calls to Role::Tiny::CORE:match, avg 282ns/call
389
390 my $overload = ${ *{_getglob "${role}::${i}"}{SCALAR} };
391 next
392 unless defined $overload;
393
394 *$glob = \$overload;
395 }
396
39718µs158µs $me->_install_does($to);
# spent 58µs making 1 call to Role::Tiny::_install_does
398}
399
400
# spent 3µs within Role::Tiny::_install_modifiers which was called: # once (3µs+0s) by Role::Tiny::apply_single_role_to_package at line 106
sub _install_modifiers {
4011700ns my ($me, $to, $name) = @_;
40214µ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
4181100nsmy $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
43412µsmy $FALLBACK = sub { 0 };
435
# spent 58µs (42+16) within Role::Tiny::_install_does which was called: # once (42µs+16µs) by Role::Tiny::_install_methods at line 397
sub _install_does {
4361700ns my ($me, $to) = @_;
437
438 # only add does() method to classes
43911µs12µs return if $me->is_role($to);
# spent 2µs making 1 call to Role::Tiny::is_role
440
441112µs12µs my $does = $me->can('does_role');
# spent 2µs making 1 call to UNIVERSAL::can
442 # add does() only if they don't have one
443110µs24µs *{_getglob "${to}::does"} = $does unless $to->can('does');
# spent 2µs making 1 call to UNIVERSAL::can # spent 2µs making 1 call to Role::Tiny::_getglob
444
445 return
446112µs35µs if $to->can('DOES') and $to->can('DOES') != (UNIVERSAL->can('DOES') || 0);
# spent 5µs making 3 calls to UNIVERSAL::can, avg 2µs/call
447
44814µs11µs my $existing = $to->can('DOES') || $to->can('isa') || $FALLBACK;
# spent 1µs making 1 call to UNIVERSAL::can
449 my $new_sub = sub {
450 my ($proto, $role) = @_;
451 $proto->$does($role) or $proto->$existing($role);
45213µs };
4532201µs236µs
# spent 24µs (12+12) within Role::Tiny::BEGIN@453 which was called: # once (12µs+12µs) by Role::Tiny::With::BEGIN@9 at line 453
no warnings 'redefine';
# spent 24µs making 1 call to Role::Tiny::BEGIN@453 # spent 12µs making 1 call to warnings::unimport
45416µ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 10µs within Role::Tiny::is_role which was called 4 times, avg 3µs/call: # once (4µs+0s) by Role::Tiny::apply_single_role_to_package at line 103 # once (2µs+0s) by Role::Tiny::_install_subs at line 75 # once (2µs+0s) by Role::Tiny::import at line 56 # once (2µs+0s) by Role::Tiny::_install_does at line 439
sub is_role {
46742µs my ($me, $role) = @_;
468417µs return !!($INFO{$role} && ($INFO{$role}{is_role} || $INFO{$role}{not_methods}));
469}
470
47115µs1;
472__END__
 
# spent 13µs within Role::Tiny::CORE:match which was called 34 times, avg 376ns/call: # 33 times (9µs+0s) by Role::Tiny::_install_methods at line 388, avg 282ns/call # once (4µs+0s) by Role::Tiny::_load_module at line 42
sub Role::Tiny::CORE:match; # opcode
# spent 4µs within Role::Tiny::CORE:subst which was called: # once (4µs+0s) by Role::Tiny::_load_module at line 37
sub Role::Tiny::CORE:subst; # opcode