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