This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to ExtUtils::MakeMaker 6.19
[perl5.git] / 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 ################################################################################