RE: How to load a "loadable object" that has a non-default file extension ?
[perl.git] / 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;