X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2FFindExt.pm;h=7bf9d52ca51978d2ea2050dc7c866b650855843f;hb=17c79f43379fc059c3c23c26a109c793268b3956;hp=69efa0adda9ee0cf007f8c4d146200f8aea1f95a;hpb=d57db09df25bb4fb2f5080ca37abbbfa49f1e8cf;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/FindExt.pm b/win32/FindExt.pm index 69efa0a..7bf9d52 100644 --- a/win32/FindExt.pm +++ b/win32/FindExt.pm @@ -6,7 +6,7 @@ use strict; use warnings; my $no = join('|',qw(GDBM_File ODBM_File NDBM_File DB_File - Syslog SysV Langinfo)); + VMS Sys-Syslog IPC-SysV I18N-Langinfo)); $no = qr/^(?:$no)$/i; my %ext; @@ -32,76 +32,65 @@ sub set_static_extensions { sub scan_ext { my $dir = shift; - find_ext("$dir/", ''); + find_ext("$dir/"); extensions(); } -sub dynamic_ext -{ - return sort grep $ext{$_} eq 'dynamic',keys %ext; -} - -sub static_ext -{ - return sort grep $ext{$_} eq 'static',keys %ext; +sub _ext_eq { + my $key = shift; + sub { + sort grep $ext{$_} eq $key, keys %ext; + } } -sub nonxs_ext -{ - return sort grep $ext{$_} eq 'nonxs',keys %ext; -} +*dynamic_ext = _ext_eq('dynamic'); +*static_ext = _ext_eq('static'); +*nonxs_ext = _ext_eq('nonxs'); -sub extensions -{ - return sort grep $ext{$_} ne 'known',keys %ext; +sub _ext_ne { + my $key = shift; + sub { + sort grep $ext{$_} ne $key, keys %ext; + } } -sub known_extensions -{ - # faithfully copy Configure in not including nonxs extensions for the nonce - return sort grep $ext{$_} ne 'nonxs',keys %ext; -} +*extensions = _ext_ne('known'); +# faithfully copy Configure in not including nonxs extensions for the nonce +*known_extensions = _ext_ne('nonxs'); sub is_static { return $ext{$_[0]} eq 'static' } -# Function to recursively find available extensions, ignoring DynaLoader -# NOTE: recursion limit of 10 to prevent runaway in case of symlink madness +# Function to find available extensions, ignoring DynaLoader sub find_ext { - my $prefix = shift; - my $dir = shift; - opendir my $dh, "$prefix$dir"; - while (defined (my $xxx = readdir $dh)) { - next if $xxx =~ /^\.\.?$/; - if ($xxx ne "DynaLoader") { - if (-f "$prefix$dir$xxx/$xxx.xs" || -f "$prefix$dir$xxx/$xxx.c" ) { - $ext{"$dir$xxx"} = $static{"$dir$xxx"} ? 'static' : 'dynamic'; - } elsif (-f "$prefix$dir$xxx/Makefile.PL") { - $ext{"$dir$xxx"} = 'nonxs'; - } else { - if (-d "$prefix$dir$xxx" && $dir =~ tr#/## < 10) { - find_ext($prefix, "$dir$xxx/"); - } - } - $ext{"$dir$xxx"} = 'known' if $ext{"$dir$xxx"} && $xxx =~ $no; + 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/.*-//; + + if (-f "$ext_dir$item/$leaf.xs" || -f "$ext_dir$item/$leaf.c" ) { + $ext{$this_ext} = $static{$this_ext} ? 'static' : 'dynamic'; + } else { + $ext{$this_ext} = 'nonxs'; } - } - -# Special case: Add in modules that nest beyond the first level. -# Currently threads/shared and Hash/Util/FieldHash, since they are -# not picked up by the recursive find above (and adding in general -# recursive finding breaks SDBM_File/sdbm). -# A.D. 20011025 (SDBM), ajgough 20071008 (FieldHash) - - if (!$dir && -d "${prefix}threads/shared") { - $ext{"threads/shared"} = 'dynamic'; - } - if (!$dir && -d "${prefix}Hash/Util/FieldHash") { - $ext{"Hash/Util/FieldHash"} = 'dynamic'; + $ext{$this_ext} = 'known' if $ext{$this_ext} && $item =~ $no; } } 1; +# Local variables: +# cperl-indent-level: 4 +# indent-tabs-mode: nil +# End: +# +# ex: set ts=8 sts=4 sw=4 et: