File | /usr/local/lib/perl/5.10.0/Class/MOP/Method/Constructor.pm |
Statements Executed | 3749 |
Total Time | 0.0135416 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
265 | 1 | 1 | 3.15ms | 23.7ms | _generate_slot_initializer | Class::MOP::Method::Constructor::
31 | 1 | 1 | 2.20ms | 45.1ms | _generate_constructor_method_inline | Class::MOP::Method::Constructor::
31 | 1 | 1 | 978µs | 978µs | _new | Class::MOP::Method::Constructor::
31 | 1 | 1 | 790µs | 47.7ms | new | Class::MOP::Method::Constructor::
103 | 7 | 2 | 602µs | 4.45ms | _attributes | Class::MOP::Method::Constructor::
93 | 2 | 2 | 587µs | 1.15ms | _generate_default_value | Class::MOP::Method::Constructor::
31 | 1 | 1 | 320µs | 45.5ms | _initialize_body | Class::MOP::Method::Constructor::
0 | 0 | 0 | 0s | 0s | BEGIN | Class::MOP::Method::Constructor::
0 | 0 | 0 | 0s | 0s | __ANON__[:92] | Class::MOP::Method::Constructor::
0 | 0 | 0 | 0s | 0s | _generate_constructor_method | Class::MOP::Method::Constructor::
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 | 31 | 52µs | 2µs | my $class = shift; |
18 | 31 | 206µs | 7µs | my %options = @_; |
19 | ||||
20 | 31 | 339µs | 11µ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 | ||||
24 | 31 | 40µs | 1µs | ($options{package_name} && $options{name}) |
25 | || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT"; | |||
26 | ||||
27 | 31 | 141µs | 5µ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 | |||
32 | 31 | 183µs | 6µs | weaken($self->{'associated_metaclass'}); # spent 138µs making 31 calls to Scalar::Util::weaken, avg 4µs/call |
33 | ||||
34 | 31 | 119µs | 4µs | $self->_initialize_body; # spent 45.5ms making 31 calls to Class::MOP::Method::Constructor::_initialize_body, avg 1.47ms/call |
35 | ||||
36 | 31 | 118µs | 4µ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 | |||
40 | 31 | 26µs | 845ns | my $class = shift; |
41 | ||||
42 | 31 | 26µs | 835ns | return Class::MOP::Class->initialize($class)->new_object(@_) |
43 | if $class ne __PACKAGE__; | |||
44 | ||||
45 | 31 | 34µs | 1µs | my $params = @_ == 1 ? $_[0] : {@_}; |
46 | ||||
47 | 31 | 825µs | 27µ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 | ||||
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 | 103 | 40µs | 391ns | my $self = shift; |
77 | 103 | 534µs | 5µ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 | |||
83 | 31 | 20µs | 652ns | my $self = shift; |
84 | 31 | 26µs | 848ns | my $method_name = '_generate_constructor_method'; |
85 | ||||
86 | 31 | 136µs | 4µ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 | ||||
88 | 31 | 230µs | 7µ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 | ||||
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 | 31 | 35µs | 1µs | my $self = shift; |
97 | ||||
98 | 296 | 1.18ms | 4µ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 | ||||
100 | 31 | 66µs | 2µs | my $close_over = { |
101 | '$defaults' => \$defaults, | |||
102 | }; | |||
103 | ||||
104 | 31 | 23µs | 732ns | my $source = 'sub {'; |
105 | 31 | 22µs | 697ns | $source .= "\n" . 'my $class = shift;'; |
106 | ||||
107 | 31 | 22µs | 723ns | $source .= "\n" . 'return Class::MOP::Class->initialize($class)->new_object(@_)'; |
108 | 31 | 259µs | 8µ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 | ||||
110 | 31 | 35µs | 1µs | $source .= "\n" . 'my $params = @_ == 1 ? $_[0] : {@_};'; |
111 | ||||
112 | 31 | 258µs | 8µ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 |
113 | 31 | 18µs | 574ns | my $idx = 0; |
114 | 265 | 891µs | 3µ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++) | |||
116 | 31 | 562µs | 18µs | } @{ $self->_attributes }); # spent 119µs making 31 calls to Class::MOP::Method::Constructor::_attributes, avg 4µs/call |
117 | 31 | 24µs | 774ns | $source .= ";\n" . 'return $instance'; |
118 | 31 | 10µs | 316ns | $source .= ";\n" . '}'; |
119 | 31 | 137µs | 4µs | warn $source if $self->options->{debug}; # spent 157µs making 31 calls to Class::MOP::Method::Constructor::options, avg 5µs/call |
120 | ||||
121 | 31 | 161µs | 5µ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 | ); | |||
125 | 31 | 9µs | 290ns | confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$e" if $e; |
126 | ||||
127 | 31 | 47µs | 2µ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 | |||
131 | 265 | 122µs | 462ns | my $self = shift; |
132 | 265 | 84µs | 317ns | my $attr = shift; |
133 | 265 | 76µs | 288ns | my $idx = shift; |
134 | ||||
135 | 265 | 56µs | 210ns | my $default; |
136 | 265 | 1.70ms | 6µ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 | ||||
142 | 265 | 2.67ms | 10µ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 { | |||
171 | 1 | 2µs | 2µ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 | |||
176 | 93 | 99µs | 1µ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 | 93 | 406µs | 4µ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 { | |||
187 | 32 | 58µs | 2µs | 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 |