xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/lib/ExtUtils/instmodsh (revision 0:68f95e015346) 
1#!/usr/local/bin/perl -w
2
3use strict;
4use IO::File;
5use ExtUtils::Packlist;
6use ExtUtils::Installed;
7
8use vars qw($Inst @Modules);
9
10################################################################################
11
12sub do_module($)
13{
14my ($module) = @_;
15my $help = <<EOF;
16Available 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
22EOF
23print($help);
24while (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
98sub toplevel()
99{
100my $help = <<EOF;
101Available commands are:
102   l            - List all installed modules
103   m <module>   - Select a module
104   q            - Quit the program
105EOF
106print($help);
107while (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();
137toplevel();
138
139################################################################################
140