lib/perl5/5.6.1/ExtUtils/inst

   1 #!/usr/local/bin/perl -w
   2
   3 use strict;
   4 use IO::File;
   5 use ExtUtils::Packlist;
   6 use ExtUtils::Installed;
   7
   8 use vars qw($Inst @Modules);
   9
  10 ################################################################################
  11
  12 sub do_module($)
  13 {
  14 my ($module) = @_;
  15 my $help = <<EOF;
  16 Available commands are:
  17    f [all|prog|doc]   - List installed files of a given type
  18    d [all|prog|doc]   - List the directories used by a module
  19    v                  - Validate the .packlist - check for missing files
  20    t <tarfile>        - Create a tar archive of the module
  21    q                  - Quit the module
  22 EOF
  23 print($help);
  24 while (1)
  25    {
  26    print("$module cmd? ");
  27    my $reply = <STDIN>; chomp($reply);
  28    CASE:
  29       {
  30       $reply =~ /^f\s*/ and do
  31          {
  32          my $class = (split(' ', $reply))[1];
  33          $class = 'all' if (! $class);
  34          my @files;
  35          if (eval { @files = $Inst->files($module, $class); })
  36             {
  37             print("$class files in $module are:\n   ",
  38                   join("\n   ", @files), "\n");
  39             last CASE;
  40             }
  41          else
  42             { print($@); }
  43          };
  44       $reply =~ /^d\s*/ and do
  45          {
  46          my $class = (split(' ', $reply))[1];
  47          $class = 'all' if (! $class);
  48          my @dirs;
  49          if (eval { @dirs = $Inst->directories($module, $class); })
  50             {
  51             print("$class directories in $module are:\n   ",
  52                   join("\n   ", @dirs), "\n");
  53             last CASE;
  54             }
  55          else
  56             { print($@); }
  57          };
  58       $reply =~ /^t\s*/ and do
  59          {
  60          my $file = (split(' ', $reply))[1];
  61          my $tmp = "/tmp/inst.$$";
  62          if (my $fh = IO::File->new($tmp, "w"))
  63             {
  64             $fh->print(join("\n", $Inst->files($module)));
  65             $fh->close();
  66             system("tar cvf $file -I $tmp");
  67             unlink($tmp);
  68             last CASE;
  69             }
  70          else { print("Can't open $file: $!\n"); }
  71          last CASE;
  72          };
  73       $reply eq 'v' and do
  74          {
  75          if (my @missing = $Inst->validate($module))
  76             {
  77             print("Files missing from $module are:\n   ",
  78                   join("\n   ", @missing), "\n");
  79             }
  80          else
  81             {
  82             print("$module has no missing files\n");
  83             }
  84          last CASE;
  85          };
  86       $reply eq 'q' and do
  87          {
  88          return;
  89          };
  90       # Default
  91          print($help);
  92       }
  93    }
  94 }
  95
  96 ################################################################################
  97
  98 sub toplevel()
  99 {
 100 my $help = <<EOF;
 101 Available commands are:
 102    l            - List all installed modules
 103    m <module>   - Select a module
 104    q            - Quit the program
 105 EOF
 106 print($help);
 107 while (1)
 108    {
 109    print("cmd? ");
 110    my $reply = <STDIN>; chomp($reply);
 111    CASE:
 112       {
 113       $reply eq 'l' and do
 114          {
 115          print("Installed modules are:\n   ", join("\n   ", @Modules), "\n");
 116          last CASE;
 117          };
 118       $reply =~ /^m\s+/ and do
 119          {
 120          do_module((split(' ', $reply))[1]);
 121          last CASE;
 122          };
 123       $reply eq 'q' and do
 124          {
 125          exit(0);
 126          };
 127       # Default
 128          print($help);
 129       }
 130    }
 131 }
 132
 133 ################################################################################
 134
 135 $Inst = ExtUtils::Installed->new();
 136 @Modules = $Inst->modules();
 137 toplevel();
 138
 139 ################################################################################