1 files changed, 272 insertions, 0 deletions
diff --git a/contrib/perl5/lib/ExtUtils/Installed.pm b/contrib/perl5/lib/ExtUtils/Installed.pm
new file mode 100644
index 0000000..dda594e
--- /dev/null
+++ b/contrib/perl5/lib/ExtUtils/Installed.pm
@@ -0,0 +1,272 @@
+package ExtUtils::Installed;
+use strict;
+use Carp qw();
+use ExtUtils::Packlist;
+use ExtUtils::MakeMaker;
+use Config;
+use File::Find;
+use File::Basename;
+use vars qw($VERSION);
+$VERSION = '0.02';
+
+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)
+   }
+if ($type eq "prog")
+   {
+   return(substr($path, 0, length($Config{prefix})) eq $Config{prefix}
+          &&
+          substr($path, 0, length($Config{installman1dir}))
+             ne $Config{installman1dir}
+          &&
+          substr($path, 0, length($Config{installman3dir}))
+              ne $Config{installman3dir}
+          ? 1 : 0);
+   }
+return(0);
+}
+
+sub _is_under($$;)
+{
+my ($self, $path, @under) = @_;
+$under[0] = "" if (! @under);
+foreach my $dir (@under)
+   {
+   return(1) if (substr($path, 0, length($dir)) eq $dir);
+   }
+return(0);
+}
+
+sub new($)
+{
+my ($class) = @_;
+$class = ref($class) || $class;
+my $self = {};
+
+# Read the core packlist
+$self->{Perl}{packlist} =
+   ExtUtils::Packlist->new("$Config{installarchlib}/.packlist");
+$self->{Perl}{version} = $];
+
+# Read the module packlists
+my $sub = sub
+   {
+   # Only process module .packlists
+   return if ($_) ne ".packlist" || $File::Find::dir eq $Config{installarchlib};
+
+   # 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!;
+   my $modfile = "$module.pm";
+   $module =~ s!/!::!g;
+
+   # Find the top-level module file in @INC
+   $self->{$module}{version} = '';
+   foreach my $dir (@INC)
+      {
+      my $p = MM->catfile($dir, $modfile);
+      if (-f $p)
+         {
+         $self->{$module}{version} = MM->parse_version($p);
+         last;
+         }
+      }
+
+   # Read the .packlist
+   $self->{$module}{packlist} = ExtUtils::Packlist->new($File::Find::name);
+   };
+find($sub, $Config{archlib}, $Config{sitearch});
+
+return(bless($self, $class));
+}
+
+sub modules($)
+{
+my ($self) = @_;
+return(sort(keys(%$self)));
+}
+
+sub files($$;$)
+{
+my ($self, $module, $type, @under) = @_;
+
+# Validate arguments
+Carp::croak("$module is not installed") if (! exists($self->{$module}));
+$type = "all" if (! defined($type));
+Carp::croak('type must be "all", "prog" or "doc"')
+   if ($type ne "all" && $type ne "prog" && $type ne "doc");
+
+my (@files);
+foreach my $file (keys(%{$self->{$module}{packlist}}))
+   {
+   push(@files, $file)
+      if ($self->_is_type($file, $type) && $self->_is_under($file, @under));
+   }
+return(@files);
+}
+
+sub directories($$;$)
+{
+my ($self, $module, $type, @under) = @_;
+my (%dirs);
+foreach my $file ($self->files($module, $type, @under))
+   {
+   $dirs{dirname($file)}++;
+   }
+return(sort(keys(%dirs)));
+}
+
+sub directory_tree($$;$)
+{
+my ($self, $module, $type, @under) = @_;
+my (%dirs);
+foreach my $dir ($self->directories($module, $type, @under))
+   {
+   $dirs{$dir}++;
+   my ($last) = ("");
+   while ($last ne $dir)
+      {
+      $last = $dir;
+      $dir = dirname($dir);
+      last if (! $self->_is_under($dir, @under));
+      $dirs{$dir}++;
+      }
+   }
+return(sort(keys(%dirs)));
+}
+
+sub validate($;$)
+{
+my ($self, $module, $remove) = @_;
+Carp::croak("$module is not installed") if (! exists($self->{$module}));
+return($self->{$module}{packlist}->validate($remove));
+}
+
+sub packlist($$)
+{
+my ($self, $module) = @_;
+Carp::croak("$module is not installed") if (! exists($self->{$module}));
+return($self->{$module}{packlist});
+}
+
+sub version($$)
+{
+my ($self, $module) = @_;
+Carp::croak("$module is not installed") if (! exists($self->{$module}));
+return($self->{$module}{version});
+}
+
+sub DESTROY
+{
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Installed - Inventory management of installed modules
+
+=head1 SYNOPSIS
+
+   use ExtUtils::Installed;
+   my ($inst) = ExtUtils::Installed->new();
+   my (@modules) = $inst->modules();
+   my (@missing) = $inst->validate("DBI");
+   my $all_files = $inst->files("DBI");
+   my $files_below_usr_local = $inst->files("DBI", "all", "/usr/local");
+   my $all_dirs = $inst->directories("DBI");
+   my $dirs_below_usr_local = $inst->directory_tree("DBI", "prog");
+   my $packlist = $inst->packlist("DBI");
+
+=head1 DESCRIPTION
+
+ExtUtils::Installed  provides a standard way to find out what core and module
+files have been installed.  It uses the information stored in .packlist files
+created during installation to provide this information.  In addition it
+provides facilities to classify the installed files and to extract directory
+information from the .packlist files.
+
+=head1 USAGE
+
+The new() function searches for all the installed .packlists on the system, and
+stores their contents. The .packlists can be queried with the functions
+described below.
+
+=head1 FUNCTIONS
+
+=over
+
+=item new()
+
+This takes no parameters, and searches for all the installed .packlists on the
+system.  The packlists are read using the ExtUtils::packlist module.
+
+=item modules()
+
+This returns a list of the names of all the installed modules.  The perl 'core'
+is given the special name 'Perl'.
+
+=item files()
+
+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,
+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.
+
+=item 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
+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
+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
+intermediate directories back up to the specified directories.
+
+=item validate()
+
+This takes one mandatory parameter, the name of a module.  It checks that all
+the files listed in the modules .packlist actually exist, and returns a list of
+any missing files.  If an optional second argument which evaluates to true is
+given any missing files will be removed from the .packlist
+
+=item packlist()
+
+This returns the ExtUtils::Packlist object for the specified module.
+
+=item version()
+
+This returns the version number for the specified module.
+
+=back
+
+=head1 EXAMPLE
+
+See the example in L<ExtUtils::Packlist>.
+
+=head1 AUTHOR
+
+Alan Burlison <Alan.Burlison@uk.sun.com>
+
+=cut