← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:11 2010

File /usr/local/lib/perl/5.10.0/Class/MOP/Method/Wrapped.pm
Statements Executed 2758
Total Time 0.0122065 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
678113.82ms12.9msClass::MOP::Method::Wrapped::::__ANON__[:159]Class::MOP::Method::Wrapped::__ANON__[:159]
46111.24ms4.10msClass::MOP::Method::Wrapped::::wrapClass::MOP::Method::Wrapped::wrap
4611874µs874µsClass::MOP::Method::Wrapped::::_newClass::MOP::Method::Wrapped::_new
9221809µs809µsClass::MOP::Method::Wrapped::::__ANON__[:69]Class::MOP::Method::Wrapped::__ANON__[:69]
4611560µs560µsClass::MOP::Method::Wrapped::::__ANON__[:161]Class::MOP::Method::Wrapped::__ANON__[:161]
4611555µs1.63msClass::MOP::Method::Wrapped::::add_around_modifierClass::MOP::Method::Wrapped::add_around_modifier
0000s0sClass::MOP::Method::Wrapped::::BEGINClass::MOP::Method::Wrapped::BEGIN
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::::_make_compatible_withClass::MOP::Method::Wrapped::_make_compatible_with
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
LineStmts.Exclusive
Time
Avg.Code
1
2package Class::MOP::Method::Wrapped;
3
4326µs9µsuse strict;
# spent 10µs making 1 call to strict::import
5336µs12µsuse warnings;
# spent 30µs making 1 call to warnings::import
6
7331µs10µsuse Carp 'confess';
# spent 51µs making 1 call to Exporter::import
8363µs21µsuse Scalar::Util 'blessed';
# spent 36µs making 1 call to Exporter::import
9
101900ns900nsour $VERSION = '1.09';
11123µs23µs$VERSION = eval $VERSION;
121600ns600nsour $AUTHORITY = 'cpan:STEVAN';
13
1431.18ms393µsuse base 'Class::MOP::Method';
# spent 87µ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 809µs within Class::MOP::Method::Wrapped::__ANON__[/usr/local/lib/perl/5.10.0/Class/MOP/Method/Wrapped.pm:69] which was called 92 times, avg 9µs/call: # 46 times (409µs+0s) by Class::MOP::Method::Wrapped::wrap at line 87, avg 9µs/call # 46 times (400µs+0s) by Class::MOP::Method::Wrapped::add_around_modifier at line 171, avg 9µs/call
my $_build_wrapped_method = sub {
239245µs487ns my $modifier_table = shift;
2492177µs2µs my ($before, $after, $around) = (
25 $modifier_table->{before},
26 $modifier_table->{after},
27 $modifier_table->{around},
28 );
2992293µs3µ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 {
679282µs891ns $modifier_table->{cache} = $around->{cache};
68 }
6916µs6µs};
70
71
# spent 4.10ms (1.24+2.86) within Class::MOP::Method::Wrapped::wrap which was called 46 times, avg 89µs/call: # 46 times (1.24ms+2.86ms) by Class::MOP::Class::__ANON__[/usr/local/lib/perl/5.10.0/Class/MOP/Class.pm:935] at line 921 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 89µs/call
sub wrap {
7246171µs4µs my ( $class, $code, %params ) = @_;
73
7446371µs8µs (blessed($code) && $code->isa('Class::MOP::Method'))
# spent 147µs making 46 calls to Scalar::Util::blessed, avg 3µs/call # spent 141µs making 46 calls to UNIVERSAL::isa, avg 3µs/call
75 || confess "Can only wrap blessed CODE";
76
7746391µs9µs my $modifier_table = {
# spent 100µs making 46 calls to Class::MOP::Method::body, avg 2µs/call
78 cache => undef,
79 orig => $code,
80 before => [],
81 after => [],
82 around => {
83 cache => $code->body,
84 methods => [],
85 },
86 };
8746180µs4µs $_build_wrapped_method->($modifier_table);
88 return $class->SUPER::wrap(
896783.09ms5µs sub { $modifier_table->{cache}->(@_) },
90 # get these from the original
91 # unless explicitly overriden
9246636µs14µs package_name => $params{package_name} || $code->package_name,
# spent 2.06ms making 46 calls to Class::MOP::Method::wrap, avg 45µs/call
93 name => $params{name} || $code->name,
94
95 modifier_table => $modifier_table,
96 );
97}
98
99
# spent 874µs within Class::MOP::Method::Wrapped::_new which was called 46 times, avg 19µs/call: # 46 times (874µs+0s) by Class::MOP::Method::wrap at line 44 of /usr/local/lib/perl/5.10.0/Class/MOP/Method.pm, avg 19µs/call
sub _new {
1004634µs739ns my $class = shift;
1014623µs502ns return Class::MOP::Class->initialize($class)->new_object(@_)
102 if $class ne __PACKAGE__;
103
1044631µs683ns my $params = @_ == 1 ? $_[0] : {@_};
105
10646698µs15µ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
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.
1559360µs651ns
# spent 560µs within Class::MOP::Method::Wrapped::__ANON__[/usr/local/lib/perl/5.10.0/Class/MOP/Method/Wrapped.pm:161] which was called 46 times, avg 12µs/call: # 46 times (560µs+0s) by Class::MOP::Method::Wrapped::add_around_modifier at line 168, avg 12µs/call
my $compile_around_method = sub {{
1564624µs524ns my $f1 = pop;
15792108µs1µs return $f1 unless @_;
1584622µs474ns my $f2 = pop;
1597243.58ms5µs
# spent 12.9ms (3.82+9.12) within Class::MOP::Method::Wrapped::__ANON__[/usr/local/lib/perl/5.10.0/Class/MOP/Method/Wrapped.pm:159] which was called 678 times, avg 19µs/call: # 678 times (3.82ms+9.12ms) by Class::MOP::Method::Wrapped::wrap or Class::MOP::Method::Wrapped::__ANON__[/usr/local/lib/perl/5.10.0/Class/MOP/Method/Wrapped.pm:89] at line 89, avg 19µs/call
push @_, sub { $f2->( $f1, @_ ) };
# spent 9.12ms making 678 calls to Class::MOP::Class:::around, avg 13µs/call
1604636µs778ns redo;
16113µs3µs }};
162
163
# spent 1.63ms (555µs+1.08) within Class::MOP::Method::Wrapped::add_around_modifier which was called 46 times, avg 36µs/call: # 46 times (555µs+1.08ms) by Class::MOP::Class::add_around_method_modifier at line 962 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 36µs/call
sub add_around_modifier {
1644628µs607ns my $code = shift;
1654618µs396ns my $modifier = shift;
1664687µs2µs unshift @{$code->{'modifier_table'}->{around}->{methods}} => $modifier;
167 $code->{'modifier_table'}->{around}->{cache} = $compile_around_method->(
16846440µs10µs @{$code->{'modifier_table'}->{around}->{methods}},
# spent 560µs making 46 calls to Class::MOP::Method::Wrapped::__ANON__[/usr/local/lib/perl/5.10.0/Class/MOP/Method/Wrapped.pm:161], avg 12µs/call # spent 119µs making 46 calls to Class::MOP::Method::body, avg 3µs/call
169 $code->{'modifier_table'}->{orig}->body
170 );
17146214µs5µs $_build_wrapped_method->($code->{'modifier_table'});
172 }
173}
174
175sub around_modifiers {
176 my $code = shift;
177 return @{$code->{'modifier_table'}->{around}->{methods}};
178}
179
180sub _make_compatible_with {
181 my $self = shift;
182 my ($other) = @_;
183
184 # XXX: this is pretty gross. the issue here is that CMOP::Method::Wrapped
185 # objects are subclasses of CMOP::Method, but when we get to moose, they'll
186 # need to be compatible with Moose::Meta::Method, which isn't possible. the
187 # right solution here is to make ::Wrapped into a role that gets applied to
188 # whatever the method_metaclass happens to be and get rid of
189 # wrapped_method_metaclass entirely, but that's not going to happen until
190 # we ditch cmop and get roles into the bootstrapping, so. i'm not
191 # maintaining the previous behavior of turning them into instances of the
192 # new method_metaclass because that's equally broken, and at least this way
193 # any issues will at least be detectable and potentially fixable. -doy
194 return $self unless $other->_is_compatible_with($self->_real_ref_name);
195
196 return $self->SUPER::_make_compatible_with(@_);
197}
198
19918µs8µs1;
200
201__END__
202
203=pod
204
205=head1 NAME
206
207Class::MOP::Method::Wrapped - Method Meta Object for methods with before/after/around modifiers
208
209=head1 DESCRIPTION
210
211This is a L<Class::MOP::Method> subclass which implements before,
212after, and around method modifiers.
213
214=head1 METHODS
215
216=head2 Construction
217
218=over 4
219
220=item B<< Class::MOP::Method::Wrapped->wrap($metamethod, %options) >>
221
222This is the constructor. It accepts a L<Class::MOP::Method> object and
223a hash of options.
224
225The options are:
226
227=over 8
228
229=item * name
230
231The method name (without a package name). This will be taken from the
232provided L<Class::MOP::Method> object if it is not provided.
233
234=item * package_name
235
236The package name for the method. This will be taken from the provided
237L<Class::MOP::Method> object if it is not provided.
238
239=item * associated_metaclass
240
241An optional L<Class::MOP::Class> object. This is the metaclass for the
242method's class.
243
244=back
245
246=item B<< $metamethod->get_original_method >>
247
248This returns the L<Class::MOP::Method> object that was passed to the
249constructor.
250
251=item B<< $metamethod->add_before_modifier($code) >>
252
253=item B<< $metamethod->add_after_modifier($code) >>
254
255=item B<< $metamethod->add_around_modifier($code) >>
256
257These methods all take a subroutine reference and apply it as a
258modifier to the original method.
259
260=item B<< $metamethod->before_modifiers >>
261
262=item B<< $metamethod->after_modifiers >>
263
264=item B<< $metamethod->around_modifiers >>
265
266These methods all return a list of subroutine references which are
267acting as the specified type of modifier.
268
269=back
270
271=head1 AUTHORS
272
273Stevan Little E<lt>stevan@iinteractive.comE<gt>
274
275=head1 COPYRIGHT AND LICENSE
276
277Copyright 2006-2010 by Infinity Interactive, Inc.
278
279L<http://www.iinteractive.com>
280
281This library is free software; you can redistribute it and/or modify
282it under the same terms as Perl itself.
283
284=cut
285