Filename | /Users/ap13/perl5/lib/perl5/Devel/OverloadInfo.pm |
Statements | Executed 21 statements in 925µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 895µs | 2.81ms | BEGIN@19 | Devel::OverloadInfo::
1 | 1 | 1 | 556µs | 998µs | BEGIN@18 | Devel::OverloadInfo::
1 | 1 | 1 | 24µs | 24µs | BEGIN@20 | Devel::OverloadInfo::
1 | 1 | 1 | 21µs | 48µs | BEGIN@14 | Devel::OverloadInfo::
1 | 1 | 1 | 17µs | 38µs | BEGIN@22 | Devel::OverloadInfo::
1 | 1 | 1 | 12µs | 21µs | BEGIN@15 | Devel::OverloadInfo::
1 | 1 | 1 | 10µs | 48µs | BEGIN@17 | Devel::OverloadInfo::
1 | 1 | 1 | 5µs | 5µs | BEGIN@16 | Devel::OverloadInfo::
0 | 0 | 0 | 0s | 0s | overload_info | Devel::OverloadInfo::
0 | 0 | 0 | 0s | 0s | stash_with_symbol | Devel::OverloadInfo::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Devel::OverloadInfo; | ||||
2 | 1 | 1µs | $Devel::OverloadInfo::VERSION = '0.002'; | ||
3 | # ABSTRACT: introspect overloaded operators | ||||
4 | |||||
5 | # =head1 DESCRIPTION | ||||
6 | # | ||||
7 | # Devel::OverloadInfo returns information about L<overloaded|overload> | ||||
8 | # operators for a given class (or object), including where in the | ||||
9 | # inheritance hierarchy the overloads are declared and where the code | ||||
10 | # implementing it is. | ||||
11 | # | ||||
12 | # =cut | ||||
13 | |||||
14 | 2 | 32µs | 2 | 76µs | # spent 48µs (21+28) within Devel::OverloadInfo::BEGIN@14 which was called:
# once (21µs+28µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 14 # spent 48µs making 1 call to Devel::OverloadInfo::BEGIN@14
# spent 28µs making 1 call to strict::import |
15 | 2 | 34µs | 2 | 30µs | # spent 21µs (12+9) within Devel::OverloadInfo::BEGIN@15 which was called:
# once (12µs+9µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 15 # spent 21µs making 1 call to Devel::OverloadInfo::BEGIN@15
# spent 9µs making 1 call to warnings::import |
16 | 2 | 23µs | 1 | 5µs | # spent 5µs within Devel::OverloadInfo::BEGIN@16 which was called:
# once (5µs+0s) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 16 # spent 5µs making 1 call to Devel::OverloadInfo::BEGIN@16 |
17 | 2 | 27µs | 2 | 87µs | # spent 48µs (10+39) within Devel::OverloadInfo::BEGIN@17 which was called:
# once (10µs+39µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 17 # spent 48µs making 1 call to Devel::OverloadInfo::BEGIN@17
# spent 39µs making 1 call to Exporter::import |
18 | 2 | 145µs | 2 | 1.07ms | # spent 998µs (556+441) within Devel::OverloadInfo::BEGIN@18 which was called:
# once (556µs+441µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 18 # spent 998µs making 1 call to Devel::OverloadInfo::BEGIN@18
# spent 72µs making 1 call to Exporter::import |
19 | 3 | 228µs | 3 | 2.84ms | # spent 2.81ms (895µs+1.91) within Devel::OverloadInfo::BEGIN@19 which was called:
# once (895µs+1.91ms) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 19 # spent 2.81ms making 1 call to Devel::OverloadInfo::BEGIN@19
# spent 19µs making 1 call to UNIVERSAL::VERSION
# spent 12µs making 1 call to Package::DeprecationManager::__ANON__[Package/DeprecationManager.pm:61] |
20 | 2 | 53µs | 1 | 24µs | # spent 24µs within Devel::OverloadInfo::BEGIN@20 which was called:
# once (24µs+0s) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 20 # spent 24µs making 1 call to Devel::OverloadInfo::BEGIN@20 |
21 | |||||
22 | 3 | 374µs | 3 | 59µs | # spent 38µs (17+21) within Devel::OverloadInfo::BEGIN@22 which was called:
# once (17µs+21µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 22 # spent 38µs making 1 call to Devel::OverloadInfo::BEGIN@22
# spent 11µs making 1 call to Exporter::import
# spent 10µs making 1 call to UNIVERSAL::VERSION |
23 | 1 | 2µs | our @EXPORT_OK = qw(overload_info); | ||
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 | # =func overload_info | ||||
37 | # | ||||
38 | # my $info = overload_info($class_or_object); | ||||
39 | # | ||||
40 | # Returns a hash reference with information about all the overloaded | ||||
41 | # operators of the argument, which can be either a class name or a blessed | ||||
42 | # object. The keys are the overloaded operators, as specified in | ||||
43 | # C<%overload::ops> (see L<overload/Overloadable Operations>). | ||||
44 | # | ||||
45 | # =over | ||||
46 | # | ||||
47 | # =item class | ||||
48 | # | ||||
49 | # The name of the class in which the operator overloading was declared. | ||||
50 | # | ||||
51 | # =item code | ||||
52 | # | ||||
53 | # A reference to the function implementing the overloaded operator. | ||||
54 | # | ||||
55 | # =item code_name | ||||
56 | # | ||||
57 | # The name of the function implementing the overloaded operator, as | ||||
58 | # returned by C<sub_fullname> in L<Sub::Identify>. | ||||
59 | # | ||||
60 | # =item method_name (optional) | ||||
61 | # | ||||
62 | # The name of the method implementing the overloaded operator, if the | ||||
63 | # overloading was specified as a named method, e.g. C<< use overload $op | ||||
64 | # => 'method'; >>. | ||||
65 | # | ||||
66 | # =item code_class (optional) | ||||
67 | # | ||||
68 | # The name of the class in which the method specified by C<method_name> | ||||
69 | # was found. | ||||
70 | # | ||||
71 | # =item value (optional) | ||||
72 | # | ||||
73 | # For the special C<fallback> key, the value it was given in C<class>. | ||||
74 | # | ||||
75 | # =back | ||||
76 | # | ||||
77 | # =cut | ||||
78 | |||||
79 | sub overload_info { | ||||
80 | my $class = blessed($_[0]) || $_[0]; | ||||
81 | |||||
82 | return undef unless overload::Overloaded($class); | ||||
83 | |||||
84 | my (%overloaded); | ||||
85 | for my $op (map split(/\s+/), values %overload::ops) { | ||||
86 | my $op_method = $op eq 'fallback' ? "()" : "($op"; | ||||
87 | my ($stash, $func) = stash_with_symbol($class, "&$op_method") | ||||
88 | or next; | ||||
89 | my $info = $overloaded{$op} = { | ||||
90 | class => $stash->name, | ||||
91 | }; | ||||
92 | if ($func == \&overload::nil) { | ||||
93 | # Named method or fallback, stored in the scalar slot | ||||
94 | if (my $value_ref = $stash->get_symbol("\$$op_method")) { | ||||
95 | my $value = $$value_ref; | ||||
96 | if ($op eq 'fallback') { | ||||
97 | $info->{value} = $value; | ||||
98 | } else { | ||||
99 | $info->{method_name} = $value; | ||||
100 | if (my ($impl_stash, $impl_func) = stash_with_symbol($class, "&$value")) { | ||||
101 | $info->{code_class} = $impl_stash->name; | ||||
102 | $info->{code} = $impl_func; | ||||
103 | } | ||||
104 | } | ||||
105 | } | ||||
106 | } else { | ||||
107 | $info->{code} = $func; | ||||
108 | } | ||||
109 | $info->{code_name} = sub_fullname($info->{code}) | ||||
110 | if exists $info->{code}; | ||||
111 | } | ||||
112 | return \%overloaded; | ||||
113 | } | ||||
114 | |||||
115 | 1 | 7µs | 1; | ||
116 | |||||
117 | __END__ |