Replace install-info by a simple wrapper (or no-op command)

In order to properly transition to GNU's install-info, dpkg's install-info
is modified to be a simple wrapper around /usr/bin/install-info. That
wrapper warns when the user explicitely calls /usr/sbin/install-info since
the new install-info is in /usr/bin/.

This wrapper is meant to be removed at some point when all references
to /usr/sbin/install-info have gone (most probably in squeeze+1).

Also remove the manual page since there's nothing to document any more
and add a lintian override until the wrapper is removed.

Reference: http://wiki.debian.org/Transitions/DpkgToGnuInstallInfo

3 files changed, 1 insertions, 541 deletions

diff --git a/scripts/.gitignore b/scripts/.gitignore
index 2d2e2a99a..3fc292e1b 100644
--- a/scripts/.gitignore
+++ b/scripts/.gitignore
@@ -15,6 +15,4 @@ dpkg-source
 dpkg-statoverride
 dpkg-vendor
 update-alternatives
-install-info
-install-info-stamp
 t.tmp
diff --git a/scripts/Makefile.am b/scripts/Makefile.am
index 59cc6f730..c71851221 100644
--- a/scripts/Makefile.am
+++ b/scripts/Makefile.am
@@ -43,7 +43,6 @@ EXTRA_DIST = \
 	dpkg-divert.pl \
 	dpkg-statoverride.pl \
 	dpkg-vendor.pl \
-	install-info.pl \
 	update-alternatives.pl \
 	changelog/debian.pl \
 	t/000_pod.t \
@@ -85,8 +84,7 @@ EXTRA_DIST = \
 	t/900_update_alternatives.t
 
 CLEANFILES = \
-	$(bin_SCRIPTS) $(changelog_SCRIPTS) \
-	install-info install-info-stamp
+	$(bin_SCRIPTS) $(changelog_SCRIPTS)
 
 perllibdir = $(PERL_LIBDIR)
 nobase_dist_perllib_DATA = \
@@ -143,18 +141,6 @@ do_perl_subst = sed -e "s:^\#![:space:]*/usr/bin/perl:\#!$(PERL):" \
 	$(do_perl_subst) <$< >$@
 	chmod +x $@
 
-
-# Automake has its own install-info rule, gah
-all-local: install-info-stamp
-install-info-stamp: $(srcdir)/install-info.pl
-	$(do_perl_subst) <$< >install-info
-	chmod +x install-info
-	touch $@
-
-install-exec-local: install-info-stamp
-	$(mkdir_p) $(DESTDIR)$(sbindir)
-	$(INSTALL_SCRIPT) install-info $(DESTDIR)$(sbindir)
-
 install-data-local:
 	$(mkdir_p) $(DESTDIR)$(sysconfdir)/alternatives
 	$(INSTALL_DATA) $(srcdir)/README.alternatives $(DESTDIR)$(sysconfdir)/alternatives/README
