| 1 | package FindExt; |
| 2 | |
| 3 | our $VERSION = '1.03'; |
| 4 | |
| 5 | use strict; |
| 6 | use warnings; |
| 7 | |
| 8 | my $no = join('|',qw(Amiga.* GDBM_File ODBM_File NDBM_File DB_File |
| 9 | VMS.* Sys-Syslog IPC-SysV)); |
| 10 | $no = qr/^(?:$no)$/i; |
| 11 | |
| 12 | sub apply_config { |
| 13 | my ($config) = @_; |
| 14 | my @no; |
| 15 | |
| 16 | push @no, 'Sys-Syslog' if $^O eq 'MSWin32'; |
| 17 | |
| 18 | # duplicates logic from Configure (mostly) |
| 19 | push @no, "DB_File" unless $config->{i_db}; |
| 20 | push @no, "GDBM_File" unless $config->{i_gdbm}; |
| 21 | push @no, "IPC-SysV" unless $config->{d_msg} || $config->{d_sem} || $config->{d_shm}; |
| 22 | push @no, "NDBM_File" unless $config->{d_ndbm}; |
| 23 | push @no, "ODBM_File" |
| 24 | unless ($config->{i_dbm} || $config->{i_rpcsvcdbm}) && !$config->{d_cplusplus}; |
| 25 | push @no, "Amiga.*" unless $^O eq "amigaos"; |
| 26 | push @no, "VMS.*" unless $^O eq "VMS"; |
| 27 | push @no, "Win32.*" unless $^O eq "MSWin32" || $^O eq "cygwin"; |
| 28 | |
| 29 | $no = join('|', @no); |
| 30 | $no = qr/^(?:$no)$/i; |
| 31 | } |
| 32 | |
| 33 | my %ext; |
| 34 | my %static; |
| 35 | |
| 36 | sub set_static_extensions { |
| 37 | # adjust results of scan_ext, and also save |
| 38 | # statics in case scan_ext hasn't been called yet. |
| 39 | # if '*' is passed then all XS extensions are static |
| 40 | # (with possible exclusions) |
| 41 | %static = (); |
| 42 | my @list = @_; |
| 43 | if (@_ and $_[0] eq '*') { |
| 44 | my %excl = map {$_=>1} map {m/^!(.*)$/} @_[1 .. $#_]; |
| 45 | @list = grep {!exists $excl{$_}} keys %ext; |
| 46 | } |
| 47 | for (@list) { |
| 48 | $static{$_} = 1; |
| 49 | $ext{$_} = 'static' if $ext{$_} && $ext{$_} eq 'dynamic'; |
| 50 | } |
| 51 | |
| 52 | # Encode is a special case. If we are building Encode as a static |
| 53 | # extension, we need to explicitly list its subextensions as well. |
| 54 | # For other nested extensions, this is handled automatically by |
| 55 | # the appropriate Makefile.PL. |
| 56 | if ($ext{Encode} && $ext{Encode} eq 'static') { |
| 57 | require File::Find; |
| 58 | File::Find::find({ |
| 59 | no_chdir => 1, |
| 60 | wanted => sub { |
| 61 | return unless m!\b(Encode/.+)/Makefile\.PL!; |
| 62 | $static{$1} = 1; |
| 63 | $ext{$1} = 'static'; |
| 64 | }, |
| 65 | }, "../cpan/Encode"); |
| 66 | } |
| 67 | } |
| 68 | |
| 69 | sub _ext_eq { |
| 70 | my $key = shift; |
| 71 | sub { |
| 72 | sort grep $ext{$_} eq $key, keys %ext; |
| 73 | } |
| 74 | } |
| 75 | |
| 76 | *dynamic_ext = _ext_eq('dynamic'); |
| 77 | *static_ext = _ext_eq('static'); |
| 78 | *nonxs_ext = _ext_eq('nonxs'); |
| 79 | |
| 80 | sub extensions { |
| 81 | sort grep $ext{$_} ne 'known', keys %ext; |
| 82 | } |
| 83 | |
| 84 | sub known_extensions { |
| 85 | sort keys %ext; |
| 86 | } |
| 87 | |
| 88 | sub is_static |
| 89 | { |
| 90 | return $ext{$_[0]} eq 'static' |
| 91 | } |
| 92 | |
| 93 | sub has_xs_or_c { |
| 94 | my $dir = shift; |
| 95 | opendir my $dh, $dir or die "opendir $dir: $!"; |
| 96 | while (defined (my $item = readdir $dh)) { |
| 97 | return 1 if $item =~ /\.xs$/; |
| 98 | return 1 if $item =~ /\.c$/; |
| 99 | } |
| 100 | return 0; |
| 101 | } |
| 102 | |
| 103 | # Function to find available extensions, ignoring DynaLoader |
| 104 | sub scan_ext |
| 105 | { |
| 106 | my $ext_dir = shift; |
| 107 | opendir my $dh, "$ext_dir"; |
| 108 | while (defined (my $item = readdir $dh)) { |
| 109 | next if $item =~ /^\.\.?$/; |
| 110 | next if $item eq "DynaLoader"; |
| 111 | next unless -d "$ext_dir/$item"; |
| 112 | my $this_ext = $item; |
| 113 | my $leaf = $item; |
| 114 | |
| 115 | $this_ext =~ s!-!/!g; |
| 116 | $leaf =~ s/.*-//; |
| 117 | |
| 118 | # List/Util.xs lives in Scalar-List-Utils, Cwd.xs lives in PathTools |
| 119 | $this_ext = 'List/Util' if $this_ext eq 'Scalar/List/Utils'; |
| 120 | $this_ext = 'Cwd' if $this_ext eq 'PathTools'; |
| 121 | |
| 122 | # Temporary hack to cope with smokers that are not clearing directories: |
| 123 | next if $ext{$this_ext}; |
| 124 | |
| 125 | if (has_xs_or_c("$ext_dir/$item")) { |
| 126 | $ext{$this_ext} = $static{$this_ext} ? 'static' : 'dynamic'; |
| 127 | } else { |
| 128 | $ext{$this_ext} = 'nonxs'; |
| 129 | } |
| 130 | $ext{$this_ext} = 'known' if $item =~ $no; |
| 131 | } |
| 132 | } |
| 133 | |
| 134 | 1; |
| 135 | # ex: set ts=8 sts=4 sw=4 et: |