This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Syncing with bleadperl
[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
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 ################################################################################