This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Sync with the latest MakeMaker snapshot.
[perl5.git] / lib / ExtUtils / instmodsh
CommitLineData
03c94fc2 1#!/usr/bin/perl -w
354f3b56
AB
2
3use strict;
4use IO::File;
5use ExtUtils::Packlist;
6use ExtUtils::Installed;
7
8use vars qw($Inst @Modules);
9
a7d1454b
RGS
10
11=head1 NAME
12
13instmodsh - A shell to examine installed modules
14
15=head1 SYNOPSIS
16
17 instmodsh
18
19=head1 DESCRIPTION
20
21A little interface to ExtUtils::Installed to examine installed modules,
22validate your packlists and even create a tarball from an installed module.
23
24=cut
25
354f3b56 26
03c94fc2 27my $Module_Help = <<EOF;
354f3b56
AB
28Available commands are:
29 f [all|prog|doc] - List installed files of a given type
30 d [all|prog|doc] - List the directories used by a module
31 v - Validate the .packlist - check for missing files
32 t <tarfile> - Create a tar archive of the module
03c94fc2 33 h - Display module help
354f3b56
AB
34 q - Quit the module
35EOF
03c94fc2
RGS
36
37my %Module_Commands = (
38 f => \&list_installed,
39 d => \&list_directories,
40 v => \&validate_packlist,
41 t => \&create_archive,
42 h => \&module_help,
43 );
44
45sub do_module($) {
46 my ($module) = @_;
47
48 print($Module_Help);
49 MODULE_CMD: while (1) {
50 print("$module cmd? ");
51
52 my $reply = <STDIN>; chomp($reply);
53 my($cmd) = $reply =~ /^(\w)\b/;
54
55 last if $cmd eq 'q';
56
57 if( $Module_Commands{$cmd} ) {
58 $Module_Commands{$cmd}->($reply, $module);
59 }
60 elsif( $cmd eq 'q' ) {
61 last MODULE_CMD;
62 }
63 else {
64 module_help();
65 }
66 }
67}
68
69
70sub list_installed {
71 my($reply, $module) = @_;
72
73 my $class = (split(' ', $reply))[1];
74 $class = 'all' unless $class;
75
76 my @files;
77 if (eval { @files = $Inst->files($module, $class); }) {
78 print("$class files in $module are:\n ",
79 join("\n ", @files), "\n");
80 }
81 else {
82 print($@);
83 }
84};
85
86
87sub list_directories {
88 my($reply, $module) = @_;
89
90 my $class = (split(' ', $reply))[1];
91 $class = 'all' unless $class;
92
93 my @dirs;
94 if (eval { @dirs = $Inst->directories($module, $class); }) {
95 print("$class directories in $module are:\n ",
96 join("\n ", @dirs), "\n");
97 }
98 else {
99 print($@);
100 }
354f3b56
AB
101}
102
03c94fc2
RGS
103
104sub create_archive {
105 my($reply, $module) = @_;
106
107 my $file = (split(' ', $reply))[1];
108 my $tmp = "/tmp/inst.$$";
109
110 if( !(defined $file and length $file) ) {
111 print "No tar file specified\n";
112 }
113 elsif( eval { require Archive::Tar } ) {
114 Archive::Tar->create_archive($file, 0, $Inst->files($module));
115 }
116 else {
117 my($first, @rest) = $Inst->files($module);
118 system('tar', 'cvf', $file, $first);
119 for my $f (@rest) {
120 system('tar', 'rvf', $file, $f);
121 }
122 print "Can't use tar\n" if $?;
123 }
124}
125
126
127sub validate_packlist {
128 my($reply, $module) = @_;
129
130 if (my @missing = $Inst->validate($module)) {
131 print("Files missing from $module are:\n ",
132 join("\n ", @missing), "\n");
133 }
134 else {
135 print("$module has no missing files\n");
136 }
137}
138
139sub module_help {
140 print $Module_Help;
141}
142
143
144
145##############################################################################
354f3b56
AB
146
147sub toplevel()
148{
149my $help = <<EOF;
150Available commands are:
151 l - List all installed modules
152 m <module> - Select a module
153 q - Quit the program
154EOF
155print($help);
156while (1)
157 {
158 print("cmd? ");
159 my $reply = <STDIN>; chomp($reply);
160 CASE:
161 {
162 $reply eq 'l' and do
163 {
164 print("Installed modules are:\n ", join("\n ", @Modules), "\n");
165 last CASE;
166 };
167 $reply =~ /^m\s+/ and do
168 {
169 do_module((split(' ', $reply))[1]);
170 last CASE;
171 };
172 $reply eq 'q' and do
173 {
174 exit(0);
175 };
176 # Default
177 print($help);
178 }
179 }
180}
181
03c94fc2
RGS
182
183###############################################################################
354f3b56
AB
184
185$Inst = ExtUtils::Installed->new();
186@Modules = $Inst->modules();
187toplevel();
188
03c94fc2 189###############################################################################