Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # Stash.pm -- show what stashes are loaded |
2 | # vishalb@hotmail.com | |
3 | package B::Stash; | |
4 | ||
5 | our $VERSION = '1.00'; | |
6 | ||
7 | =pod | |
8 | ||
9 | =head1 NAME | |
10 | ||
11 | B::Stash - show what stashes are loaded | |
12 | ||
13 | =cut | |
14 | ||
15 | BEGIN { %Seen = %INC } | |
16 | ||
17 | CHECK { | |
18 | my @arr=scan($main::{"main::"}); | |
19 | @arr=map{s/\:\:$//;$_ eq "<none>"?():$_;} @arr; | |
20 | print "-umain,-u", join (",-u",@arr) ,"\n"; | |
21 | } | |
22 | sub scan{ | |
23 | my $start=shift; | |
24 | my $prefix=shift; | |
25 | $prefix = '' unless defined $prefix; | |
26 | my @return; | |
27 | foreach my $key ( keys %{$start}){ | |
28 | # print $prefix,$key,"\n"; | |
29 | if ($key =~ /::$/){ | |
30 | unless ($start eq ${$start}{$key} or $key eq "B::" ){ | |
31 | push @return, $key unless omit($prefix.$key); | |
32 | foreach my $subscan ( scan(${$start}{$key},$prefix.$key)){ | |
33 | push @return, "$key".$subscan; | |
34 | } | |
35 | } | |
36 | } | |
37 | } | |
38 | return @return; | |
39 | } | |
40 | sub omit{ | |
41 | my $module = shift; | |
42 | my %omit=("DynaLoader::" => 1 , "XSLoader::" => 1, "CORE::" => 1 , | |
43 | "CORE::GLOBAL::" => 1, "UNIVERSAL::" => 1 ); | |
44 | return 1 if $omit{$module}; | |
45 | if ($module eq "IO::" or $module eq "IO::Handle::"){ | |
46 | $module =~ s/::/\//g; | |
47 | return 1 unless $INC{$module}; | |
48 | } | |
49 | ||
50 | return 0; | |
51 | } | |
52 | 1; |