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

File /usr/local/lib/perl/5.10.0/Class/MOP/Object.pm
Statements Executed 2017
Total Time 0.0057753 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
422322.51ms4.07msClass::MOP::Object::::_is_compatible_withClass::MOP::Object::_is_compatible_with
334211.73ms4.95msClass::MOP::Object::::_can_be_made_compatible_withClass::MOP::Object::_can_be_made_compatible_with
1119µs438µsClass::MOP::Object::::_newClass::MOP::Object::_new
0000s0sClass::MOP::Object::::BEGINClass::MOP::Object::BEGIN
0000s0sClass::MOP::Object::::_get_compatible_metaclassClass::MOP::Object::_get_compatible_metaclass
0000s0sClass::MOP::Object::::_get_compatible_metaclass_by_subclassingClass::MOP::Object::_get_compatible_metaclass_by_subclassing
0000s0sClass::MOP::Object::::_make_compatible_withClass::MOP::Object::_make_compatible_with
0000s0sClass::MOP::Object::::_real_ref_nameClass::MOP::Object::_real_ref_name
0000s0sClass::MOP::Object::::dumpClass::MOP::Object::dump
LineStmts.Exclusive
Time
Avg.Code
1
2package Class::MOP::Object;
3
4328µs9µsuse strict;
# spent 7µs making 1 call to strict::import
5324µs8µsuse warnings;
# spent 25µs making 1 call to warnings::import
6
7323µs8µsuse Carp qw(confess);
# spent 44µs making 1 call to Exporter::import
83498µs166µsuse Scalar::Util 'blessed';
# spent 36µs making 1 call to Exporter::import
9
1011µs1µsour $VERSION = '1.09';
11121µs21µs$VERSION = eval $VERSION;
121800ns800nsour $AUTHORITY = 'cpan:STEVAN';
13
14# introspection
15
16sub meta {
173320µs612ns require Class::MOP::Class;
1833231µs7µs Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
# spent 6.32ms making 33 calls to Class::MOP::Class::initialize, avg 191µs/call # spent 75µs making 33 calls to Scalar::Util::blessed, avg 2µs/call
19}
20
21
# spent 438µs (9+429) within Class::MOP::Object::_new which was called # once (9µs+429µs) by Moose::Meta::TypeConstraint::Registry::new at line 29 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Registry.pm
sub _new {
22113µs13µs Class::MOP::class_of(shift)->new_object(@_);
# spent 414µs making 1 call to Class::MOP::Class::new_object # spent 16µs making 1 call to Class::MOP::class_of
23}
24
25# RANT:
26# Cmon, how many times have you written
27# the following code while debugging:
28#
29# use Data::Dumper;
30# warn Dumper $obj;
31#
32# It can get seriously annoying, so why
33# not just do this ...
34sub dump {
35 my $self = shift;
36 require Data::Dumper;
37 local $Data::Dumper::Maxdepth = shift || 1;
38 Data::Dumper::Dumper $self;
39}
40
41sub _real_ref_name {
42 my $self = shift;
43 return blessed($self);
44}
45
46
# spent 4.07ms (2.51+1.55) within Class::MOP::Object::_is_compatible_with which was called 422 times, avg 10µs/call: # 334 times (1.97ms+1.24ms) by Class::MOP::Object::_can_be_made_compatible_with at line 55, avg 10µs/call # 77 times (456µs+274µs) by Class::MOP::Class::_single_metaclass_is_compatible at line 301 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 9µs/call # 11 times (85µs+36µs) by Class::MOP::Class::_class_metaclass_is_compatible at line 263 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 11µs/call
sub _is_compatible_with {
47422209µs496ns my $self = shift;
48422393µs931ns my ($other_name) = @_;
49
504222.66ms6µs return $self->isa($other_name);
# spent 1.55ms making 422 calls to UNIVERSAL::isa, avg 4µs/call
51}
52
53
# spent 4.95ms (1.73+3.22) within Class::MOP::Object::_can_be_made_compatible_with which was called 334 times, avg 15µs/call: # 282 times (1.43ms+2.72ms) by Class::MOP::Class::_single_metaclass_can_be_made_compatible at line 371 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 15µs/call # 52 times (301µs+499µs) by Class::MOP::Class::_class_metaclass_can_be_made_compatible at line 351 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 15µs/call
sub _can_be_made_compatible_with {
54334176µs526ns my $self = shift;
553341.47ms4µs return !$self->_is_compatible_with(@_)
# spent 3.22ms making 334 calls to Class::MOP::Object::_is_compatible_with, avg 10µs/call
56 && defined($self->_get_compatible_metaclass(@_));
57}
58
59sub _make_compatible_with {
60 my $self = shift;
61 my ($other_name) = @_;
62
63 my $new_metaclass = $self->_get_compatible_metaclass($other_name);
64
65 confess "Can't make $self compatible with metaclass $other_name"
66 unless defined $new_metaclass;
67
68 # can't use rebless_instance here, because it might not be an actual
69 # subclass in the case of, e.g. moose role reconciliation
70 $new_metaclass->meta->_force_rebless_instance($self)
71 if blessed($self) ne $new_metaclass;
72
73 return $self;
74}
75
76sub _get_compatible_metaclass {
77 my $self = shift;
78 my ($other_name) = @_;
79
80 return $self->_get_compatible_metaclass_by_subclassing($other_name);
81}
82
83sub _get_compatible_metaclass_by_subclassing {
84 my $self = shift;
85 my ($other_name) = @_;
86 my $meta_name = blessed($self) ? $self->_real_ref_name : $self;
87
88 if ($meta_name->isa($other_name)) {
89 return $meta_name;
90 }
91 elsif ($other_name->isa($meta_name)) {
92 return $other_name;
93 }
94
95 return;
96}
97
9819µs9µs1;
99
100__END__
101
102=pod
103
104=head1 NAME
105
106Class::MOP::Object - Base class for metaclasses
107
108=head1 DESCRIPTION
109
110This class is a very minimal base class for metaclasses.
111
112=head1 METHODS
113
114This class provides a few methods which are useful in all metaclasses.
115
116=over 4
117
118=item B<< Class::MOP::???->meta >>
119
120This returns a L<Class::MOP::Class> object.
121
122=item B<< $metaobject->dump($max_depth) >>
123
124This method uses L<Data::Dumper> to dump the object. You can pass an
125optional maximum depth, which will set C<$Data::Dumper::Maxdepth>. The
126default maximum depth is 1.
127
128=back
129
130=head1 AUTHORS
131
132Stevan Little E<lt>stevan@iinteractive.comE<gt>
133
134=head1 COPYRIGHT AND LICENSE
135
136Copyright 2006-2010 by Infinity Interactive, Inc.
137
138L<http://www.iinteractive.com>
139
140This library is free software; you can redistribute it and/or modify
141it under the same terms as Perl itself.
142
143=cut