← Index
NYTProf Performance Profile   « line view »
For /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
  Run on Mon Jan 29 16:55:34 2018
Reported on Mon Jan 29 16:57:07 2018

Filename/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Class/Method/Modifiers.pm
StatementsExecuted 129 statements in 984µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
311183µs280µsClass::Method::Modifiers::::install_modifierClass::Method::Modifiers::install_modifier
42196µs96µsClass::Method::Modifiers::::_sub_attrsClass::Method::Modifiers::_sub_attrs
1119µs11µsMoo::Role::::BEGIN@1 Moo::Role::BEGIN@1
1118µs54µsClass::Method::Modifiers::::BEGIN@14Class::Method::Modifiers::BEGIN@14
1116µs12µsClass::Method::Modifiers::::BEGIN@149Class::Method::Modifiers::BEGIN@149
1116µs12µsClass::Method::Modifiers::::BEGIN@200Class::Method::Modifiers::BEGIN@200
1116µs9µsClass::Method::Modifiers::::BEGIN@151Class::Method::Modifiers::BEGIN@151
1116µs6µsClass::Method::Modifiers::::BEGIN@23Class::Method::Modifiers::BEGIN@23
1115µs17µsClass::Method::Modifiers::::BEGIN@58Class::Method::Modifiers::BEGIN@58
1115µs16µsClass::Method::Modifiers::::BEGIN@150Class::Method::Modifiers::BEGIN@150
1114µs10µsClass::Method::Modifiers::::BEGIN@204Class::Method::Modifiers::BEGIN@204
1114µs7µsMoo::Role::::BEGIN@2 Moo::Role::BEGIN@2
1112µs2µ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
1216µs212µs
# spent 11µs (9+2) within Moo::Role::BEGIN@1 which was called: # once (9µs+2µs) by Moo::Role::before at line 1
use strict;
# spent 11µs making 1 call to Moo::Role::BEGIN@1 # spent 2µs making 1 call to strict::import
2224µs210µs
# spent 7µs (4+3) within Moo::Role::BEGIN@2 which was called: # once (4µs+3µs) by Moo::Role::before at line 2
use warnings;
# spent 7µs making 1 call to Moo::Role::BEGIN@2 # spent 3µs making 1 call to warnings::import
3package Class::Method::Modifiers;
4
# spent 2µs within Class::Method::Modifiers::BEGIN@4 which was called: # once (2µs+0s) by Moo::Role::before at line 6
BEGIN {
512µs $Class::Method::Modifiers::AUTHORITY = 'cpan:SARTAK';
6122µs12µs}
# spent 2µs making 1 call to Class::Method::Modifiers::BEGIN@4
7# git description: v2.10-10-gcae27a4
81200ns$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
14277µs2101µs
# spent 54µs (8+47) within Class::Method::Modifiers::BEGIN@14 which was called: # once (8µs+47µs) by Moo::Role::before at line 14
use base 'Exporter';
# spent 54µs making 1 call to Class::Method::Modifiers::BEGIN@14 # spent 47µs making 1 call to base::import
15
161700nsour @EXPORT = qw(before after around);
171400nsour @EXPORT_OK = (@EXPORT, qw(fresh install_modifier));
1812µsour %EXPORT_TAGS = (
19 moose => [qw(before after around)],
20 all => \@EXPORT_OK,
21);
22
23
# spent 6µs within Class::Method::Modifiers::BEGIN@23 which was called: # once (6µs+0s) by Moo::Role::before at line 25
BEGIN {
2414µs *_HAS_READONLY = $] >= 5.008 ? sub(){1} : sub(){0};
251104µs16µs}
# spent 6µs making 1 call to Class::Method::Modifiers::BEGIN@23
26
27our %MODIFIER_CACHE;
28
29# for backward compatibility
30sub _install_modifier; # -w
3111µs*_install_modifier = \&install_modifier;
32
33
# spent 280µs (183+98) within Class::Method::Modifiers::install_modifier which was called 3 times, avg 94µs/call: # 3 times (183µs+98µs) by Moo::_Utils::_install_modifier at line 43 of Moo/_Utils.pm, avg 94µs/call
sub install_modifier {
343800ns my $into = shift;
353500ns my $type = shift;
363600ns my $code = pop;
3731µs my @names = @_;
38
3931µs @names = @{ $names[0] } if ref($names[0]) eq 'ARRAY';
40
413700ns return _fresh($into, $code, @names) if $type eq 'fresh';
42
4339µs for my $name (@names) {
4437µs32µs my $hit = $into->can($name) or do {
# spent 2µs making 3 calls to UNIVERSAL::can, avg 700ns/call
45 require Carp;
46 Carp::confess("The method '$name' is not found in the inheritance hierarchy for class $into");
47 };
48
4932µs my $qualified = $into.'::'.$name;
5036µ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
5731µs if (!exists($cache->{"orig"})) {
582128µs229µs
# spent 17µs (5+12) within Class::Method::Modifiers::BEGIN@58 which was called: # once (5µs+12µs) by Moo::Role::before at line 58
no strict 'refs';
# spent 17µs making 1 call to Class::Method::Modifiers::BEGIN@58 # spent 12µs making 1 call to strict::unimport
59
60 # grab the original method (or undef if the method is inherited)
6133µs $cache->{"orig"} = *{$qualified}{CODE};
62
63 # the "innermost" method, the one that "around" will ultimately wrap
6431µs $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
7832µs if ($type eq 'after') {
79 push @{ $cache->{$type} }, $code;
80 }
81 else {
8232µs unshift @{ $cache->{$type} }, $code;
83 }
84
85 # wrap the method with another layer of around. much simpler than
86 # the Moose equivalent. :)
8731µs if ($type eq 'around') {
881400ns my $method = $cache->{wrapped};
8913µs131µs my $attrs = _sub_attrs($code);
# spent 31µ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 +
93129µs $cache->{wrapped} = eval "package $into; +sub $attrs { \$code->(\$method, \@_); };";
# spent 17.6ms executing statements in string eval
# includes 11.4ms spent executing 1001 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
9834µs if (@{ $cache->{$type} } == 1) {
99
100 # avoid these hash lookups every method invocation
1013700ns my $before = $cache->{"before"};
1023600ns 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
1063800ns my $wrapped = \$cache->{"wrapped"};
107
10836µs365µs my $attrs = _sub_attrs($cache->{wrapped});
# spent 65µs making 3 calls to Class::Method::Modifiers::_sub_attrs, avg 22µs/call
109
11032µs my $generated = "package $into;\n";
11132µs $generated .= "sub $name $attrs {";
112
113 # before is easy, it doesn't affect the return value(s)
11431µs if (@$before) {
115 $generated .= '
116 for my $method (@$before) {
117 $method->(@_);
118 }
119 ';
120 }
121
12231µs 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 {
14431µs $generated .= '$$wrapped->(@_);';
145 }
146
1473500ns $generated .= '}';
148
149215µs217µs
# spent 12µs (6+6) within Class::Method::Modifiers::BEGIN@149 which was called: # once (6µs+6µs) by Moo::Role::before at line 149
no strict 'refs';
# spent 12µs making 1 call to Class::Method::Modifiers::BEGIN@149 # spent 6µs making 1 call to strict::unimport
150214µs228µs
# spent 16µs (5+12) within Class::Method::Modifiers::BEGIN@150 which was called: # once (5µs+12µs) by Moo::Role::before at line 150
no warnings 'redefine';
# spent 16µs making 1 call to Class::Method::Modifiers::BEGIN@150 # spent 12µs making 1 call to warnings::unimport
1512168µs213µs
# spent 9µs (6+4) within Class::Method::Modifiers::BEGIN@151 which was called: # once (6µs+4µs) by Moo::Role::before at line 151
no warnings 'closure';
# spent 9µs making 1 call to Class::Method::Modifiers::BEGIN@151 # spent 4µs making 1 call to warnings::unimport
152389µs eval $generated;
# spent 14.3ms executing statements in string eval
# includes 118ms spent executing 4004 calls to 1 sub defined therein. # spent 12.8ms executing statements in string eval
# includes 35.0ms spent executing 2002 calls to 1 sub defined therein. # spent 3.98ms executing statements in string eval
# includes 17.0ms spent executing 1001 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)) {
200222µs219µs
# spent 12µs (6+7) within Class::Method::Modifiers::BEGIN@200 which was called: # once (6µs+7µs) by Moo::Role::before at line 200
no strict 'refs';
# spent 12µs making 1 call to Class::Method::Modifiers::BEGIN@200 # spent 7µs making 1 call to strict::unimport
201 *{"$into\::$name"} = $code;
202 }
203 else {
204297µs216µs
# spent 10µs (4+6) within Class::Method::Modifiers::BEGIN@204 which was called: # once (4µs+6µs) by Moo::Role::before at line 204
no warnings 'closure'; # for 5.8.x
# spent 10µs making 1 call to Class::Method::Modifiers::BEGIN@204 # spent 6µ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 96µs within Class::Method::Modifiers::_sub_attrs which was called 4 times, avg 24µs/call: # 3 times (65µs+0s) by Class::Method::Modifiers::install_modifier at line 108, avg 22µs/call # once (31µs+0s) by Class::Method::Modifiers::install_modifier at line 89
sub _sub_attrs {
2124800ns my ($coderef) = @_;
21342µs local *_sub = $coderef;
2144700ns local $@;
215499µ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
22514µs1;
226
227__END__