File | /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP/Method/Wrapped.pm |
Statements Executed | 4950 |
Statement Execution Time | 12.1ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1004 | 1 | 1 | 2.90ms | 7.31ms | __ANON__[:159] | Class::MOP::Method::Wrapped::
100 | 2 | 1 | 2.16ms | 5.32ms | wrap | Class::MOP::Method::Wrapped::
100 | 1 | 1 | 921µs | 921µs | _new | Class::MOP::Method::Wrapped::
200 | 4 | 1 | 804µs | 804µs | __ANON__[:69] | Class::MOP::Method::Wrapped::
65 | 1 | 1 | 652µs | 1.28ms | add_around_modifier | Class::MOP::Method::Wrapped::
33 | 1 | 1 | 468µs | 10.5ms | __ANON__[:64] | Class::MOP::Method::Wrapped::
65 | 1 | 1 | 397µs | 397µs | __ANON__[:161] | Class::MOP::Method::Wrapped::
22 | 1 | 1 | 121µs | 259µs | add_after_modifier | Class::MOP::Method::Wrapped::
13 | 1 | 1 | 78µs | 156µs | add_before_modifier | Class::MOP::Method::Wrapped::
2 | 1 | 1 | 24µs | 1.68ms | __ANON__[:49] | Class::MOP::Method::Wrapped::
1 | 1 | 1 | 14µs | 17µs | BEGIN@4 | Class::MOP::Method::Wrapped::
1 | 1 | 1 | 7µs | 860µs | BEGIN@14 | Class::MOP::Method::Wrapped::
1 | 1 | 1 | 7µs | 16µs | BEGIN@5 | Class::MOP::Method::Wrapped::
1 | 1 | 1 | 6µs | 33µs | BEGIN@7 | Class::MOP::Method::Wrapped::
1 | 1 | 1 | 6µs | 33µs | BEGIN@8 | Class::MOP::Method::Wrapped::
0 | 0 | 0 | 0s | 0s | __ANON__[:43] | Class::MOP::Method::Wrapped::
0 | 0 | 0 | 0s | 0s | __ANON__[:89] | 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 | 20µs | 2 | 20µs | # spent 17µs (14+3) within Class::MOP::Method::Wrapped::BEGIN@4 which was called
# once (14µs+3µs) by Class::MOP::Class::BEGIN@8 at line 4 # spent 17µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@4
# spent 3µs making 1 call to strict::import |
5 | 3 | 20µs | 2 | 25µs | # spent 16µs (7+9) within Class::MOP::Method::Wrapped::BEGIN@5 which was called
# once (7µs+9µs) by Class::MOP::Class::BEGIN@8 at line 5 # spent 16µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@5
# spent 9µs making 1 call to warnings::import |
6 | |||||
7 | 3 | 21µs | 2 | 60µs | # spent 33µs (6+27) within Class::MOP::Method::Wrapped::BEGIN@7 which was called
# once (6µs+27µs) by Class::MOP::Class::BEGIN@8 at line 7 # spent 33µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@7
# spent 27µs making 1 call to Exporter::import |
8 | 3 | 49µs | 2 | 59µs | # spent 33µs (6+26) within Class::MOP::Method::Wrapped::BEGIN@8 which was called
# once (6µs+26µs) by Class::MOP::Class::BEGIN@8 at line 8 # spent 33µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@8
# spent 26µs making 1 call to Exporter::import |
9 | |||||
10 | 1 | 700ns | our $VERSION = '0.98'; | ||
11 | 1 | 19µs | $VERSION = eval $VERSION; | ||
12 | 1 | 400ns | our $AUTHORITY = 'cpan:STEVAN'; | ||
13 | |||||
14 | 3 | 663µs | 2 | 1.71ms | # spent 860µs (7+853) within Class::MOP::Method::Wrapped::BEGIN@14 which was called
# once (7µs+853µs) by Class::MOP::Class::BEGIN@8 at line 14 # spent 860µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@14
# spent 853µs 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 804µ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 200 times, avg 4µs/call:
# 100 times (384µs+0s) by Class::MOP::Method::Wrapped::wrap at line 87, avg 4µs/call
# 65 times (205µs+0s) by Class::MOP::Method::Wrapped::add_around_modifier at line 171, avg 3µs/call
# 22 times (138µs+0s) by Class::MOP::Method::Wrapped::add_after_modifier at line 140, avg 6µs/call
# 13 times (78µs+0s) by Class::MOP::Method::Wrapped::add_before_modifier at line 128, avg 6µs/call | ||||
23 | 200 | 47µs | my $modifier_table = shift; | ||
24 | 200 | 158µs | my ($before, $after, $around) = ( | ||
25 | $modifier_table->{before}, | ||||
26 | $modifier_table->{after}, | ||||
27 | $modifier_table->{around}, | ||||
28 | ); | ||||
29 | 200 | 533µ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 | # spent 1.68ms (24µs+1.65) within Class::MOP::Method::Wrapped::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP/Method/Wrapped.pm:49] which was called 2 times, avg 839µs/call:
# 2 times (24µs+1.65ms) by MooseX::AttributeHelpers::Collection::Hash::_process_options at line 89, avg 839µs/call | ||||
47 | 4 | 9µs | 2 | 1.52ms | for my $c (@$before) { $c->(@_) }; # spent 1.52ms making 2 calls to Class::MOP::Class:::before, avg 761µs/call |
48 | 2 | 15µs | 2 | 132µs | return $around->{cache}->(@_); # spent 132µs making 2 calls to Moose::Meta::Attribute::_process_options, avg 66µs/call |
49 | } | ||||
50 | 13 | 41µs | } | ||
51 | elsif (@$after && !@$before) { | ||||
52 | # spent 10.5ms (468µs+10.0) within Class::MOP::Method::Wrapped::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP/Method/Wrapped.pm:64] which was called 33 times, avg 319µs/call:
# 33 times (468µs+10.0ms) by Foo::Child::domainId or Foo::Domain::parentId or MooseX::AttributeHelpers::Collection::Hash::install_accessors at line 89, avg 319µs/call | ||||
53 | 33 | 8µs | my @rval; | ||
54 | 33 | 119µs | 33 | 2.38ms | ((defined wantarray) ? # spent 2.17ms making 2 calls to Moose::Meta::Attribute::install_accessors, avg 1.09ms/call
# spent 190µs making 26 calls to Foo::Domain::parentId, avg 7µs/call
# spent 18µs making 5 calls to Foo::Child::domainId, avg 4µs/call |
55 | ((wantarray) ? | ||||
56 | (@rval = $around->{cache}->(@_)) | ||||
57 | : | ||||
58 | ($rval[0] = $around->{cache}->(@_))) | ||||
59 | : | ||||
60 | $around->{cache}->(@_)); | ||||
61 | 66 | 120µs | 33 | 7.66ms | for my $c (@$after) { $c->(@_) }; # spent 7.66ms making 33 calls to Class::MOP::Class:::after, avg 232µs/call |
62 | 33 | 21µs | return unless defined wantarray; | ||
63 | 29 | 95µs | return wantarray ? @rval : $rval[0]; | ||
64 | } | ||||
65 | 22 | 78µs | } | ||
66 | else { | ||||
67 | 165 | 65µs | $modifier_table->{cache} = $around->{cache}; | ||
68 | } | ||||
69 | 1 | 3µs | }; | ||
70 | |||||
71 | # spent 5.32ms (2.16+3.16) within Class::MOP::Method::Wrapped::wrap which was called 100 times, avg 53µs/call:
# 92 times (1.95ms+2.75ms) 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 51µs/call
# 8 times (217µs+405µs) by Class::MOP::Class::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP/Class.pm:678] at line 671 of Class/MOP/Class.pm, avg 78µs/call | ||||
72 | 100 | 163µs | my ( $class, $code, %params ) = @_; | ||
73 | |||||
74 | 100 | 482µs | 200 | 134µs | (blessed($code) && $code->isa('Class::MOP::Method')) # spent 80µs making 100 calls to UNIVERSAL::isa, avg 799ns/call
# spent 55µs making 100 calls to Scalar::Util::blessed, avg 546ns/call |
75 | || confess "Can only wrap blessed CODE"; | ||||
76 | |||||
77 | 100 | 483µs | 100 | 42µs | my $modifier_table = { # spent 42µs making 100 calls to Class::MOP::Method::body, avg 424ns/call |
78 | cache => undef, | ||||
79 | orig => $code, | ||||
80 | before => [], | ||||
81 | after => [], | ||||
82 | around => { | ||||
83 | cache => $code->body, | ||||
84 | methods => [], | ||||
85 | }, | ||||
86 | }; | ||||
87 | 100 | 110µs | 100 | 384µs | $_build_wrapped_method->($modifier_table); # spent 384µs making 100 calls to Class::MOP::Method::Wrapped::__ANON__[Class/MOP/Method/Wrapped.pm:69], avg 4µs/call |
88 | return $class->SUPER::wrap( | ||||
89 | 1039 | 3.00ms | 1039 | 19.5ms | sub { $modifier_table->{cache}->(@_) }, # spent 10.5ms making 33 calls to Class::MOP::Method::Wrapped::__ANON__[Class/MOP/Method/Wrapped.pm:64], avg 319µs/call
# spent 8.62ms making 1004 calls to Class::MOP::Method::Wrapped::__ANON__[Class/MOP/Method/Wrapped.pm:159], avg 9µs/call, recursion: max depth 5, time 1.31ms
# spent 1.68ms making 2 calls to Class::MOP::Method::Wrapped::__ANON__[Class/MOP/Method/Wrapped.pm:49], avg 839µs/call |
90 | # get these from the original | ||||
91 | # unless explicitly overriden | ||||
92 | 100 | 947µs | 100 | 2.60ms | package_name => $params{package_name} || $code->package_name, # spent 2.60ms making 100 calls to Class::MOP::Method::wrap, avg 26µs/call |
93 | name => $params{name} || $code->name, | ||||
94 | |||||
95 | modifier_table => $modifier_table, | ||||
96 | ); | ||||
97 | } | ||||
98 | |||||
99 | # spent 921µs within Class::MOP::Method::Wrapped::_new which was called 100 times, avg 9µs/call:
# 100 times (921µs+0s) by Class::MOP::Method::wrap at line 44 of Class/MOP/Method.pm, avg 9µs/call | ||||
100 | 100 | 36µs | my $class = shift; | ||
101 | 100 | 25µs | return Class::MOP::Class->initialize($class)->new_object(@_) | ||
102 | if $class ne __PACKAGE__; | ||||
103 | |||||
104 | 100 | 40µs | my $params = @_ == 1 ? $_[0] : {@_}; | ||
105 | |||||
106 | 100 | 882µ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 | # spent 156µs (78+78) within Class::MOP::Method::Wrapped::add_before_modifier which was called 13 times, avg 12µs/call:
# 13 times (78µs+78µs) by Class::MOP::Class::add_before_method_modifier at line 685 of Class/MOP/Class.pm, avg 12µs/call | ||||
125 | 13 | 5µs | my $code = shift; | ||
126 | 13 | 4µs | my $modifier = shift; | ||
127 | 13 | 15µs | unshift @{$code->{'modifier_table'}->{before}} => $modifier; | ||
128 | 13 | 36µs | 13 | 78µs | $_build_wrapped_method->($code->{'modifier_table'}); # spent 78µs making 13 calls to Class::MOP::Method::Wrapped::__ANON__[Class/MOP/Method/Wrapped.pm:69], avg 6µs/call |
129 | } | ||||
130 | |||||
131 | sub before_modifiers { | ||||
132 | my $code = shift; | ||||
133 | return @{$code->{'modifier_table'}->{before}}; | ||||
134 | } | ||||
135 | |||||
136 | # spent 259µs (121+138) within Class::MOP::Method::Wrapped::add_after_modifier which was called 22 times, avg 12µs/call:
# 22 times (121µs+138µs) by Class::MOP::Class::add_after_method_modifier at line 695 of Class/MOP/Class.pm, avg 12µs/call | ||||
137 | 22 | 8µs | my $code = shift; | ||
138 | 22 | 6µs | my $modifier = shift; | ||
139 | 22 | 20µs | push @{$code->{'modifier_table'}->{after}} => $modifier; | ||
140 | 22 | 56µs | 22 | 138µs | $_build_wrapped_method->($code->{'modifier_table'}); # spent 138µs making 22 calls to Class::MOP::Method::Wrapped::__ANON__[Class/MOP/Method/Wrapped.pm:69], avg 6µs/call |
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 | 131 | 29µs | # spent 397µ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 65 times, avg 6µs/call:
# 65 times (397µs+0s) by Class::MOP::Method::Wrapped::add_around_modifier at line 168, avg 6µs/call | ||
156 | 65 | 10µs | my $f1 = pop; | ||
157 | 130 | 174µs | return $f1 unless @_; | ||
158 | 65 | 8µs | my $f2 = pop; | ||
159 | 1069 | 2.86ms | 1004 | 4.44ms | # spent 7.31ms (2.90+4.41) 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 1004 times, avg 7µs/call:
# 1004 times (2.90ms+4.41ms) by Class::MOP::Class::Immutable::Class::MOP::Class::__ANON__::SERIAL::1::is_immutable or Class::MOP::Class::Immutable::Class::MOP::Class::add_package_symbol or Class::MOP::Class::Immutable::Class::MOP::Class::class_precedence_list 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 or Class::MOP::Class::Immutable::Class::MOP::Class::superclasses or Class::MOP::Class::__ANON__::SERIAL::2::_process_options or Class::MOP::Class::__ANON__::SERIAL::2::accessor_metaclass or Class::MOP::Class::__ANON__::SERIAL::2::attach_to_class or Class::MOP::Class::__ANON__::SERIAL::2::default or Class::MOP::Class::__ANON__::SERIAL::2::set_value at line 89, avg 7µs/call # spent 5.72ms making 1004 calls to Class::MOP::Class:::around, avg 6µs/call, recursion: max depth 5, time 1.28ms |
160 | 65 | 21µs | redo; | ||
161 | 1 | 2µs | }}; | ||
162 | |||||
163 | # spent 1.28ms (652µs+633µs) within Class::MOP::Method::Wrapped::add_around_modifier which was called 65 times, avg 20µs/call:
# 65 times (652µs+633µs) by Class::MOP::Class::add_around_method_modifier at line 705 of Class/MOP/Class.pm, avg 20µs/call | ||||
164 | 65 | 16µs | my $code = shift; | ||
165 | 65 | 8µs | my $modifier = shift; | ||
166 | 65 | 69µs | unshift @{$code->{'modifier_table'}->{around}->{methods}} => $modifier; | ||
167 | $code->{'modifier_table'}->{around}->{cache} = $compile_around_method->( | ||||
168 | 65 | 272µs | 130 | 428µs | @{$code->{'modifier_table'}->{around}->{methods}}, # spent 397µs making 65 calls to Class::MOP::Method::Wrapped::__ANON__[Class/MOP/Method/Wrapped.pm:161], avg 6µs/call
# spent 31µs making 65 calls to Class::MOP::Method::body, avg 477ns/call |
169 | $code->{'modifier_table'}->{orig}->body | ||||
170 | ); | ||||
171 | 65 | 171µs | 65 | 205µs | $_build_wrapped_method->($code->{'modifier_table'}); # spent 205µs making 65 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 | 6µ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 |