lib/ExtUtils/instmodsh

   1 #!/usr/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 my $Module_Help = <<EOF;
  28 Available commands are:
  29    f [all|prog|doc]   - List installed files of a given type
  30    d [all|prog|doc]   - List the directories used by a module
  31    v                  - Validate the .packlist - check for missing files
  32    t <tarfile>        - Create a tar archive of the module
  33    h                  - Display module help
  34    q                  - Quit the module
  35 EOF
  36
  37 my %Module_Commands = (
  38                        f => \&list_installed,
  39                        d => \&list_directories,
  40                        v => \&validate_packlist,
  41                        t => \&create_archive,
  42                        h => \&module_help,
  43                       );
  44
  45 sub do_module($) {
  46     my ($module) = @_;
  47
  48     print($Module_Help);
  49     MODULE_CMD: while (1) {
  50         print("$module cmd? ");
  51
  52         my $reply = <STDIN>; chomp($reply);
  53         my($cmd) = $reply =~ /^(\w)\b/;
  54
  55         last if $cmd eq 'q';
  56
  57         if( $Module_Commands{$cmd} ) {
  58             $Module_Commands{$cmd}->($reply, $module);
  59         }
  60         elsif( $cmd eq 'q' ) {
  61             last MODULE_CMD;
  62         }
  63         else {
  64             module_help();
  65         }
  66     }
  67 }
  68
  69
  70 sub list_installed {
  71     my($reply, $module) = @_;
  72
  73     my $class = (split(' ', $reply))[1];
  74     $class = 'all' unless $class;
  75
  76     my @files;
  77     if (eval { @files = $Inst->files($module, $class); }) {
  78         print("$class files in $module are:\n   ",
  79               join("\n   ", @files), "\n");
  80     }
  81     else {
  82         print($@);
  83     }
  84 };
  85
  86
  87 sub list_directories {
  88     my($reply, $module) = @_;
  89
  90     my $class = (split(' ', $reply))[1];
  91     $class = 'all' unless $class;
  92
  93     my @dirs;
  94     if (eval { @dirs = $Inst->directories($module, $class); }) {
  95         print("$class directories in $module are:\n   ",
  96               join("\n   ", @dirs), "\n");
  97     }
  98     else {
  99         print($@);
 100     }
 101 }
 102
 103
 104 sub create_archive {
 105     my($reply, $module) = @_;
 106
 107     my $file = (split(' ', $reply))[1];
 108     my $tmp = "/tmp/inst.$$";
 109
 110     if( !(defined $file and length $file) ) {
 111         print "No tar file specified\n";
 112     }
 113     elsif( eval { require Archive::Tar } ) {
 114         Archive::Tar->create_archive($file, 0, $Inst->files($module));
 115     }
 116     else {
 117         my($first, @rest) = $Inst->files($module);
 118         system('tar', 'cvf', $file, $first);
 119         for my $f (@rest) {
 120             system('tar', 'rvf', $file, $f);
 121         }
 122         print "Can't use tar\n" if $?;
 123     }
 124 }
 125
 126
 127 sub validate_packlist {
 128     my($reply, $module) = @_;
 129
 130     if (my @missing = $Inst->validate($module)) {
 131         print("Files missing from $module are:\n   ",
 132               join("\n   ", @missing), "\n");
 133     }
 134     else {
 135         print("$module has no missing files\n");
 136     }
 137 }
 138
 139 sub module_help {
 140     print $Module_Help;
 141 }
 142
 143
 144
 145 ##############################################################################
 146
 147 sub toplevel()
 148 {
 149 my $help = <<EOF;
 150 Available commands are:
 151    l            - List all installed modules
 152    m <module>   - Select a module
 153    q            - Quit the program
 154 EOF
 155 print($help);
 156 while (1)
 157    {
 158    print("cmd? ");
 159    my $reply = <STDIN>; chomp($reply);
 160    CASE:
 161       {
 162       $reply eq 'l' and do
 163          {
 164          print("Installed modules are:\n   ", join("\n   ", @Modules), "\n");
 165          last CASE;
 166          };
 167       $reply =~ /^m\s+/ and do
 168          {
 169          do_module((split(' ', $reply))[1]);
 170          last CASE;
 171          };
 172       $reply eq 'q' and do
 173          {
 174          exit(0);
 175          };
 176       # Default
 177          print($help);
 178       }
 179    }
 180 }
 181
 182
 183 ###############################################################################
 184
 185 $Inst = ExtUtils::Installed->new();
 186 @Modules = $Inst->modules();
 187 toplevel();
 188
 189 ###############################################################################