← 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/share/perl/5.18.2/Devel/OverloadInfo.pm
StatementsExecuted 205 statements in 1.19ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
9211541µs2.87msDevel::OverloadInfo::::is_overloadedDevel::OverloadInfo::is_overloaded
111396µs604µsDevel::OverloadInfo::::BEGIN@18Devel::OverloadInfo::BEGIN@18
111264µs885µsDevel::OverloadInfo::::BEGIN@19Devel::OverloadInfo::BEGIN@19
1119µs22µsDevel::OverloadInfo::::BEGIN@22Devel::OverloadInfo::BEGIN@22
1118µs18µsDevel::OverloadInfo::::BEGIN@14Devel::OverloadInfo::BEGIN@14
1116µs9µsDevel::OverloadInfo::::BEGIN@15Devel::OverloadInfo::BEGIN@15
1115µs23µsDevel::OverloadInfo::::BEGIN@17Devel::OverloadInfo::BEGIN@17
1114µs4µsDevel::OverloadInfo::::BEGIN@20Devel::OverloadInfo::BEGIN@20
1112µs2µsDevel::OverloadInfo::::BEGIN@16Devel::OverloadInfo::BEGIN@16
0000s0sDevel::OverloadInfo::::overload_infoDevel::OverloadInfo::overload_info
0000s0sDevel::OverloadInfo::::stash_with_symbolDevel::OverloadInfo::stash_with_symbol
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Devel::OverloadInfo;
21500ns$Devel::OverloadInfo::VERSION = '0.004';
3# ABSTRACT: introspect overloaded operators
4
5#pod =head1 DESCRIPTION
6#pod
7#pod Devel::OverloadInfo returns information about L<overloaded|overload>
8#pod operators for a given class (or object), including where in the
9#pod inheritance hierarchy the overloads are declared and where the code
10#pod implementing it is.
11#pod
12#pod =cut
13
14219µs227µs
# spent 18µs (8+9) within Devel::OverloadInfo::BEGIN@14 which was called: # once (8µs+9µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 14
use strict;
# spent 18µs making 1 call to Devel::OverloadInfo::BEGIN@14 # spent 9µs making 1 call to strict::import
15216µs212µs
# spent 9µs (6+3) within Devel::OverloadInfo::BEGIN@15 which was called: # once (6µs+3µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 15
use warnings;
# spent 9µs making 1 call to Devel::OverloadInfo::BEGIN@15 # spent 3µs making 1 call to warnings::import
16217µs12µs
# spent 2µs within Devel::OverloadInfo::BEGIN@16 which was called: # once (2µs+0s) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 16
use overload ();
# spent 2µs making 1 call to Devel::OverloadInfo::BEGIN@16
17220µs242µs
# spent 23µs (5+18) within Devel::OverloadInfo::BEGIN@17 which was called: # once (5µs+18µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 17
use Scalar::Util qw(blessed);
# spent 23µs making 1 call to Devel::OverloadInfo::BEGIN@17 # spent 18µs making 1 call to Exporter::import
18282µs2634µs
# spent 604µs (396+208) within Devel::OverloadInfo::BEGIN@18 which was called: # once (396µs+208µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 18
use Sub::Identify qw(sub_fullname);
# spent 604µs making 1 call to Devel::OverloadInfo::BEGIN@18 # spent 30µs making 1 call to Exporter::import
19391µs2892µs
# spent 885µs (264+621) within Devel::OverloadInfo::BEGIN@19 which was called: # once (264µs+621µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 19
use Package::Stash 0.14;
# spent 885µs making 1 call to Devel::OverloadInfo::BEGIN@19 # spent 7µs making 1 call to UNIVERSAL::VERSION
20223µs14µs
# spent 4µs within Devel::OverloadInfo::BEGIN@20 which was called: # once (4µs+0s) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 20
use MRO::Compat;
# spent 4µs making 1 call to Devel::OverloadInfo::BEGIN@20
21
223330µs334µs
# spent 22µs (9+12) within Devel::OverloadInfo::BEGIN@22 which was called: # once (9µs+12µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 22
use Exporter 5.57 qw(import);
# spent 22µs making 1 call to Devel::OverloadInfo::BEGIN@22 # spent 6µs making 1 call to UNIVERSAL::VERSION # spent 6µs making 1 call to Exporter::import
231900nsour @EXPORT_OK = qw(overload_info is_overloaded);
24
25sub stash_with_symbol {
26 my ($class, $symbol) = @_;
27
28 for my $package (@{mro::get_linear_isa($class)}) {
29 my $stash = Package::Stash->new($package);
30 my $value_ref = $stash->get_symbol($symbol);
31 return ($stash, $value_ref) if $value_ref;
32 }
33 return;
34}
35
36#pod =func is_overloaded
37#pod
38#pod if (is_overloaded($class_or_object)) { ... }
39#pod
40#pod Returns a boolean indicating whether the given class or object has any
41#pod overloading declared. Note that a bare C<use overload;> with no
42#pod actual operators counts as being overloaded.
43#pod
44#pod Equivalent to
45#pod L<overload::Overloaded()|overload/overload::Overloaded(arg)>, but
46#pod doesn't trigger various bugs associated with it in versions of perl
47#pod before 5.16.
48#pod
49#pod =cut
50
51
# spent 2.87ms (541µs+2.33) within Devel::OverloadInfo::is_overloaded which was called 92 times, avg 31µs/call: # 92 times (541µs+2.33ms) by Class::MOP::Mixin::HasOverloads::is_overloaded at line 19 of Class/MOP/Mixin/HasOverloads.pm, avg 31µs/call
sub is_overloaded {
5292208µs9230µs my $class = blessed($_[0]) || $_[0];
# spent 30µs making 92 calls to Scalar::Util::blessed, avg 330ns/call
53
54 # Perl before 5.16 seems to corrupt inherited overload info if
55 # there's a lone dereference overload and overload::Overloaded()
56 # is called before any object has been blessed into the class.
5792382µs922.30ms return !!("$]" >= 5.016
# spent 2.30ms making 92 calls to overload::Overloaded, avg 25µs/call
58 ? overload::Overloaded($class)
59 : stash_with_symbol($class, '&()')
60 );
61}
62
63#pod =func overload_info
64#pod
65#pod my $info = overload_info($class_or_object);
66#pod
67#pod Returns a hash reference with information about all the overloaded
68#pod operators of the argument, which can be either a class name or a blessed
69#pod object. The keys are the overloaded operators, as specified in
70#pod C<%overload::ops> (see L<overload/Overloadable Operations>).
71#pod
72#pod =over
73#pod
74#pod =item class
75#pod
76#pod The name of the class in which the operator overloading was declared.
77#pod
78#pod =item code
79#pod
80#pod A reference to the function implementing the overloaded operator.
81#pod
82#pod =item code_name
83#pod
84#pod The name of the function implementing the overloaded operator, as
85#pod returned by C<sub_fullname> in L<Sub::Identify>.
86#pod
87#pod =item method_name (optional)
88#pod
89#pod The name of the method implementing the overloaded operator, if the
90#pod overloading was specified as a named method, e.g. C<< use overload $op
91#pod => 'method'; >>.
92#pod
93#pod =item code_class (optional)
94#pod
95#pod The name of the class in which the method specified by C<method_name>
96#pod was found.
97#pod
98#pod =item value (optional)
99#pod
100#pod For the special C<fallback> key, the value it was given in C<class>.
101#pod
102#pod =back
103#pod
104#pod =cut
105
106sub overload_info {
107 my $class = blessed($_[0]) || $_[0];
108
109 return {} unless is_overloaded($class);
110
111 my (%overloaded);
112 for my $op (map split(/\s+/), values %overload::ops) {
113 my $op_method = $op eq 'fallback' ? "()" : "($op";
114 my ($stash, $func) = stash_with_symbol($class, "&$op_method")
115 or next;
116 my $info = $overloaded{$op} = {
117 class => $stash->name,
118 };
119 if ($func == \&overload::nil) {
120 # Named method or fallback, stored in the scalar slot
121 if (my $value_ref = $stash->get_symbol("\$$op_method")) {
122 my $value = $$value_ref;
123 if ($op eq 'fallback') {
124 $info->{value} = $value;
125 } else {
126 $info->{method_name} = $value;
127 if (my ($impl_stash, $impl_func) = stash_with_symbol($class, "&$value")) {
128 $info->{code_class} = $impl_stash->name;
129 $info->{code} = $impl_func;
130 }
131 }
132 }
133 } else {
134 $info->{code} = $func;
135 }
136 $info->{code_name} = sub_fullname($info->{code})
137 if exists $info->{code};
138 }
139 return \%overloaded;
140}
141
142#pod =head1 CAVEATS
143#pod
144#pod Whether the C<fallback> key exists when it has its default value of
145#pod C<undef> varies between perl versions: Before 5.18 it's there, in
146#pod later versions it's not.
147#pod
148#pod =cut
149
15012µs1;
151
152__END__