1package FindExt; 2 3our $VERSION = '1.02'; 4 5use strict; 6use warnings; 7 8my $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 12sub apply_config { 13 my ($config) = @_; 14 my @no; 15 16 # duplicates logic from Configure (mostly) 17 push @no, "DB_File" unless $config->{i_db}; 18 push @no, "GDBM_File" unless $config->{i_gdbm}; 19 push @no, "I18N-Langinfo" unless $config->{i_langinfo} && $config->{i_nl_langinfo}; 20 push @no, "IPC-SysV" unless $config->{d_msg} || $config->{d_sem} || $config->{d_shm}; 21 push @no, "NDBM_File" unless $config->{d_ndbm}; 22 push @no, "ODBM_File" 23 unless ($config->{i_dbm} || $config->{i_rpcsvcdbm}) && !$config->{d_cplusplus}; 24 push @no, "VMS.*" unless $^O eq "VMS"; 25 push @no, "Win32.*" unless $^O eq "MSWin32" || $^O eq "cygwin"; 26 27 $no = join('|', @no); 28 $no = qr/^(?:$no)$/i; 29} 30 31my %ext; 32my %static; 33 34sub set_static_extensions { 35 # adjust results of scan_ext, and also save 36 # statics in case scan_ext hasn't been called yet. 37 # if '*' is passed then all XS extensions are static 38 # (with possible exclusions) 39 %static = (); 40 my @list = @_; 41 if (@_ and $_[0] eq '*') { 42 my %excl = map {$_=>1} map {m/^!(.*)$/} @_[1 .. $#_]; 43 @list = grep {!exists $excl{$_}} keys %ext; 44 } 45 for (@list) { 46 $static{$_} = 1; 47 $ext{$_} = 'static' if $ext{$_} && $ext{$_} eq 'dynamic'; 48 } 49} 50 51sub scan_ext 52{ 53 my $dir = shift; 54 find_ext("$dir/"); 55 extensions(); 56} 57 58sub _ext_eq { 59 my $key = shift; 60 sub { 61 sort grep $ext{$_} eq $key, keys %ext; 62 } 63} 64 65*dynamic_ext = _ext_eq('dynamic'); 66*static_ext = _ext_eq('static'); 67*nonxs_ext = _ext_eq('nonxs'); 68 69sub _ext_ne { 70 my $key = shift; 71 sub { 72 sort grep $ext{$_} ne $key, keys %ext; 73 } 74} 75 76*extensions = _ext_ne('known'); 77# faithfully copy Configure in not including nonxs extensions for the nonce 78*known_extensions = _ext_ne('nonxs'); 79 80sub is_static 81{ 82 return $ext{$_[0]} eq 'static' 83} 84 85sub has_xs_or_c { 86 my $dir = shift; 87 opendir my $dh, $dir or die "opendir $dir: $!"; 88 while (defined (my $item = readdir $dh)) { 89 return 1 if $item =~ /\.xs$/; 90 return 1 if $item =~ /\.c$/; 91 } 92 return 0; 93} 94 95# Function to find available extensions, ignoring DynaLoader 96sub find_ext 97{ 98 my $ext_dir = shift; 99 opendir my $dh, "$ext_dir"; 100 while (defined (my $item = readdir $dh)) { 101 next if $item =~ /^\.\.?$/; 102 next if $item eq "DynaLoader"; 103 next unless -d "$ext_dir$item"; 104 my $this_ext = $item; 105 my $leaf = $item; 106 107 $this_ext =~ s!-!/!g; 108 $leaf =~ s/.*-//; 109 110 # Temporary hack to cope with smokers that are not clearing directories: 111 next if $ext{$this_ext}; 112 113 if (has_xs_or_c("$ext_dir$item")) { 114 $ext{$this_ext} = $static{$this_ext} ? 'static' : 'dynamic'; 115 } else { 116 $ext{$this_ext} = 'nonxs'; 117 } 118 $ext{$this_ext} = 'known' if $ext{$this_ext} && $item =~ $no; 119 } 120} 121 1221; 123# Local variables: 124# cperl-indent-level: 4 125# indent-tabs-mode: nil 126# End: 127# 128# ex: set ts=8 sts=4 sw=4 et: 129