package ExtUtils::Installed;
+
+use 5.006_001;
use strict;
use Carp qw();
use ExtUtils::Packlist;
use Config;
use File::Find;
use File::Basename;
-use vars qw($VERSION);
-$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}
+ return($self->_is_prefix($path, $Config{prefixexp})
&&
- substr($path, 0, length($Config{installman1dir}))
- ne $Config{installman1dir}
- &&
- substr($path, 0, length($Config{installman3dir}))
- ne $Config{installman3dir}
+ !($self->_is_doc($path))
? 1 : 0);
}
return(0);
$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);
}
$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");
-$self->{Perl}{version} = $];
+ 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!;
- $module =~ s!$Config{sitearch}/auto/(.*)/.packlist!$1!;
+ $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;
$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);
# 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));
}
=head1 FUNCTIONS
-=over
+=over 4
=item new()
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.
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
=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()
=back
+=head1 EXAMPLE
+
+See the example in L<ExtUtils::Packlist>.
+
=head1 AUTHOR
Alan Burlison <Alan.Burlison@uk.sun.com>