← Back to branch summary

~ubuntu-branches/ubuntu/lucid/dpkg/lucid

« back to all changes in this revision

Viewing changes to scripts/install-info.pl

  • Committer: Bazaar Package Importer
  • Author(s): Guillem Jover, Guillem Jover, Raphael Hertzog, Modestas Vainius, Updated dpkg translations, Updated dselect translations, Updated man page translations, Updated scripts translations
  • Date: 2009-09-06 09:37:45 UTC
  • mto: (1.4.1 squeeze)
  • mto: This revision was merged to the branch mainline in revision 68.
  • Revision ID: james.westby@ubuntu.com-20090906093745-orb3im04ozfxypis
Tags: 1.15.4
http://bugs.debian.org/472208
http://bugs.debian.org/33394
http://bugs.debian.org/429262
http://bugs.debian.org/218018
http://bugs.debian.org/373602
http://bugs.debian.org/536821
http://bugs.debian.org/455501
http://bugs.debian.org/540019
http://bugs.debian.org/9771
http://bugs.debian.org/523980
http://bugs.debian.org/535138
http://bugs.debian.org/537558
http://bugs.debian.org/535353
http://bugs.debian.org/537800
http://bugs.debian.org/537559
http://bugs.debian.org/540382
http://bugs.debian.org/541412
http://bugs.debian.org/496114
http://bugs.debian.org/531307
http://bugs.debian.org/494714
http://bugs.debian.org/544037
http://bugs.debian.org/541829
http://bugs.debian.org/535327
http://bugs.debian.org/536538
http://bugs.debian.org/542254
http://bugs.debian.org/537742
http://bugs.debian.org/542254
http://bugs.debian.org/537741
http://bugs.debian.org/542254
[ Guillem Jover ]
* Call _g instead of g_ in dpkg-name.
* Fix inverted logic when deciding to assume the architecture in dpkg-name
  when the package didn't have such field.
* Do not take into account Revision and Package_Revision fields in dpkg-name
  and dpkg-scanpackages as they have been handled already by “dpkg-deb -I”.
* Switch dpkg-scansources to use Dpkg::Cdata instead of duplicating the
  .dsc parsing code. As a side effect it now handles properly bogus files.
* Do not remap obsolete fields in dpkg-scanpackages as they have been
  handled already by “dpkg-deb -I”.
* Properly mark packages being purged for disappearance from the database.
  This will make the status database not be left behind with traces of old
  not-installed packages. Closes: #472208
* On parse mark not-installed leftover packages for automatic removal from
  the database on next dump. This obsoletes the --forget-old-unavail option,
  thus making it now a no-op. Closes: #33394, #429262
* Document “hold” under package selection states instead of flags in dpkg(1).
* Remove trailing ‘/’ and ‘/.’ from the directory name to be used as the
  package name on “dpkg-deb -b”. Closes: #218018, #373602
* Remove obsolete ‘hold’ and ‘hold-reinstreq’ internal status flags.
* Add fakeroot to dpkg-dev Recommends. Closes: #536821
* Fix an always false test when trying to decide which package to deselect
  to resolve a dependency problem in dselect.
* Add uClibc Linux support to ostable and triplettable. Closes: #455501
* Add uClinux support to ostable and triplettable.
  Thanks to Simon Richter <sjr@debian.org>.
* When aborting due to file conflicts print the version of the conflicted
  package. Closes: #540019
* Remove double slash in database path visible to the user in some error
  conditions.
* Stop macthing sparc64-*-* GNU triplets with sparc Debian architecture.
* Add support for config.d style directories in dpkg and dselect,
  (/etc/dpkg/dpkg.cfg.d and /etc/dpkg/dselect.cfg.d respectively).
* Define DPKG_MAINTSCRIPT_ARCH on the maintainer script environment to the
  architecture the package got built for.
* Document DPKG_MAINTSCRIPT_PACKAGE maintainer script environment variable
  in dpkg man page.
* Document DPKG_RUNNING_VERSION maintainer script environment variable
  in dpkg man page.
* Change po4a usage to not create unwated changes depending if doing out or
  in-tree builds.
