← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 01.HTTP.t
  Run on Tue May 4 15:25:55 2010
Reported on Tue May 4 15:26:06 2010

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
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
3611748µs1.82msClass::MOP::Method::Wrapped::::wrapClass::MOP::Method::Wrapped::wrap
3611353µs697µsClass::MOP::Method::Wrapped::::add_around_modifierClass::MOP::Method::Wrapped::add_around_modifier
3611327µs327µsClass::MOP::Method::Wrapped::::_newClass::MOP::Method::Wrapped::_new
9111285µs1.06msClass::MOP::Method::Wrapped::::__ANON__[:159]Class::MOP::Method::Wrapped::__ANON__[:159]
7221240µs240µsClass::MOP::Method::Wrapped::::__ANON__[:69]Class::MOP::Method::Wrapped::__ANON__[:69]
3611214µs214µsClass::MOP::Method::Wrapped::::__ANON__[:161]Class::MOP::Method::Wrapped::__ANON__[:161]
11117µs28µsClass::MOP::Method::Wrapped::::BEGIN@5Class::MOP::Method::Wrapped::BEGIN@5
11115µs19µsClass::MOP::Method::Wrapped::::BEGIN@4Class::MOP::Method::Wrapped::BEGIN@4
1119µs14.4msClass::MOP::Method::Wrapped::::BEGIN@14Class::MOP::Method::Wrapped::BEGIN@14
1117µs37µsClass::MOP::Method::Wrapped::::BEGIN@7Class::MOP::Method::Wrapped::BEGIN@7
1117µs28µsClass::MOP::Method::Wrapped::::BEGIN@8Class::MOP::Method::Wrapped::BEGIN@8
0000s0sClass::MOP::Method::Wrapped::::__ANON__[:43]Class::MOP::Method::Wrapped::__ANON__[:43]
0000s0sClass::MOP::Method::Wrapped::::__ANON__[:49]Class::MOP::Method::Wrapped::__ANON__[:49]
0000s0sClass::MOP::Method::Wrapped::::__ANON__[:64]Class::MOP::Method::Wrapped::__ANON__[:64]
0000s0sClass::MOP::Method::Wrapped::::__ANON__[:89]Class::MOP::Method::Wrapped::__ANON__[:89]
0000s0sClass::MOP::Method::Wrapped::::add_after_modifierClass::MOP::Method::Wrapped::add_after_modifier
0000s0sClass::MOP::Method::Wrapped::::add_before_modifierClass::MOP::Method::Wrapped::add_before_modifier
0000s0sClass::MOP::Method::Wrapped::::after_modifiersClass::MOP::Method::Wrapped::after_modifiers
0000s0sClass::MOP::Method::Wrapped::::around_modifiersClass::MOP::Method::Wrapped::around_modifiers
0000s0sClass::MOP::Method::Wrapped::::before_modifiersClass::MOP::Method::Wrapped::before_modifiers
0000s0sClass::MOP::Method::Wrapped::::get_original_methodClass::MOP::Method::Wrapped::get_original_method
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1
2package Class::MOP::Method::Wrapped;
3
4322µs224µ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
use strict;
# spent 19µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@4 # spent 4µs making 1 call to strict::import
5326µs239µ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
use warnings;
# spent 28µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@5 # spent 11µs making 1 call to warnings::import
6
7322µs267µ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
use Carp 'confess';
# spent 37µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@7 # spent 30µs making 1 call to Exporter::import
8343µs249µ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
use Scalar::Util 'blessed';
# spent 28µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@8 # spent 21µs making 1 call to Exporter::import
9
1011µsour $VERSION = '0.98';
11131µs$VERSION = eval $VERSION;
121600nsour $AUTHORITY = 'cpan:STEVAN';
13
1431.40ms228.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
use base 'Class::MOP::Method';
# 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
my $_build_wrapped_method = sub {
23288274µs my $modifier_table = shift;
24 my ($before, $after, $around) = (
25 $modifier_table->{before},
26 $modifier_table->{after},
27 $modifier_table->{around},
28 );
29 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 $modifier_table->{cache} = $around->{cache};
68 }
6915µ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
sub wrap {
72180757µs my ( $class, $code, %params ) = @_;
73
74 (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 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 $_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(
8991263µs911.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 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
sub _new {
100144350µs my $class = shift;
101 return Class::MOP::Class->initialize($class)->new_object(@_)
102 if $class ne __PACKAGE__;
103
104 my $params = @_ == 1 ? $_[0] : {@_};
105
106 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
119sub get_original_method {
120 my $code = shift;
121 $code->{'modifier_table'}->{orig};
122}
123
124sub 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
131sub before_modifiers {
132 my $code = shift;
133 return @{$code->{'modifier_table'}->{before}};
134}
135
136sub 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
143sub 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.
1551600ns
# 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
my $compile_around_method = sub {{
156288226µs my $f1 = pop;
157 return $f1 unless @_;
158 my $f2 = pop;
15991250µs91773µ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
push @_, sub { $f2->( $f1, @_ ) };
# spent 773µs making 91 calls to Class::MOP::Class:::around, avg 8µs/call
160 redo;
16113µ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
sub add_around_modifier {
164180289µs my $code = shift;
165 my $modifier = shift;
166 unshift @{$code->{'modifier_table'}->{around}->{methods}} => $modifier;
167 $code->{'modifier_table'}->{around}->{cache} = $compile_around_method->(
168 @{$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 $_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
175sub around_modifiers {
176 my $code = shift;
177 return @{$code->{'modifier_table'}->{around}->{methods}};
178}
179
180111µs1;
181
182__END__
183
184=pod
185
186=head1 NAME
187
188Class::MOP::Method::Wrapped - Method Meta Object for methods with before/after/around modifiers
189
190=head1 DESCRIPTION
191
192This is a L<Class::MOP::Method> subclass which implements before,
193after, 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
203This is the constructor. It accepts a L<Class::MOP::Method> object and
204a hash of options.
205
206The options are:
207
208=over 8
209
210=item * name
211
212The method name (without a package name). This will be taken from the
213provided L<Class::MOP::Method> object if it is not provided.
214
215=item * package_name
216
217The package name for the method. This will be taken from the provided
218L<Class::MOP::Method> object if it is not provided.
219
220=item * associated_metaclass
221
222An optional L<Class::MOP::Class> object. This is the metaclass for the
223method's class.
224
225=back
226
227=item B<< $metamethod->get_original_method >>
228
229This returns the L<Class::MOP::Method> object that was passed to the
230constructor.
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
238These methods all take a subroutine reference and apply it as a
239modifier 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
247These methods all return a list of subroutine references which are
248acting as the specified type of modifier.
249
250=back
251
252=head1 AUTHORS
253
254Stevan Little E<lt>stevan@iinteractive.comE<gt>
255
256=head1 COPYRIGHT AND LICENSE
257
258Copyright 2006-2010 by Infinity Interactive, Inc.
259
260L<http://www.iinteractive.com>
261
262This library is free software; you can redistribute it and/or modify
263it under the same terms as Perl itself.
264
265=cut
266