| 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 | Class::MOP::Method::wrap |
| 370 | 1 | 1 | 2.34ms | 3.40ms | Class::MOP::Method::attach_to_class |
| 84 | 2 | 2 | 982µs | 12.5ms | Class::MOP::Method::_new |
| 180 | 6 | 4 | 519µs | 519µs | Class::MOP::Method::name(xsub) |
| 20 | 2 | 2 | 349µs | 509µs | Class::MOP::Method::clone |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::BEGIN |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::__ANON__[:19] |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::detach_from_class |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::execute |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::fully_qualified_name |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::original_fully_qualified_name |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::original_name |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::original_package_name |
| 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 | 202 | 1.20ms | 6µs | my ( $class, @args ) = @_; |
| 25 | ||||
| 26 | 202 | 289µs | 1µs | unshift @args, 'body' if @args % 2 == 1; |
| 27 | ||||
| 28 | 202 | 509µs | 3µs | my %params = @args; |
| 29 | 202 | 112µs | 553ns | my $code = $params{body}; |
| 30 | ||||
| 31 | 202 | 1.51ms | 7µ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 | ||||
| 41 | 202 | 153µs | 755ns | ($params{package_name} && $params{name}) |
| 42 | || confess "You must supply the package_name and name parameters"; | |||
| 43 | ||||
| 44 | 202 | 885µs | 4µ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 | ||||
| 46 | 202 | 636µs | 3µs | weaken($self->{associated_metaclass}) if $self->{associated_metaclass}; # spent 356µs making 95 calls to Scalar::Util::weaken, avg 4µs/call |
| 47 | ||||
| 48 | 202 | 498µs | 2µ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 | |||
| 52 | 84 | 75µs | 895ns | my $class = shift; |
| 53 | ||||
| 54 | 84 | 292µs | 3µ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 | ||||
| 57 | 58 | 43µs | 748ns | my $params = @_ == 1 ? $_[0] : {@_}; |
| 58 | ||||
| 59 | 58 | 528µs | 9µ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 | ||||
| 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 | 370 | 389µs | 1µs | my ( $self, $class ) = @_; |
| 74 | 370 | 487µs | 1µs | $self->{associated_metaclass} = $class; |
| 75 | 370 | 1.78ms | 5µs | 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 | 20 | 11µs | 555ns | my $self = shift; |
| 132 | ||||
| 133 | 20 | 282µs | 14µs | my $clone = bless { %{$self}, @_ }, blessed($self); # spent 60µs making 20 calls to Scalar::Util::blessed, avg 3µs/call |
| 134 | ||||
| 135 | 20 | 77µs | 4µs | $clone->_set_original_method($self); # spent 100µs making 20 calls to Class::MOP::Method::_set_original_method, avg 5µs/call |
| 136 | ||||
| 137 | 20 | 43µs | 2µs | 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 |