|
|
@@ -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;
|
Raphael Hertzog