| File | /usr/local/lib/perl/5.10.0/Class/MOP/Method/Constructor.pm |
| Statements Executed | 3749 |
| Total Time | 0.0135415999999999 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 265 | 1 | 1 | 3.15ms | 23.7ms | Class::MOP::Method::Constructor::_generate_slot_initializer |
| 31 | 1 | 1 | 2.20ms | 45.1ms | Class::MOP::Method::Constructor::_generate_constructor_method_inline |
| 31 | 1 | 1 | 978µs | 978µs | Class::MOP::Method::Constructor::_new |
| 31 | 1 | 1 | 790µs | 47.7ms | Class::MOP::Method::Constructor::new |
| 103 | 7 | 2 | 602µs | 4.45ms | Class::MOP::Method::Constructor::_attributes |
| 93 | 2 | 2 | 587µs | 1.15ms | Class::MOP::Method::Constructor::_generate_default_value |
| 31 | 1 | 1 | 320µs | 45.5ms | Class::MOP::Method::Constructor::_initialize_body |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::Constructor::BEGIN |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::Constructor::__ANON__[:92] |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::Constructor::_generate_constructor_method |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | ||||
| 2 | package Class::MOP::Method::Constructor; | |||
| 3 | ||||
| 4 | 3 | 33µs | 11µs | use strict; # spent 16µs making 1 call to strict::import |
| 5 | 3 | 36µs | 12µs | use warnings; # spent 22µs making 1 call to warnings::import |
| 6 | ||||
| 7 | 3 | 27µs | 9µs | use Carp 'confess'; # spent 49µs making 1 call to Exporter::import |
| 8 | 3 | 55µs | 18µs | use Scalar::Util 'blessed', 'weaken'; # spent 45µs making 1 call to Exporter::import |
| 9 | ||||
| 10 | 1 | 800ns | 800ns | our $VERSION = '1.09'; |
| 11 | 1 | 30µs | 30µs | $VERSION = eval $VERSION; |
| 12 | 1 | 6µs | 6µs | our $AUTHORITY = 'cpan:STEVAN'; |
| 13 | ||||
| 14 | 3 | 946µs | 315µs | use base 'Class::MOP::Method::Inlined'; # spent 1.07ms making 1 call to base::import |
| 15 | ||||
| 16 | # spent 47.7ms (790µs+46.9) within Class::MOP::Method::Constructor::new which was called 31 times, avg 1.54ms/call:
# 31 times (790µs+46.9ms) by Class::MOP::Class::_inline_constructor at line 1298 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 1.54ms/call | |||
| 17 | 248 | 1.20ms | 5µs | my $class = shift; |
| 18 | my %options = @_; | |||
| 19 | ||||
| 20 | (blessed $options{metaclass} && $options{metaclass}->isa('Class::MOP::Class')) # spent 113µs making 31 calls to UNIVERSAL::isa, avg 4µs/call
# spent 97µs making 31 calls to Scalar::Util::blessed, avg 3µs/call | |||
| 21 | || confess "You must pass a metaclass instance if you want to inline" | |||
| 22 | if $options{is_inline}; | |||
| 23 | ||||
| 24 | ($options{package_name} && $options{name}) | |||
| 25 | || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT"; | |||
| 26 | ||||
| 27 | my $self = $class->_new(\%options); # spent 978µs making 31 calls to Class::MOP::Method::Constructor::_new, avg 32µs/call | |||
| 28 | ||||
| 29 | # we don't want this creating | |||
| 30 | # a cycle in the code, if not | |||
| 31 | # needed | |||
| 32 | weaken($self->{'associated_metaclass'}); # spent 138µs making 31 calls to Scalar::Util::weaken, avg 4µs/call | |||
| 33 | ||||
| 34 | $self->_initialize_body; # spent 45.5ms making 31 calls to Class::MOP::Method::Constructor::_initialize_body, avg 1.47ms/call | |||
| 35 | ||||
| 36 | return $self; | |||
| 37 | } | |||
| 38 | ||||
| 39 | # spent 978µs within Class::MOP::Method::Constructor::_new which was called 31 times, avg 32µs/call:
# 31 times (978µs+0s) by Class::MOP::Method::Constructor::new at line 27, avg 32µs/call | |||
| 40 | 124 | 910µs | 7µs | my $class = shift; |
| 41 | ||||
| 42 | return Class::MOP::Class->initialize($class)->new_object(@_) | |||
| 43 | if $class ne __PACKAGE__; | |||
| 44 | ||||
| 45 | my $params = @_ == 1 ? $_[0] : {@_}; | |||
| 46 | ||||
| 47 | return bless { | |||
| 48 | # inherited from Class::MOP::Method | |||
| 49 | body => $params->{body}, | |||
| 50 | # associated_metaclass => $params->{associated_metaclass}, # overriden | |||
| 51 | package_name => $params->{package_name}, | |||
| 52 | name => $params->{name}, | |||
| 53 | original_method => $params->{original_method}, | |||
| 54 | ||||
| 55 | # inherited from Class::MOP::Generated | |||
| 56 | is_inline => $params->{is_inline} || 0, | |||
| 57 | definition_context => $params->{definition_context}, | |||
| 58 | ||||
| 59 | # inherited from Class::MOP::Inlined | |||
| 60 | _expected_method_class => $params->{_expected_method_class}, | |||
| 61 | ||||
| 62 | # defined in this subclass | |||
| 63 | options => $params->{options} || {}, | |||
| 64 | associated_metaclass => $params->{metaclass}, | |||
| 65 | }, $class; | |||
| 66 | } | |||
| 67 | ||||
| 68 | ## accessors | |||
| 69 | ||||
| 70 | 38 | 88µs | 2µs | sub options { (shift)->{'options'} } |
| 71 | 124 | 194µs | 2µs | sub associated_metaclass { (shift)->{'associated_metaclass'} } |
| 72 | ||||
| 73 | ## cached values ... | |||
| 74 | ||||
| 75 | # spent 4.45ms (602µs+3.85) within Class::MOP::Method::Constructor::_attributes which was called 103 times, avg 43µs/call:
# 31 times (270µs+3.28ms) by Class::MOP::Method::Constructor::_generate_constructor_method_inline at line 98, avg 115µs/call
# 31 times (119µs+0s) by Class::MOP::Method::Constructor::_generate_constructor_method_inline at line 116, avg 4µs/call
# 10 times (41µs+0s) by Moose::Meta::Method::Constructor::_generate_slot_initializer at line 201 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Constructor.pm, avg 4µs/call
# 10 times (38µs+0s) by Moose::Meta::Method::Constructor::_generate_triggers at line 173 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Constructor.pm, avg 4µs/call
# 7 times (72µs+562µs) by Moose::Meta::Method::Constructor::_generate_slot_initializers at line 139 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Constructor.pm, avg 91µs/call
# 7 times (31µs+0s) by Moose::Meta::Method::Constructor::_initialize_body at line 88 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Constructor.pm, avg 4µs/call
# 7 times (30µs+0s) by Moose::Meta::Method::Constructor::_generate_triggers at line 172 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Constructor.pm, avg 4µs/call | |||
| 76 | 206 | 574µs | 3µs | my $self = shift; |
| 77 | $self->{'attributes'} ||= [ $self->associated_metaclass->get_all_attributes ] # spent 3.70ms making 38 calls to Class::MOP::Class::get_all_attributes, avg 97µs/call
# spent 112µs making 31 calls to Class::MOP::Method::Constructor::associated_metaclass, avg 4µs/call
# spent 32µs making 7 calls to Class::MOP::Method::associated_metaclass, avg 5µs/call | |||
| 78 | } | |||
| 79 | ||||
| 80 | ## method | |||
| 81 | ||||
| 82 | # spent 45.5ms (320µs+45.2) within Class::MOP::Method::Constructor::_initialize_body which was called 31 times, avg 1.47ms/call:
# 31 times (320µs+45.2ms) by Class::MOP::Method::Constructor::new at line 34, avg 1.47ms/call | |||
| 83 | 124 | 413µs | 3µs | my $self = shift; |
| 84 | my $method_name = '_generate_constructor_method'; | |||
| 85 | ||||
| 86 | $method_name .= '_inline' if $self->is_inline; # spent 131µs making 31 calls to Class::MOP::Method::Generated::is_inline, avg 4µs/call | |||
| 87 | ||||
| 88 | $self->{'body'} = $self->$method_name; # spent 45.1ms making 31 calls to Class::MOP::Method::Constructor::_generate_constructor_method_inline, avg 1.45ms/call | |||
| 89 | } | |||
| 90 | ||||
| 91 | sub _generate_constructor_method { | |||
| 92 | return sub { Class::MOP::Class->initialize(shift)->new_object(@_) } | |||
| 93 | } | |||
| 94 | ||||
| 95 | # spent 45.1ms (2.20+42.9) within Class::MOP::Method::Constructor::_generate_constructor_method_inline which was called 31 times, avg 1.45ms/call:
# 31 times (2.20ms+42.9ms) by Class::MOP::Method::Constructor::_initialize_body at line 88, avg 1.45ms/call | |||
| 96 | 1057 | 3.75ms | 4µs | my $self = shift; |
| 97 | ||||
| 98 | my $defaults = [map { $_->default } @{ $self->_attributes }]; # spent 3.55ms making 31 calls to Class::MOP::Method::Constructor::_attributes, avg 115µs/call
# spent 1.44ms making 265 calls to Class::MOP::Mixin::AttributeCore::default, avg 5µs/call | |||
| 99 | ||||
| 100 | my $close_over = { | |||
| 101 | '$defaults' => \$defaults, | |||
| 102 | }; | |||
| 103 | ||||
| 104 | my $source = 'sub {'; | |||
| 105 | $source .= "\n" . 'my $class = shift;'; | |||
| 106 | ||||
| 107 | $source .= "\n" . 'return Class::MOP::Class->initialize($class)->new_object(@_)'; | |||
| 108 | $source .= "\n" . ' if $class ne \'' . $self->associated_metaclass->name . '\';'; # spent 120µs making 31 calls to Class::MOP::Method::Constructor::associated_metaclass, avg 4µs/call
# spent 81µs making 31 calls to Class::MOP::Package::name, avg 3µs/call | |||
| 109 | ||||
| 110 | $source .= "\n" . 'my $params = @_ == 1 ? $_[0] : {@_};'; | |||
| 111 | ||||
| 112 | $source .= "\n" . 'my $instance = ' . $self->associated_metaclass->inline_create_instance('$class'); # spent 2.41ms making 31 calls to Class::MOP::Class::inline_create_instance, avg 78µs/call
# spent 125µs making 31 calls to Class::MOP::Method::Constructor::associated_metaclass, avg 4µs/call | |||
| 113 | my $idx = 0; | |||
| 114 | $source .= ";\n" . (join ";\n" => map { # spent 23.7ms making 265 calls to Class::MOP::Method::Constructor::_generate_slot_initializer, avg 89µs/call | |||
| 115 | $self->_generate_slot_initializer($_, $idx++) | |||
| 116 | } @{ $self->_attributes }); # spent 119µs making 31 calls to Class::MOP::Method::Constructor::_attributes, avg 4µs/call | |||
| 117 | $source .= ";\n" . 'return $instance'; | |||
| 118 | $source .= ";\n" . '}'; | |||
| 119 | warn $source if $self->options->{debug}; # spent 157µs making 31 calls to Class::MOP::Method::Constructor::options, avg 5µs/call | |||
| 120 | ||||
| 121 | my ( $code, $e ) = $self->_eval_closure( # spent 11.2ms making 31 calls to Class::MOP::Method::Generated::_eval_closure, avg 361µs/call | |||
| 122 | $close_over, | |||
| 123 | $source | |||
| 124 | ); | |||
| 125 | confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$e" if $e; | |||
| 126 | ||||
| 127 | return $code; | |||
| 128 | } | |||
| 129 | ||||
| 130 | # spent 23.7ms (3.15+20.6) within Class::MOP::Method::Constructor::_generate_slot_initializer which was called 265 times, avg 89µs/call:
# 265 times (3.15ms+20.6ms) by Class::MOP::Method::Constructor::_generate_constructor_method_inline at line 114, avg 89µs/call | |||
| 131 | 1591 | 4.71ms | 3µs | my $self = shift; |
| 132 | my $attr = shift; | |||
| 133 | my $idx = shift; | |||
| 134 | ||||
| 135 | my $default; | |||
| 136 | if ($attr->has_default) { # spent 1.06ms making 87 calls to Class::MOP::Method::Constructor::_generate_default_value, avg 12µs/call
# spent 986µs making 178 calls to Class::MOP::Mixin::AttributeCore::has_builder, avg 6µs/call
# spent 949µs making 265 calls to Class::MOP::Mixin::AttributeCore::has_default, avg 4µs/call | |||
| 137 | $default = $self->_generate_default_value($attr, $idx); | |||
| 138 | } elsif( $attr->has_builder ) { | |||
| 139 | $default = '$instance->'.$attr->builder; | |||
| 140 | } | |||
| 141 | ||||
| 142 | if ( defined( my $init_arg = $attr->init_arg ) ) { # spent 15.7ms making 339 calls to Class::MOP::Attribute::inline_set, avg 46µs/call
# spent 1.55ms making 265 calls to Class::MOP::Mixin::AttributeCore::init_arg, avg 6µs/call
# spent 316µs making 2 calls to Moose::Meta::Attribute::inline_set, avg 158µs/call | |||
| 143 | return ( | |||
| 144 | 'if(exists $params->{\'' | |||
| 145 | . $init_arg . '\'}){' . "\n" | |||
| 146 | . $attr->inline_set( | |||
| 147 | '$instance', | |||
| 148 | '$params->{\'' . $init_arg . '\'}' | |||
| 149 | ) | |||
| 150 | . "\n" . '} ' | |||
| 151 | . ( | |||
| 152 | !defined $default ? '' : 'else {' . "\n" | |||
| 153 | . $attr->inline_set( | |||
| 154 | '$instance', | |||
| 155 | $default | |||
| 156 | ) | |||
| 157 | . "\n" . '}' | |||
| 158 | ) | |||
| 159 | ); | |||
| 160 | } | |||
| 161 | elsif ( defined $default ) { | |||
| 162 | return ( | |||
| 163 | $attr->inline_set( | |||
| 164 | '$instance', | |||
| 165 | $default | |||
| 166 | ) | |||
| 167 | . "\n" | |||
| 168 | ); | |||
| 169 | } | |||
| 170 | else { | |||
| 171 | return ''; | |||
| 172 | } | |||
| 173 | } | |||
| 174 | ||||
| 175 | # spent 1.15ms (587µs+559µs) within Class::MOP::Method::Constructor::_generate_default_value which was called 93 times, avg 12µs/call:
# 87 times (536µs+521µs) by Class::MOP::Method::Constructor::_generate_slot_initializer at line 136, avg 12µs/call
# 6 times (52µs+39µs) by Moose::Meta::Method::Constructor::_generate_slot_initializer at line 223 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Constructor.pm, avg 15µs/call | |||
| 176 | 218 | 563µs | 3µs | my ($self, $attr, $index) = @_; |
| 177 | # NOTE: | |||
| 178 | # default values can either be CODE refs | |||
| 179 | # in which case we need to call them. Or | |||
| 180 | # they can be scalars (strings/numbers) | |||
| 181 | # in which case we can just deal with them | |||
| 182 | # in the code we eval. | |||
| 183 | if ($attr->is_default_a_coderef) { # spent 559µs making 93 calls to Class::MOP::Mixin::AttributeCore::is_default_a_coderef, avg 6µs/call | |||
| 184 | return '$defaults->[' . $index . ']->($instance)'; | |||
| 185 | } | |||
| 186 | else { | |||
| 187 | return '$defaults->[' . $index . ']'; | |||
| 188 | } | |||
| 189 | } | |||
| 190 | ||||
| 191 | 1 | 4µs | 4µs | 1; |
| 192 | ||||
| 193 | __END__ | |||
| 194 | ||||
| 195 | =pod | |||
| 196 | ||||
| 197 | =head1 NAME | |||
| 198 | ||||
| 199 | Class::MOP::Method::Constructor - Method Meta Object for constructors | |||
| 200 | ||||
| 201 | =head1 SYNOPSIS | |||
| 202 | ||||
| 203 | use Class::MOP::Method::Constructor; | |||
| 204 | ||||
| 205 | my $constructor = Class::MOP::Method::Constructor->new( | |||
| 206 | metaclass => $metaclass, | |||
| 207 | options => { | |||
| 208 | debug => 1, # this is all for now | |||
| 209 | }, | |||
| 210 | ); | |||
| 211 | ||||
| 212 | # calling the constructor ... | |||
| 213 | $constructor->body->execute($metaclass->name, %params); | |||
| 214 | ||||
| 215 | =head1 DESCRIPTION | |||
| 216 | ||||
| 217 | This is a subclass of C<Class::MOP::Method> which generates | |||
| 218 | constructor methods. | |||
| 219 | ||||
| 220 | =head1 METHODS | |||
| 221 | ||||
| 222 | =over 4 | |||
| 223 | ||||
| 224 | =item B<< Class::MOP::Method::Constructor->new(%options) >> | |||
| 225 | ||||
| 226 | This creates a new constructor object. It accepts a hash reference of | |||
| 227 | options. | |||
| 228 | ||||
| 229 | =over 8 | |||
| 230 | ||||
| 231 | =item * metaclass | |||
| 232 | ||||
| 233 | This should be a L<Class::MOP::Class> object. It is required. | |||
| 234 | ||||
| 235 | =item * name | |||
| 236 | ||||
| 237 | The method name (without a package name). This is required. | |||
| 238 | ||||
| 239 | =item * package_name | |||
| 240 | ||||
| 241 | The package name for the method. This is required. | |||
| 242 | ||||
| 243 | =item * is_inline | |||
| 244 | ||||
| 245 | This indicates whether or not the constructor should be inlined. This | |||
| 246 | defaults to false. | |||
| 247 | ||||
| 248 | =back | |||
| 249 | ||||
| 250 | =item B<< $metamethod->is_inline >> | |||
| 251 | ||||
| 252 | Returns a boolean indicating whether or not the constructor is | |||
| 253 | inlined. | |||
| 254 | ||||
| 255 | =item B<< $metamethod->associated_metaclass >> | |||
| 256 | ||||
| 257 | This returns the L<Class::MOP::Class> object for the method. | |||
| 258 | ||||
| 259 | =back | |||
| 260 | ||||
| 261 | =head1 AUTHORS | |||
| 262 | ||||
| 263 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | |||
| 264 | ||||
| 265 | =head1 COPYRIGHT AND LICENSE | |||
| 266 | ||||
| 267 | Copyright 2006-2010 by Infinity Interactive, Inc. | |||
| 268 | ||||
| 269 | L<http://www.iinteractive.com> | |||
| 270 | ||||
| 271 | This library is free software; you can redistribute it and/or modify | |||
| 272 | it under the same terms as Perl itself. | |||
| 273 | ||||
| 274 | =cut | |||
| 275 |