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

File /usr/local/lib/perl/5.10.0/Class/MOP/Instance.pm
Statements Executed 4118
Total Time 0.0150553 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
383222.67ms4.72msClass::MOP::Instance::::inline_set_slot_valueClass::MOP::Instance::inline_set_slot_value
476412.67ms2.67msClass::MOP::Instance::::inline_slot_accessClass::MOP::Instance::inline_slot_access
58112.19ms5.38msClass::MOP::Instance::::BUILDARGSClass::MOP::Instance::BUILDARGS
43112.02ms2.29msClass::MOP::Instance::::create_instanceClass::MOP::Instance::create_instance
286111.93ms1.93msClass::MOP::Instance::::set_slot_valueClass::MOP::Instance::set_slot_value
5811707µs7.21msClass::MOP::Instance::::newClass::MOP::Instance::new
4811638µs638µsClass::MOP::Instance::::_newClass::MOP::Instance::_new
7811546µs1.08msClass::MOP::Instance::::inline_get_slot_valueClass::MOP::Instance::inline_get_slot_value
9422300µs300µsClass::MOP::Instance::::is_inlinableClass::MOP::Instance::is_inlinable
3811253µs253µsClass::MOP::Instance::::inline_create_instanceClass::MOP::Instance::inline_create_instance
5811204µs204µsClass::MOP::Instance::::is_dependent_on_superclassesClass::MOP::Instance::is_dependent_on_superclasses
1311106µs182µsClass::MOP::Instance::::inline_is_slot_initializedClass::MOP::Instance::inline_is_slot_initialized
81148µs48µsClass::MOP::Instance::::get_slot_valueClass::MOP::Instance::get_slot_value
21120µs32µsClass::MOP::Instance::::inline_weaken_slot_valueClass::MOP::Instance::inline_weaken_slot_value
21115µs15µsClass::MOP::Instance::::is_slot_initializedClass::MOP::Instance::is_slot_initialized
0000s0sClass::MOP::Instance::::BEGINClass::MOP::Instance::BEGIN
0000s0sClass::MOP::Instance::::clone_instanceClass::MOP::Instance::clone_instance
0000s0sClass::MOP::Instance::::deinitialize_all_slotsClass::MOP::Instance::deinitialize_all_slots
0000s0sClass::MOP::Instance::::deinitialize_slotClass::MOP::Instance::deinitialize_slot
0000s0sClass::MOP::Instance::::get_all_attributesClass::MOP::Instance::get_all_attributes
0000s0sClass::MOP::Instance::::get_all_slotsClass::MOP::Instance::get_all_slots
0000s0sClass::MOP::Instance::::initialize_all_slotsClass::MOP::Instance::initialize_all_slots
0000s0sClass::MOP::Instance::::initialize_slotClass::MOP::Instance::initialize_slot
0000s0sClass::MOP::Instance::::inline_deinitialize_slotClass::MOP::Instance::inline_deinitialize_slot
0000s0sClass::MOP::Instance::::inline_initialize_slotClass::MOP::Instance::inline_initialize_slot
0000s0sClass::MOP::Instance::::inline_rebless_instance_structureClass::MOP::Instance::inline_rebless_instance_structure
0000s0sClass::MOP::Instance::::inline_strengthen_slot_valueClass::MOP::Instance::inline_strengthen_slot_value
0000s0sClass::MOP::Instance::::is_valid_slotClass::MOP::Instance::is_valid_slot
0000s0sClass::MOP::Instance::::rebless_instance_structureClass::MOP::Instance::rebless_instance_structure
0000s0sClass::MOP::Instance::::strengthen_slot_valueClass::MOP::Instance::strengthen_slot_value
0000s0sClass::MOP::Instance::::weaken_slot_valueClass::MOP::Instance::weaken_slot_value
LineStmts.Exclusive
Time
Avg.Code
1
2package Class::MOP::Instance;
3
4330µs10µsuse strict;
# spent 11µs making 1 call to strict::import
5333µs11µsuse warnings;
# spent 23µs making 1 call to warnings::import
6
7366µs22µsuse Scalar::Util 'weaken', 'blessed';
# spent 52µs making 1 call to Exporter::import
8
91700ns700nsour $VERSION = '1.09';
10122µs22µs$VERSION = eval $VERSION;
111500ns500nsour $AUTHORITY = 'cpan:STEVAN';
12
1331.39ms463µsuse base 'Class::MOP::Object';
# spent 78µs making 1 call to base::import
14
15
# spent 5.38ms (2.19+3.19) within Class::MOP::Instance::BUILDARGS which was called 58 times, avg 93µs/call: # 58 times (2.19ms+3.19ms) by Class::MOP::Instance::new at line 36, avg 93µs/call
sub BUILDARGS {
167612.94ms4µs my ($class, @args) = @_;
17
18 if ( @args == 1 ) {
# spent 172µs making 58 calls to Scalar::Util::blessed, avg 3µs/call
19 unshift @args, "associated_metaclass";
20 } elsif ( @args >= 2 && blessed($args[0]) && $args[0]->isa("Class::MOP::Class") ) {
21 # compat mode
22 my ( $meta, @attrs ) = @args;
23 @args = ( associated_metaclass => $meta, attributes => \@attrs );
24 }
25
26 my %options = @args;
27 # FIXME lazy_build
28 $options{slots} ||= [ map { $_->slots } @{ $options{attributes} || [] } ];
# spent 3.02ms making 413 calls to Class::MOP::Attribute::slots, avg 7µs/call
29 $options{slot_hash} = { map { $_ => undef } @{ $options{slots} } }; # FIXME lazy_build
30
31 return \%options;
32}
33
34
# spent 7.21ms (707µs+6.50) within Class::MOP::Instance::new which was called 58 times, avg 124µs/call: # 58 times (707µs+6.50ms) by Class::MOP::Class::_create_meta_instance at line 624 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 124µs/call
sub new {
352901.09ms4µs my $class = shift;
36 my $options = $class->BUILDARGS(@_);
# spent 5.38ms making 58 calls to Class::MOP::Instance::BUILDARGS, avg 93µs/call
37
38 # FIXME replace with a proper constructor
39 my $instance = $class->_new(%$options);
# spent 638µs making 48 calls to Class::MOP::Instance::_new, avg 13µs/call # spent 221µs making 10 calls to Moose::Meta::Instance::_new, avg 22µs/call
40
41 # FIXME weak_ref => 1,
42 weaken($instance->{'associated_metaclass'});
# spent 261µs making 58 calls to Scalar::Util::weaken, avg 5µs/call
43
44 return $instance;
45}
46
47
# spent 638µs within Class::MOP::Instance::_new which was called 48 times, avg 13µs/call: # 48 times (638µs+0s) by Class::MOP::Instance::new at line 39, avg 13µs/call
sub _new {
48192506µs3µs my $class = shift;
49 return Class::MOP::Class->initialize($class)->new_object(@_)
50 if $class ne __PACKAGE__;
51
52 my $params = @_ == 1 ? $_[0] : {@_};
53 return bless {
54 # NOTE:
55 # I am not sure that it makes
56 # sense to pass in the meta
57 # The ideal would be to just
58 # pass in the class name, but
59 # that is placing too much of
60 # an assumption on bless(),
61 # which is *probably* a safe
62 # assumption,.. but you can
63 # never tell <:)
64 'associated_metaclass' => $params->{associated_metaclass},
65 'attributes' => $params->{attributes},
66 'slots' => $params->{slots},
67 'slot_hash' => $params->{slot_hash},
68 } => $class;
69}
70
7143164µs4µssub _class_name { $_[0]->{_class_name} ||= $_[0]->associated_metaclass->name }
# spent 24µs making 6 calls to Class::MOP::Instance::associated_metaclass, avg 4µs/call # spent 17µs making 6 calls to Class::MOP::Package::name, avg 3µs/call
72
7369µs2µssub associated_metaclass { $_[0]{'associated_metaclass'} }
74
75
# spent 2.29ms (2.02+268µs) within Class::MOP::Instance::create_instance which was called 43 times, avg 53µs/call: # 43 times (2.02ms+268µs) by Class::MOP::Class::_construct_instance at line 595 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 53µs/call
sub create_instance {
76862.00ms23µs my $self = shift;
77 bless {}, $self->_class_name;
# spent 268µs making 43 calls to Class::MOP::Instance::_class_name, avg 6µs/call
78}
79
80sub clone_instance {
81 my ($self, $instance) = @_;
82 bless { %$instance }, $self->_class_name;
83}
84
85# operations on meta instance
86
87sub get_all_slots {
88 my $self = shift;
89 return @{$self->{'slots'}};
90}
91
92sub get_all_attributes {
93 my $self = shift;
94 return @{$self->{attributes}};
95}
96
97sub is_valid_slot {
98 my ($self, $slot_name) = @_;
99 exists $self->{'slot_hash'}->{$slot_name};
100}
101
102# operations on created instances
103
104
# spent 48µs within Class::MOP::Instance::get_slot_value which was called 8 times, avg 6µs/call: # 8 times (48µs+0s) by Class::MOP::Attribute::get_raw_value at line 274 of /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm, avg 6µs/call
sub get_slot_value {
1051626µs2µs my ($self, $instance, $slot_name) = @_;
106 $instance->{$slot_name};
107}
108
109
# spent 1.93ms within Class::MOP::Instance::set_slot_value which was called 286 times, avg 7µs/call: # 286 times (1.93ms+0s) by Class::MOP::Attribute::_set_initial_slot_value at line 148 of /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm, avg 7µs/call
sub set_slot_value {
1105721.38ms2µs my ($self, $instance, $slot_name, $value) = @_;
111 $instance->{$slot_name} = $value;
112}
113
114sub initialize_slot {
115 my ($self, $instance, $slot_name) = @_;
116 return;
117}
118
119sub deinitialize_slot {
120 my ( $self, $instance, $slot_name ) = @_;
121 delete $instance->{$slot_name};
122}
123
124sub initialize_all_slots {
125 my ($self, $instance) = @_;
126 foreach my $slot_name ($self->get_all_slots) {
127 $self->initialize_slot($instance, $slot_name);
128 }
129}
130
131sub deinitialize_all_slots {
132 my ($self, $instance) = @_;
133 foreach my $slot_name ($self->get_all_slots) {
134 $self->deinitialize_slot($instance, $slot_name);
135 }
136}
137
138
# spent 15µs within Class::MOP::Instance::is_slot_initialized which was called 2 times, avg 8µs/call: # 2 times (15µs+0s) by Class::MOP::Attribute::has_value at line 282 of /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm, avg 8µs/call
sub is_slot_initialized {
13948µs2µs my ($self, $instance, $slot_name, $value) = @_;
140 exists $instance->{$slot_name};
141}
142
143sub weaken_slot_value {
144 my ($self, $instance, $slot_name) = @_;
145 weaken $instance->{$slot_name};
146}
147
148sub strengthen_slot_value {
149 my ($self, $instance, $slot_name) = @_;
150 $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
151}
152
153sub rebless_instance_structure {
154 my ($self, $instance, $metaclass) = @_;
155
156 # we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8
157 bless $_[1], $metaclass->name;
158}
159
160
# spent 204µs within Class::MOP::Instance::is_dependent_on_superclasses which was called 58 times, avg 4µs/call: # 58 times (204µs+0s) by Class::MOP::Class::_create_meta_instance at line 629 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 4µs/call
sub is_dependent_on_superclasses {
1615863µs1µs return; # for meta instances that require updates on inherited slot changes
162}
163
164# inlinable operation snippets
165
1669497µs1µs
# spent 300µs within Class::MOP::Instance::is_inlinable which was called 94 times, avg 3µs/call: # 84 times (258µs+0s) by Class::MOP::Attribute::_process_accessors at line 322 of /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm, avg 3µs/call # 10 times (42µs+0s) by Moose::Meta::Method::Accessor::_instance_is_inlinable at line 122 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Accessor.pm, avg 4µs/call
sub is_inlinable { 1 }
167
168
# spent 253µs within Class::MOP::Instance::inline_create_instance which was called 38 times, avg 7µs/call: # 38 times (253µs+0s) by Class::MOP::Class::inline_create_instance at line 638 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 7µs/call
sub inline_create_instance {
16976144µs2µs my ($self, $class_variable) = @_;
170 'bless {} => ' . $class_variable;
171}
172
173
# spent 2.67ms within Class::MOP::Instance::inline_slot_access which was called 476 times, avg 6µs/call: # 383 times (2.04ms+0s) by Class::MOP::Instance::inline_set_slot_value at line 185, avg 5µs/call # 78 times (535µs+0s) by Class::MOP::Instance::inline_get_slot_value at line 180, avg 7µs/call # 13 times (77µs+0s) by Class::MOP::Instance::inline_is_slot_initialized at line 199, avg 6µs/call # 2 times (12µs+0s) by Class::MOP::Instance::inline_weaken_slot_value at line 204, avg 6µs/call
sub inline_slot_access {
1749521.79ms2µs my ($self, $instance, $slot_name) = @_;
175 sprintf q[%s->{"%s"}], $instance, quotemeta($slot_name);
176}
177
178
# spent 1.08ms (546µs+535µs) within Class::MOP::Instance::inline_get_slot_value which was called 78 times, avg 14µs/call: # 78 times (546µs+535µs) by Class::MOP::Attribute::inline_get at line 411 of /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm, avg 14µs/call
sub inline_get_slot_value {
179156532µs3µs my ($self, $instance, $slot_name) = @_;
180 $self->inline_slot_access($instance, $slot_name);
# spent 535µs making 78 calls to Class::MOP::Instance::inline_slot_access, avg 7µs/call
181}
182
183
# spent 4.72ms (2.67+2.04) within Class::MOP::Instance::inline_set_slot_value which was called 383 times, avg 12µs/call: # 357 times (2.44ms+1.87ms) by Class::MOP::Attribute::inline_set at line 419 of /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm, avg 12µs/call # 26 times (239µs+168µs) by Moose::Meta::Attribute::inline_set at line 589 of /usr/local/lib/perl/5.10.0/Moose/Meta/Attribute.pm, avg 16µs/call
sub inline_set_slot_value {
1847662.64ms3µs my ($self, $instance, $slot_name, $value) = @_;
185 $self->inline_slot_access($instance, $slot_name) . " = $value",
# spent 2.04ms making 383 calls to Class::MOP::Instance::inline_slot_access, avg 5µs/call
186}
187
188sub inline_initialize_slot {
189 my ($self, $instance, $slot_name) = @_;
190 return '';
191}
192
193sub inline_deinitialize_slot {
194 my ($self, $instance, $slot_name) = @_;
195 "delete " . $self->inline_slot_access($instance, $slot_name);
196}
197
# spent 182µs (106+77) within Class::MOP::Instance::inline_is_slot_initialized which was called 13 times, avg 14µs/call: # 13 times (106µs+77µs) by Class::MOP::Attribute::inline_has at line 428 of /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm, avg 14µs/call
sub inline_is_slot_initialized {
1982695µs4µs my ($self, $instance, $slot_name) = @_;
199 "exists " . $self->inline_slot_access($instance, $slot_name);
# spent 77µs making 13 calls to Class::MOP::Instance::inline_slot_access, avg 6µs/call
200}
201
202
# spent 32µs (20+12) within Class::MOP::Instance::inline_weaken_slot_value which was called 2 times, avg 16µs/call: # 2 times (20µs+12µs) by Moose::Meta::Attribute::inline_set at line 591 of /usr/local/lib/perl/5.10.0/Moose/Meta/Attribute.pm, avg 16µs/call
sub inline_weaken_slot_value {
203420µs5µs my ($self, $instance, $slot_name) = @_;
204 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
# spent 12µs making 2 calls to Class::MOP::Instance::inline_slot_access, avg 6µs/call
205}
206
207sub inline_strengthen_slot_value {
208 my ($self, $instance, $slot_name) = @_;
209 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
210}
211
212sub inline_rebless_instance_structure {
213 my ($self, $instance, $class_variable) = @_;
214 "bless $instance => $class_variable";
215}
216
21714µs4µs1;
218
219__END__
220
221=pod
222
223=head1 NAME
224
225Class::MOP::Instance - Instance Meta Object
226
227=head1 DESCRIPTION
228
229The Instance Protocol controls the creation of object instances, and
230the storage of attribute values in those instances.
231
232Using this API directly in your own code violates encapsulation, and
233we recommend that you use the appropriate APIs in L<Class::MOP::Class>
234and L<Class::MOP::Attribute> instead. Those APIs in turn call the
235methods in this class as appropriate.
236
237This class also participates in generating inlined code by providing
238snippets of code to access an object instance.
239
240=head1 METHODS
241
242=head2 Object construction
243
244=over 4
245
246=item B<< Class::MOP::Instance->new(%options) >>
247
248This method creates a new meta-instance object.
249
250It accepts the following keys in C<%options>:
251
252=over 8
253
254=item * associated_metaclass
255
256The L<Class::MOP::Class> object for which instances will be created.
257
258=item * attributes
259
260An array reference of L<Class::MOP::Attribute> objects. These are the
261attributes which can be stored in each instance.
262
263=back
264
265=back
266
267=head2 Creating and altering instances
268
269=over 4
270
271=item B<< $metainstance->create_instance >>
272
273This method returns a reference blessed into the associated
274metaclass's class.
275
276The default is to use a hash reference. Subclasses can override this.
277
278=item B<< $metainstance->clone_instance($instance) >>
279
280Given an instance, this method creates a new object by making
281I<shallow> clone of the original.
282
283=back
284
285=head2 Introspection
286
287=over 4
288
289=item B<< $metainstance->associated_metaclass >>
290
291This returns the L<Class::MOP::Class> object associated with the
292meta-instance object.
293
294=item B<< $metainstance->get_all_slots >>
295
296This returns a list of slot names stored in object instances. In
297almost all cases, slot names correspond directly attribute names.
298
299=item B<< $metainstance->is_valid_slot($slot_name) >>
300
301This will return true if C<$slot_name> is a valid slot name.
302
303=item B<< $metainstance->get_all_attributes >>
304
305This returns a list of attributes corresponding to the attributes
306passed to the constructor.
307
308=back
309
310=head2 Operations on Instance Structures
311
312It's important to understand that the meta-instance object is a
313different entity from the actual instances it creates. For this
314reason, any operations on the C<$instance_structure> always require
315that the object instance be passed to the method.
316
317=over 4
318
319=item B<< $metainstance->get_slot_value($instance_structure, $slot_name) >>
320
321=item B<< $metainstance->set_slot_value($instance_structure, $slot_name, $value) >>
322
323=item B<< $metainstance->initialize_slot($instance_structure, $slot_name) >>
324
325=item B<< $metainstance->deinitialize_slot($instance_structure, $slot_name) >>
326
327=item B<< $metainstance->initialize_all_slots($instance_structure) >>
328
329=item B<< $metainstance->deinitialize_all_slots($instance_structure) >>
330
331=item B<< $metainstance->is_slot_initialized($instance_structure, $slot_name) >>
332
333=item B<< $metainstance->weaken_slot_value($instance_structure, $slot_name) >>
334
335=item B<< $metainstance->strengthen_slot_value($instance_structure, $slot_name) >>
336
337=item B<< $metainstance->rebless_instance_structure($instance_structure, $new_metaclass) >>
338
339The exact details of what each method does should be fairly obvious
340from the method name.
341
342=back
343
344=head2 Inlinable Instance Operations
345
346=over 4
347
348=item B<< $metainstance->is_inlinable >>
349
350This is a boolean that indicates whether or not slot access operations
351can be inlined. By default it is true, but subclasses can override
352this.
353
354=item B<< $metainstance->inline_create_instance($class_variable) >>
355
356This method expects a string that, I<when inlined>, will become a
357class name. This would literally be something like C<'$class'>, not an
358actual class name.
359
360It returns a snippet of code that creates a new object for the
361class. This is something like C< bless {}, $class_name >.
362
363=item B<< $metainstance->inline_slot_access($instance_variable, $slot_name) >>
364
365=item B<< $metainstance->inline_get_slot_value($instance_variable, $slot_name) >>
366
367=item B<< $metainstance->inline_set_slot_value($instance_variable, $slot_name, $value) >>
368
369=item B<< $metainstance->inline_initialize_slot($instance_variable, $slot_name) >>
370
371=item B<< $metainstance->inline_deinitialize_slot($instance_variable, $slot_name) >>
372
373=item B<< $metainstance->inline_is_slot_initialized($instance_variable, $slot_name) >>
374
375=item B<< $metainstance->inline_weaken_slot_value($instance_variable, $slot_name) >>
376
377=item B<< $metainstance->inline_strengthen_slot_value($instance_variable, $slot_name) >>
378
379These methods all expect two arguments. The first is the name of a
380variable, than when inlined, will represent the object
381instance. Typically this will be a literal string like C<'$_[0]'>.
382
383The second argument is a slot name.
384
385The method returns a snippet of code that, when inlined, performs some
386operation on the instance.
387
388=item B<< $metainstance->inline_rebless_instance_structure($instance_variable, $class_variable) >>
389
390This takes the name of a variable that will, when inlined, represent the object
391instance, and the name of a variable that will represent the class to rebless
392into, and returns code to rebless an instance into a class.
393
394=back
395
396=head2 Introspection
397
398=over 4
399
400=item B<< Class::MOP::Instance->meta >>
401
402This will return a L<Class::MOP::Class> instance for this class.
403
404It should also be noted that L<Class::MOP> will actually bootstrap
405this module by installing a number of attribute meta-objects into its
406metaclass.
407
408=back
409
410=head1 AUTHORS
411
412Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
413
414Stevan Little E<lt>stevan@iinteractive.comE<gt>
415
416=head1 COPYRIGHT AND LICENSE
417
418Copyright 2006-2010 by Infinity Interactive, Inc.
419
420L<http://www.iinteractive.com>
421
422This library is free software; you can redistribute it and/or modify
423it under the same terms as Perl itself.
424
425=cut
426