line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sub::Info; |
2
|
1
|
|
|
1
|
|
28452
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
21
|
|
3
|
1
|
|
|
1
|
|
2
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
28
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.001'; |
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
3
|
use Carp qw/croak/; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
30
|
|
8
|
1
|
|
|
1
|
|
15
|
use B(); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
22
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
507
|
use Importer Importer => 'import'; |
|
1
|
|
|
|
|
4071
|
|
|
1
|
|
|
|
|
4
|
|
11
|
|
|
|
|
|
|
our @EXPORT_OK = qw{ sub_info }; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub sub_info { |
14
|
8
|
|
|
8
|
1
|
18739
|
my ($sub, @all_lines) = @_; |
15
|
8
|
|
|
|
|
13
|
my %in = map {$_ => 1} @all_lines; |
|
4
|
|
|
|
|
9
|
|
16
|
|
|
|
|
|
|
|
17
|
8
|
50
|
|
|
|
19
|
croak "sub_info requires a coderef as its first argument" |
18
|
|
|
|
|
|
|
unless ref($sub) eq 'CODE'; |
19
|
|
|
|
|
|
|
|
20
|
8
|
|
|
|
|
21
|
my $cobj = B::svref_2object($sub); |
21
|
8
|
|
|
|
|
22
|
my $name = $cobj->GV->NAME; |
22
|
8
|
|
|
|
|
38
|
my $file = $cobj->FILE; |
23
|
8
|
|
|
|
|
20
|
my $package = $cobj->GV->STASH->NAME; |
24
|
|
|
|
|
|
|
|
25
|
8
|
|
|
|
|
27
|
my $op = $cobj->START; |
26
|
8
|
|
|
|
|
13
|
while ($op) { |
27
|
58
|
100
|
|
|
|
158
|
push @all_lines => $op->line if $op->can('line'); |
28
|
58
|
100
|
|
|
|
108
|
last unless $op->can('next'); |
29
|
50
|
|
|
|
|
153
|
$op = $op->next; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
8
|
|
|
|
|
7
|
my ($start, $end, @lines); |
33
|
8
|
50
|
|
|
|
10
|
if (@all_lines) { |
34
|
8
|
|
|
|
|
13
|
@all_lines = sort { $a <=> $b } @all_lines; |
|
24
|
|
|
|
|
16
|
|
35
|
8
|
|
|
|
|
9
|
($start, $end) = ($all_lines[0], $all_lines[-1]); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Adjust start and end for the most common case of a multi-line block with |
38
|
|
|
|
|
|
|
# parens on the lines before and after. |
39
|
8
|
100
|
|
|
|
13
|
if ($start < $end) { |
40
|
4
|
50
|
66
|
|
|
11
|
$start-- unless $start <= 1 || $in{$start}; |
41
|
4
|
100
|
|
|
|
8
|
$end++ unless $in{$end}; |
42
|
|
|
|
|
|
|
} |
43
|
8
|
|
|
|
|
11
|
@lines = ($start, $end); |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
return { |
47
|
8
|
|
|
|
|
51
|
ref => $sub, |
48
|
|
|
|
|
|
|
cobj => $cobj, |
49
|
|
|
|
|
|
|
name => $name, |
50
|
|
|
|
|
|
|
file => $file, |
51
|
|
|
|
|
|
|
package => $package, |
52
|
|
|
|
|
|
|
start_line => $start, |
53
|
|
|
|
|
|
|
end_line => $end, |
54
|
|
|
|
|
|
|
all_lines => \@all_lines, |
55
|
|
|
|
|
|
|
lines => \@lines, |
56
|
|
|
|
|
|
|
}; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
1; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
__END__ |