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