ext/B/B/Stash.pm

   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;