win32/FindExt.pm

   1 package FindExt;
   2
   3 our $VERSION = '1.01';
   4
   5 use strict;
   6 use warnings;
   7
   8 my $no = join('|',qw(GDBM_File ODBM_File NDBM_File DB_File
   9                      Syslog SysV Langinfo));
  10 $no = qr/^(?:$no)$/i;
  11
  12 my %ext;
  13 my $ext;
  14 my %static;
  15
  16 sub getcwd {
  17     $_ = `cd`;
  18     chomp;
  19     s:\\:/:g ;
  20     return $ENV{'PWD'} = $_;
  21 }
  22
  23 sub set_static_extensions
  24 {
  25     # adjust results of scan_ext, and also save
  26     # statics in case scan_ext hasn't been called yet.
  27     %static = ();
  28     for (@_) {
  29         $static{$_} = 1;
  30         $ext{$_} = 'static' if $ext{$_} && $ext{$_} eq 'dynamic';
  31     }
  32 }
  33
  34 sub scan_ext
  35 {
  36  my $here = getcwd();
  37  my $dir  = shift;
  38  chdir($dir) || die "Cannot cd to $dir\n";
  39  ($ext = getcwd()) =~ s,/,\\,g;
  40  find_ext('');
  41  chdir($here) || die "Cannot cd to $here\n";
  42  my @ext = extensions();
  43 }
  44
  45 sub dynamic_ext
  46 {
  47  return sort grep $ext{$_} eq 'dynamic',keys %ext;
  48 }
  49
  50 sub static_ext
  51 {
  52  return sort grep $ext{$_} eq 'static',keys %ext;
  53 }
  54
  55 sub nonxs_ext
  56 {
  57  return sort grep $ext{$_} eq 'nonxs',keys %ext;
  58 }
  59
  60 sub extensions
  61 {
  62  return sort grep $ext{$_} ne 'known',keys %ext;
  63 }
  64
  65 sub known_extensions
  66 {
  67  # faithfully copy Configure in not including nonxs extensions for the nonce
  68  return sort grep $ext{$_} ne 'nonxs',keys %ext;
  69 }
  70
  71 sub is_static
  72 {
  73  return $ext{$_[0]} eq 'static'
  74 }
  75
  76 # Function to recursively find available extensions, ignoring DynaLoader
  77 # NOTE: recursion limit of 10 to prevent runaway in case of symlink madness
  78 sub find_ext
  79 {
  80     opendir my $dh, '.';
  81     my @items = grep { !/^\.\.?$/ } readdir $dh;
  82     closedir $dh;
  83     for my $xxx (@items) {
  84         if ($xxx ne "DynaLoader") {
  85             if (-f "$xxx/$xxx.xs" || -f "$xxx/$xxx.c" ) {
  86                 $ext{"$_[0]$xxx"} = $static{"$_[0]$xxx"} ? 'static' : 'dynamic';
  87             } elsif (-f "$xxx/Makefile.PL") {
  88                 $ext{"$_[0]$xxx"} = 'nonxs';
  89             } else {
  90                 if (-d $xxx && @_ < 10) {
  91                     chdir $xxx;
  92                     find_ext("$_[0]$xxx/", @_);
  93                     chdir "..";
  94                 }
  95             }
  96             $ext{"$_[0]$xxx"} = 'known' if $ext{"$_[0]$xxx"} && $xxx =~ $no;
  97         }
  98     }
  99
 100 # Special case:  Add in threads/shared since it is not picked up by the
 101 # recursive find above (and adding in general recursive finding breaks
 102 # SDBM_File/sdbm).  A.D.  10/25/2001.
 103 # Ditto for IO/Compress/Base and IO/Compress/Zlib
 104
 105     if (!$_[0] && -d "threads/shared") {
 106         $ext{"threads/shared"} = 'dynamic';
 107     }
 108     if (!$_[0] && -d "IO/Compress/Base") {
 109         $ext{"IO/Compress/Base"} = 'nonxs';
 110     }
 111     if (!$_[0] && -d "IO/Compress/Zlib") {
 112         $ext{"IO/Compress/Zlib"} = 'nonxs';
 113     }
 114 }
 115
 116 1;