fix diagnostics to report "our" vs "my" correctly
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / inst
CommitLineData
354f3b56 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################################################################################