summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/B/Stash.pm
blob: 5e60868a28ea7c4b248765b5448327c9e084a8aa (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
# Stash.pm -- show what stashes are loaded
# vishalb@hotmail.com 
package B::Stash;

our $VERSION = '1.00';

=pod

=head1 NAME

B::Stash - show what stashes are loaded

=cut

BEGIN { %Seen = %INC }

CHECK {
	my @arr=scan($main::{"main::"});
       @arr=map{s/\:\:$//;$_ eq "<none>"?():$_;}  @arr;
	print "-umain,-u", join (",-u",@arr) ,"\n";
}
sub scan{
	my $start=shift;
	my $prefix=shift;
	$prefix = '' unless defined $prefix;
	my @return;
	foreach my $key ( keys %{$start}){
#		print $prefix,$key,"\n";
		if ($key =~ /::$/){
			unless ($start  eq ${$start}{$key} or $key eq "B::" ){
		 		push @return, $key unless omit($prefix.$key);
				foreach my $subscan ( scan(${$start}{$key},$prefix.$key)){
		 			push @return, "$key".$subscan; 	
				}
			}
		}
	}
	return @return;
}
sub omit{
	my $module = shift;
	my %omit=("DynaLoader::" => 1 , "XSLoader::" => 1, "CORE::" => 1 ,
		"CORE::GLOBAL::" => 1, "UNIVERSAL::" => 1 );
	return 1 if $omit{$module};
	if ($module eq "IO::" or $module eq "IO::Handle::"){
		$module =~ s/::/\//g;	
		return 1 unless  $INC{$module};
	}

	return 0;
}
1;