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 |
b699af07 | 9 | VMS VMS-DCLsym VMS-Stdio Sys-Syslog IPC-SysV I18N-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; |
1f8a0b38 | 35 | find_ext("$dir/"); |
d57db09d | 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 | ||
0a3660e3 | 66 | sub has_xs_or_c { |
67 | my $dir = shift; | |
68 | opendir my $dh, $dir or die "opendir $dir: $!"; | |
69 | while (defined (my $item = readdir $dh)) { | |
70 | return 1 if $item =~ /\.xs$/; | |
71 | return 1 if $item =~ /\.c$/; | |
72 | } | |
73 | return 0; | |
74 | } | |
75 | ||
1f8a0b38 | 76 | # Function to find available extensions, ignoring DynaLoader |
8e232993 | 77 | sub find_ext |
78 | { | |
3380c781 | 79 | my $ext_dir = shift; |
1f8a0b38 | 80 | opendir my $dh, "$ext_dir"; |
3380c781 | 81 | while (defined (my $item = readdir $dh)) { |
82 | next if $item =~ /^\.\.?$/; | |
83 | next if $item eq "DynaLoader"; | |
1f8a0b38 | 84 | next unless -d "$ext_dir$item"; |
85 | my $this_ext = $item; | |
f44bdcee | 86 | my $leaf = $item; |
87 | ||
88 | $this_ext =~ s!-!/!g; | |
89 | $leaf =~ s/.*-//; | |
90 | ||
4d33dfde | 91 | # Temporary hack to cope with smokers that are not clearing directories: |
92 | next if $ext{$this_ext}; | |
93 | ||
88a6f4fc | 94 | if (has_xs_or_c("$ext_dir$item")) { |
3380c781 | 95 | $ext{$this_ext} = $static{$this_ext} ? 'static' : 'dynamic'; |
3380c781 | 96 | } else { |
1f8a0b38 | 97 | $ext{$this_ext} = 'nonxs'; |
ca58f2ae | 98 | } |
3380c781 | 99 | $ext{$this_ext} = 'known' if $ext{$this_ext} && $item =~ $no; |
ca58f2ae | 100 | } |
8e232993 | 101 | } |
102 | ||
103 | 1; | |
3380c781 | 104 | # Local variables: |
105 | # cperl-indent-level: 4 | |
106 | # indent-tabs-mode: nil | |
107 | # End: | |
108 | # | |
109 | # ex: set ts=8 sts=4 sw=4 et: |