lib/ExtUtils/instmodsh

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