Cross Reference: /osnet-11/usr/src/cmd/perl/5.8.4/distrib/lib/ExtUtils/instmodsh
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
1N/A#!/usr/local/bin/perl -w
1N/A
1N/Ause strict;
1N/Ause IO::File;
1N/Ause ExtUtils::Packlist;
1N/Ause ExtUtils::Installed;
1N/A
1N/Ause vars qw($Inst @Modules);
1N/A
1N/A################################################################################
1N/A
1N/Asub do_module($)
1N/A{
1N/Amy ($module) = @_;
1N/Amy $help = <<EOF;
1N/AAvailable commands are:
1N/A f [all|prog|doc] - List installed files of a given type
1N/A d [all|prog|doc] - List the directories used by a module
1N/A v - Validate the .packlist - check for missing files
1N/A t <tarfile> - Create a tar archive of the module
1N/A q - Quit the module
1N/AEOF
1N/Aprint($help);
1N/Awhile (1)
1N/A {
1N/A print("$module cmd? ");
1N/A my $reply = <STDIN>; chomp($reply);
1N/A CASE:
1N/A {
1N/A $reply =~ /^f\s*/ and do
1N/A {
1N/A my $class = (split(' ', $reply))[1];
1N/A $class = 'all' if (! $class);
1N/A my @files;
1N/A if (eval { @files = $Inst->files($module, $class); })
1N/A {
1N/A print("$class files in $module are:\n ",
1N/A join("\n ", @files), "\n");
1N/A last CASE;
1N/A }
1N/A else
1N/A { print($@); }
1N/A };
1N/A $reply =~ /^d\s*/ and do
1N/A {
1N/A my $class = (split(' ', $reply))[1];
1N/A $class = 'all' if (! $class);
1N/A my @dirs;
1N/A if (eval { @dirs = $Inst->directories($module, $class); })
1N/A {
1N/A print("$class directories in $module are:\n ",
1N/A join("\n ", @dirs), "\n");
1N/A last CASE;
1N/A }
1N/A else
1N/A { print($@); }
1N/A };
1N/A $reply =~ /^t\s*/ and do
1N/A {
1N/A my $file = (split(' ', $reply))[1];
1N/A my $tmp = "/tmp/inst.$$";
1N/A if (my $fh = IO::File->new($tmp, "w"))
1N/A {
1N/A $fh->print(join("\n", $Inst->files($module)));
1N/A $fh->close();
1N/A system("tar cvf $file -I $tmp");
1N/A unlink($tmp);
1N/A last CASE;
1N/A }
1N/A else { print("Can't open $file: $!\n"); }
1N/A last CASE;
1N/A };
1N/A $reply eq 'v' and do
1N/A {
1N/A if (my @missing = $Inst->validate($module))
1N/A {
1N/A print("Files missing from $module are:\n ",
1N/A join("\n ", @missing), "\n");
1N/A }
1N/A else
1N/A {
1N/A print("$module has no missing files\n");
1N/A }
1N/A last CASE;
1N/A };
1N/A $reply eq 'q' and do
1N/A {
1N/A return;
1N/A };
1N/A # Default
1N/A print($help);
1N/A }
1N/A }
1N/A}
1N/A
1N/A################################################################################
1N/A
1N/Asub toplevel()
1N/A{
1N/Amy $help = <<EOF;
1N/AAvailable commands are:
1N/A l - List all installed modules
1N/A m <module> - Select a module
1N/A q - Quit the program
1N/AEOF
1N/Aprint($help);
1N/Awhile (1)
1N/A {
1N/A print("cmd? ");
1N/A my $reply = <STDIN>; chomp($reply);
1N/A CASE:
1N/A {
1N/A $reply eq 'l' and do
1N/A {
1N/A print("Installed modules are:\n ", join("\n ", @Modules), "\n");
1N/A last CASE;
1N/A };
1N/A $reply =~ /^m\s+/ and do
1N/A {
1N/A do_module((split(' ', $reply))[1]);
1N/A last CASE;
1N/A };
1N/A $reply eq 'q' and do
1N/A {
1N/A exit(0);
1N/A };
1N/A # Default
1N/A print($help);
1N/A }
1N/A }
1N/A}
1N/A
1N/A################################################################################
1N/A
1N/A$Inst = ExtUtils::Installed->new();
1N/A@Modules = $Inst->modules();
1N/Atoplevel();
1N/A
1N/A################################################################################