File | /usr/local/lib/perl/5.10.0/Class/MOP/Method.pm |
Statements Executed | 3405 |
Total Time | 0.0108877 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
202 | 5 | 5 | 4.46ms | 21.4ms | wrap | Class::MOP::Method::
370 | 1 | 1 | 2.34ms | 3.40ms | attach_to_class | Class::MOP::Method::
84 | 2 | 2 | 982µs | 12.5ms | _new | Class::MOP::Method::
180 | 6 | 4 | 519µs | 519µs | name(xsub) | Class::MOP::Method::
20 | 2 | 2 | 349µs | 509µs | clone | Class::MOP::Method::
0 | 0 | 0 | 0s | 0s | BEGIN | Class::MOP::Method::
0 | 0 | 0 | 0s | 0s | __ANON__[:19] | Class::MOP::Method::
0 | 0 | 0 | 0s | 0s | detach_from_class | Class::MOP::Method::
0 | 0 | 0 | 0s | 0s | execute | Class::MOP::Method::
0 | 0 | 0 | 0s | 0s | fully_qualified_name | Class::MOP::Method::
0 | 0 | 0 | 0s | 0s | original_fully_qualified_name | Class::MOP::Method::
0 | 0 | 0 | 0s | 0s | original_name | Class::MOP::Method::
0 | 0 | 0 | 0s | 0s | original_package_name | Class::MOP::Method::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | ||||
2 | package Class::MOP::Method; | |||
3 | ||||
4 | 3 | 23µs | 8µs | use strict; # spent 7µs making 1 call to strict::import |
5 | 3 | 28µs | 9µs | use warnings; # spent 29µs making 1 call to warnings::import |
6 | ||||
7 | 3 | 35µs | 12µs | use Carp 'confess'; # spent 41µs making 1 call to Exporter::import |
8 | 3 | 72µs | 24µs | use Scalar::Util 'weaken', 'reftype', 'blessed'; # spent 48µs making 1 call to Exporter::import |
9 | ||||
10 | 1 | 700ns | 700ns | our $VERSION = '1.09'; |
11 | 1 | 25µs | 25µs | $VERSION = eval $VERSION; |
12 | 1 | 500ns | 500ns | our $AUTHORITY = 'cpan:STEVAN'; |
13 | ||||
14 | 3 | 82µs | 27µs | use 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. | |||
19 | 3 | 658µs | 219µs | use 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 | |||
24 | 1818 | 5.79ms | 3µs | my ( $class, @args ) = @_; |
25 | ||||
26 | unshift @args, 'body' if @args % 2 == 1; | |||
27 | ||||
28 | my %params = @args; | |||
29 | my $code = $params{body}; | |||
30 | ||||
31 | 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 | ||||
41 | ($params{package_name} && $params{name}) | |||
42 | || confess "You must supply the package_name and name parameters"; | |||
43 | ||||
44 | 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 | ||||
46 | weaken($self->{associated_metaclass}) if $self->{associated_metaclass}; # spent 356µs making 95 calls to Scalar::Util::weaken, avg 4µs/call | |||
47 | ||||
48 | 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 | |||
52 | 284 | 939µs | 3µs | my $class = shift; |
53 | ||||
54 | 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 | ||||
57 | my $params = @_ == 1 ? $_[0] : {@_}; | |||
58 | ||||
59 | 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 | ||||
70 | 71 | 122µs | 2µs | sub 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 | |||
73 | 1110 | 2.65ms | 2µs | my ( $self, $class ) = @_; |
74 | $self->{associated_metaclass} = $class; | |||
75 | weaken($self->{associated_metaclass}); # spent 1.06ms making 370 calls to Scalar::Util::weaken, avg 3µs/call | |||
76 | } | |||
77 | ||||
78 | sub detach_from_class { | |||
79 | my $self = shift; | |||
80 | delete $self->{associated_metaclass}; | |||
81 | } | |||
82 | ||||
83 | sub fully_qualified_name { | |||
84 | my $self = shift; | |||
85 | $self->package_name . '::' . $self->name; | |||
86 | } | |||
87 | ||||
88 | sub original_method { (shift)->{'original_method'} } | |||
89 | ||||
90 | 20 | 46µs | 2µs | sub _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. | |||
97 | sub 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 | ||||
105 | sub original_name { | |||
106 | my $self = shift; | |||
107 | ||||
108 | $self->original_method | |||
109 | ? $self->original_method->original_name | |||
110 | : $self->name; | |||
111 | } | |||
112 | ||||
113 | sub 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 | ||||
121 | sub 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 | |||
131 | 80 | 413µs | 5µs | my $self = shift; |
132 | ||||
133 | my $clone = bless { %{$self}, @_ }, blessed($self); # spent 60µs making 20 calls to Scalar::Util::blessed, avg 3µs/call | |||
134 | ||||
135 | $clone->_set_original_method($self); # spent 100µs making 20 calls to Class::MOP::Method::_set_original_method, avg 5µs/call | |||
136 | ||||
137 | return $clone; | |||
138 | } | |||
139 | ||||
140 | 1 | 4µs | 4µs | 1; |
141 | ||||
142 | __END__ | |||
143 | ||||
144 | =pod | |||
145 | ||||
146 | =head1 NAME | |||
147 | ||||
148 | Class::MOP::Method - Method Meta Object | |||
149 | ||||
150 | =head1 DESCRIPTION | |||
151 | ||||
152 | The Method Protocol is very small, since methods in Perl 5 are just | |||
153 | subroutines in a specific package. We provide a very basic | |||
154 | introspection interface. | |||
155 | ||||
156 | =head1 METHODS | |||
157 | ||||
158 | =over 4 | |||
159 | ||||
160 | =item B<< Class::MOP::Method->wrap($code, %options) >> | |||
161 | ||||
162 | This is the constructor. It accepts a method body in the form of | |||
163 | either a code reference or a L<Class::MOP::Method> instance, followed | |||
164 | by a hash of options. | |||
165 | ||||
166 | The options are: | |||
167 | ||||
168 | =over 8 | |||
169 | ||||
170 | =item * name | |||
171 | ||||
172 | The method name (without a package name). This is required if C<$code> | |||
173 | is a coderef. | |||
174 | ||||
175 | =item * package_name | |||
176 | ||||
177 | The package name for the method. This is required if C<$code> is a | |||
178 | coderef. | |||
179 | ||||
180 | =item * associated_metaclass | |||
181 | ||||
182 | An optional L<Class::MOP::Class> object. This is the metaclass for the | |||
183 | method's class. | |||
184 | ||||
185 | =back | |||
186 | ||||
187 | =item B<< $metamethod->clone(%params) >> | |||
188 | ||||
189 | This makes a shallow clone of the method object. In particular, | |||
190 | subroutine reference itself is shared between all clones of a given | |||
191 | method. | |||
192 | ||||
193 | When a method is cloned, the original method object will be available | |||
194 | by calling C<original_method> on the clone. | |||
195 | ||||
196 | =item B<< $metamethod->body >> | |||
197 | ||||
198 | This returns a reference to the method's subroutine. | |||
199 | ||||
200 | =item B<< $metamethod->name >> | |||
201 | ||||
202 | This returns the method's name | |||
203 | ||||
204 | =item B<< $metamethod->package_name >> | |||
205 | ||||
206 | This returns the method's package name. | |||
207 | ||||
208 | =item B<< $metamethod->fully_qualified_name >> | |||
209 | ||||
210 | This returns the method's fully qualified name (package name and | |||
211 | method name). | |||
212 | ||||
213 | =item B<< $metamethod->associated_metaclass >> | |||
214 | ||||
215 | This returns the L<Class::MOP::Class> object for the method, if one | |||
216 | exists. | |||
217 | ||||
218 | =item B<< $metamethod->original_method >> | |||
219 | ||||
220 | If this method object was created as a clone of some other method | |||
221 | object, this returns the object that was cloned. | |||
222 | ||||
223 | =item B<< $metamethod->original_name >> | |||
224 | ||||
225 | This returns the method's original name, wherever it was first | |||
226 | defined. | |||
227 | ||||
228 | If this method is a clone of a clone (of a clone, etc.), this method | |||
229 | returns the name from the I<first> method in the chain of clones. | |||
230 | ||||
231 | =item B<< $metamethod->original_package_name >> | |||
232 | ||||
233 | This returns the method's original package name, wherever it was first | |||
234 | defined. | |||
235 | ||||
236 | If this method is a clone of a clone (of a clone, etc.), this method | |||
237 | returns the package name from the I<first> method in the chain of | |||
238 | clones. | |||
239 | ||||
240 | =item B<< $metamethod->original_fully_qualified_name >> | |||
241 | ||||
242 | This returns the method's original fully qualified name, wherever it | |||
243 | was first defined. | |||
244 | ||||
245 | If this method is a clone of a clone (of a clone, etc.), this method | |||
246 | returns the fully qualified name from the I<first> method in the chain | |||
247 | of clones. | |||
248 | ||||
249 | =item B<< $metamethod->attach_to_class($metaclass) >> | |||
250 | ||||
251 | Given a L<Class::MOP::Class> object, this method sets the associated | |||
252 | metaclass for the method. This will overwrite any existing associated | |||
253 | metaclass. | |||
254 | ||||
255 | =item B<< $metamethod->detach_from_class >> | |||
256 | ||||
257 | Removes any associated metaclass object for the method. | |||
258 | ||||
259 | =item B<< $metamethod->execute(...) >> | |||
260 | ||||
261 | This executes the method. Any arguments provided will be passed on to | |||
262 | the method itself. | |||
263 | ||||
264 | =item B<< Class::MOP::Method->meta >> | |||
265 | ||||
266 | This will return a L<Class::MOP::Class> instance for this class. | |||
267 | ||||
268 | It should also be noted that L<Class::MOP> will actually bootstrap | |||
269 | this module by installing a number of attribute meta-objects into its | |||
270 | metaclass. | |||
271 | ||||
272 | =back | |||
273 | ||||
274 | =head1 AUTHORS | |||
275 | ||||
276 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | |||
277 | ||||
278 | =head1 COPYRIGHT AND LICENSE | |||
279 | ||||
280 | Copyright 2006-2010 by Infinity Interactive, Inc. | |||
281 | ||||
282 | L<http://www.iinteractive.com> | |||
283 | ||||
284 | This library is free software; you can redistribute it and/or modify | |||
285 | it 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 |