Bug#3125: bug (and correction) in dpkg-1.1.6 scripts/install-info.pl
OK, here's a little improved one, it should correct the other
strange things that have been reported. Here are the changes :
- Insensitive case matching on section title. Also the trailing
colon is ignored during the comparision.
- Should cleanup the '* Menu' line when it's in limbo. But it will
go nuts if there's a line in the header part that starts with a star.
I have a problem here : if the dir file is wrong enough as to have
lost it's '* Menu' line, I don't really see how to reliably
reconstruct it. The current behavior will correct most of those cases
but at the price that a completly legal (but rare) dir file can get it
to hell. Sounds bad :-( Which should be kept ?
P.S: I really don't feel like doing the sorting stuff someone talked
about. So this is up to you all...
--- START OF cleanup-info.pl ---
#!/usr/bin/perl --
#
# Clean up the mess that bogus install-info may have done :
#
# - gather all sections with the same heading into a single one.
# Tries to be smart about cases and trailing colon/spaces.
#
# Other clean ups :
#
# - remove empty sections,
# - squeeze blank lines (in entries part only).
#
# Order of sections is preserved (the first encountered section
# counts).
#
# Order of entries within a section is preserved.
#
# BUGS:
#
# Probably many : I just recently learned Perl for this program
# using the man pages. Hopefully this is a short enough program to
# debug.
use strict;
sub version {
print STDERR <<END;
Debian GNU/Linux cleanup-info 1.2. Copyright (C) 1994,1995 Kim-Minh
Kaplan. 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 "usage: cleanup-info [--version] [--help] [--] [<dirname>]\n";
}
my $infodir = '/usr/info';
$0 =~ m|[^/]+$|;
my $name= $&;
sub ulquit {
unlink "$infodir/dir.lock"
or warn "$name: warning - unable to unlock $infodir/dir: $!\n";
die $_[0];
}
while (scalar @ARGV > 0 && $ARGV[0] =~ m/^--/) {
$_ = shift;
if ($_ eq '--') {
last;
} elsif ($_ eq "--version") {
version;
exit 0;
} elsif ($_ eq "--help") {
usage;
exit 0;
} else {
print STDERR "$name: unknown option \`$_'\n";
usage;
exit 1;
}
}
if (scalar @ARGV > 0) {
$infodir = shift;
if (scalar @ARGV > 0) {
print STDERR "$name: too many arguments\n";
usage;
exit 1;
}
}
if (!link "$infodir/dir", "$infodir/dir.lock") {
die "$name: failed to lock dir for editing! $!\n".
($! =~ m/exist/i ? "try deleting $infodir/dir.lock\n" : '');
}
open OLD, "$infodir/dir" or ulquit "$name: can't open $infodir/dir: $!\n";
open OUT, ">$infodir/dir.new"
or ulquit "$name can't create $infodir/dir.new: $!\n";
my (%sections, @section_list, $lastline);
my $section="Miscellaneous"; # default section
my $section_canonic="miscellaneous";
while (<OLD>) { # dump the non entries part
last if (m/^\*/);
if (defined $lastline) {
print OUT $lastline
or ulquit "$name: error writing $infodir/dir.new: $!\n";
}
$lastline = $_;
};
print OUT "* Menu:\n";
if (! /^\*\s*Menu\s*:?/i) {
$lastline =~ s/\s*$//;
if ($lastline =~ /^([^\*\s].*)/) { # there was a section title
$section = $1;
$lastline =~ s/$*:$//;
$section_canonic = lc $lastline;
}
push @section_list, $section_canonic;
s/\s*$//;
$sections{$section_canonic} = "\n$section\n$_\n";
}
foreach (<OLD>) { # collect sections
next if (m/^\s*$/ or m/^\*\s*Menu/i);
s/\s*$//;
if (/^([^\*\s].*)/) { # change of section
$section = $1;
s/\s*:$//;
$section_canonic = lc $_;
} else { # add to section
if (! exists $sections{$section_canonic}) { # create section header
push @section_list, $section_canonic;
$sections{$section_canonic} = "\n$section\n";
}
$sections{$section_canonic} .= "$_\n";
}
}
eof OLD or ulquit "$name: read $infodir/dir: $!\n";
close OLD or ulquit "$name: close $infodir/dir after read: $!\n";
print OUT @sections{@section_list};
close OUT or ulquit "$name: error closing $infodir/dir.new: $!\n";
# install clean version
unlink "$infodir/dir.old";
link "$infodir/dir", "$infodir/dir.old"
or ulquit "$name: can't backup old $infodir/dir, giving up: $!\n";
rename "$infodir/dir.new", "$infodir/dir"
or ulquit "$name: failed to install $infodir/dir; I'll leave it as $infodir/dir.new: $!\n";
unlink "$infodir/dir.lock"
or die "$name: failed to unlock $infodir/dir: $!\n";
exit 0;
--- END OF cleanup-info.pl ---
---
<Kim-Minh.Kaplan@cdf.in2p3.fr> <kaplan@afflynn.frmug.fr.net>
FAX : +33-1-45 80 08 02
Linux Is Not UniX. What's lignux ?
Reply to: