Message-Id: <200202131737.RAA29010@tempest.npl.co.uk>

(updated version of the above)

p4raw-id: //depot/perl@14688

diff --git a/lib/ExtUtils/Installed.pm b/lib/ExtUtils/Installed.pm
index c9a6bfc..5b7f663 100644 (file)
--- a/lib/ExtUtils/Installed.pm
+++ b/lib/ExtUtils/Installed.pm
@@ -32,26 +32,31 @@ if ($DOSISH)
 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($self->_is_prefix($path, $Config{installman1dir})
-          ||
-          $self->_is_prefix($path, $Config{installman3dir})
-          ? 1 : 0)
+   return($self->_is_doc($path))
    }
 if ($type eq "prog")
    {
-   return($self->_is_prefix($path, $Config{prefix})
-          &&
-          !($Config{installman1dir} && 
-                       $self->_is_prefix($path, $Config{installman1dir}))
+   return($self->_is_prefix($path, $Config{prefixexp})
           &&
-          !($Config{installman3dir} && 
-                       $self->_is_prefix($path, $Config{installman3dir}))
+          !($self->_is_doc($path))
           ? 1 : 0);
    }
 return(0);
@@ -74,27 +79,25 @@ my ($class) = @_;
 $class = ref($class) || $class;
 my $self = {};
 
-my $installarchlib = $Config{installarchlib};
-my $archlib = $Config{archlib};
-my $sitearch = $Config{sitearch};
+my $archlib = $Config{archlibexp};
+my $sitearch = $Config{sitearchexp};
 
 if ($DOSISH)
    {
-   $installarchlib =~ s|\\|/|g;
    $archlib =~ s|\\|/|g;
    $sitearch =~ s|\\|/|g;
    }
 
 # Read the core packlist
 $self->{Perl}{packlist} =
-   ExtUtils::Packlist->new( File::Spec->catfile($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 $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;
@@ -256,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.
@@ -265,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
@@ -273,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()

diff --git a/lib/ExtUtils/t/Installed.t b/lib/ExtUtils/t/Installed.t
index 8bd7fe6..70287f8 100644 (file)
--- a/lib/ExtUtils/t/Installed.t
+++ b/lib/ExtUtils/t/Installed.t
@@ -26,7 +26,7 @@ use Test::More tests => 43;
 
 BEGIN { use_ok( 'ExtUtils::Installed' ) }
 
-my $noman = ! ($Config{installman1dir} && $Config{installman3dir});
+my $mandirs =  !!$Config{man1direxp} + !!$Config{man3direxp};
 
 # saves having to qualify package name for class methods
 my $ei = bless( {}, 'ExtUtils::Installed' );
@@ -40,17 +40,22 @@ is( $ei->_is_prefix('\foo\bar', '\bar'), 0,
 # _is_type
 is( $ei->_is_type(0, 'all'), 1, '_is_type() should be true for type of "all"' );
 
-foreach my $path (qw( installman1dir installman3dir )) {
-       my $file = $Config{$path} . '/foo';
+foreach my $path (qw( man1dir man3dir )) {
+SKIP: {
+       my $dir = $Config{$path.'exp'};
+        skip("no man directory $path on this system", 2 ) unless $dir;
+
+       my $file = $dir . '/foo';
        is( $ei->_is_type($file, 'doc'), 1, "... should find doc file in $path" );
        is( $ei->_is_type($file, 'prog'), 0, "... but not prog file in $path" );
+    }
 }
 
-is( $ei->_is_type($Config{prefix} . '/bar', 'prog'), 1, 
-       "... should find prog file under $Config{prefix}" );
+is( $ei->_is_type($Config{prefixexp} . '/bar', 'prog'), 1, 
+       "... should find prog file under $Config{prefixexp}" );
 
 SKIP: {
-       skip('no man directories on this system', 1) if $noman;
+       skip('no man directories on this system', 1) unless $mandirs;
        is( $ei->_is_type('bar', 'doc'), 0, 
                '... should not find doc file outside path' );
 }
@@ -103,15 +108,14 @@ FAKE
 
 
 SKIP: {
-       skip( "could not write packlist: $!", 3 ) unless $wrotelist;
+       skip("could not write packlist: $!", 3 ) unless $wrotelist;
 
        # avoid warning and death by localizing glob
        local *ExtUtils::Installed::Config;
-    my $fake_mod_dir = File::Spec->catdir(cwd(), 'auto', 'FakeMod');
+       my $fake_mod_dir = File::Spec->catdir(cwd(), 'auto', 'FakeMod');
        %ExtUtils::Installed::Config = (
-               archlib            => cwd(),
-        installarchlib => cwd(),
-               sitearch           => $fake_mod_dir,
+               archlibexp         => cwd(),
+               sitearchexp        => $fake_mod_dir,
        );
 
        # necessary to fool new()
@@ -132,9 +136,13 @@ is( join(' ', $ei->modules()), 'abc def ghi',
 # files
 $ei->{goodmod} = { 
        packlist => { 
-               File::Spec->catdir($Config{installman1dir}, 'foo') => 1,
-               File::Spec->catdir($Config{installman3dir}, 'bar') => 1,
-               File::Spec->catdir($Config{prefix}, 'foobar') => 1,
+                ($Config{man1direxp} ? 
+                    (File::Spec->catdir($Config{man1direxp}, 'foo') => 1) : 
+                        ()),
+                ($Config{man3direxp} ? 
+                    (File::Spec->catdir($Config{man3direxp}, 'bar') => 1) : 
+                        ()),
+                File::Spec->catdir($Config{prefixexp}, 'foobar') => 1,
                foobaz  => 1,
        },
 };
@@ -146,13 +154,15 @@ like( $@, qr/type must be/,'files() should croak given bad type' );
 
 my @files;
 SKIP: {
-       skip('no man directories on this system', 3) if $noman;
-       
-       @files = $ei->files('goodmod', 'doc', $Config{installman1dir});
-       is( scalar @files, 1, '... should find doc file under given dir' );
-       is( grep({ /foo$/ } @files), 1, '... checking file name' );
-       @files = $ei->files('goodmod', 'doc');
-       is( scalar @files, 2, '... should find all doc files with no dir' );
+    skip('no man directory man1dir on this system', 2) unless $Config{man1direxp}; 
+    @files = $ei->files('goodmod', 'doc', $Config{man1direxp});
+    is( scalar @files, 1, '... should find doc file under given dir' );
+    is( grep({ /foo$/ } @files), 1, '... checking file name' );
+}
+SKIP: {
+    skip('no man directories on this system', 1) unless $mandirs;
+    @files = $ei->files('goodmod', 'doc');
+    is( scalar @files, $mandirs, '... should find all doc files with no dir' );
 }
 
 @files = $ei->files('goodmod', 'prog', 'fake', 'fake2');
@@ -161,7 +171,7 @@ is( scalar @files, 0, '... should find no doc files given wrong dirs' );
 is( scalar @files, 1, '... should find doc file in correct dir' );
 like( $files[0], qr/foobar$/, '... checking file name' );
 @files = $ei->files('goodmod');
-is( scalar @files, 4, '... should find all files with no type specified' );
+is( scalar @files, 2 + $mandirs, '... should find all files with no type specified' );
 my %dirnames = map { lc($_) => dirname($_) } @files;
 
 # directories
@@ -169,24 +179,27 @@ my @dirs = $ei->directories('goodmod', 'prog', 'fake');
 is( scalar @dirs, 0, 'directories() should return no dirs if no files found' );
 
 SKIP: {
-       skip('no man directories on this system', 4) if $noman;
-
-       @dirs = $ei->directories('goodmod', 'doc');
-       is( scalar @dirs, 2, '... should find all files files() would' );
-       @dirs = $ei->directories('goodmod');
-       is( scalar @dirs, 4, '... should find all files files() would, again' );
-       @files = sort map { exists $dirnames{lc($_)} ? $dirnames{lc($_)} : '' } 
-               @files;
-       is( join(' ', @files), join(' ', @dirs), '... should sort output' );
-
-       # directory_tree
-       my $expectdirs = dirname($Config{installman1dir}) eq 
-               dirname($Config{installman3dir}) ? 3 :2;
-
-       @dirs = $ei->directory_tree('goodmod', 'doc', 
-               dirname($Config{installman1dir}));
-       is( scalar @dirs, $expectdirs, 
-               'directory_tree() should report intermediate dirs to those requested' );
+    skip('no man directories on this system', 1) unless $mandirs;
+    @dirs = $ei->directories('goodmod', 'doc');
+    is( scalar @dirs, $mandirs, '... should find all files files() would' );
+}
+@dirs = $ei->directories('goodmod');
+is( scalar @dirs, 2 + $mandirs, '... should find all files files() would, again' );
+@files = sort map { exists $dirnames{lc($_)} ? $dirnames{lc($_)} : '' } @files;
+is( join(' ', @files), join(' ', @dirs), '... should sort output' );
+
+# directory_tree
+my $expectdirs = 
+       ($mandirs == 2) && 
+       (dirname($Config{man1direxp}) eq dirname($Config{man3direxp}))
+       ? 3 : 2;
+ 
+SKIP: {
+    skip('no man directories on this system', 1) unless $mandirs;
+    @dirs = $ei->directory_tree('goodmod', 'doc', $Config{man1direxp} ?
+       dirname($Config{man1direxp}) : dirname($Config{man3direxp}));
+    is( scalar @dirs, $expectdirs, 
+        'directory_tree() should report intermediate dirs to those requested' );
 }
 
 my $fakepak = Fakepak->new(102);