win32/FindExt.pm

   1 package FindExt;
   2
   3 our $VERSION = '1.02';
   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     # adjust results of scan_ext, and also save
  25     # statics in case scan_ext hasn't been called yet.
  26     # if '*' is passed then all XS extensions are static
  27     # (with possible exclusions)
  28     %static = ();
  29     my @list = @_;
  30     if ($_[0] eq '*') {
  31         my %excl = map {$_=>1} map {m/^!(.*)$/} @_[1 .. $#_];
  32         @list = grep {!exists $excl{$_}} keys %ext;
  33     }
  34     for (@list) {
  35         $static{$_} = 1;
  36         $ext{$_} = 'static' if $ext{$_} && $ext{$_} eq 'dynamic';
  37     }
  38 }
  39
  40 sub scan_ext
  41 {
  42  my $here = getcwd();
  43  my $dir  = shift;
  44  chdir($dir) || die "Cannot cd to $dir\n";
  45  ($ext = getcwd()) =~ s,/,\\,g;
  46  find_ext('');
  47  chdir($here) || die "Cannot cd to $here\n";
  48  my @ext = extensions();
  49 }
  50
  51 sub dynamic_ext
  52 {
  53  return sort grep $ext{$_} eq 'dynamic',keys %ext;
  54 }
  55
  56 sub static_ext
  57 {
  58  return sort grep $ext{$_} eq 'static',keys %ext;
  59 }
  60
  61 sub nonxs_ext
  62 {
  63  return sort grep $ext{$_} eq 'nonxs',keys %ext;
  64 }
  65
  66 sub extensions
  67 {
  68  return sort grep $ext{$_} ne 'known',keys %ext;
  69 }
  70
  71 sub known_extensions
  72 {
  73  # faithfully copy Configure in not including nonxs extensions for the nonce
  74  return sort grep $ext{$_} ne 'nonxs',keys %ext;
  75 }
  76
  77 sub is_static
  78 {
  79  return $ext{$_[0]} eq 'static'
  80 }
  81
  82 # Function to recursively find available extensions, ignoring DynaLoader
  83 # NOTE: recursion limit of 10 to prevent runaway in case of symlink madness
  84 sub find_ext
  85 {
  86     opendir my $dh, '.';
  87     my @items = grep { !/^\.\.?$/ } readdir $dh;
  88     closedir $dh;
  89     for my $xxx (@items) {
  90         if ($xxx ne "DynaLoader") {
  91             if (-f "$xxx/$xxx.xs" || -f "$xxx/$xxx.c" ) {
  92                 $ext{"$_[0]$xxx"} = $static{"$_[0]$xxx"} ? 'static' : 'dynamic';
  93             } elsif (-f "$xxx/Makefile.PL") {
  94                 $ext{"$_[0]$xxx"} = 'nonxs';
  95             } else {
  96                 if (-d $xxx && @_ < 10) {
  97                     chdir $xxx;
  98                     find_ext("$_[0]$xxx/", @_);
  99                     chdir "..";
 100                 }
 101             }
 102             $ext{"$_[0]$xxx"} = 'known' if $ext{"$_[0]$xxx"} && $xxx =~ $no;
 103         }
 104     }
 105
 106 # Special case:  Add in modules that nest beyond the first level.
 107 # Currently threads/shared and Hash/Util/FieldHash, since they are
 108 # not picked up by the recursive find above (and adding in general
 109 # recursive finding breaks SDBM_File/sdbm).
 110 # A.D. 20011025 (SDBM), ajgough 20071008 (FieldHash)
 111
 112     if (!$_[0] && -d "threads/shared") {
 113         $ext{"threads/shared"} = 'dynamic';
 114     }
 115     if (!$_[0] && -d "Hash/Util/FieldHash") {
 116         $ext{"Hash/Util/FieldHash"} = 'dynamic';
 117     }
 118 }
 119
 120 1;