← 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:12 2010

File /usr/local/lib/perl/5.10.0/Class/MOP/Method/Constructor.pm
Statements Executed 3749
Total Time 0.0135416 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
265113.15ms23.7msClass::MOP::Method::Constructor::::_generate_slot_initializerClass::MOP::Method::Constructor::_generate_slot_initializer
31112.20ms45.1msClass::MOP::Method::Constructor::::_generate_constructor_method_inlineClass::MOP::Method::Constructor::_generate_constructor_method_inline
3111978µs978µsClass::MOP::Method::Constructor::::_newClass::MOP::Method::Constructor::_new
3111790µs47.7msClass::MOP::Method::Constructor::::newClass::MOP::Method::Constructor::new
10372602µs4.45msClass::MOP::Method::Constructor::::_attributesClass::MOP::Method::Constructor::_attributes
9322587µs1.15msClass::MOP::Method::Constructor::::_generate_default_valueClass::MOP::Method::Constructor::_generate_default_value
3111320µs45.5msClass::MOP::Method::Constructor::::_initialize_bodyClass::MOP::Method::Constructor::_initialize_body
0000s0sClass::MOP::Method::Constructor::::BEGINClass::MOP::Method::Constructor::BEGIN
0000s0sClass::MOP::Method::Constructor::::__ANON__[:92]Class::MOP::Method::Constructor::__ANON__[:92]
0000s0sClass::MOP::Method::Constructor::::_generate_constructor_methodClass::MOP::Method::Constructor::_generate_constructor_method
LineStmts.Exclusive
Time
Avg.Code
1
2package Class::MOP::Method::Constructor;
3
4333µs11µsuse strict;
# spent 16µs making 1 call to strict::import
5336µs12µsuse warnings;
# spent 22µs making 1 call to warnings::import
6
7327µs9µsuse Carp 'confess';
# spent 49µs making 1 call to Exporter::import
8355µs18µsuse Scalar::Util 'blessed', 'weaken';
# spent 45µs making 1 call to Exporter::import
9
101800ns800nsour $VERSION = '1.09';
11130µs30µs$VERSION = eval $VERSION;
1216µs6µsour $AUTHORITY = 'cpan:STEVAN';
13
143946µs315µsuse 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
sub new {
173152µs2µs my $class = shift;
1831206µs7µs my %options = @_;
19
2031339µs11µs (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
243140µs1µs ($options{package_name} && $options{name})
25 || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
26
2731141µs5µs 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
3231183µs6µs weaken($self->{'associated_metaclass'});
# spent 138µs making 31 calls to Scalar::Util::weaken, avg 4µs/call
33
3431119µs4µs $self->_initialize_body;
# spent 45.5ms making 31 calls to Class::MOP::Method::Constructor::_initialize_body, avg 1.47ms/call
35
3631118µs4µs 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
sub _new {
403126µs845ns my $class = shift;
41
423126µs835ns return Class::MOP::Class->initialize($class)->new_object(@_)
43 if $class ne __PACKAGE__;
44
453134µs1µs my $params = @_ == 1 ? $_[0] : {@_};
46
4731825µs27µs 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
703888µs2µssub options { (shift)->{'options'} }
71124194µs2µssub 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
sub _attributes {
7610340µs391ns my $self = shift;
77103534µs5µs $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
sub _initialize_body {
833120µs652ns my $self = shift;
843126µs848ns my $method_name = '_generate_constructor_method';
85
8631136µs4µs $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
8831230µs7µs $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
91sub _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
sub _generate_constructor_method_inline {
963135µs1µs my $self = shift;
97
982961.18ms4µs 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
1003166µs2µs my $close_over = {
101 '$defaults' => \$defaults,
102 };
103
1043123µs732ns my $source = 'sub {';
1053122µs697ns $source .= "\n" . 'my $class = shift;';
106
1073122µs723ns $source .= "\n" . 'return Class::MOP::Class->initialize($class)->new_object(@_)';
10831259µs8µs $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
1103135µs1µs $source .= "\n" . 'my $params = @_ == 1 ? $_[0] : {@_};';
111
11231258µs8µs $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
1133118µs574ns my $idx = 0;
114265891µs3µs $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++)
11631562µs18µs } @{ $self->_attributes });
# spent 119µs making 31 calls to Class::MOP::Method::Constructor::_attributes, avg 4µs/call
1173124µs774ns $source .= ";\n" . 'return $instance';
1183110µs316ns $source .= ";\n" . '}';
11931137µs4µs warn $source if $self->options->{debug};
# spent 157µs making 31 calls to Class::MOP::Method::Constructor::options, avg 5µs/call
120
12131161µs5µs 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 );
125319µs290ns confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$e" if $e;
126
1273147µs2µs 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
sub _generate_slot_initializer {
131265122µs462ns my $self = shift;
13226584µs317ns my $attr = shift;
13326576µs288ns my $idx = shift;
134
13526556µs210ns my $default;
1362651.70ms6µs 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
1422652.67ms10µs 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 {
17112µs2µs 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
sub _generate_default_value {
1769399µs1µ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.
18393406µs4µs 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 {
1873258µs2µs return '$defaults->[' . $index . ']';
188 }
189}
190
19114µs4µs1;
192
193__END__
194
195=pod
196
197=head1 NAME
198
199Class::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
217This is a subclass of C<Class::MOP::Method> which generates
218constructor methods.
219
220=head1 METHODS
221
222=over 4
223
224=item B<< Class::MOP::Method::Constructor->new(%options) >>
225
226This creates a new constructor object. It accepts a hash reference of
227options.
228
229=over 8
230
231=item * metaclass
232
233This should be a L<Class::MOP::Class> object. It is required.
234
235=item * name
236
237The method name (without a package name). This is required.
238
239=item * package_name
240
241The package name for the method. This is required.
242
243=item * is_inline
244
245This indicates whether or not the constructor should be inlined. This
246defaults to false.
247
248=back
249
250=item B<< $metamethod->is_inline >>
251
252Returns a boolean indicating whether or not the constructor is
253inlined.
254
255=item B<< $metamethod->associated_metaclass >>
256
257This returns the L<Class::MOP::Class> object for the method.
258
259=back
260
261=head1 AUTHORS
262
263Stevan Little E<lt>stevan@iinteractive.comE<gt>
264
265=head1 COPYRIGHT AND LICENSE
266
267Copyright 2006-2010 by Infinity Interactive, Inc.
268
269L<http://www.iinteractive.com>
270
271This library is free software; you can redistribute it and/or modify
272it under the same terms as Perl itself.
273
274=cut
275