Installer: Early check whether the installation directory is writable
[msysgit.git] / bin / instmodsh
blob486b1b142a9849a227d5a420432a17cc6e34c1c3
1 #!/usr/bin/perl
2 eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
3 if $running_under_some_shell;
4 #!/usr/bin/perl -w
6 use strict;
7 use IO::File;
8 use ExtUtils::Packlist;
9 use ExtUtils::Installed;
11 use vars qw($Inst @Modules);
14 =head1 NAME
16 instmodsh - A shell to examine installed modules
18 =head1 SYNOPSIS
20 instmodsh
22 =head1 DESCRIPTION
24 A little interface to ExtUtils::Installed to examine installed modules,
25 validate your packlists and even create a tarball from an installed module.
27 =head1 SEE ALSO
29 ExtUtils::Installed
31 =cut
34 my $Module_Help = <<EOF;
35 Available commands are:
36 f [all|prog|doc] - List installed files of a given type
37 d [all|prog|doc] - List the directories used by a module
38 v - Validate the .packlist - check for missing files
39 t <tarfile> - Create a tar archive of the module
40 h - Display module help
41 q - Quit the module
42 EOF
44 my %Module_Commands = (
45 f => \&list_installed,
46 d => \&list_directories,
47 v => \&validate_packlist,
48 t => \&create_archive,
49 h => \&module_help,
52 sub do_module($) {
53 my ($module) = @_;
55 print($Module_Help);
56 MODULE_CMD: while (1) {
57 print("$module cmd? ");
59 my $reply = <STDIN>; chomp($reply);
60 my($cmd) = $reply =~ /^(\w)\b/;
62 last if $cmd eq 'q';
64 if( $Module_Commands{$cmd} ) {
65 $Module_Commands{$cmd}->($reply, $module);
67 elsif( $cmd eq 'q' ) {
68 last MODULE_CMD;
70 else {
71 module_help();
77 sub list_installed {
78 my($reply, $module) = @_;
80 my $class = (split(' ', $reply))[1];
81 $class = 'all' unless $class;
83 my @files;
84 if (eval { @files = $Inst->files($module, $class); }) {
85 print("$class files in $module are:\n ",
86 join("\n ", @files), "\n");
88 else {
89 print($@);
94 sub list_directories {
95 my($reply, $module) = @_;
97 my $class = (split(' ', $reply))[1];
98 $class = 'all' unless $class;
100 my @dirs;
101 if (eval { @dirs = $Inst->directories($module, $class); }) {
102 print("$class directories in $module are:\n ",
103 join("\n ", @dirs), "\n");
105 else {
106 print($@);
111 sub create_archive {
112 my($reply, $module) = @_;
114 my $file = (split(' ', $reply))[1];
116 if( !(defined $file and length $file) ) {
117 print "No tar file specified\n";
119 elsif( eval { require Archive::Tar } ) {
120 Archive::Tar->create_archive($file, 0, $Inst->files($module));
122 else {
123 my($first, @rest) = $Inst->files($module);
124 system('tar', 'cvf', $file, $first);
125 for my $f (@rest) {
126 system('tar', 'rvf', $file, $f);
128 print "Can't use tar\n" if $?;
133 sub validate_packlist {
134 my($reply, $module) = @_;
136 if (my @missing = $Inst->validate($module)) {
137 print("Files missing from $module are:\n ",
138 join("\n ", @missing), "\n");
140 else {
141 print("$module has no missing files\n");
145 sub module_help {
146 print $Module_Help;
151 ##############################################################################
153 sub toplevel()
155 my $help = <<EOF;
156 Available commands are:
157 l - List all installed modules
158 m <module> - Select a module
159 q - Quit the program
161 print($help);
162 while (1)
164 print("cmd? ");
165 my $reply = <STDIN>; chomp($reply);
166 CASE:
168 $reply eq 'l' and do
170 print("Installed modules are:\n ", join("\n ", @Modules), "\n");
171 last CASE;
173 $reply =~ /^m\s+/ and do
175 do_module((split(' ', $reply))[1]);
176 last CASE;
178 $reply eq 'q' and do
180 exit(0);
182 # Default
183 print($help);
189 ###############################################################################
191 $Inst = ExtUtils::Installed->new();
192 @Modules = $Inst->modules();
193 toplevel();
195 ###############################################################################