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