line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#line 1 |
2
|
|
|
|
|
|
|
package Devel::InnerPackage; |
3
|
4
|
|
|
4
|
|
29
|
|
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
174
|
|
4
|
4
|
|
|
4
|
|
24
|
use strict; |
|
4
|
|
|
|
|
83
|
|
|
4
|
|
|
|
|
167
|
|
5
|
4
|
|
|
4
|
|
26
|
use Exporter 5.57 'import'; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
246
|
|
6
|
|
|
|
|
|
|
use vars qw($VERSION @EXPORT_OK); |
7
|
4
|
|
|
4
|
|
2432
|
|
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
26
|
|
8
|
|
|
|
|
|
|
use if $] > 5.017, 'deprecate'; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
$VERSION = '0.4'; |
11
|
|
|
|
|
|
|
@EXPORT_OK = qw(list_packages); |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
#line 62 |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub list_packages { |
16
|
|
|
|
|
|
|
my $pack = shift; $pack .= "::" unless $pack =~ m!::$!; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
no strict 'refs'; |
19
|
|
|
|
|
|
|
my @packs; |
20
|
|
|
|
|
|
|
my @stuff = grep !/^(main|)::$/, keys %{$pack}; |
21
|
|
|
|
|
|
|
for my $cand (grep /::$/, @stuff) |
22
|
|
|
|
|
|
|
{ |
23
|
|
|
|
|
|
|
$cand =~ s!::$!!; |
24
|
|
|
|
|
|
|
my @children = list_packages($pack.$cand); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
push @packs, "$pack$cand" unless $cand =~ /^::/ || |
27
|
|
|
|
|
|
|
!__PACKAGE__->_loaded($pack.$cand); # or @children; |
28
|
|
|
|
|
|
|
push @packs, @children; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
return grep {$_ !~ /::(::ISA::CACHE|SUPER)/} @packs; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
### XXX this is an inlining of the Class-Inspector->loaded() |
34
|
|
|
|
|
|
|
### method, but inlined to remove the dependency. |
35
|
|
|
|
|
|
|
sub _loaded { |
36
|
|
|
|
|
|
|
my ($class, $name) = @_; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
no strict 'refs'; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# Handle by far the two most common cases |
41
|
|
|
|
|
|
|
# This is very fast and handles 99% of cases. |
42
|
|
|
|
|
|
|
return 1 if defined ${"${name}::VERSION"}; |
43
|
|
|
|
|
|
|
return 1 if @{"${name}::ISA"}; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# Are there any symbol table entries other than other namespaces |
46
|
|
|
|
|
|
|
foreach ( keys %{"${name}::"} ) { |
47
|
|
|
|
|
|
|
next if substr($_, -2, 2) eq '::'; |
48
|
|
|
|
|
|
|
return 1 if defined &{"${name}::$_"}; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# No functions, and it doesn't have a version, and isn't anything. |
52
|
|
|
|
|
|
|
# As an absolute last resort, check for an entry in %INC |
53
|
|
|
|
|
|
|
my $filename = join( '/', split /(?:'|::)/, $name ) . '.pm'; |
54
|
|
|
|
|
|
|
return 1 if defined $INC{$filename}; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
''; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
#line 123 |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
|
64
|
298
|
50
|
|
298
|
1
|
548
|
|
|
298
|
|
|
|
|
761
|
|
65
|
|
|
|
|
|
|
|
66
|
4
|
|
|
4
|
|
30
|
1; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
1211
|
|