| 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 |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 36 | 1 | 1 | 748µs | 1.82ms | Class::MOP::Method::Wrapped::wrap |
| 36 | 1 | 1 | 353µs | 697µs | Class::MOP::Method::Wrapped::add_around_modifier |
| 36 | 1 | 1 | 327µs | 327µs | Class::MOP::Method::Wrapped::_new |
| 91 | 1 | 1 | 285µs | 1.06ms | Class::MOP::Method::Wrapped::__ANON__[:159] |
| 72 | 2 | 1 | 240µs | 240µs | Class::MOP::Method::Wrapped::__ANON__[:69] |
| 36 | 1 | 1 | 214µs | 214µs | Class::MOP::Method::Wrapped::__ANON__[:161] |
| 1 | 1 | 1 | 17µs | 28µs | Class::MOP::Method::Wrapped::BEGIN@5 |
| 1 | 1 | 1 | 15µs | 19µs | Class::MOP::Method::Wrapped::BEGIN@4 |
| 1 | 1 | 1 | 9µs | 14.4ms | Class::MOP::Method::Wrapped::BEGIN@14 |
| 1 | 1 | 1 | 7µs | 37µs | Class::MOP::Method::Wrapped::BEGIN@7 |
| 1 | 1 | 1 | 7µs | 28µs | Class::MOP::Method::Wrapped::BEGIN@8 |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::Wrapped::__ANON__[:43] |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::Wrapped::__ANON__[:49] |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::Wrapped::__ANON__[:64] |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::Wrapped::__ANON__[:89] |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::Wrapped::add_after_modifier |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::Wrapped::add_before_modifier |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::Wrapped::after_modifiers |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::Wrapped::around_modifiers |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::Wrapped::before_modifiers |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::Wrapped::get_original_method |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | |||||
| 2 | package Class::MOP::Method::Wrapped; | ||||
| 3 | |||||
| 4 | 3 | 22µs | 2 | 24µ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 # spent 19µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@4
# spent 4µs making 1 call to strict::import |
| 5 | 3 | 26µs | 2 | 39µ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 # spent 28µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@5
# spent 11µs making 1 call to warnings::import |
| 6 | |||||
| 7 | 3 | 22µs | 2 | 67µ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 # spent 37µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@7
# spent 30µs making 1 call to Exporter::import |
| 8 | 3 | 43µs | 2 | 49µ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 # spent 28µs making 1 call to Class::MOP::Method::Wrapped::BEGIN@8
# spent 21µs making 1 call to Exporter::import |
| 9 | |||||
| 10 | 1 | 1µs | our $VERSION = '0.98'; | ||
| 11 | 1 | 31µs | $VERSION = eval $VERSION; | ||
| 12 | 1 | 600ns | our $AUTHORITY = 'cpan:STEVAN'; | ||
| 13 | |||||
| 14 | 3 | 1.40ms | 2 | 28.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 # 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 | ||||
| 23 | 288 | 274µ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 | } | ||||
| 69 | 1 | 5µ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 | ||||
| 72 | 180 | 757µ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( | ||||
| 89 | 91 | 263µs | 91 | 1.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 | ||||
| 100 | 144 | 350µ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 | |||||
| 119 | sub get_original_method { | ||||
| 120 | my $code = shift; | ||||
| 121 | $code->{'modifier_table'}->{orig}; | ||||
| 122 | } | ||||
| 123 | |||||
| 124 | sub 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 | |||||
| 131 | sub before_modifiers { | ||||
| 132 | my $code = shift; | ||||
| 133 | return @{$code->{'modifier_table'}->{before}}; | ||||
| 134 | } | ||||
| 135 | |||||
| 136 | sub 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 | |||||
| 143 | sub 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. | ||||
| 155 | 1 | 600ns | # 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 | ||
| 156 | 288 | 226µs | my $f1 = pop; | ||
| 157 | return $f1 unless @_; | ||||
| 158 | my $f2 = pop; | ||||
| 159 | 91 | 250µs | 91 | 773µ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 # spent 773µs making 91 calls to Class::MOP::Class:::around, avg 8µs/call |
| 160 | redo; | ||||
| 161 | 1 | 3µ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 | ||||
| 164 | 180 | 289µ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 | |||||
| 175 | sub around_modifiers { | ||||
| 176 | my $code = shift; | ||||
| 177 | return @{$code->{'modifier_table'}->{around}->{methods}}; | ||||
| 178 | } | ||||
| 179 | |||||
| 180 | 1 | 11µs | 1; | ||
| 181 | |||||
| 182 | __END__ | ||||
| 183 | |||||
| 184 | =pod | ||||
| 185 | |||||
| 186 | =head1 NAME | ||||
| 187 | |||||
| 188 | Class::MOP::Method::Wrapped - Method Meta Object for methods with before/after/around modifiers | ||||
| 189 | |||||
| 190 | =head1 DESCRIPTION | ||||
| 191 | |||||
| 192 | This is a L<Class::MOP::Method> subclass which implements before, | ||||
| 193 | after, 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 | |||||
| 203 | This is the constructor. It accepts a L<Class::MOP::Method> object and | ||||
| 204 | a hash of options. | ||||
| 205 | |||||
| 206 | The options are: | ||||
| 207 | |||||
| 208 | =over 8 | ||||
| 209 | |||||
| 210 | =item * name | ||||
| 211 | |||||
| 212 | The method name (without a package name). This will be taken from the | ||||
| 213 | provided L<Class::MOP::Method> object if it is not provided. | ||||
| 214 | |||||
| 215 | =item * package_name | ||||
| 216 | |||||
| 217 | The package name for the method. This will be taken from the provided | ||||
| 218 | L<Class::MOP::Method> object if it is not provided. | ||||
| 219 | |||||
| 220 | =item * associated_metaclass | ||||
| 221 | |||||
| 222 | An optional L<Class::MOP::Class> object. This is the metaclass for the | ||||
| 223 | method's class. | ||||
| 224 | |||||
| 225 | =back | ||||
| 226 | |||||
| 227 | =item B<< $metamethod->get_original_method >> | ||||
| 228 | |||||
| 229 | This returns the L<Class::MOP::Method> object that was passed to the | ||||
| 230 | constructor. | ||||
| 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 | |||||
| 238 | These methods all take a subroutine reference and apply it as a | ||||
| 239 | modifier 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 | |||||
| 247 | These methods all return a list of subroutine references which are | ||||
| 248 | acting as the specified type of modifier. | ||||
| 249 | |||||
| 250 | =back | ||||
| 251 | |||||
| 252 | =head1 AUTHORS | ||||
| 253 | |||||
| 254 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | ||||
| 255 | |||||
| 256 | =head1 COPYRIGHT AND LICENSE | ||||
| 257 | |||||
| 258 | Copyright 2006-2010 by Infinity Interactive, Inc. | ||||
| 259 | |||||
| 260 | L<http://www.iinteractive.com> | ||||
| 261 | |||||
| 262 | This library is free software; you can redistribute it and/or modify | ||||
| 263 | it under the same terms as Perl itself. | ||||
| 264 | |||||
| 265 | =cut | ||||
| 266 |