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