* Use po4a “--previous” support when updating the man pages.
  Suggested by Christian Perrier <bubulle@debian.org>.
* On configuration error print file name and line number.
* Allow quoting values in configuration file options.
* Add new --pre-invoke and --post-invoke hooks in dpkg.
* Add new --control-path command to dpkg-query.
* Use ohshit on bad version syntax in --compare-versions.
* Add Multi-Arch to the list of known binary package fields for dpkg-dev.
  Thanks to Steve Langasek <vorlon@debian.org>.

[ Raphael Hertzog ]
* Replace install-info by a wrapper around GNU's install-info. The wrapper
  will be dropped in squeeze+1. dpkg now Breaks: old versions of
  info-browsers that do not depend on the new install-info package
  that provides the real functionality. Closes: #9771, #523980
  See http://wiki.debian.org/Transitions/DpkgToGnuInstallInfo for details.
* Fix dpkg's preinst in case /var/lib/dpkg/alternatives contains unexpected
  sub-directories. Closes: #535138
  And also when one of the file doesn't contain correct alternatives
  information (improper number of lines). Closes: #537558
* Upgrade Standards-Version to 3.8.2 (no changes).
* Update deb-substvars(5) to list fields that do not support substvars.
  Closes: #535353
* Fix dpkg-parsechangelog to include all entries with -v0 parameter.
  Closes: #537800
* Fix update-alternatives to mention the correct slave link that can't
  be installed due to a conflicting file instead of quoting the master link.
* Add support for extra override file in dpkg-scanpackages. Thanks to Robert
  Millan for the patch. Closes: #537559
* Add support for extra override file in dpkg-scansources.
* Document format of extra override file in a new manual page
  deb-extra-override(5).
* Update sample in dpkg-gensymbols(1) to give an accurate listing of
  64 bit arches. Thanks to Julien Cristau for the patch. Closes: #540382
* Create /etc/cron.daily/dpkg to handle the backup of
  /var/lib/dpkg/status in /var/backups. This is taken out of the cron
  package and need no conflicts/breaks as the code does nothing if
  the current status file is already backupped. Thanks to Leo 'costela'
  Antunes <costela@debian.org> for the patch. Closes: #541412
* Change behaviour of dpkg --merge-avail to not update a package's
  information if the version provided is older than the one already listed
  in the available file. Thanks to Ian Jackson
  <ian@davenant.greenend.org.uk> for the patch. Closes: #496114
* dpkg-architecture can now export DEB_{HOST,BUILD}_ARCH_{BITS,ENDIAN}
  (pointer size and endianness):
  - cputable (in dpkg) modified to contain those information
  - dpkg-dev depends on dpkg (>= 1.15.4) to ensure that we have an updated
    cputable (and so that a versioned build-dependency on dpkg-dev is enough
    to use this new feature)
  Closes: #531307
* Split overly long Binary: field values over multiple lines. This is
  allowed since policy 3.8.3. Closes: #494714
* Improve performance of dpkg-shlibdeps by caching minimal version
  associated to each library in Dpkg::Shlib::SymbolFile. Thanks to
  Jiří Paleček <jpalecek@web.de> for the patch.
* Slightly improve dpkg-source(1) by giving the section name that we're
  referring to. Closes: #544037
* Fix translation error in german manpage of dpkg-buildpackage. Thanks
  to Joachim Breitner <nomeata@debian.org>. Closes: #541829

[ Modestas Vainius ]
* Provide a meaningful label for dpkg-gensymbols diff.

[ Updated dpkg translations ]
* Asturian (Marcos Alvarez Costales). Closes: #535327
* French (Christian Perrier).
* German (Sven Joachim).
* Italian (Milo Casagrande). Closes: #536538
* Russian (Yuri Kozlov). Closes: #542254
* Slovak (Ivan Masár). Closes: #537742
* Swedish (Peter Krefting).

[ Updated dselect translations ]
* Russian (Yuri Kozlov). Closes: #542254
* Slovak (Ivan Masár). Closes: #537741

[ Updated man page translations ]
* French (Christian Perrier).
* German (Helge Kreutzmann), proofread by Jens Seidel.
* Swedish (Peter Krefting).

