File | /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP/Method/Wrapped.pm |
Statements Executed | 1284 |
Statement Execution Time | 3.97ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
36 | 1 | 1 | 748µs | 1.82ms | wrap | Class::MOP::Method::Wrapped::
36 | 1 | 1 | 353µs | 697µs | add_around_modifier | Class::MOP::Method::Wrapped::
36 | 1 | 1 | 327µs | 327µs | _new | Class::MOP::Method::Wrapped::
91 | 1 | 1 | 285µs | 1.06ms | __ANON__[:159] | Class::MOP::Method::Wrapped::
72 | 2 | 1 | 240µs | 240µs | __ANON__[:69] | Class::MOP::Method::Wrapped::
36 | 1 | 1 | 214µs | 214µs | __ANON__[:161] | Class::MOP::Method::Wrapped::
1 | 1 | 1 | 17µs | 28µs | BEGIN@5 | Class::MOP::Method::Wrapped::
1 | 1 | 1 | 15µs | 19µs | BEGIN@4 | Class::MOP::Method::Wrapped::
1 | 1 | 1 | 9µs | 14.4ms | BEGIN@14 | Class::MOP::Method::Wrapped::
1 | 1 | 1 | 7µs | 37µs | BEGIN@7 | Class::MOP::Method::Wrapped::
1 | 1 | 1 | 7µs | 28µs | BEGIN@8 | Class::MOP::Method::Wrapped::
0 | 0 | 0 | 0s | 0s | __ANON__[:43] | Class::MOP::Method::Wrapped::
0 | 0 | 0 | 0s | 0s | __ANON__[:49] | Class::MOP::Method::Wrapped::
0 | 0 | 0 | 0s | 0s | __ANON__[:64] | Class::MOP::Method::Wrapped::
0 | 0 | 0 | 0s | 0s | __ANON__[:89] | Class::MOP::Method::Wrapped::
0 | 0 | 0 | 0s | 0s | add_after_modifier | Class::MOP::Method::Wrapped::
0 | 0 | 0 | 0s | 0s | add_before_modifier | Class::MOP::Method::Wrapped::
0 | 0 | 0 | 0s | 0s | after_modifiers | Class::MOP::Method::Wrapped::
0 | 0 | 0 | 0s | 0s | around_modifiers | Class::MOP::Method::Wrapped::
0 | 0 | 0 | 0s | 0s | before_modifiers | Class::MOP::Method::Wrapped::
0 | 0 | 0 | 0s | 0s | get_original_method | Class::MOP::Method::Wrapped::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | |||||
2 | package Class::MOP::Method::Wrapped; | ||||
3 | |||||
4 | 3 | 22µs | 2 | 24µs | # spent 19µs (15+4) within Class::MOP::Method::Wrapped::BEGIN@4 which was called
# once (15µs+4µs) by Class::MOP::Class::BEGIN@8 at line 4 # spent 19µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@4
# spent 4µs making 1 call to strict::import |
5 | 3 | 26µs | 2 | 39µs | # spent 28µs (17+11) within Class::MOP::Method::Wrapped::BEGIN@5 which was called
# once (17µs+11µs) by Class::MOP::Class::BEGIN@8 at line 5 # spent 28µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@5
# spent 11µs making 1 call to warnings::import |
6 | |||||
7 | 3 | 22µs | 2 | 67µs | # spent 37µs (7+30) within Class::MOP::Method::Wrapped::BEGIN@7 which was called
# once (7µs+30µs) by Class::MOP::Class::BEGIN@8 at line 7 # spent 37µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@7
# spent 30µs making 1 call to Exporter::import |
8 | 3 | 43µs | 2 | 49µs | # spent 28µs (7+21) within Class::MOP::Method::Wrapped::BEGIN@8 which was called
# once (7µs+21µs) by Class::MOP::Class::BEGIN@8 at line 8 # spent 28µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@8
# spent 21µs making 1 call to Exporter::import |
9 | |||||
10 | 1 | 1µs | our $VERSION = '0.98'; | ||
11 | 1 | 31µs | $VERSION = eval $VERSION; | ||
12 | 1 | 600ns | our $AUTHORITY = 'cpan:STEVAN'; | ||
13 | |||||
14 | 3 | 1.40ms | 2 | 28.8ms | # spent 14.4ms (9µs+14.4) within Class::MOP::Method::Wrapped::BEGIN@14 which was called
# once (9µs+14.4ms) by Class::MOP::Class::BEGIN@8 at line 14 # spent 14.4ms making 1 call to Class::MOP::Method::Wrapped::BEGIN@14
# spent 14.4ms making 1 call to base::import |
15 | |||||
16 | # NOTE: | ||||
17 | # this ugly beast is the result of trying | ||||
18 | # to micro optimize this as much as possible | ||||
19 | # while not completely loosing maintainability. | ||||
20 | # At this point it's "fast enough", after all | ||||
21 | # you can't get something for nothing :) | ||||
22 | # spent 240µs within Class::MOP::Method::Wrapped::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP/Method/Wrapped.pm:69] which was called 72 times, avg 3µs/call:
# 36 times (126µs+0s) by Class::MOP::Method::Wrapped::wrap at line 87, avg 3µs/call
# 36 times (114µs+0s) by Class::MOP::Method::Wrapped::add_around_modifier at line 171, avg 3µs/call | ||||
23 | 72 | 16µs | my $modifier_table = shift; | ||
24 | 72 | 54µs | my ($before, $after, $around) = ( | ||
25 | $modifier_table->{before}, | ||||
26 | $modifier_table->{after}, | ||||
27 | $modifier_table->{around}, | ||||
28 | ); | ||||
29 | 72 | 175µs | if (@$before && @$after) { | ||
30 | $modifier_table->{cache} = sub { | ||||
31 | for my $c (@$before) { $c->(@_) }; | ||||
32 | my @rval; | ||||
33 | ((defined wantarray) ? | ||||
34 | ((wantarray) ? | ||||
35 | (@rval = $around->{cache}->(@_)) | ||||
36 | : | ||||
37 | ($rval[0] = $around->{cache}->(@_))) | ||||
38 | : | ||||
39 | $around->{cache}->(@_)); | ||||
40 | for my $c (@$after) { $c->(@_) }; | ||||
41 | return unless defined wantarray; | ||||
42 | return wantarray ? @rval : $rval[0]; | ||||
43 | } | ||||
44 | } | ||||
45 | elsif (@$before && !@$after) { | ||||
46 | $modifier_table->{cache} = sub { | ||||
47 | for my $c (@$before) { $c->(@_) }; | ||||
48 | return $around->{cache}->(@_); | ||||
49 | } | ||||
50 | } | ||||
51 | elsif (@$after && !@$before) { | ||||
52 | $modifier_table->{cache} = sub { | ||||
53 | my @rval; | ||||
54 | ((defined wantarray) ? | ||||
55 | ((wantarray) ? | ||||
56 | (@rval = $around->{cache}->(@_)) | ||||
57 | : | ||||
58 | ($rval[0] = $around->{cache}->(@_))) | ||||
59 | : | ||||
60 | $around->{cache}->(@_)); | ||||
61 | for my $c (@$after) { $c->(@_) }; | ||||
62 | return unless defined wantarray; | ||||
63 | return wantarray ? @rval : $rval[0]; | ||||
64 | } | ||||
65 | } | ||||
66 | else { | ||||
67 | 72 | 29µs | $modifier_table->{cache} = $around->{cache}; | ||
68 | } | ||||
69 | 1 | 5µs | }; | ||
70 | |||||
71 | # spent 1.82ms (748µs+1.07) within Class::MOP::Method::Wrapped::wrap which was called 36 times, avg 50µs/call:
# 36 times (748µs+1.07ms) by Class::MOP::Class::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP/Class.pm:678] at line 664 of Class/MOP/Class.pm, avg 50µs/call | ||||
72 | 36 | 48µs | my ( $class, $code, %params ) = @_; | ||
73 | |||||
74 | 36 | 169µs | 72 | 45µs | (blessed($code) && $code->isa('Class::MOP::Method')) # spent 27µs making 36 calls to UNIVERSAL::isa, avg 739ns/call
# spent 18µs making 36 calls to Scalar::Util::blessed, avg 506ns/call |
75 | || confess "Can only wrap blessed CODE"; | ||||
76 | |||||
77 | 36 | 168µs | 36 | 15µs | my $modifier_table = { # spent 15µs making 36 calls to Class::MOP::Method::body, avg 411ns/call |
78 | cache => undef, | ||||
79 | orig => $code, | ||||
80 | before => [], | ||||
81 | after => [], | ||||
82 | around => { | ||||
83 | cache => $code->body, | ||||
84 | methods => [], | ||||
85 | }, | ||||
86 | }; | ||||
87 | 36 | 38µs | 36 | 126µs | $_build_wrapped_method->($modifier_table); # spent 126µs making 36 calls to Class::MOP::Method::Wrapped::__ANON__[Class/MOP/Method/Wrapped.pm:69], avg 3µs/call |
88 | return $class->SUPER::wrap( | ||||
89 | 91 | 263µs | 91 | 1.06ms | sub { $modifier_table->{cache}->(@_) }, # spent 1.06ms making 91 calls to Class::MOP::Method::Wrapped::__ANON__[Class/MOP/Method/Wrapped.pm:159], avg 12µs/call |
90 | # get these from the original | ||||
91 | # unless explicitly overriden | ||||
92 | 36 | 334µs | 36 | 883µs | package_name => $params{package_name} || $code->package_name, # spent 883µs making 36 calls to Class::MOP::Method::wrap, avg 25µs/call |
93 | name => $params{name} || $code->name, | ||||
94 | |||||
95 | modifier_table => $modifier_table, | ||||
96 | ); | ||||
97 | } | ||||
98 | |||||
99 | # spent 327µs within Class::MOP::Method::Wrapped::_new which was called 36 times, avg 9µs/call:
# 36 times (327µs+0s) by Class::MOP::Method::wrap at line 44 of Class/MOP/Method.pm, avg 9µs/call | ||||
100 | 36 | 10µs | my $class = shift; | ||
101 | 36 | 7µs | return Class::MOP::Class->initialize($class)->new_object(@_) | ||
102 | if $class ne __PACKAGE__; | ||||
103 | |||||
104 | 36 | 13µs | my $params = @_ == 1 ? $_[0] : {@_}; | ||
105 | |||||
106 | 36 | 319µs | return bless { | ||
107 | # inherited from Class::MOP::Method | ||||
108 | 'body' => $params->{body}, | ||||
109 | 'associated_metaclass' => $params->{associated_metaclass}, | ||||
110 | 'package_name' => $params->{package_name}, | ||||
111 | 'name' => $params->{name}, | ||||
112 | 'original_method' => $params->{original_method}, | ||||
113 | |||||
114 | # defined in this class | ||||
115 | 'modifier_table' => $params->{modifier_table} | ||||
116 | } => $class; | ||||
117 | } | ||||
118 | |||||
119 | sub get_original_method { | ||||
120 | my $code = shift; | ||||
121 | $code->{'modifier_table'}->{orig}; | ||||
122 | } | ||||
123 | |||||
124 | sub add_before_modifier { | ||||
125 | my $code = shift; | ||||
126 | my $modifier = shift; | ||||
127 | unshift @{$code->{'modifier_table'}->{before}} => $modifier; | ||||
128 | $_build_wrapped_method->($code->{'modifier_table'}); | ||||
129 | } | ||||
130 | |||||
131 | sub before_modifiers { | ||||
132 | my $code = shift; | ||||
133 | return @{$code->{'modifier_table'}->{before}}; | ||||
134 | } | ||||
135 | |||||
136 | sub add_after_modifier { | ||||
137 | my $code = shift; | ||||
138 | my $modifier = shift; | ||||
139 | push @{$code->{'modifier_table'}->{after}} => $modifier; | ||||
140 | $_build_wrapped_method->($code->{'modifier_table'}); | ||||
141 | } | ||||
142 | |||||
143 | sub after_modifiers { | ||||
144 | my $code = shift; | ||||
145 | return @{$code->{'modifier_table'}->{after}}; | ||||
146 | } | ||||
147 | |||||
148 | { | ||||
149 | # NOTE: | ||||
150 | # this is another possible candidate for | ||||
151 | # optimization as well. There is an overhead | ||||
152 | # associated with the currying that, if | ||||
153 | # eliminated might make around modifiers | ||||
154 | # more manageable. | ||||
155 | 73 | 16µs | # spent 214µs within Class::MOP::Method::Wrapped::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP/Method/Wrapped.pm:161] which was called 36 times, avg 6µs/call:
# 36 times (214µs+0s) by Class::MOP::Method::Wrapped::add_around_modifier at line 168, avg 6µs/call | ||
156 | 36 | 4µs | my $f1 = pop; | ||
157 | 72 | 95µs | return $f1 unless @_; | ||
158 | 36 | 4µs | my $f2 = pop; | ||
159 | 127 | 345µs | 91 | 773µs | # spent 1.06ms (285µs+773µs) within Class::MOP::Method::Wrapped::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP/Method/Wrapped.pm:159] which was called 91 times, avg 12µs/call:
# 91 times (285µs+773µs) by Class::MOP::Class::Immutable::Class::MOP::Class::add_package_symbol or Class::MOP::Class::Immutable::Class::MOP::Class::get_all_attributes or Class::MOP::Class::Immutable::Class::MOP::Class::get_meta_instance or Class::MOP::Class::Immutable::Class::MOP::Class::is_immutable or Class::MOP::Class::Immutable::Class::MOP::Class::linearized_isa at line 89, avg 12µs/call # spent 773µs making 91 calls to Class::MOP::Class:::around, avg 8µs/call |
160 | 36 | 12µs | redo; | ||
161 | 1 | 3µs | }}; | ||
162 | |||||
163 | # spent 697µs (353+344) within Class::MOP::Method::Wrapped::add_around_modifier which was called 36 times, avg 19µs/call:
# 36 times (353µs+344µs) by Class::MOP::Class::add_around_method_modifier at line 705 of Class/MOP/Class.pm, avg 19µs/call | ||||
164 | 36 | 9µs | my $code = shift; | ||
165 | 36 | 4µs | my $modifier = shift; | ||
166 | 36 | 38µs | unshift @{$code->{'modifier_table'}->{around}->{methods}} => $modifier; | ||
167 | $code->{'modifier_table'}->{around}->{cache} = $compile_around_method->( | ||||
168 | 36 | 148µs | 72 | 230µs | @{$code->{'modifier_table'}->{around}->{methods}}, # spent 214µs making 36 calls to Class::MOP::Method::Wrapped::__ANON__[Class/MOP/Method/Wrapped.pm:161], avg 6µs/call
# spent 16µs making 36 calls to Class::MOP::Method::body, avg 444ns/call |
169 | $code->{'modifier_table'}->{orig}->body | ||||
170 | ); | ||||
171 | 36 | 90µs | 36 | 114µs | $_build_wrapped_method->($code->{'modifier_table'}); # spent 114µs making 36 calls to Class::MOP::Method::Wrapped::__ANON__[Class/MOP/Method/Wrapped.pm:69], avg 3µs/call |
172 | } | ||||
173 | } | ||||
174 | |||||
175 | sub around_modifiers { | ||||
176 | my $code = shift; | ||||
177 | return @{$code->{'modifier_table'}->{around}->{methods}}; | ||||
178 | } | ||||
179 | |||||
180 | 1 | 11µs | 1; | ||
181 | |||||
182 | __END__ | ||||
183 | |||||
184 | =pod | ||||
185 | |||||
186 | =head1 NAME | ||||
187 | |||||
188 | Class::MOP::Method::Wrapped - Method Meta Object for methods with before/after/around modifiers | ||||
189 | |||||
190 | =head1 DESCRIPTION | ||||
191 | |||||
192 | This is a L<Class::MOP::Method> subclass which implements before, | ||||
193 | after, and around method modifiers. | ||||
194 | |||||
195 | =head1 METHODS | ||||
196 | |||||
197 | =head2 Construction | ||||
198 | |||||
199 | =over 4 | ||||
200 | |||||
201 | =item B<< Class::MOP::Method::Wrapped->wrap($metamethod, %options) >> | ||||
202 | |||||
203 | This is the constructor. It accepts a L<Class::MOP::Method> object and | ||||
204 | a hash of options. | ||||
205 | |||||
206 | The options are: | ||||
207 | |||||
208 | =over 8 | ||||
209 | |||||
210 | =item * name | ||||
211 | |||||
212 | The method name (without a package name). This will be taken from the | ||||
213 | provided L<Class::MOP::Method> object if it is not provided. | ||||
214 | |||||
215 | =item * package_name | ||||
216 | |||||
217 | The package name for the method. This will be taken from the provided | ||||
218 | L<Class::MOP::Method> object if it is not provided. | ||||
219 | |||||
220 | =item * associated_metaclass | ||||
221 | |||||
222 | An optional L<Class::MOP::Class> object. This is the metaclass for the | ||||
223 | method's class. | ||||
224 | |||||
225 | =back | ||||
226 | |||||
227 | =item B<< $metamethod->get_original_method >> | ||||
228 | |||||
229 | This returns the L<Class::MOP::Method> object that was passed to the | ||||
230 | constructor. | ||||
231 | |||||
232 | =item B<< $metamethod->add_before_modifier($code) >> | ||||
233 | |||||
234 | =item B<< $metamethod->add_after_modifier($code) >> | ||||
235 | |||||
236 | =item B<< $metamethod->add_around_modifier($code) >> | ||||
237 | |||||
238 | These methods all take a subroutine reference and apply it as a | ||||
239 | modifier to the original method. | ||||
240 | |||||
241 | =item B<< $metamethod->before_modifiers >> | ||||
242 | |||||
243 | =item B<< $metamethod->after_modifiers >> | ||||
244 | |||||
245 | =item B<< $metamethod->around_modifiers >> | ||||
246 | |||||
247 | These methods all return a list of subroutine references which are | ||||
248 | acting as the specified type of modifier. | ||||
249 | |||||
250 | =back | ||||
251 | |||||
252 | =head1 AUTHORS | ||||
253 | |||||
254 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | ||||
255 | |||||
256 | =head1 COPYRIGHT AND LICENSE | ||||
257 | |||||
258 | Copyright 2006-2010 by Infinity Interactive, Inc. | ||||
259 | |||||
260 | L<http://www.iinteractive.com> | ||||
261 | |||||
262 | This library is free software; you can redistribute it and/or modify | ||||
263 | it under the same terms as Perl itself. | ||||
264 | |||||
265 | =cut | ||||
266 |