X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FExtUtils%2FInstalled.pm;h=5b7f66327b2a3d352c3a66a38fd668672ae4f0a3;hb=6557ab03f6af50f3a62216c7f6466b808b1071d1;hp=b7ff8155b3080bc599e95580bf467ec6af7242c4;hpb=bbc7dcd2bd43efd6773e46b614c6eb1db5af78d2;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/ExtUtils/Installed.pm b/lib/ExtUtils/Installed.pm
index b7ff815..5b7f663 100644
--- a/lib/ExtUtils/Installed.pm
+++ b/lib/ExtUtils/Installed.pm
@@ -1,6 +1,6 @@
 package ExtUtils::Installed;
 
-use 5.005_64;
+use 5.006_001;
 use strict;
 use Carp qw();
 use ExtUtils::Packlist;
@@ -8,30 +8,55 @@ use ExtUtils::MakeMaker;
 use Config;
 use File::Find;
 use File::Basename;
-our $VERSION = '0.02';
+use File::Spec;
+our $VERSION = '0.04';
 
+my $DOSISH = ($^O =~ /^(MSWin\d\d|os2|dos|mint)$/);
+
+sub _is_prefix
+{
+my ($self, $path, $prefix) = @_;
+if (substr($path, 0, length($prefix)) eq $prefix)
+   {
+   return(1);
+   }
+if ($DOSISH)
+   {
+   $path =~ s|\\|/|g;
+   $prefix =~ s|\\|/|g;
+   if ($path =~ m{^\Q$prefix\E}i)
+      {
+      return(1);
+      }
+   }
+return(0);
+}
+
+sub _is_doc($$)
+{ 
+my ($self, $path) = @_;
+my $man1dir = $Config{man1direxp};
+my $man3dir = $Config{man3direxp};
+return(($man1dir && $self->_is_prefix($path, $man1dir))
+      ||
+      ($man3dir && $self->_is_prefix($path, $man3dir))
+      ? 1 : 0)
+}
+ 
 sub _is_type($$$)
 {
 my ($self, $path, $type) = @_;
 return(1) if ($type eq "all");
+
 if ($type eq "doc")
    {
-   return(substr($path, 0, length($Config{installman1dir}))
-              eq $Config{installman1dir}
-          ||
-          substr($path, 0, length($Config{installman3dir}))
-              eq $Config{installman3dir}
-          ? 1 : 0)
+   return($self->_is_doc($path))
    }
 if ($type eq "prog")
    {
-   return(substr($path, 0, length($Config{prefix})) eq $Config{prefix}
-          &&
-          substr($path, 0, length($Config{installman1dir}))
-             ne $Config{installman1dir}
+   return($self->_is_prefix($path, $Config{prefixexp})
           &&
-          substr($path, 0, length($Config{installman3dir}))
-              ne $Config{installman3dir}
+          !($self->_is_doc($path))
           ? 1 : 0);
    }
 return(0);
@@ -43,7 +68,7 @@ my ($self, $path, @under) = @_;
 $under[0] = "" if (! @under);
 foreach my $dir (@under)
    {
-   return(1) if (substr($path, 0, length($dir)) eq $dir);
+   return(1) if ($self->_is_prefix($path, $dir));
    }
 return(0);
 }
@@ -54,21 +79,30 @@ my ($class) = @_;
 $class = ref($class) || $class;
 my $self = {};
 
+my $archlib = $Config{archlibexp};
+my $sitearch = $Config{sitearchexp};
+
+if ($DOSISH)
+   {
+   $archlib =~ s|\\|/|g;
+   $sitearch =~ s|\\|/|g;
+   }
+
 # Read the core packlist
 $self->{Perl}{packlist} =
-   ExtUtils::Packlist->new("$Config{installarchlib}/.packlist");
+   ExtUtils::Packlist->new( File::Spec->catfile($archlib, '.packlist') );
 $self->{Perl}{version} = $Config{version};
 
 # Read the module packlists
 my $sub = sub
    {
    # Only process module .packlists
-   return if ($_) ne ".packlist" || $File::Find::dir eq $Config{installarchlib};
+   return if ($_) ne ".packlist" || $File::Find::dir eq $archlib;
 
    # Hack of the leading bits of the paths & convert to a module name
    my $module = $File::Find::name;
-   $module =~ s!$Config{archlib}/auto/(.*)/.packlist!$1!s;
-   $module =~ s!$Config{sitearch}/auto/(.*)/.packlist!$1!s;
+   $module =~ s!\Q$archlib\E/auto/(.*)/.packlist!$1!s;
+   $module =~ s!\Q$sitearch\E/auto/(.*)/.packlist!$1!s;
    my $modfile = "$module.pm";
    $module =~ s!/!::!g;
 
@@ -76,7 +110,7 @@ my $sub = sub
    $self->{$module}{version} = '';
    foreach my $dir (@INC)
       {
-      my $p = MM->catfile($dir, $modfile);
+      my $p = File::Spec->catfile($dir, $modfile);
       if (-f $p)
          {
          $self->{$module}{version} = MM->parse_version($p);
@@ -87,7 +121,7 @@ my $sub = sub
    # Read the .packlist
    $self->{$module}{packlist} = ExtUtils::Packlist->new($File::Find::name);
    };
-find($sub, $Config{archlib}, $Config{sitearch});
+find($sub, $archlib, $sitearch);
 
 return(bless($self, $class));
 }
@@ -225,7 +259,7 @@ is given the special name 'Perl'.
 This takes one mandatory parameter, the name of a module.  It returns a list of
 all the filenames from the package.  To obtain a list of core perl files, use
 the module name 'Perl'.  Additional parameters are allowed.  The first is one
-of the strings "prog", "man" or "all", to select either just program files,
+of the strings "prog", "doc" or "all", to select either just program files,
 just manual files or all files.  The remaining parameters are a list of
 directories. The filenames returned will be restricted to those under the
 specified directories.
@@ -234,7 +268,7 @@ specified directories.
 
 This takes one mandatory parameter, the name of a module.  It returns a list of
 all the directories from the package.  Additional parameters are allowed.  The
-first is one of the strings "prog", "man" or "all", to select either just
+first is one of the strings "prog", "doc" or "all", to select either just
 program directories, just manual directories or all directories.  The remaining
 parameters are a list of directories. The directories returned will be
 restricted to those under the specified directories.  This method returns only
@@ -242,7 +276,7 @@ the leaf directories that contain files from the specified module.
 
 =item directory_tree()
 
-This is identical in operation to directory(), except that it includes all the
+This is identical in operation to directories(), except that it includes all the
 intermediate directories back up to the specified directories.
 
 =item validate()