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 |
030a108e |
9 | VMS Syslog IPC-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 | |
442749d5 |
39 | sub _ext_eq { |
40 | my $key = shift; |
41 | sub { |
42 | sort grep $ext{$_} eq $key, keys %ext; |
43 | } |
ca58f2ae |
44 | } |
45 | |
442749d5 |
46 | *dynamic_ext = _ext_eq('dynamic'); |
47 | *static_ext = _ext_eq('static'); |
48 | *nonxs_ext = _ext_eq('nonxs'); |
8e232993 |
49 | |
442749d5 |
50 | sub _ext_ne { |
51 | my $key = shift; |
52 | sub { |
53 | sort grep $ext{$_} ne $key, keys %ext; |
54 | } |
ca58f2ae |
55 | } |
56 | |
442749d5 |
57 | *extensions = _ext_ne('known'); |
58 | # faithfully copy Configure in not including nonxs extensions for the nonce |
59 | *known_extensions = _ext_ne('nonxs'); |
ca58f2ae |
60 | |
61 | sub is_static |
62 | { |
63 | return $ext{$_[0]} eq 'static' |
8e232993 |
64 | } |
65 | |
ca58f2ae |
66 | # Function to recursively find available extensions, ignoring DynaLoader |
67 | # NOTE: recursion limit of 10 to prevent runaway in case of symlink madness |
8e232993 |
68 | sub find_ext |
69 | { |
3380c781 |
70 | my $ext_dir = shift; |
d57db09d |
71 | my $prefix = shift; |
3380c781 |
72 | opendir my $dh, "$ext_dir$prefix"; |
73 | while (defined (my $item = readdir $dh)) { |
74 | next if $item =~ /^\.\.?$/; |
75 | next if $item eq "DynaLoader"; |
f44bdcee |
76 | my $this_ext = my $this_ext_dir = "$prefix$item"; |
77 | my $leaf = $item; |
78 | |
79 | $this_ext =~ s!-!/!g; |
80 | $leaf =~ s/.*-//; |
81 | |
82 | if (-f "$ext_dir$this_ext_dir/$leaf.xs" || -f "$ext_dir$this_ext_dir/$leaf.c" ) { |
3380c781 |
83 | $ext{$this_ext} = $static{$this_ext} ? 'static' : 'dynamic'; |
f44bdcee |
84 | } elsif (-f "$ext_dir$this_ext_dir/Makefile.PL") { |
3380c781 |
85 | $ext{$this_ext} = 'nonxs'; |
86 | } else { |
87 | # It's not actually an extension. So recurse into it. |
f44bdcee |
88 | if (-d "$ext_dir$this_ext_dir" && $prefix =~ tr#/## < 10) { |
89 | find_ext($ext_dir, "$this_ext_dir/"); |
ca58f2ae |
90 | } |
ca58f2ae |
91 | } |
3380c781 |
92 | $ext{$this_ext} = 'known' if $ext{$this_ext} && $item =~ $no; |
ca58f2ae |
93 | } |
94 | |
9788a75a |
95 | # Special case: Add in modules that nest beyond the first level. |
96 | # Currently threads/shared and Hash/Util/FieldHash, since they are |
97 | # not picked up by the recursive find above (and adding in general |
98 | # recursive finding breaks SDBM_File/sdbm). |
99 | # A.D. 20011025 (SDBM), ajgough 20071008 (FieldHash) |
ca58f2ae |
100 | |
3380c781 |
101 | if (!$prefix && -d "${ext_dir}threads/shared") { |
ca58f2ae |
102 | $ext{"threads/shared"} = 'dynamic'; |
8e232993 |
103 | } |
3380c781 |
104 | if (!$prefix && -d "${ext_dir}Hash/Util/FieldHash") { |
9788a75a |
105 | $ext{"Hash/Util/FieldHash"} = 'dynamic'; |
106 | } |
8e232993 |
107 | } |
108 | |
109 | 1; |
3380c781 |
110 | # Local variables: |
111 | # cperl-indent-level: 4 |
112 | # indent-tabs-mode: nil |
113 | # End: |
114 | # |
115 | # ex: set ts=8 sts=4 sw=4 et: |