ext/B/B/Stash.pm

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