Commit | Line | Data |
---|---|---|
8e232993 | 1 | package FindExt; |
28b605d8 | 2 | |
a1f2e719 | 3 | our $VERSION = '1.02'; |
28b605d8 | 4 | |
8e232993 | 5 | use strict; |
ca58f2ae | 6 | use warnings; |
8e232993 | 7 | |
ca58f2ae | 8 | my $no = join('|',qw(GDBM_File ODBM_File NDBM_File DB_File |
86c8d741 | 9 | Syslog SysV Langinfo)); |
8e232993 NIS |
10 | $no = qr/^(?:$no)$/i; |
11 | ||
12 | my %ext; | |
13 | my $ext; | |
ca58f2ae YST |
14 | my %static; |
15 | ||
16 | sub getcwd { | |
cf2f24a4 JD |
17 | $_ = `cd`; |
18 | chomp; | |
19 | s:\\:/:g ; | |
20 | return $ENV{'PWD'} = $_; | |
ca58f2ae YST |
21 | } |
22 | ||
a1f2e719 | 23 | sub set_static_extensions { |
ca58f2ae YST |
24 | # adjust results of scan_ext, and also save |
25 | # statics in case scan_ext hasn't been called yet. | |
a1f2e719 VK |
26 | # if '*' is passed then all XS extensions are static |
27 | # (with possible exclusions) | |
ca58f2ae | 28 | %static = (); |
a1f2e719 VK |
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) { | |
ca58f2ae YST |
35 | $static{$_} = 1; |
36 | $ext{$_} = 'static' if $ext{$_} && $ext{$_} eq 'dynamic'; | |
37 | } | |
38 | } | |
39 | ||
8e232993 NIS |
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; | |
ca58f2ae | 46 | find_ext(''); |
8e232993 NIS |
47 | chdir($here) || die "Cannot cd to $here\n"; |
48 | my @ext = extensions(); | |
49 | } | |
50 | ||
ca58f2ae YST |
51 | sub dynamic_ext |
52 | { | |
53 | return sort grep $ext{$_} eq 'dynamic',keys %ext; | |
54 | } | |
55 | ||
56 | sub static_ext | |
8e232993 | 57 | { |
ca58f2ae | 58 | return sort grep $ext{$_} eq 'static',keys %ext; |
8e232993 NIS |
59 | } |
60 | ||
ca58f2ae | 61 | sub nonxs_ext |
8e232993 | 62 | { |
ca58f2ae | 63 | return sort grep $ext{$_} eq 'nonxs',keys %ext; |
8e232993 NIS |
64 | } |
65 | ||
66 | sub extensions | |
67 | { | |
ca58f2ae YST |
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' | |
8e232993 NIS |
80 | } |
81 | ||
ca58f2ae YST |
82 | # Function to recursively find available extensions, ignoring DynaLoader |
83 | # NOTE: recursion limit of 10 to prevent runaway in case of symlink madness | |
8e232993 NIS |
84 | sub find_ext |
85 | { | |
679f4c1f SH |
86 | opendir my $dh, '.'; |
87 | my @items = grep { !/^\.\.?$/ } readdir $dh; | |
88 | closedir $dh; | |
89 | for my $xxx (@items) { | |
ca58f2ae | 90 | if ($xxx ne "DynaLoader") { |
78ff2d7b | 91 | if (-f "$xxx/$xxx.xs" || -f "$xxx/$xxx.c" ) { |
ca58f2ae YST |
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 | ||
9788a75a SH |
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) | |
ca58f2ae YST |
111 | |
112 | if (!$_[0] && -d "threads/shared") { | |
113 | $ext{"threads/shared"} = 'dynamic'; | |
8e232993 | 114 | } |
9788a75a SH |
115 | if (!$_[0] && -d "Hash/Util/FieldHash") { |
116 | $ext{"Hash/Util/FieldHash"} = 'dynamic'; | |
117 | } | |
8e232993 NIS |
118 | } |
119 | ||
120 | 1; |