← Index
NYTProf Performance Profile   « line view »
For /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
  Run on Mon Jan 29 16:55:34 2018
Reported on Mon Jan 29 16:57:06 2018

Filename/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/x86_64-linux/Class/MOP/Object.pm
StatementsExecuted 1509 statements in 6.28ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
295215.15ms5.78msClass::MOP::Object::::_can_be_made_compatible_withClass::MOP::Object::_can_be_made_compatible_with
30232510µs644µsClass::MOP::Object::::_is_compatible_withClass::MOP::Object::_is_compatible_with
1118µs15µsClass::MOP::Object::::BEGIN@9Class::MOP::Object::BEGIN@9
1117µs9µsClass::MOP::Object::::BEGIN@4Class::MOP::Object::BEGIN@4
1116µs216µsClass::MOP::Object::::_newClass::MOP::Object::_new
1115µs21µsClass::MOP::Object::::BEGIN@8Class::MOP::Object::BEGIN@8
1114µs8µsClass::MOP::Object::::BEGIN@5Class::MOP::Object::BEGIN@5
1114µs22µsClass::MOP::Object::::BEGIN@7Class::MOP::Object::BEGIN@7
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::::_inline_throw_errorClass::MOP::Object::_inline_throw_error
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
0000s0sClass::MOP::Object::::throw_errorClass::MOP::Object::throw_error
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Class::MOP::Object;
21200nsour $VERSION = '2.1605';
3
4214µs210µs
# spent 9µs (7+1) within Class::MOP::Object::BEGIN@4 which was called: # once (7µs+1µs) by parent::import at line 4
use strict;
# spent 9µs making 1 call to Class::MOP::Object::BEGIN@4 # spent 1µs making 1 call to strict::import
5212µs212µs
# spent 8µs (4+4) within Class::MOP::Object::BEGIN@5 which was called: # once (4µs+4µs) by parent::import at line 5
use warnings;
# spent 8µs making 1 call to Class::MOP::Object::BEGIN@5 # spent 4µs making 1 call to warnings::import
6
7217µs222µs
# spent 22µs (4+18) within Class::MOP::Object::BEGIN@7 which was called: # once (4µs+18µs) by parent::import at line 7
use parent 'Class::MOP::Mixin';
# spent 22µs making 1 call to Class::MOP::Object::BEGIN@7 # spent 18µs making 1 call to parent::import, recursion: max depth 2, sum of overlapping time 18µs
8214µs237µs
# spent 21µs (5+16) within Class::MOP::Object::BEGIN@8 which was called: # once (5µs+16µs) by parent::import at line 8
use Scalar::Util 'blessed';
# spent 21µs making 1 call to Class::MOP::Object::BEGIN@8 # spent 16µs making 1 call to Exporter::import
92253µs221µs
# spent 15µs (8+6) within Class::MOP::Object::BEGIN@9 which was called: # once (8µs+6µs) by parent::import at line 9
use Module::Runtime;
# spent 15µs making 1 call to Class::MOP::Object::BEGIN@9 # spent 6µs making 1 call to Module::Runtime::import
10
11# introspection
12
13sub throw_error {
14 shift->_throw_exception( Legacy => message => join('', @_) );
15}
16
17sub _inline_throw_error {
18 my ( $self, $message ) = @_;
19 return 'die Module::Runtime::use_module("Moose::Exception::Legacy")->new(message => ' . $message. ')';
20}
21
22
# spent 216µs (6+211) within Class::MOP::Object::_new which was called: # once (6µs+211µs) by Moose::Meta::TypeConstraint::Registry::new at line 29 of Moose/Meta/TypeConstraint/Registry.pm
sub _new {
2316µs2211µs Class::MOP::class_of(shift)->new_object(@_);
# spent 206µs making 1 call to Class::MOP::Class::new_object # spent 5µs making 1 call to Class::MOP::class_of
24}
25
26# RANT:
27# Cmon, how many times have you written
28# the following code while debugging:
29#
30# use Data::Dumper;
31# warn Dumper $obj;
32#
33# It can get seriously annoying, so why
34# not just do this ...
35sub dump {
36 my $self = shift;
37 require Data::Dumper;
38 local $Data::Dumper::Maxdepth = shift || 1;
39 Data::Dumper::Dumper $self;
40}
41
42sub _real_ref_name {
43 my $self = shift;
44 return blessed($self);
45}
46
47
# spent 644µs (510+134) within Class::MOP::Object::_is_compatible_with which was called 302 times, avg 2µs/call: # 295 times (501µs+132µs) by Class::MOP::Object::_can_be_made_compatible_with at line 56, avg 2µs/call # 6 times (8µs+2µs) by Class::MOP::Class::_single_metaclass_is_compatible at line 286 of Class/MOP/Class.pm, avg 2µs/call # once (1µs+300ns) by Class::MOP::Class::_class_metaclass_is_compatible at line 252 of Class/MOP/Class.pm
sub _is_compatible_with {
4830237µs my $self = shift;
4930238µs my ($other_name) = @_;
50
513025.37ms302134µs return $self->isa($other_name);
# spent 134µs making 302 calls to UNIVERSAL::isa, avg 445ns/call
52}
53
54
# spent 5.78ms (5.15+633µs) within Class::MOP::Object::_can_be_made_compatible_with which was called 295 times, avg 20µs/call: # 246 times (5.02ms+489µs) by Class::MOP::Class::_single_metaclass_can_be_made_compatible at line 356 of Class/MOP/Class.pm, avg 22µs/call # 49 times (125µs+144µs) by Class::MOP::Class::_class_metaclass_can_be_made_compatible at line 336 of Class/MOP/Class.pm, avg 5µs/call
sub _can_be_made_compatible_with {
5529532µs my $self = shift;
56295479µs295632µs return !$self->_is_compatible_with(@_)
# spent 632µs making 295 calls to Class::MOP::Object::_is_compatible_with, avg 2µs/call
57 && defined($self->_get_compatible_metaclass(@_));
58}
59
60sub _make_compatible_with {
61 my $self = shift;
62 my ($other_name) = @_;
63
64 my $new_metaclass = $self->_get_compatible_metaclass($other_name);
65
66 unless ( defined $new_metaclass ) {
67 $self->_throw_exception( CannotMakeMetaclassCompatible => superclass_name => $other_name,
68 class => $self,
69 );
70 }
71
72 # can't use rebless_instance here, because it might not be an actual
73 # subclass in the case of, e.g. moose role reconciliation
74 $new_metaclass->meta->_force_rebless_instance($self)
75 if blessed($self) ne $new_metaclass;
76
77 return $self;
78}
79
80sub _get_compatible_metaclass {
81 my $self = shift;
82 my ($other_name) = @_;
83
84 return $self->_get_compatible_metaclass_by_subclassing($other_name);
85}
86
87sub _get_compatible_metaclass_by_subclassing {
88 my $self = shift;
89 my ($other_name) = @_;
90 my $meta_name = blessed($self) ? $self->_real_ref_name : $self;
91
92 if ($meta_name->isa($other_name)) {
93 return $meta_name;
94 }
95 elsif ($other_name->isa($meta_name)) {
96 return $other_name;
97 }
98
99 return;
100}
101
10212µs1;
103
104# ABSTRACT: Base class for metaclasses
105
106__END__