← Index
NYTProf Performance Profile   « line view »
For index.cgi
  Run on Sat May 9 17:18:47 2020
Reported on Sat May 9 17:19:07 2020

Filename/usr/local/share/perl/5.18.2/Class/Method/Modifiers.pm
StatementsExecuted 66 statements in 1.80ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111142µs228µsClass::Method::Modifiers::::install_modifierClass::Method::Modifiers::install_modifier
22184µs84µsClass::Method::Modifiers::::_sub_attrsClass::Method::Modifiers::_sub_attrs
11116µs34µsMoo::::BEGIN@1 Moo::BEGIN@1
11111µs22µsClass::Method::Modifiers::::BEGIN@204Class::Method::Modifiers::BEGIN@204
11110µs26µsClass::Method::Modifiers::::BEGIN@200Class::Method::Modifiers::BEGIN@200
11110µs23µsClass::Method::Modifiers::::BEGIN@150Class::Method::Modifiers::BEGIN@150
11110µs25µsClass::Method::Modifiers::::BEGIN@58Class::Method::Modifiers::BEGIN@58
11110µs16µsMoo::::BEGIN@2 Moo::BEGIN@2
11110µs105µsClass::Method::Modifiers::::BEGIN@14Class::Method::Modifiers::BEGIN@14
1119µs23µsClass::Method::Modifiers::::BEGIN@149Class::Method::Modifiers::BEGIN@149
1119µs17µsClass::Method::Modifiers::::BEGIN@151Class::Method::Modifiers::BEGIN@151
1117µs7µsClass::Method::Modifiers::::BEGIN@23Class::Method::Modifiers::BEGIN@23
1115µs5µsClass::Method::Modifiers::::BEGIN@4Class::Method::Modifiers::BEGIN@4
0000s0sClass::Method::Modifiers::::_freshClass::Method::Modifiers::_fresh
0000s0sClass::Method::Modifiers::::_is_in_packageClass::Method::Modifiers::_is_in_package
0000s0sClass::Method::Modifiers::::afterClass::Method::Modifiers::after
0000s0sClass::Method::Modifiers::::aroundClass::Method::Modifiers::around
0000s0sClass::Method::Modifiers::::beforeClass::Method::Modifiers::before
0000s0sClass::Method::Modifiers::::freshClass::Method::Modifiers::fresh
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1234µs252µs
# spent 34µs (16+18) within Moo::BEGIN@1 which was called: # once (16µs+18µs) by Moo::around at line 1
use strict;
# spent 34µs making 1 call to Moo::BEGIN@1 # spent 18µs making 1 call to strict::import
2254µs222µs
# spent 16µs (10+6) within Moo::BEGIN@2 which was called: # once (10µs+6µs) by Moo::around at line 2
use warnings;
# spent 16µs making 1 call to Moo::BEGIN@2 # spent 6µs making 1 call to warnings::import
3package Class::Method::Modifiers;
4
# spent 5µs within Class::Method::Modifiers::BEGIN@4 which was called: # once (5µs+0s) by Moo::around at line 6
BEGIN {
516µs $Class::Method::Modifiers::AUTHORITY = 'cpan:SARTAK';
6146µs15µs}
# spent 5µs making 1 call to Class::Method::Modifiers::BEGIN@4
7# git description: v2.10-10-gcae27a4
811µs$Class::Method::Modifiers::VERSION = '2.11';
9# ABSTRACT: Provides Moose-like method modifiers
10# KEYWORDS: method wrap modification patch
11# vim: set ts=8 sw=4 tw=78 et :
12
13# work around https://rt.cpan.org/Ticket/Display.html?id=89173
142141µs2201µs
# spent 105µs (10+95) within Class::Method::Modifiers::BEGIN@14 which was called: # once (10µs+95µs) by Moo::around at line 14
use base 'Exporter';
# spent 105µs making 1 call to Class::Method::Modifiers::BEGIN@14 # spent 96µs making 1 call to base::import
15
1612µsour @EXPORT = qw(before after around);
1711µsour @EXPORT_OK = (@EXPORT, qw(fresh install_modifier));
1814µsour %EXPORT_TAGS = (
19 moose => [qw(before after around)],
20 all => \@EXPORT_OK,
21);
22
23
# spent 7µs within Class::Method::Modifiers::BEGIN@23 which was called: # once (7µs+0s) by Moo::around at line 25
BEGIN {
2417µs *_HAS_READONLY = $] >= 5.008 ? sub(){1} : sub(){0};
251225µs17µs}
# spent 7µs making 1 call to Class::Method::Modifiers::BEGIN@23
26
271200nsour %MODIFIER_CACHE;
28
29# for backward compatibility
30sub _install_modifier; # -w
3113µs*_install_modifier = \&install_modifier;
32
33
# spent 228µs (142+85) within Class::Method::Modifiers::install_modifier which was called: # once (142µs+85µs) by Moo::_Utils::_install_modifier at line 48 of Moo/_Utils.pm
sub install_modifier {
341500ns my $into = shift;
351300ns my $type = shift;
361400ns my $code = pop;
371900ns my @names = @_;
38
391700ns @names = @{ $names[0] } if ref($names[0]) eq 'ARRAY';
40
411300ns return _fresh($into, $code, @names) if $type eq 'fresh';
42
4316µs for my $name (@names) {
4416µs12µs my $hit = $into->can($name) or do {
# spent 2µs making 1 call to UNIVERSAL::can
45 require Carp;
46 Carp::confess("The method '$name' is not found in the inheritance hierarchy for class $into");
47 };
48
4911µs my $qualified = $into.'::'.$name;
5016µs my $cache = $MODIFIER_CACHE{$into}{$name} ||= {
51 before => [],
52 after => [],
53 around => [],
54 };
55
56 # this must be the first modifier we're installing
571700ns if (!exists($cache->{"orig"})) {
582311µs241µs
# spent 25µs (10+15) within Class::Method::Modifiers::BEGIN@58 which was called: # once (10µs+15µs) by Moo::around at line 58
no strict 'refs';
# spent 25µs making 1 call to Class::Method::Modifiers::BEGIN@58 # spent 16µs making 1 call to strict::unimport
59
60 # grab the original method (or undef if the method is inherited)
6112µs $cache->{"orig"} = *{$qualified}{CODE};
62
63 # the "innermost" method, the one that "around" will ultimately wrap
641600ns $cache->{"wrapped"} = $cache->{"orig"} || $hit; #sub {
65 # # we can't cache this, because new methods or modifiers may be
66 # # added between now and when this method is called
67 # for my $package (@{ mro::get_linear_isa($into) }) {
68 # next if $package eq $into;
69 # my $code = *{$package.'::'.$name}{CODE};
70 # goto $code if $code;
71 # }
72 # require Carp;
73 # Carp::confess("$qualified\::$name disappeared?");
74 #};
75 }
76
77 # keep these lists in the order the modifiers are called
781600ns if ($type eq 'after') {
79 push @{ $cache->{$type} }, $code;
80 }
81 else {
8211µs unshift @{ $cache->{$type} }, $code;
83 }
84
85 # wrap the method with another layer of around. much simpler than
86 # the Moose equivalent. :)
871700ns if ($type eq 'around') {
881300ns my $method = $cache->{wrapped};
8914µs146µs my $attrs = _sub_attrs($code);
# spent 46µs making 1 call to Class::Method::Modifiers::_sub_attrs
90 # a bare "sub :lvalue {...}" will be parsed as a label and an
91 # indirect method call. force it to be treated as an expression
92 # using +
93149µs $cache->{wrapped} = eval "package $into; +sub $attrs { \$code->(\$method, \@_); };";
# spent 26µs executing statements in string eval
# includes 14µs spent executing 2 calls to 1 sub defined therein.
94 }
95
96 # install our new method which dispatches the modifiers, but only
97 # if a new type was added
9813µs if (@{ $cache->{$type} } == 1) {
99
100 # avoid these hash lookups every method invocation
1011500ns my $before = $cache->{"before"};
1021300ns my $after = $cache->{"after"};
103
104 # this is a coderef that changes every new "around". so we need
105 # to take a reference to it. better a deref than a hash lookup
1061600ns my $wrapped = \$cache->{"wrapped"};
107
10815µs138µs my $attrs = _sub_attrs($cache->{wrapped});
# spent 38µs making 1 call to Class::Method::Modifiers::_sub_attrs
109
11012µs my $generated = "package $into;\n";
11111µs $generated .= "sub $name $attrs {";
112
113 # before is easy, it doesn't affect the return value(s)
1141500ns if (@$before) {
115 $generated .= '
116 for my $method (@$before) {
117 $method->(@_);
118 }
119 ';
120 }
121
1221500ns if (@$after) {
123 $generated .= '
124 my $ret;
125 if (wantarray) {
126 $ret = [$$wrapped->(@_)];
127 '.(_HAS_READONLY ? 'Internals::SvREADONLY(@$ret, 1);' : '').'
128 }
129 elsif (defined wantarray) {
130 $ret = \($$wrapped->(@_));
131 }
132 else {
133 $$wrapped->(@_);
134 }
135
136 for my $method (@$after) {
137 $method->(@_);
138 }
139
140 wantarray ? @$ret : $ret ? $$ret : ();
141 '
142 }
143 else {
1441500ns $generated .= '$$wrapped->(@_);';
145 }
146
1471300ns $generated .= '}';
148
149234µs237µs
# spent 23µs (9+14) within Class::Method::Modifiers::BEGIN@149 which was called: # once (9µs+14µs) by Moo::around at line 149
no strict 'refs';
# spent 23µs making 1 call to Class::Method::Modifiers::BEGIN@149 # spent 14µs making 1 call to strict::unimport
150232µs236µs
# spent 23µs (10+13) within Class::Method::Modifiers::BEGIN@150 which was called: # once (10µs+13µs) by Moo::around at line 150
no warnings 'redefine';
# spent 23µs making 1 call to Class::Method::Modifiers::BEGIN@150 # spent 13µs making 1 call to warnings::unimport
1512370µs225µs
# spent 17µs (9+8) within Class::Method::Modifiers::BEGIN@151 which was called: # once (9µs+8µs) by Moo::around at line 151
no warnings 'closure';
# spent 17µs making 1 call to Class::Method::Modifiers::BEGIN@151 # spent 8µs making 1 call to warnings::unimport
152141µs eval $generated;
# spent 12µs executing statements in string eval
# includes 31µs spent executing 2 calls to 1 sub defined therein.
153 };
154 }
155}
156
157sub before {
158 _install_modifier(scalar(caller), 'before', @_);
159}
160
161sub after {
162 _install_modifier(scalar(caller), 'after', @_);
163}
164
165sub around {
166 _install_modifier(scalar(caller), 'around', @_);
167}
168
169sub fresh {
170 my $code = pop;
171 my @names = @_;
172
173 @names = @{ $names[0] } if ref($names[0]) eq 'ARRAY';
174
175 _fresh(scalar(caller), $code, @names);
176}
177
178sub _fresh {
179 my ($into, $code, @names) = @_;
180
181 for my $name (@names) {
182 if ($name !~ /\A [a-zA-Z_] [a-zA-Z0-9_]* \z/xms) {
183 require Carp;
184 Carp::confess("Invalid method name '$name'");
185 }
186 if ($into->can($name)) {
187 require Carp;
188 Carp::confess("Class $into already has a method named '$name'");
189 }
190
191 # We need to make sure that the installed method has its CvNAME in
192 # the appropriate package; otherwise, it would be subject to
193 # deletion if callers use namespace::autoclean. If $code was
194 # compiled in the target package, we can just install it directly;
195 # otherwise, we'll need a different approach. Using Sub::Name would
196 # be fine in all cases, at the cost of introducing a dependency on
197 # an XS-using, non-core module. So instead we'll use string-eval to
198 # create a new subroutine that wraps $code.
199 if (_is_in_package($code, $into)) {
200251µs242µs
# spent 26µs (10+16) within Class::Method::Modifiers::BEGIN@200 which was called: # once (10µs+16µs) by Moo::around at line 200
no strict 'refs';
# spent 26µs making 1 call to Class::Method::Modifiers::BEGIN@200 # spent 16µs making 1 call to strict::unimport
201 *{"$into\::$name"} = $code;
202 }
203 else {
2042247µs234µs
# spent 22µs (11+12) within Class::Method::Modifiers::BEGIN@204 which was called: # once (11µs+12µs) by Moo::around at line 204
no warnings 'closure'; # for 5.8.x
# spent 22µs making 1 call to Class::Method::Modifiers::BEGIN@204 # spent 12µs making 1 call to warnings::unimport
205 my $attrs = _sub_attrs($code);
206 eval "package $into; sub $name $attrs { \$code->(\@_) }";
207 }
208 }
209}
210
211
# spent 84µs within Class::Method::Modifiers::_sub_attrs which was called 2 times, avg 42µs/call: # once (46µs+0s) by Class::Method::Modifiers::install_modifier at line 89 # once (38µs+0s) by Class::Method::Modifiers::install_modifier at line 108
sub _sub_attrs {
21221µs my ($coderef) = @_;
21322µs local *_sub = $coderef;
2142500ns local $@;
215289µs (eval 'sub { _sub = 1 }') ? ':lvalue' : '';
216}
217
218sub _is_in_package {
219 my ($coderef, $package) = @_;
220 require B;
221 my $cv = B::svref_2object($coderef);
222 return $cv->GV->STASH->NAME eq $package;
223}
224
22517µs1;
226
227__END__
Report produced by the NYTProf 6.06 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.