[ Updated scripts translations ]
* French completed (Christian Perrier).
* German (Helge Kreutzmann).
* Russian (Yuri Kozlov). Closes: #542254
* Swedish (Peter Krefting).

Show diffs side-by-side

added added

removed removed

Lines of Context:
scripts/install-info.pl
1
 
#!/usr/bin/perl --
2
 
 
3
 
BEGIN { # Work-around for bug #479711 in perl
4
 
    $ENV{PERL_DL_NONLAZY} = 1;
5
 
}
6
 
 
7
 
use Text::Wrap;
8
 
use Dpkg;
9
 
use Dpkg::Gettext;
10
 
 
11
 
textdomain("dpkg");
12
 
 
13
 
# FIXME: sort entries
14
 
# FIXME: send to FSF ?
15
 
 
16
 
sub version {
17
 
    printf _g("Debian %s version %s.\n"), $progname, $version;
18
 
 
19
 
    printf _g("
20
 
Copyright (C) 1994,1995 Ian Jackson.");
21
 
 
22
 
    printf _g("
23
 
This is free software; see the GNU General Public Licence version 2 or
24
 
later for copying conditions. There is NO warranty.
25
 
");
26
 
}
27
 
 
28
 
sub usage {
29
 
    $file = $_[0];
30
 
    printf $file _g(
31
 
"Usage: %s [<options> ...] [--] <filename>
32
 
 
33
 
Options:
34
 
  --section <regexp> <title>
35
 
                           put the new entry in the <regex> matched section
36
 
                           or create a new one with <title> if non-existent.
37
 
  --menuentry=<text>       set the menu entry.
38
 
  --description=<text>     set the description to be used in the menu entry.
39
 
  --info-file=<path>       specify info file to install in the directory.
40
 
  --dir-file=<path>        specify file name of info directory file.
41
 
  --infodir=<directory>    same as '--dir-file=<directory>/dir'.
42
 
  --info-dir=<directory>   likewise.
43
 
  --keep-old               do not replace entries nor remove empty ones.
44
 
  --remove                 remove the entry specified by <filename> basename.
45
 
  --remove-exactly         remove the exact <filename> entry.
46
 
  --test                   enables test mode (no actions taken).
47
 
  --debug                  enables debug mode (show more information).
48
 
  --quiet                  do not show output messages.
49
 
  --help                   show this help message.
50
 
  --version                show the version.
51
 
"), $progname;
52
 
}
53
 
 
54
 
$dirfile = '/usr/share/info/dir';
55
 
$maxwidth=79;
56
 
$Text::Wrap::columns=$maxwidth;
57
 
$backup='/var/backups/infodir.bak';
58
 
$default='/usr/share/base-files/info.dir';
59
 
 
60
 
$menuentry="";
61
 
$description="";
62
 
$sectionre="";
63
 
$sectiontitle="";
64
 
$infoentry="";
65
 
$quiet=0;
66
 
$nowrite=0;
67
 
$keepold=0;
68
 
$debug=0;
69
 
$remove=0;
70
 
 
71
 
my $remove_exactly;
72
 
 
73
 
$0 =~ m|[^/]+$|; $name= $&;
74
 
 
75
 
while ($ARGV[0] =~ m/^--/) {
76
 
    $_= shift(@ARGV);
77
 
    last if $_ eq '--';
78
 
    if ($_ eq '--version') {
79
 
        &version(STDOUT); exit 0;
80
 
    } elsif ($_ eq '--quiet') {
81
 
        $quiet=1;
82
 
    } elsif ($_ eq '--test') {
83
 
        $nowrite=1;
84
 
    } elsif ($_ eq '--keep-old') {
85
 
        $keepold=1;
86
 
    } elsif ($_ eq '--remove') {
87
 
        $remove=1;
88
 
    } elsif ($_ eq '--remove-exactly') {
89
 
        $remove=1;
90
 
        $remove_exactly=1;
91
 
    } elsif ($_ eq '--help') {
92
 
        &usage(STDOUT); exit 0;
93
 
    } elsif ($_ eq '--version') {
94
 
        &version; exit 0;
95
 
    } elsif ($_ eq '--debug') {
96
 
        open(DEBUG,">&STDERR")
97
 
            || &quit(sprintf(_g("could not open stderr for output! %s"), $!));
98
 
        $debug=1;
99
 
    } elsif ($_ eq '--section') {
100
 
        if (@ARGV < 2) {
101
 
            printf STDERR _g("%s: --section needs two more args")."\n", $name;
102
 
            &usage(STDERR); exit 1;
103
 
        }
104
 
        $sectionre= shift(@ARGV);
105
 
        $sectiontitle= shift(@ARGV);
106
 
    } elsif (m/^--(c?align|maxwidth)=([0-9]+)$/) {
107
 
        warn(sprintf(_g("%s: option --%s is deprecated (ignored)"), $name, $1)."\n");
108
 
    } elsif (m/^--info-?dir=/) {
109
 
        $dirfile = $' . '/dir';
110
 
    } elsif (m/^--info-file=/) {
111
 
        $filename = $';
112
 
    } elsif (m/^--menuentry=/) {
113
 
        $menuentry = $';
114
 
    } elsif (m/^--description=/) {
115
 
        $description = $';
116
 
    } elsif (m/^--dir-file=/) { # for compatibility with GNU install-info
117
 
        $dirfile = $';
118
 
    } else {
119
 
        printf STDERR _g("%s: unknown option \`%s'")."\n", $name, $_;
120
 
        &usage(STDERR); exit 1;
121
 
    }
122
 
}
123
 
 
124
 
if (!@ARGV) { &usage(STDERR); exit 1; }
125
 
 
126
 
if ( !$filename ) {
127
 
        $filename= shift(@ARGV);
128
 
        $name = "$name($filename)";
129
 
}
130
 
if (@ARGV) { printf STDERR _g("%s: too many arguments")."\n", $name; &usage(STDERR); exit 1; }
131
 
 
132
 
if ($remove) {
133
 
    printf(STDERR _g("%s: --section ignored with --remove")."\n", $name) if length($sectiontitle);
134
 
    printf(STDERR _g("%s: --description ignored with --remove")."\n", $name) if length($description);
135
 
}
136
 
 
137
 
printf(STDERR _g("%s: test mode - dir file will not be updated")."\n", $name)
138
 
    if $nowrite && !$quiet;
139
 
 
140
 
umask(umask(0777) & ~0444);
141
 
 
142
 
if($remove_exactly) {
143
 
    $remove_exactly = $filename;
144
 
}
145
 
 
146
 
$filename =~ m|[^/]+$|; $basename= $&; $basename =~ s/(\.info)?(\.gz)?$//;
147
 
 
148
 
# The location of the info files from the dir entry, i.e. (emacs-20/emacs).
149
 
my $fileinentry;
150
 
 
151
 
&dprint("dirfile='$dirfile' filename='$filename' maxwidth='$maxwidth'");
152
 
&dprint("menuentry='$menuentry' basename='$basename'");
153
 
&dprint("description='$description' remove=$remove");
154
 
 
155
 
if (!$remove) {
156
 
 
157
 
    if (!-f $filename && -f "$filename.gz" || $filename =~ s/\.gz$//) {
158
 
        $filename= "gzip -cd <$filename.gz |";  $pipeit= 1;
159
 
    } elsif (-f $filename) {
160
 
        $filename= "< $filename";
161
 
    } else {
162
 
        die "$progname: File $filename not found\n";
163
 
    }
164
 
 
165
 
    if (!length($description)) {
166
 
        
167
 
        open(IF,"$filename") || &quit(sprintf(_g("unable to read %s: %s"), $filename, $!));
168
 
        $asread='';
169
 
        while(<IF>) {
170
 
            m/^START-INFO-DIR-ENTRY$/ && last;
171
 
            m/^INFO-DIR-SECTION (.+)$/ && do {
172
 
                $sectiontitle = $1              unless ($sectiontitle);
173
 
                $sectionre = '^'.quotemeta($1)  unless ($sectionre);
174
 
            }
175
 
        }
176
 
        while(<IF>) { last if m/^END-INFO-DIR-ENTRY$/; $asread.= $_; }
177
 
        if ($pipeit) {
178
 
            while (<IF>) {};
179
 
        }
180
 
 
181
 
        close(IF); &checkpipe;
182
 
        if ($asread =~ m/(\*\s*[^:]+:\s*\(([^\)]+)\).*\. *.*\n){2}/) {
183
 
            $infoentry= $asread;
184
 
            $multiline= 1;
185
 
            $fileinentry = $2;
186
 
            &dprint("multiline '$asread'");
187
 
        } elsif ($asread =~ m/^\*\s*([^:]+):(\s*\(([^\)]+)\)\.|:)\s*/) {
188
 
            $menuentry= $1;
189
 
            $description = $';
190
 
            $fileinentry = $3;
191
 
            &dprint("infile menuentry '$menuentry' description '$description'");
192
 
        } elsif (length($asread)) {
193
 
            printf STDERR _g("%s: warning, ignoring confusing INFO-DIR-ENTRY in file.")."\n", $name;
194
 
        }
195
 
    }
196
 
 
197
 
    if (length($infoentry)) {
198
 
 
199
 
        $infoentry =~ m/\n/;
200
 
        print "$`\n" unless $quiet;
201
 
        $infoentry =~ m/^\*\s*([^:]+):\s*\(([^\)]+)\)/ || 
202
 
            &quit(_g("invalid info entry")); # internal error
203
 
        $sortby= $1;
204
 
        $fileinentry= $2;
205
 
 
206
 
    } else {
207
 
 
208
 
        if (!length($description)) {
209
 
            open(IF,"$filename") || &quit(_g("unable to read %s: %s"), $filename, $!);
210
 
            $asread='';
211
 
            while(<IF>) {
212
 
                if (m/^\s*[Tt]his file documents/) {
213
 
                    $asread = $';
214
 
                    last;
215
 
                }
216
 
            }
217
 
            if (length($asread)) {
218
 
                while(<IF>) { last if m/^\s*$/; $asread.= $_; }
219
 
                $description= $asread;
220
 
            }
221
 
            if ($pipeit) {
222
 
                while (<IF>) {};
223
 
            }
224
 
            close(IF); &checkpipe;
225
 
        }
226
 
 
227
 
        if (!length($description)) {
228
 
            printf STDERR _g("
229
 
No \`START-INFO-DIR-ENTRY' and no \`This file documents'.
230
 
%s: unable to determine description for \`dir' entry - giving up
231
 
"), $name;
232
 
            exit 1;
233
 
        }
234
 
 
235
 
        $description =~ s/^\s*(.)//;  $_=$1;  y/a-z/A-Z/;
236
 
        $description= $_ . $description;
237
 
 
238
 
        if (!length($menuentry)) {
239
 
            $menuentry= $basename;  $menuentry =~ s/\Winfo$//;
240
 
            $menuentry =~ s/^.//;  $_=$&;  y/a-z/A-Z/;
241
 
            $menuentry= $_ . $menuentry;
242
 
        }
243
 
 
244
 
        &dprint("menuentry='$menuentry'  description='$description'");
245
 
 
246
 
        if($fileinentry) {
247
 
            $cprefix= sprintf("* %s: (%s).", $menuentry, $fileinentry);
248
 
        } else {
249
 
            $cprefix= sprintf("* %s: (%s).", $menuentry, $basename);
250
 
        }
251
 
 
252
 
        $align--; $calign--;
253
 
        $lprefix= length($cprefix);
254
 
        if ($lprefix < $align) {
255
 
            $cprefix .= ' ' x ($align - $lprefix);
256
 
            $lprefix= $align;
257
 
        }
258
 
        $prefix= "\n". (' 'x $calign);
259
 
        $cwidth= $maxwidth+1;
260
 
 
261
 
        for $_ (split(/\s+/,$description)) {
262
 
            $l= length($_);
263
 
            $cwidth++; $cwidth += $l;
264
 
            if ($cwidth > $maxwidth) {
265
 
                $infoentry .= $cprefix;
266
 
                $cwidth= $lprefix+1+$l;
267
 
                $cprefix= $prefix; $lprefix= $calign;
268
 
            }
269
 
            $infoentry.= ' '; $infoentry .= $_;
270
 
        }
271
 
 
272
 
        $infoentry.= "\n";
273
 
        print $infoentry unless $quiet;
274
 
        $sortby= $menuentry;  $sortby =~ y/A-Z/a-z/;
275
 
 
276
 
    }
277
 
}
278
 
 
279
 
if (!$nowrite && ( ! -e $dirfile || ! -s _ )) {
280
 
    if (-r $backup) {
281
 
        printf( STDERR _g("%s: no file %s, retrieving backup file %s.")."\n",
282
 
                $name, $dirfile, "$backup" );
283
 
        if (system ('cp', $backup, $dirfile)) {
284
 
            printf( STDERR _g("%s: copying %s to %s failed, giving up: %s")."\n",
285
 
                    $name, $backup, $dirfile, $! );
286
 
            exit 1;
287
 
        }
288
 
    } else {
289
 
        if (-r $default) {
290
 
            printf( STDERR _g("%s: no backup file %s available, retrieving default file.")."\n",
291
 
                    $name, $backup );
292
 
 
293
 
            if (system('cp', $default, $dirfile)) {
294
 
                printf( STDERR _g("%s: copying %s to %s failed, giving up: %s")."\n",
295
 
                        $name, $default, $dirfile, $! );
296
 
                exit 1;
297
 
            }
298
 
        } else {
299
 
            printf STDERR _g("%s: no backup file %s available.")."\n", $name, $backup;
300
 
            printf STDERR _g("%s: no default file %s available, giving up.")."\n", $name, $default;
301
 
            exit 1;
302
 
        }
303
 
    }
304
 
}
305
 
 
306
 
if (!$nowrite && !link($dirfile, "$dirfile.lock")) {
307
 
    printf( STDERR _g("%s: failed to lock dir for editing! %s")."\n",
308
 
            $name, $! );
309
 
    printf( STDERR _g("try deleting %s?")."\n", "$dirfile.lock")
310
 
        if $!{EEXIST};
311
 
    exit 1;
312
 
}
313
 
 
314
 
open(OLD, $dirfile) || &ulquit(sprintf(_g("unable to open %s: %s"), $dirfile, $!));
315
 
@work= <OLD>;
316
 
eof(OLD) || &ulquit(sprintf(_g("unable to read %s: %s"), $dirfile, $!));
317
 
close(OLD) || &ulquit(sprintf(_g("unable to close %s after read: %s"),
318
 
                                 $dirfile, $!));
319
 
 
320
 
while (($#work >= 0) && ($work[$#work] !~ m/\S/)) { $#work--; }
321
 
 
322
 
while (@work) {
323
 
    $_= shift(@work);
324
 
    push(@head,$_);
325
 
    last if (m/^\*\s*Menu:/i);
326
 
}
327
 
 
328
 
if (!$remove) {
329
 
 
330
 
    my $target_entry;
331
 
 
332
 
    if($fileinentry) {
333
 
        $target_entry = $fileinentry;
334
 
    } else {
335
 
        $target_entry = $basename;
336
 
    }
337
 
 
338
 
    for ($i=0; $i<=$#work; $i++) {
339
 
        next unless $work[$i] =~ m/^\*\s*[^:]+:\s*\(([^\)]+)\).*\.\s/;
340
 
        last if $1 eq $target_entry || $1 eq "$target_entry.info";
341
 
    }
342
 
    for ($j=$i; $j<=$#work+1; $j++) {
343
 
        next if $work[$j] =~ m/^\s+\S/;
344
 
        last unless $work[$j] =~ m/^\* *[^:]+: *\(([^\)]+)\).*\.\s/;
345
 
        last unless $1 eq $target_entry || $1 eq "$target_entry.info";
346
 
    }
347
 
 
348
 
    if ($i < $j) {
349
 
        if ($keepold) {
350
 
            printf(_g("%s: existing entry for \`%s' not replaced")."\n", $name, $target_entry) unless $quiet;
351
 
            $nowrite=1;
352
 
        } else {
353
 
            printf(_g("%s: replacing existing dir entry for \`%s'")."\n", $name, $target_entry) unless $quiet;
354
 
        }
355
 
        $mss= $i;
356
 
        @work= (@work[0..$i-1], @work[$j..$#work]);
357
 
    } elsif (length($sectionre)) {
358
 
        $mss= -1;
359
 
        for ($i=0; $i<=$#work; $i++) {
360
 
            $_= $work[$i];
361
 
            next if m/^(\*|\s)/;
362
 
            next unless m/$sectionre/io;
363
 
            $mss= $i+1; last;
364
 
        }
365
 
        if ($mss < 0) {
366
 
            printf(_g("%s: creating new section \`%s'")."\n", $name, $sectiontitle) unless $quiet;
367
 
            for ($i= $#work; $i>=0 && $work[$i] =~ m/\S/; $i--) { }
368
 
            if ($i <= 0) { # We ran off the top, make this section and Misc.
369
 
                printf(_g("%s: no sections yet, creating Miscellaneous section too.")."\n", $name)
370
 
                    unless $quiet;
371
 
                @work= ("\n", "$sectiontitle\n", "\n", "Miscellaneous:\n", @work);
372
 
                $mss= 1;
373
 
            } else {
374
 
                @work= (@work[0..$i], "$sectiontitle\n", "\n", @work[$i+1..$#work]);
375
 
                $mss= $i+1;
376
 
            }
377
 
        }
378
 
        while ($mss <= $#work) {
379
 
            $work[$mss] =~ m/\S/ || last;
380
 
            $work[$mss] =~ m/^\* *([^:]+):/ || ($mss++, next);
381
 
            last if $multiline;
382
 
            $_=$1;  y/A-Z/a-z/;
383
 
            last if $_ gt $sortby;
384
 
            $mss++;
385
 
        }
386
 
    } else {
387
 
        printf(_g("%s: no section specified for new entry, placing at end")."\n", $name)
388
 
            unless $quiet;
389
 
        $mss= $#work+1;
390
 
    }
391
 
 
392
 
    @work= (@work[0..$mss-1], map("$_\n",split(/\n/,$infoentry)), @work[$mss..$#work]);
393
 
    
394
 
} else {
395
 
 
396
 
    my $target_entry;
397
 
 
398
 
    if($remove_exactly) {
399
 
        $target_entry = $remove_exactly;
400
 
    } else {
401
 
        $target_entry = $basename;
402
 
    }
403
 
 
404
 
    for ($i=0; $i<=$#work; $i++) {
405
 
        next unless $work[$i] =~ m/^\* *([^:]+): *\((\w[^\)]*)\)/;
406
 
        $tme= $1; $tfile= $2; $match= $&;
407
 
        next unless $tfile eq $target_entry;
408
 
        last if !length($menuentry);
409
 
        $tme =~ y/A-Z/a-z/;
410
 
        last if $tme eq $menuentry;
411
 
    }
412
 
    for ($j=$i; $j<=$#work+1; $j++) {
413
 
        next if $work[$j] =~ m/^\s+\S/;
414
 
        last unless $work[$j] =~ m/^\* *([^:]+): *\((\w[^\)]*)\)/;
415
 
        $tme= $1; $tfile= $2;
416
 
        last unless $tfile eq $target_entry;
417
 
        next if !length($menuentry);
418
 
        $tme =~ y/A-Z/a-z/;
419
 
        last unless $tme eq $menuentry;
420
 
    }
421
 
 
422
 
    if ($i < $j) {
423
 
        &dprint("i=$i \$work[\$i]='$work[$i]' j=$j \$work[\$j]='$work[$j]'");
424
 
        printf(_g("%s: deleting entry \`%s ...'")."\n", $name, $match) unless $quiet;
425
 
        $_= $work[$i-1];
426
 
        unless (m/^\s/ || m/^\*/ || m/^$/ ||
427
 
                $j > $#work || $work[$j] !~ m/^\s*$/) {
428
 
            s/:?\s+$//;
429
 
            if ($keepold) {
430
 
                printf(_g("%s: empty section \`%s' not removed")."\n", $name, $_) unless $quiet;
431
 
            } else {
432
 
                $i--; $j++;
433
 
                printf(_g("%s: deleting empty section \`%s'")."\n", $name, $_) unless $quiet;
434
 
            }
435
 
        }
436
 
        @work= (@work[0..$i-1], @work[$j..$#work]);
437
 
    } else {
438
 
        unless ($quiet) {
439
 
            if (length($menuentry)) {
440
 
                printf _g("%s: no entry for file \`%s' and menu entry \`%s'")."\n", $name, $target_entry, $menuentry;
441
 
            } else {
442
 
                printf _g("%s: no entry for file \`%s'")."\n", $name, $target_entry;
443
 
            }
444
 
        }
445
 
    }
446
 
}
447
 
$length = 0;
448
 
 
449
 
$j = -1;
450
 
for ($i=0; $i<=$#work; $i++) {
451
 
        $_ = $work[$i];
452
 
        chomp;
453
 
        if ( m/^(\* *[^:]+: *\(\w[^\)]*\)[^.]*\.)[ \t]*(.*)/ ) {
454
 
                $length = length($1) if ( length($1) > $length );
455
 
                $work[++$j] = $_;
456
 
        } elsif ( m/^[ \t]+(.*)/ ) {
457
 
                $work[$j] = "$work[$j] $1";
458
 
        } else {
459
 
                $work[++$j] = $_;
460
 
        }
461
 
}
462
 
@work = @work[0..$j];
463
 
 
464
 
my $descalign=40;
465
 
 
466
 
@newwork = ();
467
 
foreach ( @work ) {
468
 
        if ( m/^(\* *[^:]+: *\(\w[^\)]*\)[^.]*\.)[ \t]*(.*)/ ||
469
 
                m/^([ \t]+)(.*)/ ) {
470
 
                if (length $1 >= $descalign) {
471
 
                        push @newwork, $1;
472
 
                        $_=(" " x $descalign) . $2;
473
 
                }
474
 
                else {
475
 
                        $_ = $1 . (" " x ($descalign - length $1)) . $2;
476
 
                }
477
 
                push @newwork, split( "\n", wrap('', " " x $descalign, $_ ) );
478
 
        } else {
479
 
                push @newwork, $_;
480
 
        }
481
 
}
482
 
 
483
 
if (!$nowrite) {
484
 
    open(NEW,"> $dirfile.new") || &ulquit(sprintf(_g("unable to create %s: %s"),
485
 
                                                     "$dirfile.new", $!));
486
 
    print(NEW @head,join("\n",@newwork)) ||
487
 
        &ulquit(sprintf(_g("unable to write %s: %s"), "$dirfile.new", $!));
488
 
    close(NEW) || &ulquit(sprintf(_g("unable to close %s: %s"), "$dirfile.new", $!));
489
 
 
490
 
    unlink("$dirfile.old");
491
 
    link($dirfile, "$dirfile.old") ||
492
 
        &ulquit(sprintf(_g("unable to backup old %s, giving up: %s"),
493
 
                           $dirfile, $!));
494
 
    rename("$dirfile.new", $dirfile) ||
495
 
        &ulquit(sprintf(_g("unable to install new %s: %s"), $dirfile, $!));
496
 
 
497
 
    unlink("$dirfile.lock") ||
498
 
        &quit(sprintf(_g("unable to unlock %s: %s"), $dirfile, $!));
499
 
    system ('cp', $dirfile, $backup) &&
500
 
        warn sprintf(_g("%s: could not backup %s in %s: %s"), $name, $dirfile, $backup, $!)."\n";
501
 
}
502
 
 
503
 
sub quit
504
 
{
505
 
    die "$name: $@\n";
506
 
}
507
 
 
508
 
sub ulquit {
509
 
    unlink("$dirfile.lock") ||
510
 
        warn sprintf(_g("%s: warning - unable to unlock %s: %s"),
511
 
                     $name, $dirfile, $!)."\n";
512
 
    &quit($_[0]);
513
 
}
514
 
 
515
 
sub checkpipe {
516
 
    return if !$pipeit || !$? || $?==0x8D00 || $?==0x0D;
517
 
    &quit(sprintf(_g("unable to read %s: %d"), $filename, $?));
518
 
}
519
 
 
520
 
sub dprint {
521
 
    printf(DEBUG _g("dbg: %s")."\n", $_[0]) if ($debug);
522
 
}
523
 
 
524
 
exit 0;