← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/pan_genome_post_analysis
  Run on Fri Mar 27 11:43:32 2015
Reported on Fri Mar 27 11:45:33 2015

Filename/Users/ap13/perl5/lib/perl5/Devel/OverloadInfo.pm
StatementsExecuted 21 statements in 925µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111895µs2.81msDevel::OverloadInfo::::BEGIN@19Devel::OverloadInfo::BEGIN@19
111556µs998µsDevel::OverloadInfo::::BEGIN@18Devel::OverloadInfo::BEGIN@18
11124µs24µsDevel::OverloadInfo::::BEGIN@20Devel::OverloadInfo::BEGIN@20
11121µs48µsDevel::OverloadInfo::::BEGIN@14Devel::OverloadInfo::BEGIN@14
11117µs38µsDevel::OverloadInfo::::BEGIN@22Devel::OverloadInfo::BEGIN@22
11112µs21µsDevel::OverloadInfo::::BEGIN@15Devel::OverloadInfo::BEGIN@15
11110µs48µsDevel::OverloadInfo::::BEGIN@17Devel::OverloadInfo::BEGIN@17
1115µs5µ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;
211µ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
14232µs276µ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
use strict;
# spent 48µs making 1 call to Devel::OverloadInfo::BEGIN@14 # spent 28µs making 1 call to strict::import
15234µs230µ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
use warnings;
# spent 21µs making 1 call to Devel::OverloadInfo::BEGIN@15 # spent 9µs making 1 call to warnings::import
16223µs15µ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
use overload ();
# spent 5µs making 1 call to Devel::OverloadInfo::BEGIN@16
17227µs287µ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
use Scalar::Util qw(blessed);
# spent 48µs making 1 call to Devel::OverloadInfo::BEGIN@17 # spent 39µs making 1 call to Exporter::import
182145µs21.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
use Sub::Identify qw(sub_fullname);
# spent 998µs making 1 call to Devel::OverloadInfo::BEGIN@18 # spent 72µs making 1 call to Exporter::import
193228µs32.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
use Package::Stash 0.14;
# 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]
20253µs124µ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
use MRO::Compat;
# spent 24µs making 1 call to Devel::OverloadInfo::BEGIN@20
21
223374µs359µ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
use Exporter 5.57 qw(import);
# 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
2312µsour @EXPORT_OK = qw(overload_info);
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# =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
79sub 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
11517µs1;
116
117__END__