← 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.pm
Statements Executed 3405
Total Time 0.0108877 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
202554.46ms21.4msClass::MOP::Method::::wrapClass::MOP::Method::wrap
370112.34ms3.40msClass::MOP::Method::::attach_to_classClass::MOP::Method::attach_to_class
8422982µs12.5msClass::MOP::Method::::_newClass::MOP::Method::_new
18064519µs519µsClass::MOP::Method::::nameClass::MOP::Method::name(xsub)
2022349µs509µsClass::MOP::Method::::cloneClass::MOP::Method::clone
0000s0sClass::MOP::Method::::BEGINClass::MOP::Method::BEGIN
0000s0sClass::MOP::Method::::__ANON__[:19]Class::MOP::Method::__ANON__[:19]
0000s0sClass::MOP::Method::::detach_from_classClass::MOP::Method::detach_from_class
0000s0sClass::MOP::Method::::executeClass::MOP::Method::execute
0000s0sClass::MOP::Method::::fully_qualified_nameClass::MOP::Method::fully_qualified_name
0000s0sClass::MOP::Method::::original_fully_qualified_nameClass::MOP::Method::original_fully_qualified_name
0000s0sClass::MOP::Method::::original_nameClass::MOP::Method::original_name
0000s0sClass::MOP::Method::::original_package_nameClass::MOP::Method::original_package_name
LineStmts.Exclusive
Time
Avg.Code
1
2package Class::MOP::Method;
3
4323µs8µsuse strict;
# spent 7µs making 1 call to strict::import
5328µs9µsuse warnings;
# spent 29µs making 1 call to warnings::import
6
7335µs12µsuse Carp 'confess';
# spent 41µs making 1 call to Exporter::import
8372µs24µsuse Scalar::Util 'weaken', 'reftype', 'blessed';
# spent 48µs making 1 call to Exporter::import
9
101700ns700nsour $VERSION = '1.09';
11125µs25µs$VERSION = eval $VERSION;
121500ns500nsour $AUTHORITY = 'cpan:STEVAN';
13
14382µs27µsuse base 'Class::MOP::Object';
# spent 900µs making 1 call to base::import, max recursion depth 1
15
16# NOTE:
17# if poked in the right way,
18# they should act like CODE refs.
193658µs219µsuse overload '&{}' => sub { $_[0]->body }, fallback => 1;
# spent 48µs making 1 call to overload::import
20
21# construction
22
23
# spent 21.4ms (4.46+17.0) within Class::MOP::Method::wrap which was called 202 times, avg 106µs/call: # 64 times (1.43ms+1.62ms) by Class::MOP::Mixin::HasMethods::wrap_method_body at line 51 of /usr/local/lib/perl/5.10.0/Class/MOP/Mixin/HasMethods.pm, avg 48µs/call # 57 times (1.16ms+1.29ms) by Class::MOP::Attribute::_process_accessors at line 312 of /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm, avg 43µs/call # 46 times (968µs+1.09ms) by Class::MOP::Method::Wrapped::wrap at line 92 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Wrapped.pm, avg 45µs/call # 31 times (809µs+12.5ms) by Class::MOP::Method::Meta::wrap at line 58 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Meta.pm, avg 430µs/call # 4 times (96µs+449µs) by Moose::Meta::Method::Overridden::new at line 43 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Overridden.pm, avg 136µs/call
sub wrap {
242021.20ms6µs my ( $class, @args ) = @_;
25
26202289µs1µs unshift @args, 'body' if @args % 2 == 1;
27
28202509µs3µs my %params = @args;
29202112µs553ns my $code = $params{body};
30
312021.51ms7µs if (blessed($code) && $code->isa(__PACKAGE__)) {
# spent 555µs making 202 calls to Scalar::Util::blessed, avg 3µs/call # spent 467µs making 202 calls to Scalar::Util::reftype, avg 2µs/call
32 my $method = $code->clone;
33 delete $params{body};
34 Class::MOP::class_of($class)->rebless_instance($method, %params);
35 return $method;
36 }
37 elsif (!ref $code || 'CODE' ne reftype($code)) {
38 confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
39 }
40
41202153µs755ns ($params{package_name} && $params{name})
42 || confess "You must supply the package_name and name parameters";
43
44202885µs4µs my $self = $class->_new(\%params);
# spent 9.85ms making 82 calls to Class::MOP::Method::_new, avg 120µs/call # spent 3.45ms making 13 calls to Moose::Meta::Method::_new, avg 265µs/call # spent 1.01ms making 57 calls to Class::MOP::Method::Accessor::_new, avg 18µs/call # spent 874µs making 46 calls to Class::MOP::Method::Wrapped::_new, avg 19µs/call # spent 423µs making 4 calls to Moose::Meta::Method::Overridden::_new, avg 106µs/call
45
46202636µs3µs weaken($self->{associated_metaclass}) if $self->{associated_metaclass};
# spent 356µs making 95 calls to Scalar::Util::weaken, avg 4µs/call
47
48202498µs2µs return $self;
49}
50
51
# spent 12.5ms (982µs+11.6) within Class::MOP::Method::_new which was called 84 times, avg 149µs/call: # 82 times (959µs+8.89ms) by Class::MOP::Method::wrap at line 44, avg 120µs/call # 2 times (23µs+2.67ms) by Class::MOP::Method::Accessor::new at line 32 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Accessor.pm, avg 1.35ms/call
sub _new {
528475µs895ns my $class = shift;
53
5484292µs3µs return Class::MOP::Class->initialize($class)->new_object(@_)
# spent 9.03ms making 26 calls to Class::MOP::Class::new_object, avg 347µs/call # spent 2.54ms making 26 calls to Class::MOP::Class::initialize, avg 98µs/call
55 if $class ne __PACKAGE__;
56
575843µs748ns my $params = @_ == 1 ? $_[0] : {@_};
58
5958528µs9µs return bless {
60 'body' => $params->{body},
61 'associated_metaclass' => $params->{associated_metaclass},
62 'package_name' => $params->{package_name},
63 'name' => $params->{name},
64 'original_method' => $params->{original_method},
65 } => $class;
66}
67
68## accessors
69
7071122µs2µssub associated_metaclass { shift->{'associated_metaclass'} }
71
72
# spent 3.40ms (2.34+1.06) within Class::MOP::Method::attach_to_class which was called 370 times, avg 9µs/call: # 370 times (2.34ms+1.06ms) by Class::MOP::Mixin::HasMethods::add_method at line 74 of /usr/local/lib/perl/5.10.0/Class/MOP/Mixin/HasMethods.pm, avg 9µs/call
sub attach_to_class {
73370389µs1µs my ( $self, $class ) = @_;
74370487µs1µs $self->{associated_metaclass} = $class;
753701.78ms5µs weaken($self->{associated_metaclass});
# spent 1.06ms making 370 calls to Scalar::Util::weaken, avg 3µs/call
76}
77
78sub detach_from_class {
79 my $self = shift;
80 delete $self->{associated_metaclass};
81}
82
83sub fully_qualified_name {
84 my $self = shift;
85 $self->package_name . '::' . $self->name;
86}
87
88sub original_method { (shift)->{'original_method'} }
89
902046µs2µssub _set_original_method { $_[0]->{'original_method'} = $_[1] }
91
92# It's possible that this could cause a loop if there is a circular
93# reference in here. That shouldn't ever happen in normal
94# circumstances, since original method only gets set when clone is
95# called. We _could_ check for such a loop, but it'd involve some sort
96# of package-lexical variable, and wouldn't be terribly subclassable.
97sub original_package_name {
98 my $self = shift;
99
100 $self->original_method
101 ? $self->original_method->original_package_name
102 : $self->package_name;
103}
104
105sub original_name {
106 my $self = shift;
107
108 $self->original_method
109 ? $self->original_method->original_name
110 : $self->name;
111}
112
113sub original_fully_qualified_name {
114 my $self = shift;
115
116 $self->original_method
117 ? $self->original_method->original_fully_qualified_name
118 : $self->fully_qualified_name;
119}
120
121sub execute {
122 my $self = shift;
123 $self->body->(@_);
124}
125
126# We used to go through use Class::MOP::Class->clone_instance to do this, but
127# this was awfully slow. This method may be called a number of times when
128# classes are loaded (especially during Moose role application), so it is
129# worth optimizing. - DR
130
# spent 509µs (349+160) within Class::MOP::Method::clone which was called 20 times, avg 25µs/call: # 10 times (219µs+82µs) by Class::MOP::MiniTrait::apply at line 25 of /usr/local/lib/perl/5.10.0/Class/MOP/MiniTrait.pm, avg 30µs/call # 10 times (130µs+78µs) by Class::MOP::Mixin::HasMethods::add_method at line 67 of /usr/local/lib/perl/5.10.0/Class/MOP/Mixin/HasMethods.pm, avg 21µs/call
sub clone {
1312011µs555ns my $self = shift;
132
13320282µs14µs my $clone = bless { %{$self}, @_ }, blessed($self);
# spent 60µs making 20 calls to Scalar::Util::blessed, avg 3µs/call
134
1352077µs4µs $clone->_set_original_method($self);
# spent 100µs making 20 calls to Class::MOP::Method::_set_original_method, avg 5µs/call
136
1372043µs2µs return $clone;
138}
139
14014µs4µs1;
141
142__END__
143
144=pod
145
146=head1 NAME
147
148Class::MOP::Method - Method Meta Object
149
150=head1 DESCRIPTION
151
152The Method Protocol is very small, since methods in Perl 5 are just
153subroutines in a specific package. We provide a very basic
154introspection interface.
155
156=head1 METHODS
157
158=over 4
159
160=item B<< Class::MOP::Method->wrap($code, %options) >>
161
162This is the constructor. It accepts a method body in the form of
163either a code reference or a L<Class::MOP::Method> instance, followed
164by a hash of options.
165
166The options are:
167
168=over 8
169
170=item * name
171
172The method name (without a package name). This is required if C<$code>
173is a coderef.
174
175=item * package_name
176
177The package name for the method. This is required if C<$code> is a
178coderef.
179
180=item * associated_metaclass
181
182An optional L<Class::MOP::Class> object. This is the metaclass for the
183method's class.
184
185=back
186
187=item B<< $metamethod->clone(%params) >>
188
189This makes a shallow clone of the method object. In particular,
190subroutine reference itself is shared between all clones of a given
191method.
192
193When a method is cloned, the original method object will be available
194by calling C<original_method> on the clone.
195
196=item B<< $metamethod->body >>
197
198This returns a reference to the method's subroutine.
199
200=item B<< $metamethod->name >>
201
202This returns the method's name
203
204=item B<< $metamethod->package_name >>
205
206This returns the method's package name.
207
208=item B<< $metamethod->fully_qualified_name >>
209
210This returns the method's fully qualified name (package name and
211method name).
212
213=item B<< $metamethod->associated_metaclass >>
214
215This returns the L<Class::MOP::Class> object for the method, if one
216exists.
217
218=item B<< $metamethod->original_method >>
219
220If this method object was created as a clone of some other method
221object, this returns the object that was cloned.
222
223=item B<< $metamethod->original_name >>
224
225This returns the method's original name, wherever it was first
226defined.
227
228If this method is a clone of a clone (of a clone, etc.), this method
229returns the name from the I<first> method in the chain of clones.
230
231=item B<< $metamethod->original_package_name >>
232
233This returns the method's original package name, wherever it was first
234defined.
235
236If this method is a clone of a clone (of a clone, etc.), this method
237returns the package name from the I<first> method in the chain of
238clones.
239
240=item B<< $metamethod->original_fully_qualified_name >>
241
242This returns the method's original fully qualified name, wherever it
243was first defined.
244
245If this method is a clone of a clone (of a clone, etc.), this method
246returns the fully qualified name from the I<first> method in the chain
247of clones.
248
249=item B<< $metamethod->attach_to_class($metaclass) >>
250
251Given a L<Class::MOP::Class> object, this method sets the associated
252metaclass for the method. This will overwrite any existing associated
253metaclass.
254
255=item B<< $metamethod->detach_from_class >>
256
257Removes any associated metaclass object for the method.
258
259=item B<< $metamethod->execute(...) >>
260
261This executes the method. Any arguments provided will be passed on to
262the method itself.
263
264=item B<< Class::MOP::Method->meta >>
265
266This will return a L<Class::MOP::Class> instance for this class.
267
268It should also be noted that L<Class::MOP> will actually bootstrap
269this module by installing a number of attribute meta-objects into its
270metaclass.
271
272=back
273
274=head1 AUTHORS
275
276Stevan Little E<lt>stevan@iinteractive.comE<gt>
277
278=head1 COPYRIGHT AND LICENSE
279
280Copyright 2006-2010 by Infinity Interactive, Inc.
281
282L<http://www.iinteractive.com>
283
284This library is free software; you can redistribute it and/or modify
285it under the same terms as Perl itself.
286
287=cut
288
# spent 519µs within Class::MOP::Method::name which was called 179 times, avg 3µs/call: # 56 times (155µs+0s) by Class::MOP::MiniTrait::apply at line 19 of /usr/local/lib/perl/5.10.0/Class/MOP/MiniTrait.pm, avg 3µs/call # 56 times (137µs+0s) by Class::MOP::Class::get_all_methods at line 999 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 2µs/call # 45 times (158µs+0s) by Class::MOP::Method::Inlined::can_be_inlined at line 40 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Inlined.pm, avg 4µs/call # 8 times (29µs+0s) by Class::MOP::Method::Inlined::_uninlined_body at line 20 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Inlined.pm, avg 4µs/call # 7 times (21µs+0s) by Class::MOP::Method::Inlined::can_be_inlined at line 58 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Inlined.pm, avg 3µs/call # 7 times (19µs+0s) by Class::MOP::Method::Inlined::can_be_inlined at line 70 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Inlined.pm, avg 3µs/call
sub Class::MOP::Method::name; # xsub