This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
better perl version output in corelist-diff
[perl5.git] / win32 / FindExt.pm
1 package FindExt;
2
3 our $VERSION = '1.02';
4
5 use strict;
6 use warnings;
7
8 my $no = join('|',qw(GDBM_File ODBM_File NDBM_File DB_File
9                      VMS VMS-DCLsym VMS-Stdio Sys-Syslog IPC-SysV I18N-Langinfo));
10 $no = qr/^(?:$no)$/i;
11
12 my %ext;
13 my %static;
14
15 sub set_static_extensions {
16     # adjust results of scan_ext, and also save
17     # statics in case scan_ext hasn't been called yet.
18     # if '*' is passed then all XS extensions are static
19     # (with possible exclusions)
20     %static = ();
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) {
27         $static{$_} = 1;
28         $ext{$_} = 'static' if $ext{$_} && $ext{$_} eq 'dynamic';
29     }
30 }
31
32 sub scan_ext
33 {
34     my $dir  = shift;
35     find_ext("$dir/");
36     extensions();
37 }
38
39 sub _ext_eq {
40     my $key = shift;
41     sub {
42         sort grep $ext{$_} eq $key, keys %ext;
43     }
44 }
45
46 *dynamic_ext = _ext_eq('dynamic');
47 *static_ext = _ext_eq('static');
48 *nonxs_ext = _ext_eq('nonxs');
49
50 sub _ext_ne {
51     my $key = shift;
52     sub {
53         sort grep $ext{$_} ne $key, keys %ext;
54     }
55 }
56
57 *extensions = _ext_ne('known');
58 # faithfully copy Configure in not including nonxs extensions for the nonce
59 *known_extensions = _ext_ne('nonxs');
60
61 sub is_static
62 {
63  return $ext{$_[0]} eq 'static'
64 }
65
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
76 # Function to find available extensions, ignoring DynaLoader
77 sub find_ext
78 {
79     my $ext_dir = shift;
80     opendir my $dh, "$ext_dir";
81     while (defined (my $item = readdir $dh)) {
82         next if $item =~ /^\.\.?$/;
83         next if $item eq "DynaLoader";
84         next unless -d "$ext_dir$item";
85         my $this_ext = $item;
86         my $leaf = $item;
87
88         $this_ext =~ s!-!/!g;
89         $leaf =~ s/.*-//;
90
91         # Temporary hack to cope with smokers that are not clearing directories:
92         next if $ext{$this_ext};
93
94         if (has_xs_or_c("$ext_dir$item")) {
95             $ext{$this_ext} = $static{$this_ext} ? 'static' : 'dynamic';
96         } else {
97             $ext{$this_ext} = 'nonxs';
98         }
99         $ext{$this_ext} = 'known' if $ext{$this_ext} && $item =~ $no;
100     }
101 }
102
103 1;
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: