Profile of Devel/OverloadInfo.pm

← 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
Statements | Executed 205 statements in 1.19ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
92 | 1 | 1 | 541µs | 2.87ms | Devel::OverloadInfo::::is_overloadedDevel::OverloadInfo::is_overloaded
1 | 1 | 1 | 396µs | 604µs | Devel::OverloadInfo::::BEGIN@18Devel::OverloadInfo::BEGIN@18
1 | 1 | 1 | 264µs | 885µs | Devel::OverloadInfo::::BEGIN@19Devel::OverloadInfo::BEGIN@19
1 | 1 | 1 | 9µs | 22µs | Devel::OverloadInfo::::BEGIN@22Devel::OverloadInfo::BEGIN@22
1 | 1 | 1 | 8µs | 18µs | Devel::OverloadInfo::::BEGIN@14Devel::OverloadInfo::BEGIN@14
1 | 1 | 1 | 6µs | 9µs | Devel::OverloadInfo::::BEGIN@15Devel::OverloadInfo::BEGIN@15
1 | 1 | 1 | 5µs | 23µs | Devel::OverloadInfo::::BEGIN@17Devel::OverloadInfo::BEGIN@17
1 | 1 | 1 | 4µs | 4µs | Devel::OverloadInfo::::BEGIN@20Devel::OverloadInfo::BEGIN@20
1 | 1 | 1 | 2µs | 2µs | Devel::OverloadInfo::::BEGIN@16Devel::OverloadInfo::BEGIN@16
0 | 0 | 0 | 0s | 0s | Devel::OverloadInfo::::overload_infoDevel::OverloadInfo::overload_info
0 | 0 | 0 | 0s | 0s | Devel::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
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Devel::OverloadInfo;
2 | 1 | 500ns |  |  | $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 |  |  |  |  |
14 | 2 | 19µs | 2 | 27µ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
15 | 2 | 16µs | 2 | 12µ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
16 | 2 | 17µs | 1 | 2µ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
17 | 2 | 20µs | 2 | 42µ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
18 | 2 | 82µs | 2 | 634µ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
19 | 3 | 91µs | 2 | 892µ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
20 | 2 | 23µs | 1 | 4µ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 |  |  |  |  |
22 | 3 | 330µs | 3 | 34µ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
23 | 1 | 900ns |  |  | our @EXPORT_OK = qw(overload_info is_overloaded);
24 |  |  |  |  |
25 |  |  |  |  | sub 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 {
52 | 92 | 208µs | 92 | 30µ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.
57 | 92 | 382µs | 92 | 2.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 |  |  |  |  |
106 |  |  |  |  | sub 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 |  |  |  |  |
150 | 1 | 2µs |  |  | 1;
151 |  |  |  |  |
152 |  |  |  |  | __END__