| Filename | /home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Role/Tiny.pm |
| Statements | Executed 18447 statements in 51.9ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 4004 | 1 | 1 | 17.3ms | 21.1ms | Role::Tiny::does_role |
| 17 | 2 | 1 | 609µs | 1.65ms | Role::Tiny::_install_methods |
| 29 | 3 | 1 | 398µs | 436µs | Role::Tiny::_concrete_methods_of |
| 176 | 2 | 1 | 215µs | 215µs | Role::Tiny::_getglob |
| 14 | 1 | 1 | 196µs | 5.34ms | Role::Tiny::apply_roles_to_package |
| 11 | 1 | 1 | 189µs | 2.32ms | Role::Tiny::apply_single_role_to_package |
| 17 | 1 | 1 | 173µs | 434µs | Role::Tiny::_install_does |
| 3 | 1 | 1 | 169µs | 322µs | Role::Tiny::_composite_info_for |
| 174 | 3 | 2 | 166µs | 166µs | Role::Tiny::is_role |
| 17 | 2 | 1 | 87µs | 103µs | Role::Tiny::_check_requires |
| 46 | 2 | 1 | 51µs | 51µs | Role::Tiny::_getstash |
| 17 | 2 | 1 | 44µs | 44µs | Role::Tiny::_copy_applied_list |
| 17 | 2 | 1 | 43µs | 60µs | Role::Tiny::_load_module |
| 17 | 2 | 1 | 34µs | 564µs | Role::Tiny::_install_modifiers |
| 11 | 1 | 1 | 26µs | 2.96ms | Role::Tiny::apply_role_to_package |
| 14 | 1 | 1 | 18µs | 18µs | Role::Tiny::role_application_steps |
| 17 | 1 | 1 | 17µs | 17µs | Role::Tiny::CORE:subst (opcode) |
| 1 | 1 | 1 | 8µs | 10µs | Role::Tiny::BEGIN@6 |
| 1 | 1 | 1 | 7µs | 18µs | Role::Tiny::BEGIN@366 |
| 168 | 1 | 1 | 7µs | 7µs | Role::Tiny::CORE:match (opcode) |
| 1 | 1 | 1 | 6µs | 14µs | Role::Tiny::BEGIN@432 |
| 3 | 1 | 1 | 6µs | 6µs | Role::Tiny::CORE:sort (opcode) |
| 1 | 1 | 1 | 6µs | 18µs | Role::Tiny::BEGIN@290 |
| 1 | 1 | 1 | 5µs | 5µs | Role::Tiny::BEGIN@20 |
| 1 | 1 | 1 | 4µs | 7µs | Role::Tiny::BEGIN@7 |
| 1 | 1 | 1 | 2µs | 2µs | Search::Elasticsearch::Cxn::HTTPTiny::CORE:qr (opcode) |
| 0 | 0 | 0 | 0s | 0s | BenchmarkAnything::Storage::Search::Elasticsearch::Serializer::JSON::DontTouchMyUTF8::DOES |
| 0 | 0 | 0 | 0s | 0s | Role::Tiny::__ANON__[:413] |
| 0 | 0 | 0 | 0s | 0s | Role::Tiny::__ANON__[:431] |
| 0 | 0 | 0 | 0s | 0s | Role::Tiny::__ANON__[:58] |
| 0 | 0 | 0 | 0s | 0s | Role::Tiny::__ANON__[:63] |
| 0 | 0 | 0 | 0s | 0s | Role::Tiny::__ANON__[:67] |
| 0 | 0 | 0 | 0s | 0s | Role::Tiny::__GUARD__::DESTROY |
| 0 | 0 | 0 | 0s | 0s | Role::Tiny::_composable_package_for |
| 0 | 0 | 0 | 0s | 0s | Role::Tiny::_composite_name |
| 0 | 0 | 0 | 0s | 0s | Role::Tiny::_install_single_modifier |
| 0 | 0 | 0 | 0s | 0s | Role::Tiny::apply_roles_to_object |
| 0 | 0 | 0 | 0s | 0s | Role::Tiny::create_class_with_roles |
| 0 | 0 | 0 | 0s | 0s | Role::Tiny::import |
| 0 | 0 | 0 | 0s | 0s | Role::Tiny::methods_provided_by |
| 0 | 0 | 0 | 0s | 0s | Search::Elasticsearch::Client::5_0::Direct::DOES |
| 0 | 0 | 0 | 0s | 0s | Search::Elasticsearch::Client::5_0::Direct::Indices::DOES |
| 0 | 0 | 0 | 0s | 0s | Search::Elasticsearch::Cxn::HTTPTiny::DOES |
| 0 | 0 | 0 | 0s | 0s | Search::Elasticsearch::CxnPool::Static::DOES |
| 0 | 0 | 0 | 0s | 0s | Search::Elasticsearch::Logger::LogAny::DOES |
| 0 | 0 | 0 | 0s | 0s | Search::Elasticsearch::Serializer::JSON::DOES |
| 0 | 0 | 0 | 0s | 0s | Search::Elasticsearch::Transport::DOES |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Role::Tiny; | ||||
| 2 | |||||
| 3 | 176 | 292µs | sub _getglob { \*{$_[0]} } | ||
| 4 | 46 | 77µs | sub _getstash { \%{"$_[0]::"} } | ||
| 5 | |||||
| 6 | 2 | 16µs | 2 | 11µs | # spent 10µs (8+1) within Role::Tiny::BEGIN@6 which was called:
# once (8µs+1µs) by Moo::Role::BEGIN@5 at line 6 # spent 10µs making 1 call to Role::Tiny::BEGIN@6
# spent 1µs making 1 call to strict::import |
| 7 | 2 | 89µs | 2 | 10µs | # spent 7µs (4+3) within Role::Tiny::BEGIN@7 which was called:
# once (4µs+3µs) by Moo::Role::BEGIN@5 at line 7 # spent 7µs making 1 call to Role::Tiny::BEGIN@7
# spent 3µs making 1 call to warnings::import |
| 8 | |||||
| 9 | 1 | 200ns | our $VERSION = '2.000001'; | ||
| 10 | 1 | 10µs | $VERSION = eval $VERSION; # spent 2µ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 5µs within Role::Tiny::BEGIN@20 which was called:
# once (5µs+0s) by Moo::Role::BEGIN@5 at line 23 | ||||
| 21 | 1 | 2µs | *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0}; | ||
| 22 | 1 | 4µs | *_MRO_MODULE = "$]" < 5.010 ? sub(){"MRO/Compat.pm"} : sub(){"mro.pm"}; | ||
| 23 | 1 | 992µs | 1 | 5µs | } # spent 5µ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 | 17 | 40µs | 17 | 17µs | (my $proto = $_[0]) =~ s/::/\//g; # spent 17µs making 17 calls to Role::Tiny::CORE:subst, avg 1µs/call |
| 31 | 17 | 4µs | $proto .= '.pm'; | ||
| 32 | 17 | 26µ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 | return 1 if grep !/::$/, keys %{_getstash($_[0])||{}}; | ||||
| 36 | my $guard = _WORK_AROUND_BROKEN_MODULE_STATE | ||||
| 37 | && bless([ $proto ], 'Role::Tiny::__GUARD__'); | ||||
| 38 | require $proto; | ||||
| 39 | pop @$guard if _WORK_AROUND_BROKEN_MODULE_STATE; | ||||
| 40 | return 1; | ||||
| 41 | } | ||||
| 42 | |||||
| 43 | sub import { | ||||
| 44 | my $target = caller; | ||||
| 45 | my $me = shift; | ||||
| 46 | strict->import; | ||||
| 47 | warnings->import; | ||||
| 48 | return if $me->is_role($target); # already exported into this package | ||||
| 49 | $INFO{$target}{is_role} = 1; | ||||
| 50 | # get symbol table reference | ||||
| 51 | my $stash = _getstash($target); | ||||
| 52 | # install before/after/around subs | ||||
| 53 | 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 | }; | ||||
| 59 | } | ||||
| 60 | *{_getglob "${target}::requires"} = sub { | ||||
| 61 | push @{$INFO{$target}{requires}||=[]}, @_; | ||||
| 62 | return; | ||||
| 63 | }; | ||||
| 64 | *{_getglob "${target}::with"} = sub { | ||||
| 65 | $me->apply_roles_to_package($target, @_); | ||||
| 66 | return; | ||||
| 67 | }; | ||||
| 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 | my @not_methods = (map { *$_{CODE}||() } grep !ref($_), values %$stash); | ||||
| 73 | @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods; | ||||
| 74 | # a role does itself | ||||
| 75 | $APPLIED_TO{$target} = { $target => undef }; | ||||
| 76 | $_->($target) for @ON_ROLE_CREATE; | ||||
| 77 | } | ||||
| 78 | |||||
| 79 | # spent 18µs within Role::Tiny::role_application_steps which was called 14 times, avg 1µs/call:
# 14 times (18µs+0s) by Moo::Role::role_application_steps at line 252 of Moo/Role.pm, avg 1µs/call | ||||
| 80 | 14 | 23µs | qw(_install_methods _check_requires _install_modifiers _copy_applied_list); | ||
| 81 | } | ||||
| 82 | |||||
| 83 | # spent 2.32ms (189µs+2.13) within Role::Tiny::apply_single_role_to_package which was called 11 times, avg 210µs/call:
# 11 times (189µs+2.13ms) by Moo::Role::apply_single_role_to_package at line 271 of Moo/Role.pm, avg 210µs/call | ||||
| 84 | 11 | 3µs | my ($me, $to, $role) = @_; | ||
| 85 | |||||
| 86 | 11 | 10µs | 11 | 41µs | _load_module($role); # spent 41µs making 11 calls to Role::Tiny::_load_module, avg 4µs/call |
| 87 | |||||
| 88 | 11 | 3µs | die "This is apply_role_to_package" if ref($to); | ||
| 89 | 11 | 8µs | 11 | 72µs | die "${role} is not a Role::Tiny" unless $me->is_role($role); # spent 72µs making 11 calls to Moo::Role::is_role, avg 7µs/call |
| 90 | |||||
| 91 | 11 | 31µs | 11 | 42µs | foreach my $step ($me->role_application_steps) { # spent 42µs making 11 calls to Moo::Role::role_application_steps, avg 4µs/call |
| 92 | 66 | 95µs | 66 | 1.97ms | $me->$step($to, $role); # spent 1.08ms making 11 calls to Role::Tiny::_install_methods, avg 98µs/call
# spent 718µs making 11 calls to Moo::Role::_handle_constructor, avg 65µs/call
# spent 75µs making 11 calls to Role::Tiny::_check_requires, avg 7µs/call
# spent 54µs making 11 calls to Moo::Role::_maybe_make_accessors, avg 5µs/call
# spent 29µs making 11 calls to Role::Tiny::_copy_applied_list, avg 3µs/call
# spent 16µs making 11 calls to Role::Tiny::_install_modifiers, avg 1µs/call |
| 93 | } | ||||
| 94 | } | ||||
| 95 | |||||
| 96 | sub _copy_applied_list { | ||||
| 97 | 17 | 4µs | my ($me, $to, $role) = @_; | ||
| 98 | # copy our role list into the target's | ||||
| 99 | 17 | 50µ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 | 300ns | 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 | 11 | 49µs | 11 | 2.94ms | # spent 2.96ms (26µs+2.94) within Role::Tiny::apply_role_to_package which was called 11 times, avg 269µs/call:
# 11 times (26µs+2.94ms) by Role::Tiny::apply_roles_to_package at line 201, avg 269µs/call # spent 2.94ms making 11 calls to Moo::Role::apply_single_role_to_package, avg 267µs/call |
| 197 | |||||
| 198 | # spent 5.34ms (196µs+5.14) within Role::Tiny::apply_roles_to_package which was called 14 times, avg 381µs/call:
# 14 times (196µs+5.14ms) by Moo::Role::apply_roles_to_package at line 263 of Moo/Role.pm, avg 381µs/call | ||||
| 199 | 14 | 8µs | my ($me, $to, @roles) = @_; | ||
| 200 | |||||
| 201 | 14 | 35µs | 11 | 2.96ms | return $me->apply_role_to_package($to, $roles[0]) if @roles == 1; # spent 2.96ms making 11 calls to Role::Tiny::apply_role_to_package, avg 269µs/call |
| 202 | |||||
| 203 | 3 | 10µs | 3 | 322µs | my %conflicts = %{$me->_composite_info_for(@roles)->{conflicts}}; # spent 322µs making 3 calls to Role::Tiny::_composite_info_for, avg 107µs/call |
| 204 | 3 | 3µs | my @have = grep $to->can($_), keys %conflicts; | ||
| 205 | 3 | 1µs | delete @conflicts{@have}; | ||
| 206 | |||||
| 207 | 3 | 2µ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 | 3 | 7µs | 6 | 32µs | my @role_methods = map $me->_concrete_methods_of($_), @roles; # spent 32µs making 6 calls to Role::Tiny::_concrete_methods_of, avg 5µs/call |
| 223 | # separate loops, since local ..., delete ... for ...; creates a scope | ||||
| 224 | 3 | 4µs | local @{$_}{@have} for @role_methods; | ||
| 225 | 3 | 4µ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 | 3 | 1µ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 | our %BACKCOMPAT_HACK; | ||||
| 237 | 3 | 18µs | 3 | 4µs | if($me ne __PACKAGE__ # spent 4µs making 3 calls to UNIVERSAL::can, avg 1µs/call |
| 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 | 3 | 6µs | 3 | 12µs | foreach my $step ($me->role_application_steps) { # spent 12µs making 3 calls to Moo::Role::role_application_steps, avg 4µs/call |
| 251 | 18 | 7µs | foreach my $role (@roles) { | ||
| 252 | 36 | 44µs | 36 | 1.81ms | $me->$step($to, $role); # spent 625µs making 6 calls to Moo::Role::_handle_constructor, avg 104µs/call
# spent 572µs making 6 calls to Role::Tiny::_install_methods, avg 95µs/call
# spent 549µs making 6 calls to Role::Tiny::_install_modifiers, avg 91µs/call
# spent 28µs making 6 calls to Role::Tiny::_check_requires, avg 5µs/call
# spent 22µs making 6 calls to Moo::Role::_maybe_make_accessors, avg 4µs/call
# spent 15µs making 6 calls to Role::Tiny::_copy_applied_list, avg 2µs/call |
| 253 | } | ||||
| 254 | } | ||||
| 255 | } | ||||
| 256 | 3 | 12µs | $APPLIED_TO{$to}{join('|',@roles)} = 1; | ||
| 257 | } | ||||
| 258 | |||||
| 259 | # spent 322µs (169+154) within Role::Tiny::_composite_info_for which was called 3 times, avg 107µs/call:
# 3 times (169µs+154µs) by Role::Tiny::apply_roles_to_package at line 203, avg 107µs/call | ||||
| 260 | 3 | 2µs | my ($me, @roles) = @_; | ||
| 261 | 3 | 25µs | 3 | 6µs | $COMPOSITE_INFO{join('|', sort @roles)} ||= do { # spent 6µs making 3 calls to Role::Tiny::CORE:sort, avg 2µs/call |
| 262 | 3 | 2µs | foreach my $role (@roles) { | ||
| 263 | 6 | 5µs | 6 | 20µs | _load_module($role); # spent 20µs making 6 calls to Role::Tiny::_load_module, avg 3µs/call |
| 264 | } | ||||
| 265 | 3 | 2µs | my %methods; | ||
| 266 | 3 | 2µs | foreach my $role (@roles) { | ||
| 267 | 6 | 10µs | 6 | 128µs | my $this_methods = $me->_concrete_methods_of($role); # spent 128µs making 6 calls to Role::Tiny::_concrete_methods_of, avg 21µs/call |
| 268 | 6 | 57µs | $methods{$_}{$this_methods->{$_}} = $role for keys %$this_methods; | ||
| 269 | } | ||||
| 270 | 3 | 400ns | my %requires; | ||
| 271 | 3 | 9µs | @requires{map @{$INFO{$_}{requires}||[]}, @roles} = (); | ||
| 272 | 3 | 13µs | delete $requires{$_} for keys %methods; | ||
| 273 | 3 | 35µs | delete $methods{$_} for grep keys(%{$methods{$_}}) == 1, keys %methods; | ||
| 274 | 3 | 6µ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 | 327µs | 2 | 30µs | # spent 18µs (6+12) within Role::Tiny::BEGIN@290 which was called:
# once (6µs+12µs) by Moo::Role::BEGIN@5 at line 290 # spent 18µ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 | 17 | 6µs | my ($me, $to, $name, $requires) = @_; | ||
| 314 | 17 | 31µs | return unless my @requires = @{$requires||$INFO{$name}{requires}||[]}; | ||
| 315 | 11 | 71µs | 20 | 16µs | if (my @requires_fail = grep !$to->can($_), @requires) { # spent 16µs making 20 calls to UNIVERSAL::can, avg 785ns/call |
| 316 | # role -> role, add to requires, role -> class, error out | ||||
| 317 | 2 | 3µs | 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 436µs (398+38) within Role::Tiny::_concrete_methods_of which was called 29 times, avg 15µs/call:
# 17 times (250µs+26µs) by Role::Tiny::_install_methods at line 353, avg 16µs/call
# 6 times (120µs+8µs) by Role::Tiny::_composite_info_for at line 267, avg 21µs/call
# 6 times (28µs+4µs) by Role::Tiny::apply_roles_to_package at line 222, avg 5µs/call | ||||
| 326 | 29 | 6µs | my ($me, $role) = @_; | ||
| 327 | 29 | 8µs | my $info = $INFO{$role}; | ||
| 328 | # grab role symbol table | ||||
| 329 | 29 | 21µs | 29 | 38µs | my $stash = _getstash($role); # spent 38µs making 29 calls to Role::Tiny::_getstash, avg 1µs/call |
| 330 | # reverse so our keys become the values (captured coderefs) in case | ||||
| 331 | # they got copied or re-used since | ||||
| 332 | 29 | 125µ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 | 239 | 38µs | my $code = *{$stash->{$_}}{CODE}; | ||
| 337 | 239 | 60µs | ( ! $code or exists $not_methods->{$code} ) ? () : ($_ => $code) | ||
| 338 | 29 | 147µs | } 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 | 17 | 6µs | my ($me, $to, $role) = @_; | ||
| 350 | |||||
| 351 | 17 | 7µs | my $info = $INFO{$role}; | ||
| 352 | |||||
| 353 | 17 | 21µs | 17 | 276µs | my $methods = $me->_concrete_methods_of($role); # spent 276µs making 17 calls to Role::Tiny::_concrete_methods_of, avg 16µs/call |
| 354 | |||||
| 355 | # grab target symbol table | ||||
| 356 | 17 | 19µs | 17 | 13µs | my $stash = _getstash($to); # spent 13µs making 17 calls to Role::Tiny::_getstash, avg 771ns/call |
| 357 | |||||
| 358 | # determine already extant methods of target | ||||
| 359 | 17 | 2µs | my %has_methods; | ||
| 360 | @has_methods{grep | ||||
| 361 | 17 | 92µs | +(ref($stash->{$_}) || *{$stash->{$_}}{CODE}), | ||
| 362 | keys %$stash | ||||
| 363 | } = (); | ||||
| 364 | |||||
| 365 | 17 | 55µs | foreach my $i (grep !exists $has_methods{$_}, keys %$methods) { | ||
| 366 | 2 | 257µs | 2 | 29µs | # spent 18µs (7+11) within Role::Tiny::BEGIN@366 which was called:
# once (7µs+11µs) by Moo::Role::BEGIN@5 at line 366 # spent 18µs making 1 call to Role::Tiny::BEGIN@366
# spent 11µs making 1 call to warnings::unimport |
| 367 | 168 | 92µs | 168 | 208µs | my $glob = _getglob "${to}::${i}"; # spent 208µs making 168 calls to Role::Tiny::_getglob, avg 1µs/call |
| 368 | 168 | 38µ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 | unless $i =~ /^\(/ | ||||
| 374 | && ((defined &overload::nil && $methods->{$i} == \&overload::nil) | ||||
| 375 | 168 | 141µs | 168 | 7µs | || (defined &overload::_nil && $methods->{$i} == \&overload::_nil)); # spent 7µs making 168 calls to Role::Tiny::CORE:match, avg 43ns/call |
| 376 | |||||
| 377 | my $overload = ${ *{_getglob "${role}::${i}"}{SCALAR} }; | ||||
| 378 | next | ||||
| 379 | unless defined $overload; | ||||
| 380 | |||||
| 381 | *$glob = \$overload; | ||||
| 382 | } | ||||
| 383 | |||||
| 384 | 17 | 49µs | 17 | 539µs | $me->_install_does($to); # spent 539µs making 17 calls to Moo::Role::_install_does, avg 32µs/call |
| 385 | } | ||||
| 386 | |||||
| 387 | sub _install_modifiers { | ||||
| 388 | 17 | 5µs | my ($me, $to, $name) = @_; | ||
| 389 | 17 | 23µs | return unless my $modifiers = $INFO{$name}{modifiers}; | ||
| 390 | 3 | 8µs | if (my $info = $INFO{$to}) { | ||
| 391 | push @{$info->{modifiers}}, @{$modifiers||[]}; | ||||
| 392 | } else { | ||||
| 393 | 2 | 2µs | foreach my $modifier (@{$modifiers||[]}) { | ||
| 394 | 3 | 5µs | 3 | 530µs | $me->_install_single_modifier($to, @$modifier); # spent 530µs making 3 calls to Moo::Role::_install_single_modifier, avg 177µs/call |
| 395 | } | ||||
| 396 | } | ||||
| 397 | } | ||||
| 398 | |||||
| 399 | 1 | 100ns | 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 434µs (173+260) within Role::Tiny::_install_does which was called 17 times, avg 26µs/call:
# 17 times (173µs+260µs) by Moo::Role::_install_does at line 371 of Moo/Role.pm, avg 26µs/call | ||||
| 415 | 17 | 4µs | my ($me, $to) = @_; | ||
| 416 | |||||
| 417 | # only add does() method to classes | ||||
| 418 | 17 | 18µs | 17 | 192µs | return if $me->is_role($to); # spent 192µs making 17 calls to Moo::Role::is_role, avg 11µs/call |
| 419 | |||||
| 420 | 13 | 32µs | 13 | 8µs | my $does = $me->can('does_role'); # spent 8µs making 13 calls to UNIVERSAL::can, avg 631ns/call |
| 421 | # add does() only if they don't have one | ||||
| 422 | 13 | 38µs | 13 | 22µs | *{_getglob "${to}::does"} = $does unless $to->can('does'); # spent 22µs making 13 calls to UNIVERSAL::can, avg 2µs/call |
| 423 | |||||
| 424 | return | ||||
| 425 | 13 | 76µs | 39 | 27µs | if $to->can('DOES') and $to->can('DOES') != (UNIVERSAL->can('DOES') || 0); # spent 27µs making 39 calls to UNIVERSAL::can, avg 685ns/call |
| 426 | |||||
| 427 | 8 | 16µs | 8 | 4µs | my $existing = $to->can('DOES') || $to->can('isa') || $FALLBACK; # spent 4µs making 8 calls to UNIVERSAL::can, avg 562ns/call |
| 428 | my $new_sub = sub { | ||||
| 429 | my ($proto, $role) = @_; | ||||
| 430 | $proto->$does($role) or $proto->$existing($role); | ||||
| 431 | 8 | 17µs | }; | ||
| 432 | 2 | 99µs | 2 | 21µs | # spent 14µs (6+7) within Role::Tiny::BEGIN@432 which was called:
# once (6µs+7µs) by Moo::Role::BEGIN@5 at line 432 # spent 14µs making 1 call to Role::Tiny::BEGIN@432
# spent 7µs making 1 call to warnings::unimport |
| 433 | 8 | 25µs | 8 | 7µs | return *{_getglob "${to}::DOES"} = $new_sub; # spent 7µs making 8 calls to Role::Tiny::_getglob, avg 850ns/call |
| 434 | } | ||||
| 435 | |||||
| 436 | # spent 21.1ms (17.3+3.78) within Role::Tiny::does_role which was called 4004 times, avg 5µs/call:
# 4004 times (17.3ms+3.78ms) by Moo::Role::does_role at line 377 of Moo/Role.pm, avg 5µs/call | ||||
| 437 | 4004 | 957µs | my ($proto, $role) = @_; | ||
| 438 | 4004 | 1.51ms | require(_MRO_MODULE); | ||
| 439 | 4004 | 12.4ms | 4004 | 3.78ms | foreach my $class (@{mro::get_linear_isa(ref($proto)||$proto)}) { # spent 3.78ms making 4004 calls to mro::get_linear_isa, avg 944ns/call |
| 440 | 4004 | 32.7ms | return 1 if exists $APPLIED_TO{$class}{$role}; | ||
| 441 | } | ||||
| 442 | return 0; | ||||
| 443 | } | ||||
| 444 | |||||
| 445 | # spent 166µs within Role::Tiny::is_role which was called 174 times, avg 957ns/call:
# 96 times (106µs+0s) by Moo::Role::_inhale_if_moose at line 138 of Moo/Role.pm, avg 1µs/call
# 68 times (46µs+0s) by Moo::Role::is_role at line 132 of Moo/Role.pm, avg 669ns/call
# 10 times (16µs+0s) by Moo::import at line 28 of Moo.pm, avg 2µs/call | ||||
| 446 | 174 | 33µs | my ($me, $role) = @_; | ||
| 447 | 174 | 221µs | return !!($INFO{$role} && $INFO{$role}{is_role}); | ||
| 448 | } | ||||
| 449 | |||||
| 450 | 1 | 3µs | 1; | ||
| 451 | __END__ | ||||
# spent 7µs within Role::Tiny::CORE:match which was called 168 times, avg 43ns/call:
# 168 times (7µs+0s) by Role::Tiny::_install_methods at line 375, avg 43ns/call | |||||
# spent 6µs within Role::Tiny::CORE:sort which was called 3 times, avg 2µs/call:
# 3 times (6µs+0s) by Role::Tiny::_composite_info_for at line 261, avg 2µs/call | |||||
# spent 17µs within Role::Tiny::CORE:subst which was called 17 times, avg 1µs/call:
# 17 times (17µs+0s) by Role::Tiny::_load_module at line 30, avg 1µs/call | |||||
# spent 2µs within Search::Elasticsearch::Cxn::HTTPTiny::CORE:qr which was called:
# once (2µs+0s) by Module::Runtime::require_module at line 9 of Search/Elasticsearch/Cxn/HTTPTiny.pm |