summaryrefslogtreecommitdiff
path: root/win32/FindExt.pm
blob: 4d4682171cc273eec2d6da28edf8a742294eaac7 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
package FindExt;

our $VERSION = '1.03';

use strict;
use warnings;

my $no = join('|',qw(Amiga.* GDBM_File ODBM_File NDBM_File DB_File
                     VMS.* Sys-Syslog IPC-SysV));
$no = qr/^(?:$no)$/i;

sub apply_config {
    my ($config) = @_;
    my @no;

    push @no, 'Sys-Syslog' if $^O eq 'MSWin32';

    # duplicates logic from Configure (mostly)
    push @no, "DB_File" unless $config->{i_db};
    push @no, "GDBM_File" unless $config->{i_gdbm};
    push @no, "IPC-SysV" unless $config->{d_msg} || $config->{d_sem} || $config->{d_shm};
    push @no, "NDBM_File" unless $config->{d_ndbm};
    push @no, "ODBM_File"
      unless ($config->{i_dbm} || $config->{i_rpcsvcdbm}) && !$config->{d_cplusplus};
    push @no, "Amiga.*" unless $^O eq "amigaos";
    push @no, "VMS.*" unless $^O eq "VMS";
    push @no, "Win32.*" unless $^O eq "MSWin32" || $^O eq "cygwin";

    $no = join('|', @no);
    $no = qr/^(?:$no)$/i;
}

my %ext;
my %static;

sub set_static_extensions {
    # adjust results of scan_ext, and also save
    # statics in case scan_ext hasn't been called yet.
    # if '*' is passed then all XS extensions are static
    # (with possible exclusions)
    %static = ();
    my @list = @_;
    if (@_ and $_[0] eq '*') {
	my %excl = map {$_=>1} map {m/^!(.*)$/} @_[1 .. $#_];
	@list = grep {!exists $excl{$_}} keys %ext;
    }
    for (@list) {
        $static{$_} = 1;
        $ext{$_} = 'static' if $ext{$_} && $ext{$_} eq 'dynamic';
    }

    # Encode is a special case.  If we are building Encode as a static
    # extension, we need to explicitly list its subextensions as well.
    # For other nested extensions, this is handled automatically by
    # the appropriate Makefile.PL.
    if ($ext{Encode} && $ext{Encode} eq 'static') {
        require File::Find;
        File::Find::find({
                          no_chdir => 1,
                          wanted => sub {
                              return unless m!\b(Encode/.+)/Makefile\.PL!;
                              $static{$1} = 1;
                              $ext{$1} = 'static';
                          },
                         }, "../cpan/Encode");
    }
}

sub _ext_eq {
    my $key = shift;
    sub {
        sort grep $ext{$_} eq $key, keys %ext;
    }
}

*dynamic_ext = _ext_eq('dynamic');
*static_ext = _ext_eq('static');
*nonxs_ext = _ext_eq('nonxs');

sub extensions {
    sort grep $ext{$_} ne 'known', keys %ext;
}

sub known_extensions {
    sort keys %ext;
}

sub is_static
{
 return $ext{$_[0]} eq 'static'
}

sub has_xs_or_c {
    my $dir = shift;
    opendir my $dh, $dir or die "opendir $dir: $!";
    while (defined (my $item = readdir $dh)) {
        return 1 if $item =~ /\.xs$/;
        return 1 if $item =~ /\.c$/;
    }
    return 0;
}

# Function to find available extensions, ignoring DynaLoader
sub scan_ext
{
    my $ext_dir = shift;
    opendir my $dh, "$ext_dir";
    while (defined (my $item = readdir $dh)) {
        next if $item =~ /^\.\.?$/;
        next if $item eq "DynaLoader";
        next unless -d "$ext_dir/$item";
        my $this_ext = $item;
        my $leaf = $item;

        $this_ext =~ s!-!/!g;
        $leaf =~ s/.*-//;

        # List/Util.xs lives in Scalar-List-Utils, Cwd.xs lives in PathTools
        $this_ext = 'List/Util' if $this_ext eq 'Scalar/List/Utils';
        $this_ext = 'Cwd'       if $this_ext eq 'PathTools';

	# Temporary hack to cope with smokers that are not clearing directories:
        next if $ext{$this_ext};

        if (has_xs_or_c("$ext_dir/$item")) {
            $ext{$this_ext} = $static{$this_ext} ? 'static' : 'dynamic';
        } else {
            $ext{$this_ext} = 'nonxs';
        }
        $ext{$this_ext} = 'known' if $item =~ $no;
    }
}

1;
# ex: set ts=8 sts=4 sw=4 et: