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