home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Exec 2 / CD_Magazyn_EXEC_nr_2.iso / Linux / Archiwa / dpkg.tar.gz / dpkg-1.6.12_powerpc.nondebbin.tar / usr / sbin / cleanup-info next >
Text File  |  2000-04-07  |  4KB  |  156 lines
  1. #! /usr/bin/perl --
  2. #
  3. #   Clean up the mess that bogus install-info may have done :
  4. #
  5. #    - gather all sections with the same heading into a single one.
  6. #    Tries to be smart about cases and trailing colon/spaces.
  7. #
  8. #   Other clean ups :
  9. #
  10. #    - remove empty sections,
  11. #    - squeeze blank lines (in entries part only).
  12. #
  13. #   Order of sections is preserved (the first encountered section
  14. # counts).
  15. #
  16. #   Order of entries within a section is preserved.
  17. #
  18. # BUGS:
  19. #
  20. #   Probably many : I just recently learned Perl for this program
  21. # using the man pages.  Hopefully this is a short enough program to
  22. # debug.
  23.  
  24. # don't put that in for production.
  25. # use strict;
  26.  
  27. my $version="1.6.12"; # This line modified by Makefile
  28. sub version {
  29.     print STDERR <<END;
  30. Debian GNU/Linux cleanup-info $version.  Copyright (C)1996 Kim-Minh Kaplan.
  31. This is free software; see the GNU General Public Licence
  32. version 2 or later for copying conditions.  There is NO warranty.
  33. END
  34. }
  35.  
  36. sub usage {
  37.     print STDERR <<'EOF';
  38. usage: cleanup-info [--version] [--help] [--unsafe] [--] [<dirname>]
  39. Warning: the ``--unsafe'' option may garble an otherwise correct file
  40. EOF
  41. }
  42.  
  43. my $infodir = '/usr/info';
  44. my $unsafe = 0;
  45. $0 =~ m|[^/]+$|;
  46. my $name= $&;
  47.  
  48. sub ulquit {
  49.     unlink "$infodir/dir.lock"
  50.     or warn "$name: warning - unable to unlock $infodir/dir: $!\n";
  51.     die $_[0];
  52. }
  53.  
  54. while (scalar @ARGV > 0 && $ARGV[0] =~ /^--/) {
  55.     $_ = shift;
  56.     /^--$/ and last;
  57.     /^--version$/ and do {
  58.     version;
  59.     exit 0;
  60.     };
  61.     /^--help$/ and do {
  62.     usage;
  63.     exit 0;
  64.     };
  65.     /^--unsafe$/ and do {
  66.     $unsafe=1;
  67.     next;
  68.     };
  69.     print STDERR "$name: unknown option \`$_'\n";
  70.     usage;
  71.     exit 1;
  72. }
  73.  
  74. if (scalar @ARGV > 0) {
  75.     $infodir = shift;
  76.     if (scalar @ARGV > 0) {
  77.     print STDERR "$name: too many arguments\n";
  78.     usage;
  79.     exit 1;
  80.     }
  81. }
  82.  
  83. if (!link "$infodir/dir", "$infodir/dir.lock") {
  84.     die "$name: failed to lock dir for editing! $!\n".
  85.         ($! =~ /exist/i ? "try deleting $infodir/dir.lock\n" : '');
  86. }
  87. open OLD, "$infodir/dir"  or ulquit "$name: can't open $infodir/dir: $!\n";
  88. open OUT, ">$infodir/dir.new"
  89.     or ulquit "$name can't create $infodir/dir.new: $!\n";
  90.  
  91. my (%sections, @section_list, $lastline);
  92. my $section="Miscellaneous";    # default section
  93. my $section_canonic="miscellaneous";
  94. my $waitfor = $unsafe ? '^\*.*:' : '^\*\s*Menu';
  95.  
  96. while (<OLD>) {                # dump the non entries part
  97.     last if (/$waitfor/oi);
  98.     if (defined $lastline) {
  99.     print OUT $lastline
  100.         or ulquit "$name: error writing $infodir/dir.new: $!\n";
  101.     }
  102.     $lastline = $_;
  103. };
  104.  
  105. if (/^\*\s*Menu\s*:?/i) {
  106.     print OUT $lastline if defined $lastline;
  107.     print OUT $_;
  108. } else {
  109.     print OUT "* Menu:\n";
  110.     if (defined $lastline) {
  111.     $lastline =~ s/\s*$//;
  112.     if ($lastline =~ /^([^\*\s].*)/) { # there was a section title
  113.         $section = $1;
  114.         $lastline =~ s/\s*:$//;
  115.         $section_canonic = lc $lastline;
  116.     }
  117.     }
  118.     push @section_list, $section_canonic;
  119.     s/\s*$//;
  120.     $sections{$section_canonic} = "\n$section\n$_\n";
  121. }
  122.  
  123. foreach (<OLD>) {        # collect sections
  124.     next if (/^\s*$/ or $unsafe and /^\*\s*Menu/oi);
  125.     s/\s*$//;
  126.     if (/^([^\*\s].*)/) {        # change of section
  127.     $section = $1;
  128.     s/\s*:$//;
  129.     $section_canonic = lc $_;
  130.     } else {            # add to section
  131.     if (! exists $sections{$section_canonic}) { # create section header
  132.         push @section_list, $section_canonic;
  133.         $sections{$section_canonic} = "\n$section\n";
  134.     }
  135.     $sections{$section_canonic} .= "$_\n";
  136.     }
  137. }
  138.  
  139. eof OLD or ulquit "$name: read $infodir/dir: $!\n";
  140. close OLD or ulquit "$name: close $infodir/dir after read: $!\n";
  141.  
  142. print OUT @sections{@section_list};
  143. close OUT or ulquit "$name: error closing $infodir/dir.new: $!\n";
  144.  
  145. # install clean version
  146. unlink "$infodir/dir.old";
  147. link "$infodir/dir", "$infodir/dir.old"
  148.     or ulquit "$name: can't backup old $infodir/dir, giving up: $!\n";
  149. rename "$infodir/dir.new", "$infodir/dir"
  150.     or ulquit "$name: failed to install $infodir/dir; I'll leave it as $infodir/dir.new: $!\n";
  151.  
  152. unlink "$infodir/dir.lock"
  153.     or die "$name: failed to unlock $infodir/dir: $!\n";
  154.  
  155. exit 0;
  156.