← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:05 2021

Filename/usr/local/lib/perl5/site_perl/mach/5.32/Sub/Identify.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sSub::Identify::::BEGIN@3Sub::Identify::BEGIN@3
0000s0sSub::Identify::::BEGIN@4Sub::Identify::BEGIN@4
0000s0sSub::Identify::::BEGIN@6Sub::Identify::BEGIN@6
0000s0sSub::Identify::::__ANON__[:49]Sub::Identify::__ANON__[:49]
0000s0sSub::Identify::::__ANON__[:58]Sub::Identify::__ANON__[:58]
0000s0sSub::Identify::::__ANON__[:70]Sub::Identify::__ANON__[:70]
0000s0sSub::Identify::::get_code_infoSub::Identify::get_code_info (xsub)
0000s0sSub::Identify::::stash_nameSub::Identify::stash_name
0000s0sSub::Identify::::sub_fullnameSub::Identify::sub_fullname
0000s0sSub::Identify::::sub_nameSub::Identify::sub_name
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Sub::Identify;
2
3use strict;
4use Exporter;
5
6BEGIN {
7 our $VERSION = '0.14';
8 our @ISA = ('Exporter');
9 our %EXPORT_TAGS = (
10 all => [
11 our @EXPORT_OK = qw(
12 sub_name
13 stash_name
14 sub_fullname
15 get_code_info
16 get_code_location
17 is_sub_constant
18 )
19 ]
20 );
21
22 our $IsPurePerl = 1;
23 unless ($ENV{PERL_SUB_IDENTIFY_PP}) {
24 if (
25 eval {
26 require XSLoader;
27 XSLoader::load(__PACKAGE__, $VERSION);
28 1;
29 }
30 ) {
31 $IsPurePerl = 0;
32 }
33 else {
34 die $@ if $@ && $@ !~ /object version|loadable object/;
35 }
36 }
37
38 if ($IsPurePerl) {
39 require B;
40 *get_code_info = sub ($) {
41 my ($coderef) = @_;
42 ref $coderef or return;
43 my $cv = B::svref_2object($coderef);
44 $cv->isa('B::CV') or return;
45 # bail out if GV is undefined
46 $cv->GV->isa('B::SPECIAL') and return;
47
48 return ($cv->GV->STASH->NAME, $cv->GV->NAME);
49 };
50 *get_code_location = sub ($) {
51 my ($coderef) = @_;
52 ref $coderef or return;
53 my $cv = B::svref_2object($coderef);
54 $cv->isa('B::CV') && $cv->START->isa('B::COP')
55 or return;
56
57 return ($cv->START->file, $cv->START->line);
58 };
59 }
60 if ($IsPurePerl || $] < 5.016) {
61 require B;
62 *is_sub_constant = sub ($) {
63 my ($coderef) = @_;
64 ref $coderef or return 0;
65 my $cv = B::svref_2object($coderef);
66 $cv->isa('B::CV') or return 0;
67 my $p = prototype $coderef;
68 defined $p && $p eq "" or return 0;
69 return ($cv->CvFLAGS & B::CVf_CONST()) == B::CVf_CONST();
70 };
71 }
72}
73
74sub stash_name ($) { (get_code_info($_[0]))[0] }
75sub sub_name ($) { (get_code_info($_[0]))[1] }
76sub sub_fullname ($) { join '::', get_code_info($_[0]) }
77
781;
79
80__END__