Commit | Line | Data |
354f3b56 |
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 | |
a7d1454b |
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 | |
354f3b56 |
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 | ################################################################################ |