Filename | /Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Class/Method/Modifiers.pm |
Statements | Executed 1080 statements in 6.65ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
18 | 2 | 2 | 3.46ms | 5.38ms | install_modifier | Class::Method::Modifiers::
45 | 2 | 1 | 1.86ms | 1.86ms | _sub_attrs | Class::Method::Modifiers::
2 | 2 | 2 | 82µs | 873µs | around | Class::Method::Modifiers::
1 | 1 | 1 | 32µs | 36µs | BEGIN@1 | Moo::_Utils::
1 | 1 | 1 | 10µs | 16µs | BEGIN@54 | Class::Method::Modifiers::
1 | 1 | 1 | 9µs | 44µs | BEGIN@2.27 | Moo::_Utils::
1 | 1 | 1 | 8µs | 74µs | BEGIN@10 | Class::Method::Modifiers::
1 | 1 | 1 | 8µs | 11µs | BEGIN@145 | Class::Method::Modifiers::
1 | 1 | 1 | 8µs | 29µs | BEGIN@146 | Class::Method::Modifiers::
1 | 1 | 1 | 7µs | 11µs | BEGIN@196 | Class::Method::Modifiers::
1 | 1 | 1 | 6µs | 16µs | BEGIN@200 | Class::Method::Modifiers::
1 | 1 | 1 | 4µs | 14µs | BEGIN@147 | Class::Method::Modifiers::
1 | 1 | 1 | 4µs | 4µs | BEGIN@19 | Class::Method::Modifiers::
0 | 0 | 0 | 0s | 0s | _fresh | Class::Method::Modifiers::
0 | 0 | 0 | 0s | 0s | _is_in_package | Class::Method::Modifiers::
0 | 0 | 0 | 0s | 0s | after | Class::Method::Modifiers::
0 | 0 | 0 | 0s | 0s | before | Class::Method::Modifiers::
0 | 0 | 0 | 0s | 0s | fresh | Class::Method::Modifiers::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | 2 | 37µs | 2 | 40µs | # spent 36µs (32+4) within Moo::_Utils::BEGIN@1 which was called:
# once (32µs+4µs) by Moo::_Utils::_install_modifier at line 1 # spent 36µs making 1 call to Moo::_Utils::BEGIN@1
# spent 4µs making 1 call to strict::import |
2 | 2 | 59µs | 2 | 79µs | # spent 44µs (9+35) within Moo::_Utils::BEGIN@2.27 which was called:
# once (9µs+35µs) by Moo::_Utils::_install_modifier at line 2 # spent 44µs making 1 call to Moo::_Utils::BEGIN@2.27
# spent 35µs making 1 call to warnings::import |
3 | package Class::Method::Modifiers; # git description: v2.12-17-gbc38636 | ||||
4 | # ABSTRACT: Provides Moose-like method modifiers | ||||
5 | # KEYWORDS: method wrap modification patch | ||||
6 | # vim: set ts=8 sts=4 sw=4 tw=115 et : | ||||
7 | |||||
8 | 1 | 0s | our $VERSION = '2.13'; | ||
9 | |||||
10 | 2 | 105µs | 2 | 140µs | # spent 74µs (8+66) within Class::Method::Modifiers::BEGIN@10 which was called:
# once (8µs+66µs) by Moo::_Utils::_install_modifier at line 10 # spent 74µs making 1 call to Class::Method::Modifiers::BEGIN@10
# spent 66µs making 1 call to base::import |
11 | |||||
12 | 1 | 1µs | our @EXPORT = qw(before after around); | ||
13 | 1 | 1µs | our @EXPORT_OK = (@EXPORT, qw(fresh install_modifier)); | ||
14 | 1 | 3µs | our %EXPORT_TAGS = ( | ||
15 | moose => [qw(before after around)], | ||||
16 | all => \@EXPORT_OK, | ||||
17 | ); | ||||
18 | |||||
19 | # spent 4µs within Class::Method::Modifiers::BEGIN@19 which was called:
# once (4µs+0s) by Moo::_Utils::_install_modifier at line 21 | ||||
20 | 1 | 4µs | *_HAS_READONLY = $] >= 5.008 ? sub(){1} : sub(){0}; | ||
21 | 1 | 172µs | 1 | 4µs | } # spent 4µs making 1 call to Class::Method::Modifiers::BEGIN@19 |
22 | |||||
23 | our %MODIFIER_CACHE; | ||||
24 | |||||
25 | # for backward compatibility | ||||
26 | sub _install_modifier; # -w | ||||
27 | 1 | 2µs | *_install_modifier = \&install_modifier; | ||
28 | |||||
29 | # spent 5.38ms (3.46+1.92) within Class::Method::Modifiers::install_modifier which was called 18 times, avg 299µs/call:
# 16 times (3.01ms+1.57ms) by Moo::_Utils::_install_modifier at line 86 of Moo/_Utils.pm, avg 287µs/call
# 2 times (447µs+344µs) by Class::Method::Modifiers::around at line 162, avg 396µs/call | ||||
30 | 18 | 10µs | my $into = shift; | ||
31 | 18 | 8µs | my $type = shift; | ||
32 | 18 | 7µs | my $code = pop; | ||
33 | 18 | 6µs | my @names = @_; | ||
34 | |||||
35 | 18 | 38µs | @names = @{ $names[0] } if ref($names[0]) eq 'ARRAY'; | ||
36 | |||||
37 | 18 | 14µs | return _fresh($into, $code, @names) if $type eq 'fresh'; | ||
38 | |||||
39 | 18 | 137µs | for my $name (@names) { | ||
40 | 34 | 240µs | 34 | 58µs | my $hit = $into->can($name) or do { # spent 58µs making 34 calls to UNIVERSAL::can, avg 2µs/call |
41 | require Carp; | ||||
42 | Carp::confess("The method '$name' is not found in the inheritance hierarchy for class $into"); | ||||
43 | }; | ||||
44 | |||||
45 | 34 | 17µs | my $qualified = $into.'::'.$name; | ||
46 | 34 | 85µs | my $cache = $MODIFIER_CACHE{$into}{$name} ||= { | ||
47 | before => [], | ||||
48 | after => [], | ||||
49 | around => [], | ||||
50 | }; | ||||
51 | |||||
52 | # this must be the first modifier we're installing | ||||
53 | 34 | 25µs | if (!exists($cache->{"orig"})) { | ||
54 | 2 | 211µs | 2 | 22µs | # spent 16µs (10+6) within Class::Method::Modifiers::BEGIN@54 which was called:
# once (10µs+6µs) by Moo::_Utils::_install_modifier at line 54 # spent 16µs making 1 call to Class::Method::Modifiers::BEGIN@54
# spent 6µs making 1 call to strict::unimport |
55 | |||||
56 | # grab the original method (or undef if the method is inherited) | ||||
57 | 34 | 49µs | $cache->{"orig"} = *{$qualified}{CODE}; | ||
58 | |||||
59 | # the "innermost" method, the one that "around" will ultimately wrap | ||||
60 | 34 | 17µs | $cache->{"wrapped"} = $cache->{"orig"} || $hit; #sub { | ||
61 | # # we can't cache this, because new methods or modifiers may be | ||||
62 | # # added between now and when this method is called | ||||
63 | # for my $package (@{ mro::get_linear_isa($into) }) { | ||||
64 | # next if $package eq $into; | ||||
65 | # my $code = *{$package.'::'.$name}{CODE}; | ||||
66 | # goto $code if $code; | ||||
67 | # } | ||||
68 | # require Carp; | ||||
69 | # Carp::confess("$qualified\::$name disappeared?"); | ||||
70 | #}; | ||||
71 | } | ||||
72 | |||||
73 | # keep these lists in the order the modifiers are called | ||||
74 | 34 | 30µs | if ($type eq 'after') { | ||
75 | push @{ $cache->{$type} }, $code; | ||||
76 | } | ||||
77 | else { | ||||
78 | 34 | 45µs | unshift @{ $cache->{$type} }, $code; | ||
79 | } | ||||
80 | |||||
81 | # wrap the method with another layer of around. much simpler than | ||||
82 | # the Moose equivalent. :) | ||||
83 | 34 | 19µs | if ($type eq 'around') { | ||
84 | 11 | 9µs | my $method = $cache->{wrapped}; | ||
85 | 11 | 29µs | 11 | 515µs | my $attrs = _sub_attrs($code); # spent 515µs making 11 calls to Class::Method::Modifiers::_sub_attrs, avg 47µs/call |
86 | # a bare "sub :lvalue {...}" will be parsed as a label and an | ||||
87 | # indirect method call. force it to be treated as an expression | ||||
88 | # using + | ||||
89 | 11 | 455µs | $cache->{wrapped} = eval "package $into; +sub $attrs { \$code->(\$method, \@_); };"; # spent 207ms executing statements in 3 string evals (merged) # includes 206ms spent executing 75880 calls to 1 sub defined therein. # spent 363µs executing statements in 2 string evals (merged) # includes 299µs spent executing 90 calls to 1 sub defined therein. # spent 162µs executing statements in string eval # includes 139µs spent executing 22 calls to 1 sub defined therein. # spent 61µs executing statements in 3 string evals (merged) # includes 79µs spent executing 16 calls to 1 sub defined therein. # spent 21µs executing statements in string eval # includes 21µs spent executing 1 call to 1 sub defined therein. # spent 8µs executing statements in string eval | ||
90 | } | ||||
91 | |||||
92 | # install our new method which dispatches the modifiers, but only | ||||
93 | # if a new type was added | ||||
94 | 34 | 63µs | if (@{ $cache->{$type} } == 1) { | ||
95 | |||||
96 | # avoid these hash lookups every method invocation | ||||
97 | 34 | 13µs | my $before = $cache->{"before"}; | ||
98 | 34 | 13µs | my $after = $cache->{"after"}; | ||
99 | |||||
100 | # this is a coderef that changes every new "around". so we need | ||||
101 | # to take a reference to it. better a deref than a hash lookup | ||||
102 | 34 | 11µs | my $wrapped = \$cache->{"wrapped"}; | ||
103 | |||||
104 | 34 | 90µs | 34 | 1.34ms | my $attrs = _sub_attrs($cache->{wrapped}); # spent 1.34ms making 34 calls to Class::Method::Modifiers::_sub_attrs, avg 39µs/call |
105 | |||||
106 | 34 | 23µs | my $generated = "package $into;\n"; | ||
107 | 34 | 19µs | $generated .= "sub $name $attrs {"; | ||
108 | |||||
109 | # before is easy, it doesn't affect the return value(s) | ||||
110 | 34 | 41µs | if (@$before) { | ||
111 | $generated .= ' | ||||
112 | for my $method (@$before) { | ||||
113 | $method->(@_); | ||||
114 | } | ||||
115 | '; | ||||
116 | } | ||||
117 | |||||
118 | 34 | 13µs | if (@$after) { | ||
119 | $generated .= ' | ||||
120 | my $ret; | ||||
121 | if (wantarray) { | ||||
122 | $ret = [$$wrapped->(@_)]; | ||||
123 | '.(_HAS_READONLY ? 'Internals::SvREADONLY(@$ret, 1);' : '').' | ||||
124 | } | ||||
125 | elsif (defined wantarray) { | ||||
126 | $ret = \($$wrapped->(@_)); | ||||
127 | } | ||||
128 | else { | ||||
129 | $$wrapped->(@_); | ||||
130 | } | ||||
131 | |||||
132 | for my $method (@$after) { | ||||
133 | $method->(@_); | ||||
134 | } | ||||
135 | |||||
136 | wantarray ? @$ret : $ret ? $$ret : (); | ||||
137 | ' | ||||
138 | } | ||||
139 | else { | ||||
140 | 34 | 7µs | $generated .= '$$wrapped->(@_);'; | ||
141 | } | ||||
142 | |||||
143 | 34 | 10µs | $generated .= '}'; | ||
144 | |||||
145 | 2 | 28µs | 2 | 14µs | # spent 11µs (8+3) within Class::Method::Modifiers::BEGIN@145 which was called:
# once (8µs+3µs) by Moo::_Utils::_install_modifier at line 145 # spent 11µs making 1 call to Class::Method::Modifiers::BEGIN@145
# spent 3µs making 1 call to strict::unimport |
146 | 2 | 22µs | 2 | 50µs | # spent 29µs (8+21) within Class::Method::Modifiers::BEGIN@146 which was called:
# once (8µs+21µs) by Moo::_Utils::_install_modifier at line 146 # spent 29µs making 1 call to Class::Method::Modifiers::BEGIN@146
# spent 21µs making 1 call to warnings::unimport |
147 | 2 | 295µs | 2 | 24µs | # spent 14µs (4+10) within Class::Method::Modifiers::BEGIN@147 which was called:
# once (4µs+10µs) by Moo::_Utils::_install_modifier at line 147 # spent 14µs making 1 call to Class::Method::Modifiers::BEGIN@147
# spent 10µs making 1 call to warnings::unimport |
148 | 34 | 1.97ms | eval $generated; # spent 221ms executing statements in string eval # includes 188ms spent executing 75815 calls to 1 sub defined therein. # spent 276µs executing statements in string eval # includes 201µs spent executing 73 calls to 1 sub defined therein. # spent 209µs executing statements in string eval # includes 183µs spent executing 65 calls to 1 sub defined therein. # spent 114µs executing statements in string eval # includes 145µs spent executing 16 calls to 1 sub defined therein. # spent 94µs executing statements in string eval # includes 52µs spent executing 17 calls to 1 sub defined therein. # spent 82µs executing statements in string eval # includes 355µs spent executing 58 calls to 1 sub defined therein. # spent 61µs executing statements in string eval # includes 154µs spent executing 33 calls to 1 sub defined therein. # spent 53µs executing statements in string eval # includes 64µs spent executing 8 calls to 1 sub defined therein. # spent 51µs executing statements in string eval # includes 128µs spent executing 6 calls to 1 sub defined therein. # spent 50µs executing statements in string eval # includes 19µs spent executing 2 calls to 1 sub defined therein. # spent 46µs executing statements in string eval # includes 49µs spent executing 5 calls to 1 sub defined therein. # spent 32µs executing statements in string eval # includes 41µs spent executing 4 calls to 1 sub defined therein. # spent 26µs executing statements in string eval # includes 29µs spent executing 4 calls to 1 sub defined therein. # spent 17µs executing statements in string eval # includes 13µs spent executing 1 call to 1 sub defined therein. # spent 7µs executing statements in string eval # includes 8µs spent executing 1 call to 1 sub defined therein. # spent 7µs executing statements in string eval # includes 20µs spent executing 2 calls to 1 sub defined therein. # spent 5µs executing statements in string eval # includes 6µs spent executing 1 call to 1 sub defined therein. # spent 5µs executing statements in string eval # includes 16µs spent executing 1 call to 1 sub defined therein. | ||
149 | }; | ||||
150 | } | ||||
151 | } | ||||
152 | |||||
153 | sub before { | ||||
154 | _install_modifier(scalar(caller), 'before', @_); | ||||
155 | } | ||||
156 | |||||
157 | sub after { | ||||
158 | _install_modifier(scalar(caller), 'after', @_); | ||||
159 | } | ||||
160 | |||||
161 | # spent 873µs (82+791) within Class::Method::Modifiers::around which was called 2 times, avg 436µs/call:
# once (76µs+571µs) by Module::Runtime::require_module at line 22 of Data/Perl/Collection/Hash/MooseLike.pm
# once (6µs+220µs) by Module::Runtime::require_module at line 20 of Data/Perl/Collection/Array/MooseLike.pm | ||||
162 | 2 | 14µs | 2 | 791µs | _install_modifier(scalar(caller), 'around', @_); # spent 791µs making 2 calls to Class::Method::Modifiers::install_modifier, avg 396µs/call |
163 | } | ||||
164 | |||||
165 | sub fresh { | ||||
166 | my $code = pop; | ||||
167 | my @names = @_; | ||||
168 | |||||
169 | @names = @{ $names[0] } if ref($names[0]) eq 'ARRAY'; | ||||
170 | |||||
171 | _fresh(scalar(caller), $code, @names); | ||||
172 | } | ||||
173 | |||||
174 | sub _fresh { | ||||
175 | my ($into, $code, @names) = @_; | ||||
176 | |||||
177 | for my $name (@names) { | ||||
178 | if ($name !~ /\A [a-zA-Z_] [a-zA-Z0-9_]* \z/xms) { | ||||
179 | require Carp; | ||||
180 | Carp::confess("Invalid method name '$name'"); | ||||
181 | } | ||||
182 | if ($into->can($name)) { | ||||
183 | require Carp; | ||||
184 | Carp::confess("Class $into already has a method named '$name'"); | ||||
185 | } | ||||
186 | |||||
187 | # We need to make sure that the installed method has its CvNAME in | ||||
188 | # the appropriate package; otherwise, it would be subject to | ||||
189 | # deletion if callers use namespace::autoclean. If $code was | ||||
190 | # compiled in the target package, we can just install it directly; | ||||
191 | # otherwise, we'll need a different approach. Using Sub::Name would | ||||
192 | # be fine in all cases, at the cost of introducing a dependency on | ||||
193 | # an XS-using, non-core module. So instead we'll use string-eval to | ||||
194 | # create a new subroutine that wraps $code. | ||||
195 | if (_is_in_package($code, $into)) { | ||||
196 | 2 | 40µs | 2 | 15µs | # spent 11µs (7+4) within Class::Method::Modifiers::BEGIN@196 which was called:
# once (7µs+4µs) by Moo::_Utils::_install_modifier at line 196 # spent 11µs making 1 call to Class::Method::Modifiers::BEGIN@196
# spent 4µs making 1 call to strict::unimport |
197 | *{"$into\::$name"} = $code; | ||||
198 | } | ||||
199 | else { | ||||
200 | 2 | 223µs | 2 | 26µs | # spent 16µs (6+10) within Class::Method::Modifiers::BEGIN@200 which was called:
# once (6µs+10µs) by Moo::_Utils::_install_modifier at line 200 # spent 16µs making 1 call to Class::Method::Modifiers::BEGIN@200
# spent 10µs making 1 call to warnings::unimport |
201 | my $attrs = _sub_attrs($code); | ||||
202 | eval "package $into; sub $name $attrs { \$code->(\@_) }"; | ||||
203 | } | ||||
204 | } | ||||
205 | } | ||||
206 | |||||
207 | sub _sub_attrs { | ||||
208 | 45 | 16µs | my ($coderef) = @_; | ||
209 | 45 | 30µs | local *_sub = $coderef; | ||
210 | 45 | 8µs | local $@; | ||
211 | # this assignment will fail to compile if it isn't an lvalue sub. we | ||||
212 | # never want to actually call the sub though, so we return early. | ||||
213 | 45 | 1.86ms | (eval 'return 1; &_sub = 1') ? ':lvalue' : ''; | ||
214 | } | ||||
215 | |||||
216 | sub _is_in_package { | ||||
217 | my ($coderef, $package) = @_; | ||||
218 | require B; | ||||
219 | my $cv = B::svref_2object($coderef); | ||||
220 | return $cv->GV->STASH->NAME eq $package; | ||||
221 | } | ||||
222 | |||||
223 | 1 | 7µs | 1; | ||
224 | |||||
225 | __END__ |