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

File /usr/local/lib/perl/5.10.0/Class/MOP/Method/Constructor.pm
Statements Executed 3749
Total Time 0.0135415999999999 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 {
172481.20ms5µ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
sub _new {
40124910µs7µ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
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 {
76206574µs3µ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
sub _initialize_body {
83124413µs3µ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
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 {
9610573.75ms4µ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
sub _generate_slot_initializer {
13115914.71ms3µ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
sub _generate_default_value {
176218563µs3µ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
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