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