home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 February / PCWorld_2000-02_cd.bin / live / usr / sbin / install-info < prev    next >
Text File  |  1999-03-02  |  11KB  |  356 lines
  1. #! /usr/bin/perl --
  2.  
  3. # fixme: --dirfile option
  4. # fixme: sort entries
  5. # fixme: send to FSF ?
  6.  
  7. $version="1.4.0.34"; # This line modified by Makefile
  8. sub version {
  9.         print STDERR <<END;
  10. Debian GNU/Linux install-info $version.  Copyright (C) 1994,1995
  11. Ian Jackson.  This is free software; see the GNU General Public Licence
  12. version 2 or later for copying conditions.  There is NO warranty.
  13. END
  14. }
  15.  
  16. sub usage {
  17.     print STDERR <<END;
  18. usage: install-info [--version] [--help] [--debug] [--maxwidth=nnn]
  19.              [--section regexp title] [--infodir=xxx] [--align=nnn]
  20.              [--calign=nnn] [--quiet] [--menuentry=xxx] [--info-dir=xxx]
  21.              [--keep-old] [--description=xxx] [--test] [--remove] [--]
  22.              filename
  23. END
  24. }
  25.  
  26. $infodir='/usr/info';
  27. $maxwidth=79;
  28. $align=27;
  29. $calign=29;
  30.  
  31. undef $menuentry;
  32. undef $quiet;
  33. undef $nowrite;
  34. undef $keepold;
  35. undef $description;
  36. undef $sectionre;
  37. undef $sectiontitle;
  38. $0 =~ m|[^/]+$|; $name= $&;
  39.  
  40. while ($ARGV[0] =~ m/^--/) {
  41.     $_= shift(@ARGV);
  42.     last if $_ eq '--';
  43.     if ($_ eq '--version') {
  44.         &version; exit 0;
  45.     } elsif ($_ eq '--quiet') {
  46.         $quiet=1;
  47.     } elsif ($_ eq '--test') {
  48.         $nowrite=1;
  49.     } elsif ($_ eq '--keep-old') {
  50.         $keepold=1;
  51.     } elsif ($_ eq '--remove') {
  52.         $remove=1;
  53.     } elsif ($_ eq '--help') {
  54.         &usage; exit 0;
  55.     } elsif ($_ eq '--debug') {
  56.         open(DEBUG,">&STDERR") || exit 1;
  57.     } elsif ($_ eq '--section') {
  58.         if (@ARGV < 2) {
  59.             print STDERR "$name: --section needs two more args\n";
  60.             &usage; exit 1;
  61.         }
  62.         $sectionre= shift(@ARGV);
  63.         $sectiontitle= shift(@ARGV);
  64.     } elsif (m/^--maxwidth=([0-9]+)$/) {
  65.         $maxwidth= $1;
  66.     } elsif (m/^--align=([0-9]+)$/) {
  67.         $align= $1;
  68.     } elsif (m/^--calign=([0-9]+)$/) {
  69.         $calign= $1;
  70.     } elsif (m/^--infodir=/) {
  71.         $infodir=$';
  72.     } elsif (m/^--menuentry=/) {
  73.         $menuentry=$';
  74.     } elsif (m/^--info-dir=/) {
  75.         $infodir=$';
  76.     } elsif (m/^--description=/) {
  77.         $description=$';
  78.     } else {
  79.         print STDERR "$name: unknown option \`$_'\n"; &usage; exit 1;
  80.     }
  81. }
  82.  
  83. if (!@ARGV) { &version; print STDERR "\n"; &usage; exit 1; }
  84.  
  85. $filename= shift(@ARGV);
  86. if (@ARGV) { print STDERR "$name: too many arguments\n"; &usage; exit 1; }
  87.  
  88. if ($remove) {
  89.     print STDERR "$name: --section ignored with --remove\n" if length($sectiontitle);
  90.     print STDERR "$name: --description ignored with --remove\n" if length($description);
  91. }
  92.  
  93. print STDERR "$name: test mode - dir file will not be updated\n"
  94.     if $nowrite && !$quiet;
  95.  
  96. umask(umask(0777) & ~0444);
  97.  
  98. $filename =~ m|[^/]+$|; $basename= $&; $basename =~ s/(\.info)?(\.gz)?$//;
  99. print DEBUG <<END;
  100.  infodir=\`$infodir'  filename=\`$filename'  maxwidth=\`$maxwidth'
  101.  menuentry=\`$menuentry'  basename=\`$basename'
  102.  description=\`$description' remove=$remove
  103. END
  104.  
  105. if (!$remove) {
  106.  
  107.     if (!-f $filename && -f "$filename.gz" || $filename =~ s/\.gz$//) {
  108.         $filename= "gzip -d <$filename.gz |";  $pipeit= 1;
  109.     } else {
  110.         $filename= "< $filename";
  111.     }
  112.  
  113.     if (!length($description)) {
  114.         
  115.         open(IF,"$filename") || die "$name: read $filename: $!\n";
  116.         $asread='';
  117.         while(<IF>) { last if m/^START-INFO-DIR-ENTRY$/; }
  118.         while(<IF>) { last if m/^END-INFO-DIR-ENTRY$/; $asread.= $_; }
  119.         close(IF); &checkpipe;
  120.         if ($asread =~ m/(\* *[^:]+: *\([^\)]+\).*\. *.*\n){2,}/) {
  121.             $infoentry= $asread; $multiline= 1;
  122.             print DEBUG <<END;
  123.  multiline \`$asread'
  124. END
  125.         } elsif ($asread =~ m/^\* *([^:]+):( *\([^\)]+\)\.|:)\s*/) {
  126.             $menuentry= $1; $description= $';
  127.             print DEBUG <<END;
  128.  infile menuentry \`$menuentry' description \`$description'
  129. END
  130.         } elsif (length($asread)) {
  131.             print STDERR <<END;
  132. $name: warning, ignoring confusing INFO-DIR-ENTRY in file.
  133. END
  134.         }
  135.     }
  136.  
  137.     if (length($infoentry)) {
  138.  
  139.         $infoentry =~ m/\n/;
  140.         print "$`\n" unless $quiet;
  141.         $infoentry =~ m/^\* *([^:]+): *\(([^\)]+)\)/ || die; # internal error
  142.         $sortby= $1;  $fileinentry= $2;
  143.         
  144.     } else {
  145.         
  146.         if (!length($description)) {
  147.             open(IF,"$filename") || die "$name: read $filename: $!\n";
  148.             $asread='';
  149.             while(<IF>) {
  150.                 if (m/^\s*[Tt]his file documents/) {
  151.                     $asread=$';
  152.                     last;
  153.                 }
  154.             }
  155.             if (length($asread)) {
  156.                 while(<IF>) { last if m/^\s*$/; $asread.= $_; }
  157.                 $description= $asread;
  158.             }
  159.             close(IF); &checkpipe;
  160.         }
  161.  
  162.         if (!length($description)) {
  163.             print STDERR <<END;
  164. No \`START-INFO-DIR-ENTRY' and no \`This file documents'.
  165. $name: unable to determine description for \`dir' entry - giving up
  166. END
  167.             exit 1;
  168.         }
  169.  
  170.         $description =~ s/^\s*(.)//;  $_=$1;  y/a-z/A-Z/;
  171.         $description= $_ . $description;
  172.  
  173.         if (!length($menuentry)) {
  174.             $menuentry= $basename;  $menuentry =~ s/\Winfo$//;
  175.             $menuentry =~ s/^.//;  $_=$&;  y/a-z/A-Z/;
  176.             $menuentry= $_ . $menuentry;
  177.         }
  178.  
  179.         print DEBUG <<END;
  180.  menuentry=\`$menuentry'  description=\`$description'
  181. END
  182.  
  183.         $cprefix= sprintf("* %s: (%s).", $menuentry, $basename);
  184.         $align--; $calign--;
  185.         $lprefix= length($cprefix);
  186.         if ($lprefix < $align) {
  187.             $cprefix .= ' ' x ($align - $lprefix);
  188.             $lprefix= $align;
  189.         }
  190.         $prefix= "\n". (' 'x $calign);
  191.         $cwidth= $maxwidth+1;
  192.  
  193.         for $_ (split(/\s+/,$description)) {
  194.             $l= length($_);
  195.             $cwidth++; $cwidth += $l;
  196.             if ($cwidth > $maxwidth) {
  197.                 $infoentry .= $cprefix;
  198.                 $cwidth= $lprefix+1+$l;
  199.                 $cprefix= $prefix; $lprefix= $calign;
  200.             }
  201.             $infoentry.= ' '; $infoentry .= $_;
  202.         }
  203.  
  204.         $infoentry.= "\n";
  205.         print $infoentry unless $quiet;
  206.         $sortby= $menuentry;  $sortby =~ y/A-Z/a-z/;
  207.  
  208.     }
  209. }
  210.  
  211. if (!$nowrite && !link("$infodir/dir","$infodir/dir.lock")) {
  212.     die "$name: failed to lock dir for editing! $!\n".
  213.         ($! =~ m/exists/i ? "try deleting $infodir/dir.lock ?\n" : '');
  214. }
  215.  
  216. open(OLD,"$infodir/dir") || &ulquit("$name: open $infodir/dir: $!\n");
  217. @work= <OLD>;
  218. eof(OLD) || &ulquit("$name: read $infodir/dir: $!\n");
  219. close(OLD) || &ulquit("$name: close $infodir/dir after read: $!\n");
  220. while ($work[$#work] !~ m/\S/) { $#work--; }
  221.  
  222. while (@work) {
  223.     $_=shift(@work);
  224.     push(@head,$_);
  225.     last if (m/^\*\s*Menu:/i);
  226. }
  227.  
  228. if (!$remove) {
  229.  
  230.     for ($i=0; $i<=$#work; $i++) {
  231.         next unless $work[$i] =~ m/^\* *[^:]+: *\(([^\)]+)\).*\.\s/;
  232.         last if $1 eq $basename || $1 eq "$basename.info";
  233.     }
  234.     for ($j=$i; $j<=$#work+1; $j++) {
  235.         next if $work[$j] =~ m/^\s+\S/;
  236.         last unless $work[$j] =~ m/^\* *[^:]+: *\(([^\)]+)\).*\.\s/;
  237.         last unless $1 eq $basename || $1 eq "$basename.info";
  238.     }
  239.  
  240.     if ($i < $j) {
  241.         if ($keepold) {
  242.             print "$name: existing entry for \`$basename' not replaced\n" unless $quiet;
  243.             $nowrite=1;
  244.         } else {
  245.             print "$name: replacing existing dir entry for \`$basename'\n" unless $quiet;
  246.         }
  247.         $mss= $i;
  248.         @work= (@work[0..$i-1], @work[$j..$#work]);
  249.     } elsif (length($sectionre)) {
  250.         $mss= -1;
  251.         for ($i=0; $i<=$#work; $i++) {
  252.             $_= $work[$i];
  253.             next if m/^\*/;
  254.             next unless m/$sectionre/io;
  255.             $mss= $i+1; last;
  256.         }
  257.         if ($mss < 0) {
  258.             print "$name: creating new section \`$sectiontitle'\n" unless $quiet;
  259.             for ($i= $#work; $i>=0 && $work[$i] =~ m/\S/; $i--) { }
  260.             if ($i <= 0) { # We ran off the top, make this section and Misc.
  261.                 print "$name: no sections yet, creating Miscellaneous section too.\n"
  262.                     unless $quiet;
  263.                 @work= ("\n", "$sectiontitle\n", "\n", "Miscellaneous:\n", @work);
  264.                 $mss= 1;
  265.             } else {
  266.                 @work= (@work[0..$i], "$sectiontitle\n", "\n", @work[$i+1..$#work]);
  267.                 $mss= $i+1;
  268.             }
  269.         }
  270.         while ($mss <= $#work) {
  271.             $work[$mss] =~ m/\S/ || last;
  272.             $work[$mss] =~ m/^\* *([^:]+):/ || ($mss++, next);
  273.             last if $multiline;
  274.             $_=$1;  y/A-Z/a-z/;
  275.             last if $_ gt $sortby;
  276.             $mss++;
  277.         }
  278.     } else {
  279.         print "$name: no section specified for new entry, placing at end\n"
  280.             unless $quiet;
  281.         $mss= $#work+1;
  282.     }
  283.  
  284.     @work= (@work[0..$mss-1], $infoentry, @work[$mss..$#work]);
  285.     
  286. } else {
  287.  
  288.     for ($i=0; $i<=$#work; $i++) {
  289.         next unless $work[$i] =~ m/^\* *([^:]+): *\((\w[^\)]*)\)/;
  290.         $tme= $1; $tfile= $2; $match= $&;
  291.         next unless $tfile eq $basename;
  292.         last if !length($menuentry);
  293.         $tme =~ y/A-Z/a-z/;
  294.         last if $tme eq $menuentry;
  295.     }
  296.     for ($j=$i; $j<=$#work+1; $j++) {
  297.         next if $work[$j] =~ m/^\s+\S/;
  298.         last unless $work[$j] =~ m/^\* *([^:]+): *\((\w[^\)]*)\)/;
  299.         $tme= $1; $tfile= $2;
  300.         last unless $tfile eq $basename;
  301.         next if !length($menuentry);
  302.         $tme =~ y/A-Z/a-z/;
  303.         last unless $tme eq $menuentry;
  304.     }
  305.         print DEBUG <<END;
  306.  i=$i \$work[\$i]=\`$work[$i]' j=$j \$work[\$j]=\`$work[$j]'
  307. END
  308.  
  309.     if ($i < $j) {
  310.         print "$name: deleting entry \`$match ...'\n" unless $quiet;
  311.         $_= $work[$i-1];
  312.         unless (m/^\s/ || m/^\*/ || m/^$/ ||
  313.                 $j > $#work || $work[$j] !~ m/^\s*$/) {
  314.             s/:?\s+$//;
  315.             if ($keepold) {
  316.                 print "$name: empty section \`$_' not removed\n" unless $quiet;
  317.             } else {
  318.                 $i--; $j++;
  319.                 print "$name: deleting empty section \`$_'\n" unless $quiet;
  320.             }
  321.         }
  322.         @work= (@work[0..$i-1], @work[$j..$#work]);
  323.     } else {
  324.         print "$name: no entry for file \`$basename'".
  325.               (length($menuentry) ? " and menu entry \`$menuentry'": '').
  326.               ".\n"
  327.             unless $quiet;
  328.     }
  329. }
  330.  
  331. if (!$nowrite) {
  332.     open(NEW,"> $infodir/dir.new") || &ulquit("$name: create $infodir/dir.new: $!\n");
  333.     print(NEW @head,@work) || &ulquit("$name: write $infodir/dir.new: $!\n");
  334.     close(NEW) || &ulquit("$name: close $infodir/dir.new: $!\n");
  335.  
  336.     unlink("$infodir/dir.old");
  337.     link("$infodir/dir","$infodir/dir.old") ||
  338.         &ulquit("$name: cannot backup old $infodir/dir, giving up: $!\n");
  339.     rename("$infodir/dir.new","$infodir/dir") ||
  340.         &ulquit("$name: install new $infodir/dir: $!\n");
  341. unlink("$infodir/dir.lock") || die "$name: unlock $infodir/dir: $!\n";
  342. }
  343.  
  344. sub ulquit {
  345.     unlink("$infodir/dir.lock") ||
  346.         warn "$name: warning - unable to unlock $infodir/dir: $!\n";
  347.     die $_[0];
  348. }
  349.  
  350. sub checkpipe {
  351.     return if !$pipeit || !$? || $?==0x8D00;
  352.     die "$name: read $filename: $?\n";
  353. }
  354.  
  355. exit 0;
  356.