Profile of Role/Tiny.pm

← 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
Statements | Executed 407 statements in 4.77ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 4.50ms | 18.7ms | Role::Tiny::::_load_module Role::Tiny::_load_module
1 | 1 | 1 | 204µs | 434µs | Role::Tiny::::_install_methods Role::Tiny::_install_methods
40 | 6 | 1 | 95µs | 95µs | Role::Tiny::::_getglob Role::Tiny::_getglob
1 | 1 | 1 | 80µs | 84µs | Role::Tiny::::_concrete_methods_of Role::Tiny::_concrete_methods_of
1 | 1 | 1 | 69µs | 102µs | Role::Tiny::::_check_requires Role::Tiny::_check_requires
39 | 22 | 1 | 53µs | 53µs | Role::Tiny::::__ANON__[:86] Role::Tiny::__ANON__[:86]
1 | 1 | 1 | 42µs | 58µs | Role::Tiny::::_install_does Role::Tiny::_install_does
1 | 1 | 1 | 39µs | 107µs | Role::Tiny::::import Role::Tiny::import
1 | 1 | 1 | 36µs | 19.3ms | Role::Tiny::::apply_single_role_to_package Role::Tiny::apply_single_role_to_package
1 | 1 | 1 | 36µs | 54µs | Role::Tiny::::_install_subs Role::Tiny::_install_subs
1 | 1 | 1 | 29µs | 34µs | Role::Tiny::::BEGIN@6 Role::Tiny::BEGIN@6
1 | 1 | 1 | 14µs | 50µs | Role::Tiny::::BEGIN@303 Role::Tiny::BEGIN@303
1 | 1 | 1 | 13µs | 33µs | Role::Tiny::::BEGIN@379 Role::Tiny::BEGIN@379
34 | 2 | 1 | 13µs | 13µs | Role::Tiny::::CORE:match Role::Tiny::CORE:match (opcode)
1 | 1 | 1 | 12µs | 24µs | Role::Tiny::::BEGIN@453 Role::Tiny::BEGIN@453
4 | 4 | 1 | 11µs | 11µs | Role::Tiny::::_getstash Role::Tiny::_getstash
1 | 1 | 1 | 11µs | 11µs | Role::Tiny::::BEGIN@20 Role::Tiny::BEGIN@20
4 | 4 | 1 | 10µs | 10µs | Role::Tiny::::is_role Role::Tiny::is_role
1 | 1 | 1 | 10µs | 32µs | Role::Tiny::::BEGIN@27 Role::Tiny::BEGIN@27
1 | 1 | 1 | 10µs | 16µs | Role::Tiny::::BEGIN@7 Role::Tiny::BEGIN@7
1 | 1 | 1 | 7µs | 19.3ms | Role::Tiny::::apply_roles_to_package Role::Tiny::apply_roles_to_package
1 | 1 | 1 | 5µs | 19.3ms | Role::Tiny::::apply_role_to_package Role::Tiny::apply_role_to_package
1 | 1 | 1 | 5µs | 5µs | Role::Tiny::::_copy_applied_list Role::Tiny::_copy_applied_list
1 | 1 | 1 | 4µs | 4µs | Role::Tiny::::CORE:subst Role::Tiny::CORE:subst (opcode)
1 | 1 | 1 | 3µs | 3µs | Role::Tiny::::_install_modifiers Role::Tiny::_install_modifiers
1 | 1 | 1 | 2µs | 2µs | Role::Tiny::::role_application_steps Role::Tiny::role_application_steps
0 | 0 | 0 | 0s | 0s | Role::Tiny::::__ANON__[:434] Role::Tiny::__ANON__[:434]
0 | 0 | 0 | 0s | 0s | Role::Tiny::::__ANON__[:452] Role::Tiny::__ANON__[:452]
0 | 0 | 0 | 0s | 0s | Role::Tiny::::__ANON__[:81] Role::Tiny::__ANON__[:81]
0 | 0 | 0 | 0s | 0s | Role::Tiny::::__ANON__[:90] Role::Tiny::__ANON__[:90]
0 | 0 | 0 | 0s | 0s | Role::Tiny::__GUARD__::::DESTROYRole::Tiny::__GUARD__::DESTROY
0 | 0 | 0 | 0s | 0s | Role::Tiny::::_composable_package_for Role::Tiny::_composable_package_for
0 | 0 | 0 | 0s | 0s | Role::Tiny::::_composite_info_for Role::Tiny::_composite_info_for
0 | 0 | 0 | 0s | 0s | Role::Tiny::::_composite_name Role::Tiny::_composite_name
0 | 0 | 0 | 0s | 0s | Role::Tiny::::_install_single_modifier Role::Tiny::_install_single_modifier
0 | 0 | 0 | 0s | 0s | Role::Tiny::::apply_roles_to_object Role::Tiny::apply_roles_to_object
0 | 0 | 0 | 0s | 0s | Role::Tiny::::create_class_with_roles Role::Tiny::create_class_with_roles
0 | 0 | 0 | 0s | 0s | Role::Tiny::::croak Role::Tiny::croak
0 | 0 | 0 | 0s | 0s | Role::Tiny::::does_role Role::Tiny::does_role
0 | 0 | 0 | 0s | 0s | Role::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
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Role::Tiny;
2 |  |  |  |  |
3 | 40 | 135µ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]} }
4 | 4 | 18µ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 |  |  |  |  |
6 | 2 | 37µs | 2 | 38µ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
7 | 2 | 180µs | 2 | 23µ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 |  |  |  |  |
9 | 1 | 500ns |  |  | our $VERSION = '2.000003';
10 | 1 | 18µs |  |  | $VERSION = eval $VERSION; # spent 3µs executing statements in string eval
11 |  |  |  |  |
12 |  |  |  |  | our %INFO;
13 |  |  |  |  | our %APPLIED_TO;
14 |  |  |  |  | our %COMPOSED;
15 |  |  |  |  | our %COMPOSITE_INFO;
16 |  |  |  |  | our @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 {
21 | 1 | 5µs |  |  | *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0};
22 | 1 | 6µs |  |  | *_MRO_MODULE = "$]" < 5.010 ? sub(){"MRO/Compat.pm"} : sub(){"mro.pm"};
23 | 1 | 38µs | 1 | 11µs | } # spent 11µs making 1 call to Role::Tiny::BEGIN@20
24 |  |  |  |  |
25 |  |  |  |  | sub croak {
26 |  |  |  |  | require Carp;
27 | 2 | 1.98ms | 2 | 54µ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 |  |  |  |  |
32 |  |  |  |  | sub 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 {
37 | 1 | 12µs | 1 | 4µs | (my $proto = $_[0]) =~ s/::/\//g; # spent 4µs making 1 call to Role::Tiny::CORE:subst
38 | 1 | 700ns |  |  | $proto .= '.pm';
39 | 1 | 500ns |  |  | 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
42 | 1 | 14µs | 2 | 7µ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
43 | 1 | 300ns |  |  | my $guard = _WORK_AROUND_BROKEN_MODULE_STATE
44 |  |  |  |  | && bless([ $proto ], 'Role::Tiny::__GUARD__');
45 | 1 | 265µs |  |  | require $proto;
46 |  |  |  |  | pop @$guard if _WORK_AROUND_BROKEN_MODULE_STATE;
47 | 1 | 4µ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 {
51 | 1 | 800ns |  |  | my $target = caller;
52 | 1 | 400ns |  |  | my $me = shift;
53 | 1 | 1µs | 1 | 2µs | strict->import; # spent 2µs making 1 call to strict::import
54 | 1 | 1µs | 1 | 8µs | warnings->import; # spent 8µs making 1 call to warnings::import
55 | 1 | 2µs | 1 | 54µs | $me->_install_subs($target); # spent 54µs making 1 call to Role::Tiny::_install_subs
56 | 1 | 2µs | 1 | 2µs | return if $me->is_role($target); # already exported into this package # spent 2µs making 1 call to Role::Tiny::is_role
57 | 1 | 1µs |  |  | $INFO{$target}{is_role} = 1;
58 |  |  |  |  | # get symbol table reference
59 | 1 | 1µs | 1 | 2µ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
64 | 1 | 7µs |  |  | my @not_methods = (map { *$_{CODE}||() } grep !ref($_), values %$stash);
65 | 1 | 5µs |  |  | @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods;
66 |  |  |  |  | # a role does itself
67 | 1 | 1µs |  |  | $APPLIED_TO{$target} = { $target => undef };
68 | 1 | 6µ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 {
74 | 1 | 1µs |  |  | my ($me, $target) = @_;
75 | 1 | 2µs | 1 | 2µs | return if $me->is_role($target); # spent 2µs making 1 call to Role::Tiny::is_role
76 |  |  |  |  | # install before/after/around subs
77 | 1 | 1µs |  |  | foreach my $type (qw(before after around)) {
78 |  |  |  |  | *{_getglob "${target}::${type}"} = sub {
79 |  |  |  |  | push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
80 |  |  |  |  | return;
81 | 3 | 14µs | 3 | 10µ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 {
84 | 39 | 25µs |  |  | push @{$INFO{$target}{requires}||=[]}, @_;
85 | 39 | 91µs |  |  | return;
86 | 1 | 4µs | 1 | 2µ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;
90 | 1 | 6µs | 1 | 3µ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 {
94 | 1 | 6µ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 {
98 | 1 | 600ns |  |  | my ($me, $to, $role) = @_;
99 |  |  |  |  |
100 | 1 | 2µs | 1 | 18.7ms | _load_module($role); # spent 18.7ms making 1 call to Role::Tiny::_load_module
101 |  |  |  |  |
102 | 1 | 700ns |  |  | croak "This is apply_role_to_package" if ref($to);
103 | 1 | 3µs | 1 | 4µ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 |  |  |  |  |
105 | 1 | 7µs | 1 | 2µs | foreach my $step ($me->role_application_steps) { # spent 2µs making 1 call to Role::Tiny::role_application_steps
106 | 4 | 12µs | 4 | 545µ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 {
111 | 1 | 500ns |  |  | my ($me, $to, $role) = @_;
112 |  |  |  |  | # copy our role list into the target's
113 | 1 | 6µs |  |  | @{$APPLIED_TO{$to}||={}}{keys %{$APPLIED_TO{$role}}} = ();
114 |  |  |  |  | }
115 |  |  |  |  |
116 |  |  |  |  | sub 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 |  |  |  |  |
125 | 1 | 400ns |  |  | my $role_suffix = 'A000';
126 |  |  |  |  | sub _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 |  |  |  |  |
143 |  |  |  |  | sub 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 |  |  |  |  |
209 | 1 | 5µs | 1 | 19.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 {
212 | 1 | 1µs |  |  | my ($me, $to, @roles) = @_;
213 |  |  |  |  |
214 | 1 | 6µs | 1 | 19.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 |  |  |  |  |
272 |  |  |  |  | sub _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 |  |  |  |  |
291 |  |  |  |  | sub _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.
303 | 2 | 630µs | 2 | 85µ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 {
326 | 1 | 700ns |  |  | my ($me, $to, $name, $requires) = @_;
327 | 1 | 6µs |  |  | return unless my @requires = @{$requires||$INFO{$name}{requires}||[]};
328 | 1 | 97µs | 39 | 33µ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 {
339 | 1 | 500ns |  |  | my ($me, $role) = @_;
340 | 1 | 600ns |  |  | my $info = $INFO{$role};
341 |  |  |  |  | # grab role symbol table
342 | 1 | 2µs | 1 | 4µ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
345 | 1 | 5µ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 {
349 | 45 | 14µs |  |  | my $code = *{$stash->{$_}}{CODE};
350 | 45 | 23µs |  |  | ( ! $code or exists $not_methods->{$code} ) ? () : ($_ => $code)
351 | 1 | 35µs |  |  | } grep !ref($stash->{$_}), keys %$stash
352 |  |  |  |  | };
353 |  |  |  |  | }
354 |  |  |  |  |
355 |  |  |  |  | sub 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 {
362 | 1 | 800ns |  |  | my ($me, $to, $role) = @_;
363 |  |  |  |  |
364 | 1 | 800ns |  |  | my $info = $INFO{$role};
365 |  |  |  |  |
366 | 1 | 5µs | 1 | 84µ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
369 | 1 | 2µs | 1 | 2µs | my $stash = _getstash($to); # spent 2µs making 1 call to Role::Tiny::_getstash
370 |  |  |  |  |
371 |  |  |  |  | # determine already extant methods of target
372 | 1 | 300ns |  |  | my %has_methods;
373 |  |  |  |  | @has_methods{grep
374 | 1 | 30µs |  |  | +(ref($stash->{$_}) || *{$stash->{$_}}{CODE}),
375 |  |  |  |  | keys %$stash
376 |  |  |  |  | } = ();
377 |  |  |  |  |
378 | 1 | 14µs |  |  | foreach my $i (grep !exists $has_methods{$_}, keys %$methods) {
379 | 2 | 552µs | 2 | 53µ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
380 | 33 | 44µs | 33 | 76µs | my $glob = _getglob "${to}::${i}"; # spent 76µs making 33 calls to Role::Tiny::_getglob, avg 2µs/call
381 | 33 | 13µ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)
388 | 33 | 63µs | 33 | 9µ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 |  |  |  |  |
397 | 1 | 8µs | 1 | 58µ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 {
401 | 1 | 700ns |  |  | my ($me, $to, $name) = @_;
402 | 1 | 4µ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 |  |  |  |  |
418 | 1 | 100ns |  |  | my $vcheck_error;
419 |  |  |  |  |
420 |  |  |  |  | sub _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 |  |  |  |  |
434 | 1 | 2µs |  |  | my $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 {
436 | 1 | 700ns |  |  | my ($me, $to) = @_;
437 |  |  |  |  |
438 |  |  |  |  | # only add does() method to classes
439 | 1 | 1µs | 1 | 2µs | return if $me->is_role($to); # spent 2µs making 1 call to Role::Tiny::is_role
440 |  |  |  |  |
441 | 1 | 12µs | 1 | 2µ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
443 | 1 | 10µs | 2 | 4µ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
446 | 1 | 12µs | 3 | 5µ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 |  |  |  |  |
448 | 1 | 4µs | 1 | 1µ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);
452 | 1 | 3µs |  |  | };
453 | 2 | 201µs | 2 | 36µ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
454 | 1 | 6µs | 1 | 2µs | return *{_getglob "${to}::DOES"} = $new_sub; # spent 2µs making 1 call to Role::Tiny::_getglob
455 |  |  |  |  | }
456 |  |  |  |  |
457 |  |  |  |  | sub 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 {
467 | 4 | 2µs |  |  | my ($me, $role) = @_;
468 | 4 | 17µs |  |  | return !!($INFO{$role} && ($INFO{$role}{is_role} || $INFO{$role}{not_methods}));
469 |  |  |  |  | }
470 |  |  |  |  |
471 | 1 | 5µs |  |  | 1;
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