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