diff options
Diffstat (limited to 'scripts/install-info.pl')
| -rwxr-xr-x | scripts/install-info.pl | 342 |
1 files changed, 342 insertions, 0 deletions
diff --git a/scripts/install-info.pl b/scripts/install-info.pl new file mode 100755 index 000000000..0455ab1a3 --- /dev/null +++ b/scripts/install-info.pl @@ -0,0 +1,342 @@ +#!/usr/bin/perl -- + +# fixme: --dirfile option +# fixme: sort entries +# fixme: send to FSF ? + +$version= '0.93.42.2'; # This line modified by Makefile +sub version { + print STDERR <<END; +Debian GNU/Linux install-info $version. Copyright (C) 1994,1995 +Ian Jackson. This is free software; see the GNU General Public Licence +version 2 or later for copying conditions. There is NO warranty. +END +} + +sub usage { + print STDERR <<END; +usage: install-info [--version] [--help] [--debug] [--maxwidth=nnn] + [--section regexp title] [--infodir=xxx] [--align=nnn] + [--calign=nnn] [--quiet] [--menuentry=xxx] [--keep-old] + [--description=xxx] [--test] [--remove] [--] filename +END +} + +$infodir='/usr/info'; +$maxwidth=79; +$align=27; +$calign=29; + +undef $menuentry; +undef $quiet; +undef $nowrite; +undef $keepold; +undef $description; +undef $sectionre; +undef $sectiontitle; +$0 =~ m|[^/]+$|; $name= $&; + +while ($ARGV[0] =~ m/^--/) { + $_= shift(@ARGV); + last if $eq eq '--'; + if ($_ eq '--version') { + &version; exit 0; + } elsif ($_ eq '--quiet') { + $quiet=1; + } elsif ($_ eq '--test') { + $nowrite=1; + } elsif ($_ eq '--keep-old') { + $keepold=1; + } elsif ($_ eq '--remove') { + $remove=1; + } elsif ($_ eq '--help') { + &usage; exit 0; + } elsif ($_ eq '--debug') { + open(DEBUG,">&STDERR") || exit 1; + } elsif ($_ eq '--section') { + if (@ARGV < 2) { + print STDERR "$name: --section needs two more args\n"; + &usage; exit 1; + } + $sectionre= shift(@ARGV); + $sectiontitle= shift(@ARGV); + } elsif (m/^--maxwidth=([0-9]+)$/) { + $maxwidth= $1; + } elsif (m/^--align=([0-9]+)$/) { + $align= $1; + } elsif (m/^--calign=([0-9]+)$/) { + $calign= $1; + } elsif (m/^--infodir=/) { + $infodir=$'; + } elsif (m/^--menuentry=/) { + $menuentry=$'; + } elsif (m/^--description=/) { + $description=$'; + } else { + print STDERR "$name: unknown option \`$_'\n"; &usage; exit 1; + } +} + +if (!@ARGV) { &version; print STDERR "\n"; &usage; exit 1; } + +$filename= shift(@ARGV); +if (@ARGV) { print STDERR "$name: too many arguments\n"; &usage; exit 1; } + +if ($remove) { + print STDERR "$name: --section ignored with --remove\n" if length($sectiontitle); + print STDERR "$name: --description ignored with --remove\n" if length($description); +} + +print STDERR "$name: test mode - dir file will not be updated\n" + if $nowrite && !$quiet; + +umask(umask(0777) & ~0444); + +$filename =~ m|[^/]+$|; $basename= $&; $basename =~ s/(\.info)?(\.gz)?$//; +print DEBUG <<END; + infodir=\`$infodir' filename=\`$filename' maxwidth=\`$maxwidth' + menuentry=\`$menuentry' basename=\`$basename' + description=\`$description' remove=$remove +END + +if (!$remove) { + + if (!-f $filename && -f "$filename.gz" || $filename =~ s/\.gz$//) { + $filename= "gzip -d <$filename.gz |"; $pipeit= 1; + } else { + $filename= "< $filename"; + } + + if (!length($description)) { + + open(IF,"$filename") || die "$name: read $filename: $!\n"; + $asread=''; + while(<IF>) { last if m/^START-INFO-DIR-ENTRY$/; } + while(<IF>) { last if m/^END-INFO-DIR-ENTRY$/; $asread.= $_; } + close(IF); &checkpipe; + if ($asread =~ m/(\* *[^:]+: *\([^\)]+\).*\. *.*\n){2,}/) { + $infoentry= $asread; $multiline= 1; + print DEBUG <<END; + multiline \`$asread' +END + } elsif ($asread =~ m/^\* *([^:]+):( *\([^\)]+\)\.|:)\s*/) { + $menuentry= $1; $description= $'; + print DEBUG <<END; + infile menuentry \`$menuentry' description \`$description' +END + } elsif (length($asread)) { + print STDERR <<END; +$name: warning, ignoring confusing INFO-DIR-ENTRY in file. +END + } + } + + if (length($infoentry)) { + + $infoentry =~ m/\n/; + print "$`\n" unless $quiet; + $infoentry =~ m/^\* *([^:]+): *\(([^\)]+)\)/ || die; # internal error + $sortby= $1; $fileinentry= $2; + + } else { + + if (!length($description)) { + open(IF,"$filename") || die "$name: read $filename: $!\n"; + $asread=''; + while(<IF>) { + if (m/^\s*[Tt]his file documents/) { + $asread=$'; + last; + } + } + if (length($asread)) { + while(<IF>) { last if m/^\s*$/; $asread.= $_; } + $description= $asread; + } + close(IF); &checkpipe; + } + + if (!length($description)) { + print STDERR <<END; +No \`START-INFO-DIR-ENTRY' and no \`This file documents'. +$name: unable to determine description for \`dir' entry - giving up +END + exit 1; + } + + $description =~ s/^\s*(.)//; $_=$1; y/a-z/A-Z/; + $description= $_ . $description; + + if (!length($menuentry)) { + $menuentry= $basename; $menuentry =~ s/\Winfo$//; + $menuentry =~ s/^.//; $_=$&; y/a-z/A-Z/; + $menuentry= $_ . $menuentry; + } + + print DEBUG <<END; + menuentry=\`$menuentry' description=\`$description' +END + + $cprefix= sprintf("* %s: (%s).", $menuentry, $basename); + $align--; $calign--; + $lprefix= length($cprefix); + if ($lprefix < $align) { + $cprefix .= ' ' x ($align - $lprefix); + $lprefix= $align; + } + $prefix= "\n". (' 'x $calign); + $cwidth= $maxwidth+1; + + for $_ (split(/\s+/,$description)) { + $l= length($_); + $cwidth++; $cwidth += $l; + if ($cwidth > $maxwidth) { + $infoentry .= $cprefix; + $cwidth= $lprefix+1+$l; + $cprefix= $prefix; $lprefix= $calign; + } + $infoentry.= ' '; $infoentry .= $_; + } + + $infoentry.= "\n"; + print $infoentry unless $quiet; + $sortby= $menuentry; $sortby =~ y/A-Z/a-z/; + + } +} + +if (!link("$infodir/dir","$infodir/dir.lock")) { + die "$name: failed to lock dir for editing! $!\n". + ($! =~ m/exists/i ? "try deleting $infodir/dir.lock ?\n" : ''); +} + +open(OLD,"$infodir/dir") || &ulquit("$name: open $infodir/dir: $!\n"); +@work= <OLD>; +eof(OLD) || &ulquit("$name: read $infodir/dir: $!\n"); +close(OLD) || &ulquit("$name: close $infodir/dir after read: $!\n"); +while ($work[$#work] !~ m/\S/) { $#work--; } + +if (!$remove) { + + for ($i=0; $i<=$#work; $i++) { + next unless $work[$i] =~ m/^\* *[^:]+: *\(([^\)]+)\).*\.\s/; + last if $1 eq $basename || $1 eq "$basename.info"; + } + for ($j=$i; $j<=$#work+1; $j++) { + next if $work[$j] =~ m/^\s+\S/; + last unless $work[$j] =~ m/^\* *[^:]+: *\(([^\)]+)\).*\.\s/; + last unless $1 eq $basename || $1 eq "$basename.info"; + } + + if ($i < $j) { + if ($keepold) { + print "$name: existing entry for \`$basename' not replaced\n" unless $quiet; + $nowrite=1; + } else { + print "$name: replacing existing dir entry for \`$basename'\n" unless $quiet; + } + $mss= $i; + @work= (@work[0..$i-1], @work[$j..$#work]); + } elsif (length($sectionre)) { + for ($i=0; $i<=$#work && $work[$i] !~ m/^\* *menu/i; $i++) { } + $mss= -1; + for (; $i<=$#work; $i++) { + $_= $work[$i]; + next if m/^\*/; + next unless m/$sectionre/io; + $mss= $i+1; last; + } + if ($mss < 0) { + print "$name: creating new section \`$sectiontitle'\n" unless $quiet; + for ($i= $#work; $i>=0 && $work[$i] =~ m/\S/; $i--) { } + $i >= 0 || &ulquit("$name: nowhere to create new section - giving up\n"); + @work= (@work[0..$i], "$sectiontitle\n", "\n", @work[$i+1..$#work]); + $mss= $i+1; + } + while ($mss <= $#work) { + $work[$mss] =~ m/\S/ || last; + $work[$mss] =~ m/^\* *([^:]+):/ || ($mss++, next); + last if $multiline; + $_=$1; y/A-Z/a-z/; + last if $_ gt $sortby; + $mss++; + } + } else { + print "$name: no section specified for new entry, placing at end\n" + unless $quiet; + $mss= $#work+1; + } + + @work= (@work[0..$mss-1], $infoentry, @work[$mss..$#work]); + +} else { + + for ($i=0; $i<=$#work; $i++) { + next unless $work[$i] =~ m/^\* *([^:]+): *\((\w[^\)]*)\)/; + $tme= $1; $tfile= $2; $match= $&; + next unless $tfile eq $basename; + last if !length($menuentry); + $tme =~ y/A-Z/a-z/; + last if $tme eq $menuentry; + } + for ($j=$i; $j<=$#work+1; $j++) { + next if $work[$j] =~ m/^\s+\S/; + last unless $work[$j] =~ m/^\* *([^:]+): *\((\w[^\)]*)\)/; + $tme= $1; $tfile= $2; + last unless $tfile eq $basename; + next if !length($menuentry); + $tme =~ y/A-Z/a-z/; + last unless $tme eq $menuentry; + } + print DEBUG <<END; + i=$i \$work[\$i]=\`$work[$i]' j=$j \$work[\$j]=\`$work[$j]' +END + + if ($i < $j) { + print "$name: deleting entry \`$match ...'\n" unless $quiet; + $_= $work[$i-1]; + unless (m/^\s/ || m/^\*/ || m/^$/ || + $j > $#work || $work[$j] !~ m/^\s*$/) { + s/:?\s+$//; + if ($keepold) { + print "$name: empty section \`$_' not removed\n" unless $quiet; + } else { + $i--; $j++; + print "$name: deleting empty section \`$_'\n" unless $quiet; + } + } + @work= (@work[0..$i-1], @work[$j..$#work]); + } else { + print "$name: no entry for file \`$basename'". + (length($menuentry) ? " and menu entry \`$menuentry'": ''). + ".\n" + unless $quiet; + } +} + +if (!$nowrite) { + open(NEW,"> $infodir/dir.new") || &ulquit("$name: create $infodir/dir.new: $!\n"); + print(NEW @work) || &ulquit("$name: write $infodir/dir.new: $!\n"); + close(NEW) || &ulquit("$name: close $infodir/dir.new: $!\n"); + + unlink("$infodir/dir.old"); + link("$infodir/dir","$infodir/dir.old") || + &ulquit("$name: cannot backup old $infodir/dir, giving up: $!\n"); + rename("$infodir/dir.new","$infodir/dir") || + &ulquit("$name: install new $infodir/dir: $!\n"); +} + +unlink("$infodir/dir.lock") || die "$name: unlock $infodir/dir: $!\n"; + +sub ulquit { + unlink("$infodir/dir.lock") || + warn "$name: warning - unable to unlock $infodir/dir: $!\n"; + die $_[0]; +} + +sub checkpipe { + return if !$pipeit || !$? || $?==0x8D00; + die "$name: read $filename: $?\n"; +} + +exit 0; |