instmodsh revision 7c478bd95313f5f23a4c958a745db2134aa03244
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny#!/usr/local/bin/perl -w
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zelenyuse strict;
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zelenyuse IO::File;
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zelenyuse ExtUtils::Packlist;
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zelenyuse ExtUtils::Installed;
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zelenyuse vars qw($Inst @Modules);
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny################################################################################
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zelenysub do_module($)
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny{
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zelenymy ($module) = @_;
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zelenymy $help = <<EOF;
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan ZelenyAvailable commands are:
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny f [all|prog|doc] - List installed files of a given type
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny d [all|prog|doc] - List the directories used by a module
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny v - Validate the .packlist - check for missing files
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny t <tarfile> - Create a tar archive of the module
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny q - Quit the module
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan ZelenyEOF
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zelenyprint($help);
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zelenywhile (1)
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny {
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny print("$module cmd? ");
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny my $reply = <STDIN>; chomp($reply);
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny CASE:
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny {
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny $reply =~ /^f\s*/ and do
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny {
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny my $class = (split(' ', $reply))[1];
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce $class = 'all' if (! $class);
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce my @files;
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce if (eval { @files = $Inst->files($module, $class); })
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce {
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce print("$class files in $module are:\n ",
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce join("\n ", @files), "\n");
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce last CASE;
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce }
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce else
a3c8390d19593b1e5277d95bfb4ab206d4785150Nikolai Kondrashov { print($@); }
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce };
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce $reply =~ /^d\s*/ and do
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce {
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce my $class = (split(' ', $reply))[1];
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce $class = 'all' if (! $class);
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce my @dirs;
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce if (eval { @dirs = $Inst->directories($module, $class); })
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce {
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce print("$class directories in $module are:\n ",
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce join("\n ", @dirs), "\n");
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce last CASE;
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce }
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce else
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce { print($@); }
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce };
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce $reply =~ /^t\s*/ and do
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bose {
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bose my $file = (split(' ', $reply))[1];
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bose my $tmp = "/tmp/inst.$$";
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bose if (my $fh = IO::File->new($tmp, "w"))
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bose {
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bose $fh->print(join("\n", $Inst->files($module)));
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bose $fh->close();
39be7dbfa25a1cae78741a1c6c8c744e8c87e38fSimo Sorce system("tar cvf $file -I $tmp");
39be7dbfa25a1cae78741a1c6c8c744e8c87e38fSimo Sorce unlink($tmp);
39be7dbfa25a1cae78741a1c6c8c744e8c87e38fSimo Sorce last CASE;
39be7dbfa25a1cae78741a1c6c8c744e8c87e38fSimo Sorce }
39be7dbfa25a1cae78741a1c6c8c744e8c87e38fSimo Sorce else { print("Can't open $file: $!\n"); }
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny last CASE;
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce };
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny $reply eq 'v' and do
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny {
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny if (my @missing = $Inst->validate($module))
03abdaa21ecf562b714f204ca42379ff08626f75Simo Sorce {
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny print("Files missing from $module are:\n ",
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny join("\n ", @missing), "\n");
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny }
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce else
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny {
03abdaa21ecf562b714f204ca42379ff08626f75Simo Sorce print("$module has no missing files\n");
03abdaa21ecf562b714f204ca42379ff08626f75Simo Sorce }
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny last CASE;
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny };
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny $reply eq 'q' and do
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny {
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny return;
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny };
cbaba2f47da96c4191971bce86f03afb3f88864aSimo Sorce # Default
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny print($help);
03abdaa21ecf562b714f204ca42379ff08626f75Simo Sorce }
3d28e0e560b787b5c57ed7327d184310342a7e38Jakub Hrozek }
3d28e0e560b787b5c57ed7327d184310342a7e38Jakub Hrozek}
3d28e0e560b787b5c57ed7327d184310342a7e38Jakub Hrozek
3d28e0e560b787b5c57ed7327d184310342a7e38Jakub Hrozek################################################################################
ed4a9bd4d0f7fb359bed66a8d63a92e7be633aaeSumit Bose
ed4a9bd4d0f7fb359bed66a8d63a92e7be633aaeSumit Bosesub toplevel()
e11c7dc43f4ff9897e37cc0d793f8e1fb3b8453aSimo Sorce{
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorcemy $help = <<EOF;
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan ZelenyAvailable commands are:
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce l - List all installed modules
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce m <module> - Select a module
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny q - Quit the program
03abdaa21ecf562b714f204ca42379ff08626f75Simo SorceEOF
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorceprint($help);
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zelenywhile (1)
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce {
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce print("cmd? ");
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bose my $reply = <STDIN>; chomp($reply);
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bose CASE:
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bose {
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny $reply eq 'l' and do
8b1f2574ce7a964965a18ab047ab09c4694380c4Jan Zeleny {
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce print("Installed modules are:\n ", join("\n ", @Modules), "\n");
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce last CASE;
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce };
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce $reply =~ /^m\s+/ and do
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce {
881c4ba834b23ae651ac01db667801f314eb0a5dJan Zeleny do_module((split(' ', $reply))[1]);
881c4ba834b23ae651ac01db667801f314eb0a5dJan Zeleny last CASE;
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce };
39be7dbfa25a1cae78741a1c6c8c744e8c87e38fSimo Sorce $reply eq 'q' and do
39be7dbfa25a1cae78741a1c6c8c744e8c87e38fSimo Sorce {
cbaba2f47da96c4191971bce86f03afb3f88864aSimo Sorce exit(0);
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce };
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bose # Default
39be7dbfa25a1cae78741a1c6c8c744e8c87e38fSimo Sorce print($help);
39be7dbfa25a1cae78741a1c6c8c744e8c87e38fSimo Sorce }
39be7dbfa25a1cae78741a1c6c8c744e8c87e38fSimo Sorce }
e11c7dc43f4ff9897e37cc0d793f8e1fb3b8453aSimo Sorce}
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce################################################################################
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bose
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bose$Inst = ExtUtils::Installed->new();
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bose@Modules = $Inst->modules();
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bosetoplevel();
acebf94a16c91b17c7c082538ab3083ee26aa992Sumit Bose
6ff0d2242fe93d694b81b29ab12289db4859e1dcSimo Sorce################################################################################
39be7dbfa25a1cae78741a1c6c8c744e8c87e38fSimo Sorce