X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2FFindExt.pm;h=b73d777d032255611c806203a528ba7b4c0d8ddd;hb=81f61c1a1801c3f63576c7bdd2b7e2b2f91cd51d;hp=831250313dd1c905e00a09f30de72037913b0aa1;hpb=86c8d741faf9ef8a6ed15637c3666fb66e2495d4;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/FindExt.pm b/win32/FindExt.pm index 8312503..b73d777 100644 --- a/win32/FindExt.pm +++ b/win32/FindExt.pm @@ -1,63 +1,108 @@ package FindExt; + +our $VERSION = '1.01'; + use strict; -use File::Find; -use File::Basename; -use Cwd; +use warnings; -my $no = join('|',qw(DynaLoader GDBM_File ODBM_File NDBM_File DB_File +my $no = join('|',qw(GDBM_File ODBM_File NDBM_File DB_File Syslog SysV Langinfo)); $no = qr/^(?:$no)$/i; my %ext; my $ext; +my %static; + +sub getcwd { + $ENV{'PWD'} = Win32::GetCwd(); + $ENV{'PWD'} =~ s:\\:/:g ; + return $ENV{'PWD'}; +} + +sub set_static_extensions +{ + # adjust results of scan_ext, and also save + # statics in case scan_ext hasn't been called yet. + %static = (); + for (@_) { + $static{$_} = 1; + $ext{$_} = 'static' if $ext{$_} && $ext{$_} eq 'dynamic'; + } +} + sub scan_ext { my $here = getcwd(); my $dir = shift; chdir($dir) || die "Cannot cd to $dir\n"; ($ext = getcwd()) =~ s,/,\\,g; - find(\&find_ext,'.'); + find_ext(''); chdir($here) || die "Cannot cd to $here\n"; my @ext = extensions(); } -sub dynamic_extensions +sub dynamic_ext { - return grep $ext{$_} eq 'dynamic',keys %ext; + return sort grep $ext{$_} eq 'dynamic',keys %ext; } -sub noxs_extensions +sub static_ext { - return grep $ext{$_} eq 'nonxs',keys %ext; + return sort grep $ext{$_} eq 'static',keys %ext; +} + +sub nonxs_ext +{ + return sort grep $ext{$_} eq 'nonxs',keys %ext; } sub extensions { - return keys %ext; + return sort grep $ext{$_} ne 'known',keys %ext; +} + +sub known_extensions +{ + # faithfully copy Configure in not including nonxs extensions for the nonce + return sort grep $ext{$_} ne 'nonxs',keys %ext; +} + +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 sub find_ext { - if (/^(.*)\.pm$/i || /^(.*)_pm\.PL$/i || /^(.*)\.xs$/i) - { - my $name = $1; - return if $name =~ $no; - my $dir = $File::Find::dir; - $dir =~ s,./,,; - return if exists $ext{$dir}; - return unless -f "$ext/$dir/Makefile.PL"; - if ($dir =~ /$name$/i) - { - if (-f "$ext/$dir/$name.xs") - { - $ext{$dir} = 'dynamic'; - } - else - { - $ext{$dir} = 'nonxs'; - } + opendir my $dh, '.'; + my @items = grep { !/^\.\.?$/ } readdir $dh; + closedir $dh; + for my $xxx (@items) { + if ($xxx ne "DynaLoader") { + if (-f "$xxx/$xxx.xs") { + $ext{"$_[0]$xxx"} = $static{"$_[0]$xxx"} ? 'static' : 'dynamic'; + } elsif (-f "$xxx/Makefile.PL") { + $ext{"$_[0]$xxx"} = 'nonxs'; + } else { + if (-d $xxx && @_ < 10) { + chdir $xxx; + find_ext("$_[0]$xxx/", @_); + chdir ".."; + } + } + $ext{"$_[0]$xxx"} = 'known' if $ext{"$_[0]$xxx"} && $xxx =~ $no; + } + } + +# Special case: Add in threads/shared since it is not picked up by the +# recursive find above (and adding in general recursive finding breaks +# SDBM_File/sdbm). A.D. 10/25/2001. + + if (!$_[0] && -d "threads/shared") { + $ext{"threads/shared"} = 'dynamic'; } - } } 1;