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