1 files changed, 139 insertions, 0 deletions
diff --git a/lib/ExtUtils/inst b/lib/ExtUtils/inst
new file mode 100755
index 0000000000..cbf2d01194
--- /dev/null
+++ b/lib/ExtUtils/inst
@@ -0,0 +1,139 @@
+#!/usr/local/bin/perl -w
+
+use strict;
+use IO::File;
+use ExtUtils::Packlist;
+use ExtUtils::Installed;
+
+use vars qw($Inst @Modules);
+
+################################################################################
+
+sub do_module($)
+{
+my ($module) = @_;
+my $help = <<EOF;
+Available commands are:
+   f [all|prog|doc]   - List installed files of a given type
+   d [all|prog|doc]   - List the directories used by a module
+   v                  - Validate the .packlist - check for missing files
+   t <tarfile>        - Create a tar archive of the module
+   q                  - Quit the module
+EOF
+print($help);
+while (1)
+   {
+   print("$module cmd? ");
+   my $reply = <STDIN>; chomp($reply);
+   CASE:
+      {
+      $reply =~ /^f\s*/ and do
+         {
+         my $class = (split(' ', $reply))[1];
+         $class = 'all' if (! $class);
+         my @files;
+         if (eval { @files = $Inst->files($module, $class); })
+            {
+            print("$class files in $module are:\n   ",
+                  join("\n   ", @files), "\n");
+            last CASE;
+            }
+         else
+            { print($@); }
+         };
+      $reply =~ /^d\s*/ and do
+         {
+         my $class = (split(' ', $reply))[1];
+         $class = 'all' if (! $class);
+         my @dirs;
+         if (eval { @dirs = $Inst->directories($module, $class); })
+            {
+            print("$class directories in $module are:\n   ",
+                  join("\n   ", @dirs), "\n");
+            last CASE;
+            }
+         else
+            { print($@); }
+         };
+      $reply =~ /^t\s*/ and do
+         {
+         my $file = (split(' ', $reply))[1];
+         my $tmp = "/tmp/inst.$$";
+         if (my $fh = IO::File->new($tmp, "w"))
+            {
+            $fh->print(join("\n", $Inst->files($module)));
+            $fh->close();
+            system("tar cvf $file -I $tmp");
+            unlink($tmp);
+            last CASE;
+            }
+         else { print("Can't open $file: $!\n"); }
+         last CASE;
+         };
+      $reply eq 'v' and do
+         {
+         if (my @missing = $Inst->validate($module))
+            {
+            print("Files missing from $module are:\n   ",
+                  join("\n   ", @missing), "\n");
+            }
+         else
+            {
+            print("$module has no missing files\n");
+            }
+         last CASE;
+         };
+      $reply eq 'q' and do
+         {
+         return;
+         };
+      # Default
+         print($help);
+      }
+   }
+}
+
+################################################################################
+
+sub toplevel()
+{
+my $help = <<EOF;
+Available commands are:
+   l            - List all installed modules
+   m <module>   - Select a module
+   q            - Quit the program
+EOF
+print($help);
+while (1)
+   {
+   print("cmd? ");
+   my $reply = <STDIN>; chomp($reply);
+   CASE:
+      {
+      $reply eq 'l' and do
+         {
+         print("Installed modules are:\n   ", join("\n   ", @Modules), "\n");
+         last CASE;
+         };
+      $reply =~ /^m\s+/ and do
+         {
+         do_module((split(' ', $reply))[1]);
+         last CASE;
+         };
+      $reply eq 'q' and do
+         {
+         exit(0);
+         };
+      # Default
+         print($help);
+      }
+   }
+}
+
+################################################################################
+
+$Inst = ExtUtils::Installed->new();
+@Modules = $Inst->modules();
+toplevel();
+
+################################################################################