diff --git a/scripts/install-info.pl b/scripts/install-info.pl
deleted file mode 100755
index c3552bd44..000000000
--- a/scripts/install-info.pl
+++ /dev/null
@@ -1,524 +0,0 @@
-#!/usr/bin/perl --
-
-BEGIN { # Work-around for bug #479711 in perl
-    $ENV{PERL_DL_NONLAZY} = 1;
-}
-
-use Text::Wrap;
-use Dpkg;
-use Dpkg::Gettext;
-
-textdomain("dpkg");
-
-# FIXME: sort entries
-# FIXME: send to FSF ?
-
-sub version {
-    printf _g("Debian %s version %s.\n"), $progname, $version;
-
-    printf _g("
-Copyright (C) 1994,1995 Ian Jackson.");
-
-    printf _g("
-This is free software; see the GNU General Public Licence version 2 or
-later for copying conditions. There is NO warranty.
-");
-}
-
-sub usage {
-    $file = $_[0];
-    printf $file _g(
-"Usage: %s [<options> ...] [--] <filename>
-
-Options:
-  --section <regexp> <title>
-                           put the new entry in the <regex> matched section
-                           or create a new one with <title> if non-existent.
-  --menuentry=<text>       set the menu entry.
-  --description=<text>     set the description to be used in the menu entry.
-  --info-file=<path>       specify info file to install in the directory.
-  --dir-file=<path>        specify file name of info directory file.
-  --infodir=<directory>    same as '--dir-file=<directory>/dir'.
-  --info-dir=<directory>   likewise.
-  --keep-old               do not replace entries nor remove empty ones.
-  --remove                 remove the entry specified by <filename> basename.
-  --remove-exactly         remove the exact <filename> entry.
-  --test                   enables test mode (no actions taken).
-  --debug                  enables debug mode (show more information).
-  --quiet                  do not show output messages.
-  --help                   show this help message.
-  --version                show the version.
-"), $progname;
-}
-
-$dirfile = '/usr/share/info/dir';
-$maxwidth=79;
-$Text::Wrap::columns=$maxwidth;
-$backup='/var/backups/infodir.bak';
-$default='/usr/share/base-files/info.dir';
-
-$menuentry="";
-$description="";
-$sectionre="";
-$sectiontitle="";
-$infoentry="";
-$quiet=0;
-$nowrite=0;
-$keepold=0;
-$debug=0;
-$remove=0;
-
-my $remove_exactly;
-
-$0 =~ m|[^/]+$|; $name= $&;
-
-while ($ARGV[0] =~ m/^--/) {
-    $_= shift(@ARGV);
-    last if $_ eq '--';
-    if ($_ eq '--version') {
-        &version(STDOUT); 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 '--remove-exactly') {
-        $remove=1;
-        $remove_exactly=1;
-    } elsif ($_ eq '--help') {
-        &usage(STDOUT); exit 0;
-    } elsif ($_ eq '--version') {
-        &version; exit 0;
-    } elsif ($_ eq '--debug') {
-	open(DEBUG,">&STDERR")
-	    || &quit(sprintf(_g("could not open stderr for output! %s"), $!));
-	$debug=1;
-    } elsif ($_ eq '--section') {
-        if (@ARGV < 2) {
-	    printf STDERR _g("%s: --section needs two more args")."\n", $name;
-            &usage(STDERR); exit 1;
-        }
-        $sectionre= shift(@ARGV);
-        $sectiontitle= shift(@ARGV);
-    } elsif (m/^--(c?align|maxwidth)=([0-9]+)$/) {
-	warn(sprintf(_g("%s: option --%s is deprecated (ignored)"), $name, $1)."\n");
-    } elsif (m/^--info-?dir=/) {
-	$dirfile = $' . '/dir';
-    } elsif (m/^--info-file=/) {
-	$filename = $';
-    } elsif (m/^--menuentry=/) {
-	$menuentry = $';
-    } elsif (m/^--description=/) {
-	$description = $';
-    } elsif (m/^--dir-file=/) { # for compatibility with GNU install-info
-	$dirfile = $';
-    } else {
-        printf STDERR _g("%s: unknown option \`%s'")."\n", $name, $_;
-        &usage(STDERR); exit 1;
-    }
-}
-
-if (!@ARGV) { &usage(STDERR); exit 1; }
-
-if ( !$filename ) {
-	$filename= shift(@ARGV);
-	$name = "$name($filename)";
-}
-if (@ARGV) { printf STDERR _g("%s: too many arguments")."\n", $name; &usage(STDERR); exit 1; }
-
-if ($remove) {
-    printf(STDERR _g("%s: --section ignored with --remove")."\n", $name) if length($sectiontitle);
-    printf(STDERR _g("%s: --description ignored with --remove")."\n", $name) if length($description);
-}
-
-printf(STDERR _g("%s: test mode - dir file will not be updated")."\n", $name)
-    if $nowrite && !$quiet;
-
-umask(umask(0777) & ~0444);
-
-if($remove_exactly) {
-    $remove_exactly = $filename;
-}
-
-$filename =~ m|[^/]+$|; $basename= $&; $basename =~ s/(\.info)?(\.gz)?$//;
-
-# The location of the info files from the dir entry, i.e. (emacs-20/emacs).
-my $fileinentry;
-
-&dprint("dirfile='$dirfile' filename='$filename' maxwidth='$maxwidth'");
-&dprint("menuentry='$menuentry' basename='$basename'");
-&dprint("description='$description' remove=$remove");
-
-if (!$remove) {
-
-    if (!-f $filename && -f "$filename.gz" || $filename =~ s/\.gz$//) {
-        $filename= "gzip -cd <$filename.gz |";  $pipeit= 1;
-    } elsif (-f $filename) {
-        $filename= "< $filename";
-    } else {
-        die "$progname: File $filename not found\n";
-    }
-
-    if (!length($description)) {
-        
-        open(IF,"$filename") || &quit(sprintf(_g("unable to read %s: %s"), $filename, $!));
-        $asread='';
-        while(<IF>) {
-	    m/^START-INFO-DIR-ENTRY$/ && last;
-	    m/^INFO-DIR-SECTION (.+)$/ && do {
-		$sectiontitle = $1		unless ($sectiontitle);
-		$sectionre = '^'.quotemeta($1)	unless ($sectionre);
-	    }
-	}
-        while(<IF>) { last if m/^END-INFO-DIR-ENTRY$/; $asread.= $_; }
-	if ($pipeit) {
-	    while (<IF>) {};
-	}
-
-        close(IF); &checkpipe;
-        if ($asread =~ m/(\*\s*[^:]+:\s*\(([^\)]+)\).*\. *.*\n){2}/) {
-            $infoentry= $asread;
-            $multiline= 1;
-            $fileinentry = $2;
-            &dprint("multiline '$asread'");
-        } elsif ($asread =~ m/^\*\s*([^:]+):(\s*\(([^\)]+)\)\.|:)\s*/) {
-            $menuentry= $1;
-            $description = $';
-            $fileinentry = $3;
-            &dprint("infile menuentry '$menuentry' description '$description'");
-        } elsif (length($asread)) {
-            printf STDERR _g("%s: warning, ignoring confusing INFO-DIR-ENTRY in file.")."\n", $name;
-        }
-    }
-
-    if (length($infoentry)) {
-
-        $infoentry =~ m/\n/;
-        print "$`\n" unless $quiet;
-        $infoentry =~ m/^\*\s*([^:]+):\s*\(([^\)]+)\)/ || 
-            &quit(_g("invalid info entry")); # internal error
-        $sortby= $1;
-        $fileinentry= $2;
-
-    } else {
-
-        if (!length($description)) {
-            open(IF,"$filename") || &quit(_g("unable to read %s: %s"), $filename, $!);
-            $asread='';
-            while(<IF>) {
-                if (m/^\s*[Tt]his file documents/) {
-                    $asread = $';
-                    last;
-                }
-            }
-            if (length($asread)) {
-                while(<IF>) { last if m/^\s*$/; $asread.= $_; }
-                $description= $asread;
-            }
-	    if ($pipeit) {
-		while (<IF>) {};
-	    }
-            close(IF); &checkpipe;
-        }
-
-        if (!length($description)) {
-            printf STDERR _g("
-No \`START-INFO-DIR-ENTRY' and no \`This file documents'.
-%s: unable to determine description for \`dir' entry - giving up
-"), $name;
-            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;
-        }
-
-        &dprint("menuentry='$menuentry'  description='$description'");
-
-        if($fileinentry) {
-            $cprefix= sprintf("* %s: (%s).", $menuentry, $fileinentry);
-        } else {
-            $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 (!$nowrite && ( ! -e $dirfile || ! -s _ )) {
-    if (-r $backup) {
-	printf( STDERR _g("%s: no file %s, retrieving backup file %s.")."\n",
-		$name, $dirfile, "$backup" );
-	if (system ('cp', $backup, $dirfile)) {
-	    printf( STDERR _g("%s: copying %s to %s failed, giving up: %s")."\n",
-		    $name, $backup, $dirfile, $! );
-	    exit 1;
-	}
-    } else {
-        if (-r $default) {
-	    printf( STDERR _g("%s: no backup file %s available, retrieving default file.")."\n",
-		    $name, $backup );
-
-	    if (system('cp', $default, $dirfile)) {
-		printf( STDERR _g("%s: copying %s to %s failed, giving up: %s")."\n",
-			$name, $default, $dirfile, $! );
-		exit 1;
-	    }
-	} else {
-	    printf STDERR _g("%s: no backup file %s available.")."\n", $name, $backup;
-	    printf STDERR _g("%s: no default file %s available, giving up.")."\n", $name, $default;
-	    exit 1;
-	}
-    }
-}
-
-if (!$nowrite && !link($dirfile, "$dirfile.lock")) {
-    printf( STDERR _g("%s: failed to lock dir for editing! %s")."\n",
-	    $name, $! );
-    printf( STDERR _g("try deleting %s?")."\n", "$dirfile.lock")
-	if $!{EEXIST};
-    exit 1;
-}
-
-open(OLD, $dirfile) || &ulquit(sprintf(_g("unable to open %s: %s"), $dirfile, $!));
-@work= <OLD>;
-eof(OLD) || &ulquit(sprintf(_g("unable to read %s: %s"), $dirfile, $!));
-close(OLD) || &ulquit(sprintf(_g("unable to close %s after read: %s"),
-				 $dirfile, $!));
-
-while (($#work >= 0) && ($work[$#work] !~ m/\S/)) { $#work--; }
-
-while (@work) {
-    $_= shift(@work);
-    push(@head,$_);
-    last if (m/^\*\s*Menu:/i);
-}
-
-if (!$remove) {
-
-    my $target_entry;
-
-    if($fileinentry) {
-        $target_entry = $fileinentry;
-    } else {
-        $target_entry = $basename;
-    }
-
-    for ($i=0; $i<=$#work; $i++) {
-        next unless $work[$i] =~ m/^\*\s*[^:]+:\s*\(([^\)]+)\).*\.\s/;
-        last if $1 eq $target_entry || $1 eq "$target_entry.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 $target_entry || $1 eq "$target_entry.info";
-    }
-
-    if ($i < $j) {
-        if ($keepold) {
-            printf(_g("%s: existing entry for \`%s' not replaced")."\n", $name, $target_entry) unless $quiet;
-            $nowrite=1;
-        } else {
-            printf(_g("%s: replacing existing dir entry for \`%s'")."\n", $name, $target_entry) unless $quiet;
-        }
-        $mss= $i;
-        @work= (@work[0..$i-1], @work[$j..$#work]);
-    } elsif (length($sectionre)) {
-        $mss= -1;
-        for ($i=0; $i<=$#work; $i++) {
-            $_= $work[$i];
-            next if m/^(\*|\s)/;
-            next unless m/$sectionre/io;
-            $mss= $i+1; last;
-        }
-        if ($mss < 0) {
-            printf(_g("%s: creating new section \`%s'")."\n", $name, $sectiontitle) unless $quiet;
-            for ($i= $#work; $i>=0 && $work[$i] =~ m/\S/; $i--) { }
-            if ($i <= 0) { # We ran off the top, make this section and Misc.
-                printf(_g("%s: no sections yet, creating Miscellaneous section too.")."\n", $name)
-                    unless $quiet;
-                @work= ("\n", "$sectiontitle\n", "\n", "Miscellaneous:\n", @work);
-                $mss= 1;
-            } else {
-                @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 {
-        printf(_g("%s: no section specified for new entry, placing at end")."\n", $name)
-            unless $quiet;
-        $mss= $#work+1;
-    }
-
-    @work= (@work[0..$mss-1], map("$_\n",split(/\n/,$infoentry)), @work[$mss..$#work]);
-    
-} else {
-
-    my $target_entry;
-
-    if($remove_exactly) {
-        $target_entry = $remove_exactly;
-    } else {
-        $target_entry = $basename;
-    }
-
-    for ($i=0; $i<=$#work; $i++) {
-        next unless $work[$i] =~ m/^\* *([^:]+): *\((\w[^\)]*)\)/;
-        $tme= $1; $tfile= $2; $match= $&;
-        next unless $tfile eq $target_entry;
-        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 $target_entry;
-        next if !length($menuentry);
-        $tme =~ y/A-Z/a-z/;
-        last unless $tme eq $menuentry;
-    }
-
-    if ($i < $j) {
-        &dprint("i=$i \$work[\$i]='$work[$i]' j=$j \$work[\$j]='$work[$j]'");
-        printf(_g("%s: deleting entry \`%s ...'")."\n", $name, $match) unless $quiet;
-        $_= $work[$i-1];
-        unless (m/^\s/ || m/^\*/ || m/^$/ ||
-                $j > $#work || $work[$j] !~ m/^\s*$/) {
-            s/:?\s+$//;
-            if ($keepold) {
-                printf(_g("%s: empty section \`%s' not removed")."\n", $name, $_) unless $quiet;
-            } else {
-                $i--; $j++;
-                printf(_g("%s: deleting empty section \`%s'")."\n", $name, $_) unless $quiet;
-            }
-        }
-        @work= (@work[0..$i-1], @work[$j..$#work]);
-    } else {
-        unless ($quiet) {
-            if (length($menuentry)) {
-                printf _g("%s: no entry for file \`%s' and menu entry \`%s'")."\n", $name, $target_entry, $menuentry;
-            } else {
-                printf _g("%s: no entry for file \`%s'")."\n", $name, $target_entry;
-            }
-        }
-    }
-}
-$length = 0;
-
-$j = -1;
-for ($i=0; $i<=$#work; $i++) {
-	$_ = $work[$i];
-	chomp;
-	if ( m/^(\* *[^:]+: *\(\w[^\)]*\)[^.]*\.)[ \t]*(.*)/ ) {
-		$length = length($1) if ( length($1) > $length );
-		$work[++$j] = $_;
-	} elsif ( m/^[ \t]+(.*)/ ) {
-		$work[$j] = "$work[$j] $1";
-	} else {
-		$work[++$j] = $_;
-	}
-}
-@work = @work[0..$j];
-
-my $descalign=40;
-
-@newwork = ();
-foreach ( @work ) {
-	if ( m/^(\* *[^:]+: *\(\w[^\)]*\)[^.]*\.)[ \t]*(.*)/ ||
-		m/^([ \t]+)(.*)/ ) {
-		if (length $1 >= $descalign) {
-			push @newwork, $1;
-			$_=(" " x $descalign) . $2;
-		}
-		else {
-			$_ = $1 . (" " x ($descalign - length $1)) . $2;
-		}
-		push @newwork, split( "\n", wrap('', " " x $descalign, $_ ) );
-	} else {
-		push @newwork, $_;
-	}
-}
-
-if (!$nowrite) {
-    open(NEW,"> $dirfile.new") || &ulquit(sprintf(_g("unable to create %s: %s"),
-						     "$dirfile.new", $!));
-    print(NEW @head,join("\n",@newwork)) ||
-	&ulquit(sprintf(_g("unable to write %s: %s"), "$dirfile.new", $!));
-    close(NEW) || &ulquit(sprintf(_g("unable to close %s: %s"), "$dirfile.new", $!));
-
-    unlink("$dirfile.old");
-    link($dirfile, "$dirfile.old") ||
-	&ulquit(sprintf(_g("unable to backup old %s, giving up: %s"),
-			   $dirfile, $!));
-    rename("$dirfile.new", $dirfile) ||
-	&ulquit(sprintf(_g("unable to install new %s: %s"), $dirfile, $!));
-
-    unlink("$dirfile.lock") ||
-	&quit(sprintf(_g("unable to unlock %s: %s"), $dirfile, $!));
-    system ('cp', $dirfile, $backup) &&
-	warn sprintf(_g("%s: could not backup %s in %s: %s"), $name, $dirfile, $backup, $!)."\n";
-}
-
-sub quit
-{
-    die "$name: $@\n";
-}
-
-sub ulquit {
-    unlink("$dirfile.lock") ||
-	warn sprintf(_g("%s: warning - unable to unlock %s: %s"),
-		     $name, $dirfile, $!)."\n";
-    &quit($_[0]);
-}
-
-sub checkpipe {
-    return if !$pipeit || !$? || $?==0x8D00 || $?==0x0D;
-    &quit(sprintf(_g("unable to read %s: %d"), $filename, $?));
-}
-
-sub dprint {
-    printf(DEBUG _g("dbg: %s")."\n", $_[0]) if ($debug);
-}
-
-exit 0;