← Index
NYTProf Performance Profile   « line view »
For script/ponapi
  Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:10 2016

Filename/usr/local/lib/perl/5.18.2/Class/MOP/Object.pm
StatementsExecuted 4639 statements in 11.7ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1086322.62ms3.62msClass::MOP::Object::::_is_compatible_withClass::MOP::Object::_is_compatible_with
684211.66ms4.04msClass::MOP::Object::::_can_be_made_compatible_withClass::MOP::Object::_can_be_made_compatible_with
1118µs266µsClass::MOP::Object::::_newClass::MOP::Object::_new
1118µs16µsClass::MOP::Object::::BEGIN@4Class::MOP::Object::BEGIN@4
1117µs11µsClass::MOP::Object::::BEGIN@9Class::MOP::Object::BEGIN@9
1116µs23µsClass::MOP::Object::::BEGIN@7Class::MOP::Object::BEGIN@7
1116µs8µsClass::MOP::Object::::BEGIN@5Class::MOP::Object::BEGIN@5
1115µs23µsClass::MOP::Object::::BEGIN@8Class::MOP::Object::BEGIN@8
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;
21500nsour $VERSION = '2.1604';
3
4220µs224µs
# spent 16µs (8+8) within Class::MOP::Object::BEGIN@4 which was called: # once (8µs+8µs) by parent::import at line 4
use strict;
# spent 16µs making 1 call to Class::MOP::Object::BEGIN@4 # spent 8µs making 1 call to strict::import
5221µs211µs
# spent 8µs (6+3) within Class::MOP::Object::BEGIN@5 which was called: # once (6µs+3µs) by parent::import at line 5
use warnings;
# spent 8µs making 1 call to Class::MOP::Object::BEGIN@5 # spent 3µs making 1 call to warnings::import
6
7224µs223µs
# spent 23µs (6+17) within Class::MOP::Object::BEGIN@7 which was called: # once (6µs+17µs) by parent::import at line 7
use parent 'Class::MOP::Mixin';
# spent 23µs making 1 call to Class::MOP::Object::BEGIN@7 # spent 17µs making 1 call to parent::import, recursion: max depth 2, sum of overlapping time 17µs
8286µs241µs
# spent 23µs (5+18) within Class::MOP::Object::BEGIN@8 which was called: # once (5µs+18µs) by parent::import at line 8
use Scalar::Util 'blessed';
# spent 23µs making 1 call to Class::MOP::Object::BEGIN@8 # spent 18µs making 1 call to Exporter::import
92877µs214µs
# spent 11µs (7+4) within Class::MOP::Object::BEGIN@9 which was called: # once (7µs+4µs) by parent::import at line 9
use Module::Runtime;
# spent 11µs making 1 call to Class::MOP::Object::BEGIN@9 # spent 4µ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 266µs (8+258) within Class::MOP::Object::_new which was called: # once (8µs+258µs) by Moose::Meta::TypeConstraint::Registry::new at line 29 of Moose/Meta/TypeConstraint/Registry.pm
sub _new {
2316µs2258µs Class::MOP::class_of(shift)->new_object(@_);
# spent 251µs making 1 call to Class::MOP::Class::new_object # spent 7µ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 3.62ms (2.62+1.00) within Class::MOP::Object::_is_compatible_with which was called 1086 times, avg 3µs/call: # 684 times (1.70ms+687µs) by Class::MOP::Object::_can_be_made_compatible_with at line 56, avg 3µs/call # 342 times (775µs+283µs) by Class::MOP::Class::_single_metaclass_is_compatible at line 286 of Class/MOP/Class.pm, avg 3µs/call # 60 times (139µs+33µs) by Class::MOP::Class::_class_metaclass_is_compatible at line 252 of Class/MOP/Class.pm, avg 3µs/call
sub _is_compatible_with {
481086191µs my $self = shift;
491086199µs my ($other_name) = @_;
50
5110864.09ms10861.00ms return $self->isa($other_name);
# spent 1.00ms making 1086 calls to UNIVERSAL::isa, avg 923ns/call
52}
53
54
# spent 4.04ms (1.66+2.39) within Class::MOP::Object::_can_be_made_compatible_with which was called 684 times, avg 6µs/call: # 577 times (1.28ms+1.93ms) by Class::MOP::Class::_single_metaclass_can_be_made_compatible at line 356 of Class/MOP/Class.pm, avg 6µs/call # 107 times (378µs+460µs) by Class::MOP::Class::_class_metaclass_can_be_made_compatible at line 336 of Class/MOP/Class.pm, avg 8µs/call
sub _can_be_made_compatible_with {
55684131µs my $self = shift;
566846.09ms6842.39ms return !$self->_is_compatible_with(@_)
# spent 2.39ms making 684 calls to Class::MOP::Object::_is_compatible_with, avg 3µ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__