Browse Source

* Add gettext support for the Perl scripts. Based on a patch by
Nicolas François. Closes: #165843
* Only print usage information of dpkg-scanpackages on stdout
if requested explicetly. Use stderr in case of error.
Closes: #366659

Frank Lichtenheld 18 years ago
parent
commit
322d4f8257

+ 43 - 0
ChangeLog

@@ -1,3 +1,46 @@
+2006-05-12  Frank Lichtenheld  <djpig@debian.org>
+
+	* scripts/dpkg-scanpackages.pl: Print usage
+	information on stderr instead of stdout in
+	case of error. Only print it on stdout if
+	requested via -h.
+
+	* scripts/dpkg-architecture.pl: Convert encoding
+	of the file from iso-8859-1 to utf-8.
+
+2006-05-12  Nicolas François  <nicolas.francois@centraliens.net>,
+	    Frank Lichtenheld  <djpig@debian.org>
+
+	* scripts/dpkg-gettext.pl: New module. Acts like a
+	wrapper around Locale::gettext so that the scripts
+	are usable without it, too.
+	* debian/dpkg.install: Install dpkg-gettext.pl.
+	* scripts/Makefile.am (dist_pkglib_SCRIPTS): Add dpkg-gettext.pl.
+
+	* po/POTFILES.in: Add scripts installed with dpkg
+	to the list.
+	* po/Makevars (XGETTEXT_OPTIONS): Add _g to list of keywords.
+	* debian/dpkg-dev.install: Install .mo files.
+	* debian/control (dpkg-dev[Depends]): Bump dependency on dpkg
+	to 1.13.20 since it needs dpkg-gettext.pl.
+	* scripts/cleanup-info.pl: Add gettext support.
+	* scripts/controllib.pl: Likewise.
+	* scripts/dpkg-architecture.pl: Likewise.
+	* scripts/dpkg-checkbuilddeps.pl: Likewise.
+	* scripts/dpkg-distaddfile.pl: Likewise.
+	* scripts/dpkg-divert.pl: Likewise.
+	* scripts/dpkg-genchanges.pl: Likewise.
+	* scripts/dpkg-gencontrol.pl: Likewise.
+	* scripts/dpkg-parsechangelog.pl: Likewise.
+	* scripts/debian/changelog.pl: Likewise.
+	* scripts/dpkg-scanpackages.pl: Likewise.
+	* scripts/dpkg-scansources.pl: Likewise.
+	* scripts/dpkg-shlibdeps.pl: Likewise.
+	* scripts/dpkg-source.pl: Likewise.
+	* scripts/dpkg-statoverride.pl: Likewise.
+	* scripts/install-info.pl: Likewise.
+	* scripts/update-alternatives.pl: Likewise.
+
 2006-05-10  Frank Lichtenheld  <djpig@debian.org>
 
 	* scripts/dpkg-buildpackage.sh: Pass all

+ 5 - 0
debian/changelog

@@ -1,6 +1,11 @@
 dpkg (1.13.20~) UNRELEASED; urgency=low
 
   [ Frank Lichtenheld ]
+  * Add gettext support for the Perl scripts. Based on a patch by
+    Nicolas François. Closes: #165843
+  * Only print usage information of dpkg-scanpackages on stdout
+    if requested explicetly. Use stderr in case of error.
+    Closes: #366659
   * Add remarks to dpkg-scansources and dpkg-scanpackages
     man pages about the need to compress the generated files
     to be able to access them via apt. Closes: #65839

+ 1 - 1
debian/control

@@ -31,7 +31,7 @@ Package: dpkg-dev
 Section: utils
 Priority: standard
 Architecture: all
-Depends: dpkg (>= 1.13.1), perl5, perl-modules, cpio (>= 2.4.2-2),
+Depends: dpkg (>= 1.13.20), perl5, perl-modules, cpio (>= 2.4.2-2),
  patch (>= 2.2-1), make, binutils
 Recommends: gcc | c-compiler, bzip2
 Suggests: gnupg, debian-keyring

+ 1 - 0
debian/dpkg-dev.install

@@ -16,6 +16,7 @@ usr/bin/dpkg-shlibdeps
 usr/bin/dpkg-source
 usr/lib/dpkg/controllib.pl
 usr/lib/dpkg/parsechangelog
+usr/share/locale/*/LC_MESSAGES/dpkg-dev.mo
 usr/share/man/*/*/822-date.1
 usr/share/man/*/822-date.1
 usr/share/man/*/*/deb-control.5

+ 1 - 0
debian/dpkg.install

@@ -7,6 +7,7 @@ usr/bin/dpkg
 usr/bin/dpkg-deb
 usr/bin/dpkg-query
 usr/bin/dpkg-split
+usr/lib/dpkg/dpkg-gettext.pl
 usr/lib/dpkg/enoent
 usr/lib/dpkg/mksplit
 usr/sbin

+ 1 - 1
po/Makevars

@@ -8,7 +8,7 @@ subdir = po
 top_builddir = ..
 
 # These options get passed to xgettext.
-XGETTEXT_OPTIONS = --keyword=_ --keyword=N_
+XGETTEXT_OPTIONS = --keyword=_ --keyword=N_ --keyword=_g
 
 # This is the copyright holder that gets inserted into the header of the
 # $(DOMAIN).pot file.  Set this to the copyright holder of the surrounding

+ 6 - 0
po/POTFILES.in

@@ -50,3 +50,9 @@ dpkg-split/split.c
 
 utils/enoent.c
 utils/start-stop-daemon.c
+
+scripts/cleanup-info.pl
+scripts/dpkg-divert.pl
+scripts/dpkg-statoverride.pl
+scripts/install-info.pl
+scripts/update-alternatives.pl

+ 2 - 1
scripts/Makefile.am

@@ -53,7 +53,8 @@ CLEANFILES = \
 
 
 dist_pkglib_SCRIPTS = \
-	controllib.pl
+	controllib.pl \
+	dpkg-gettext.pl
 
 
 do_perl_subst = sed -e "s:^\#![:space:]*/usr/bin/perl:\#!$(PERL):" \

+ 25 - 22
scripts/changelog/debian.pl

@@ -15,18 +15,21 @@ $varlistfile= 'debian/substvars';
 push(@INC,$dpkglibdir);
 require 'controllib.pl';
 
+require 'dpkg-gettext.pl';
+textdomain("dpkg-dev");
+
 $progname= "parsechangelog/$progname";
 
 $since='';
 
 sub usageversion {
-    print STDERR
-"Debian $progname $version.  Copyright (C) 1996
+    print STDERR _g(
+"Debian %s %s.  Copyright (C) 1996
 Ian Jackson.  This is free software; see the GNU General Public Licence
 version 2 or later for copying conditions.  There is NO warranty.
 
-Usage: $progname [-v<versionsince>] | -h
-";
+Usage: %s [-v<versionsince>] | -h
+"), $progname, $version, $progname;
 }
 
 while (@ARGV) {
@@ -36,7 +39,7 @@ while (@ARGV) {
     } elsif (m/^-h$/) {
         &usageversion; exit(0);
     } else {
-        &usageerr("unknown option or argument \`$_'");
+        &usageerr(sprintf(_g("unknown option or argument \`%s'"), $_));
     }
 }
 
@@ -57,32 +60,32 @@ while (<STDIN>) {
             $f{'Source'}= $1;
             $f{'Version'}= $2;
             $f{'Distribution'}= $3;
-            &error("-v<since> option specifies most recent version") if
+            &error(_g("-v<since> option specifies most recent version")) if
                 $2 eq $since;
             $f{'Distribution'} =~ s/^\s+//;
         } elsif ($expect eq 'next heading or eof') {
             last if $2 eq $since;
             $f{'Changes'}.= " .\n";
         } else {
-            &clerror("found start of entry where expected $expect");
+            &clerror(sprintf(_g("found start of entry where expected %s"), $expect));
         }
         $rhs= $'; $rhs =~ s/^\s+//;
         undef %kvdone;
         for $kv (split(/\s*,\s*/,$rhs)) {
             $kv =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i ||
-                &clerror("bad key-value after \`;': \`$kv'");
+                &clerror(sprintf(_g("bad key-value after \`;': \`%s'"), $kv));
             $k=(uc substr($1,0,1)).(lc substr($1,1)); $v=$2;
-            $kvdone{$k}++ && &clwarn("repeated key-value $k");
+            $kvdone{$k}++ && &clwarn(sprintf(_g("repeated key-value %s"), $k));
             if ($k eq 'Urgency') {
                 $v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i ||
-                    &clerror("badly formatted urgency value, at changelog ");
+                    &clerror(_g("badly formatted urgency value, at changelog "));
                 $newurg= lc $1;
                 $newurgn= $urgencies{lc $1}; $newcomment= $2;
                 $newurgn ||
-                    &clwarn("unknown urgency value $newurg - comparing very low");
+                    &clwarn(sprintf(_g("unknown urgency value %s - comparing very low"), $newurg));
                 if (defined($f{'Urgency'})) {
                     $f{'Urgency'} =~ m/^([-0-9a-z]+)((\s+.*)?)$/i ||
-                        &internerr("urgency >$f{'Urgency'}<");
+                        &internerr(sprintf(_g("urgency >%s<"), $f{'Urgency'}));
                     $oldurg= lc $1;
                     $oldurgn= $urgencies{lc $1}; $oldcomment= $2;
                 } else {
@@ -100,40 +103,40 @@ while (<STDIN>) {
                 # XC for putting in Control, XS for putting in Source
                 $f{$k}= $v;
             } else {
-                &clwarn("unknown key-value key $k - copying to XS-$k");
+                &clwarn(sprintf(_g("unknown key-value key %s - copying to %s"), $k, "XS-$k"));
                 $f{"XS-$k"}= $v;
             }
         }
         $expect= 'start of change data'; $blanklines=0;
         $f{'Changes'}.= " $_\n .\n";
     } elsif (m/^\S/) {
-        &clerror("badly formatted heading line");
+        &clerror(_g("badly formatted heading line"));
     } elsif (m/^ \-\- (.*) <(.*)>  ((\w+\,\s*)?\d{1,2}\s+\w+\s+\d{4}\s+\d{1,2}:\d\d:\d\d\s+[-+]\d{4}(\s+\([^\\\(\)]\))?)$/) {
         $expect eq 'more change data or trailer' ||
-            &clerror("found trailer where expected $expect");
+            &clerror(sprintf(_g("found trailer where expected %s"), $expect));
         $f{'Maintainer'}= "$1 <$2>" unless defined($f{'Maintainer'});
         $f{'Date'}= $3 unless defined($f{'Date'});
 #        $f{'Changes'}.= " .\n $_\n";
         $expect= 'next heading or eof';
         last if $since eq '';
     } elsif (m/^ \-\-/) {
-        &clerror("badly formatted trailer line");
+        &clerror(_g("badly formatted trailer line"));
     } elsif (m/^\s{2,}\S/) {
         $expect eq 'start of change data' || $expect eq 'more change data or trailer' ||
-            &clerror("found change data where expected $expect");
+            &clerror(sprintf(_g("found change data where expected %s"), $expect));
         $f{'Changes'}.= (" .\n"x$blanklines)." $_\n"; $blanklines=0;
         $expect= 'more change data or trailer';
     } elsif (!m/\S/) {
         next if $expect eq 'start of change data' || $expect eq 'next heading or eof';
         $expect eq 'more change data or trailer' ||
-            &clerror("found blank line where expected $expect");
+            &clerror(sprintf(_g("found blank line where expected %s"), $expect));
         $blanklines++;
     } else {
-        &clerror("unrecognised line");
+        &clerror(_g("unrecognised line"));
     }
 }
 
-$expect eq 'next heading or eof' || die "found eof where expected $expect";
+$expect eq 'next heading or eof' || die sprintf(_g("found eof where expected %s"), $expect);
 
 $f{'Changes'} =~ s/\n$//;
 $f{'Changes'} =~ s/^/\n/;
@@ -145,5 +148,5 @@ $f{'Closes'} = join(' ',sort { $a <=> $b} @closes);
 
 &outputclose(0);
 
-sub clerror { &error("$_[0], at changelog line $."); }
-sub clwarn { &warn("$_[0], at changelog line $."); }
+sub clerror { &error(sprintf(_g("%s, at changelog line %d"), $_[0], $.)); }
+sub clwarn { &warn(sprintf(_g("%s, at changelog line %d"), $_[0], $.)); }

+ 35 - 17
scripts/cleanup-info.pl

@@ -24,17 +24,22 @@
 # don't put that in for production.
 # use strict;
 
+my $dpkglibdir = "."; # This line modified by Makefile
+push(@INC,$dpkglibdir);
+require 'dpkg-gettext.pl';
+textdomain("dpkg");
+
 my $version = '1.1.6'; # This line modified by Makefile
 sub version {
-    print STDERR <<END;
-Debian cleanup-info $version.  Copyright (C)1996 Kim-Minh Kaplan.
+    printf STDERR _g(<<END), $version;
+Debian cleanup-info %s.  Copyright (C)1996 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 <<'EOF';
+    print STDERR _g(<<'EOF');
 usage: cleanup-info [--version] [--help] [--unsafe] [--] [<dirname>]
 Warning: the ``--unsafe'' option may garble an otherwise correct file
 EOF
@@ -47,7 +52,8 @@ my $name= $&;
 
 sub ulquit {
     unlink "$infodir/dir.lock"
-	or warn "$name: warning - unable to unlock $infodir/dir: $!\n";
+	or warn sprintf(_g("%s: warning - unable to unlock %s: %s"),
+	                $name, "$infodir/dir", $!)."\n";
     die $_[0];
 }
 
@@ -66,7 +72,7 @@ while (scalar @ARGV > 0 && $ARGV[0] =~ /^--/) {
 	$unsafe=1;
 	next;
     };
-    print STDERR "$name: unknown option \`$_'\n";
+    printf STDERR _g("%s: unknown option \`%s'")."\n", $name, $_;
     usage;
     exit 1;
 }
@@ -74,19 +80,24 @@ while (scalar @ARGV > 0 && $ARGV[0] =~ /^--/) {
 if (scalar @ARGV > 0) {
     $infodir = shift;
     if (scalar @ARGV > 0) {
-	print STDERR "$name: too many arguments\n";
+	printf STDERR _g("%s: too many arguments")."\n", $name;
 	usage;
 	exit 1;
     }
 }
 
 if (!link "$infodir/dir", "$infodir/dir.lock") {
-    die "$name: failed to lock dir for editing! $!\n".
-        ($! =~ /exist/i ? "try deleting $infodir/dir.lock\n" : '');
+    die sprintf(_g("%s: failed to lock dir for editing! %s"),
+                $name, $!)."\n".
+        ($! =~ /exist/i ? sprintf(_g("try deleting %s"),
+                                  "$infodir/dir.lock")."\n" : '');
 }
-open OLD, "$infodir/dir"  or ulquit "$name: can't open $infodir/dir: $!\n";
+open OLD, "$infodir/dir"
+    or ulquit sprintf(_g("%s: can't open %s: %s"),
+                      $name, "$infodir/dir", $!)."\n";
 open OUT, ">$infodir/dir.new"
-    or ulquit "$name can't create $infodir/dir.new: $!\n";
+    or ulquit sprintf(_g("%s: can't create %s: %s"),
+                      $name, "$infodir/dir.new", $!)."\n";
 
 my (%sections, @section_list, $lastline);
 my $section="Miscellaneous";	# default section
@@ -97,7 +108,8 @@ while (<OLD>) {				# dump the non entries part
     last if (/$waitfor/oi);
     if (defined $lastline) {
 	print OUT $lastline
-	    or ulquit "$name: error writing $infodir/dir.new: $!\n";
+	    or ulquit sprintf(_g("%s: error writing %s: %s"),
+	                      $name, "$infodir/dir.new", $!)."\n";
     }
     $lastline = $_;
 };
@@ -136,20 +148,26 @@ foreach (<OLD>) {		# collect sections
     }
 }
 
-eof OLD or ulquit "$name: read $infodir/dir: $!\n";
-close OLD or ulquit "$name: close $infodir/dir after read: $!\n";
+eof OLD or ulquit sprintf(_g("%s: read %s: %s"),
+                          $name, "$infodir/dir", $!)."\n";
+close OLD or ulquit sprintf(_g("%s: close %s after read: %s"),
+                            $name, "$infodir/dir", $!)."\n";
 
 print OUT @sections{@section_list};
-close OUT or ulquit "$name: error closing $infodir/dir.new: $!\n";
+close OUT or ulquit sprintf(_g("%s: error closing %s: %s"),
+                            $name, "$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";
+    or ulquit sprintf(_g("%s: can't backup old %s, giving up: %s"),
+                      $name, "$infodir/dir", $!)."\n";
 rename "$infodir/dir.new", "$infodir/dir"
-    or ulquit "$name: failed to install $infodir/dir; I'll leave it as $infodir/dir.new: $!\n";
+    or ulquit sprintf(_g("%s: failed to install %s; I'll leave it as %s: %s"),
+                      $name, "$infodir/dir", "$infodir/dir.new", $!)."\n";
 
 unlink "$infodir/dir.lock"
-    or die "$name: failed to unlock $infodir/dir: $!\n";
+    or die sprintf(_g("%s: failed to unlock %s: %s"),
+                   $name, "$infodir/dir", $!)."\n";
 
 exit 0;

+ 62 - 49
scripts/controllib.pl

@@ -1,5 +1,12 @@
 #!/usr/bin/perl
 
+use English;
+
+$dpkglibdir= "."; # This line modified by Makefile
+push(@INC,$dpkglibdir);
+require 'dpkg-gettext.pl';
+textdomain("dpkg-dev");
+
 # Global variables:
 # $v                - value parameter to function
 # $sourcepackage    - name of sourcepackage
@@ -54,14 +61,14 @@ if(!defined($getlogin)) {
 
 if (defined ($ENV{'LOGNAME'})) {
     @fowner = getpwnam ($ENV{'LOGNAME'});
-    if (! @fowner) { die (sprintf ('unable to get login information for username "%s"', $ENV{'LOGNAME'})); }
+    if (! @fowner) { die (sprintf (_g('unable to get login information for username "%s"'), $ENV{'LOGNAME'})); }
 } elsif (defined ($getlogin)) {
     @fowner = getpwnam ($getlogin);
-    if (! @fowner) { die (sprintf ('unable to get login information for username "%s"', $getlogin)); }
+    if (! @fowner) { die (sprintf (_g('unable to get login information for username "%s"'), $getlogin)); }
 } else {
-    &warn (sprintf ('no utmp entry available and LOGNAME not defined; using uid of process (%d)', $<));
+    &warn (sprintf (_g('no utmp entry available and LOGNAME not defined; using uid of process (%d)'), $<));
     @fowner = getpwuid ($<);
-    if (! @fowner) { die (sprintf ('unable to get login information for uid %d', $<)); }
+    if (! @fowner) { die (sprintf (_g('unable to get login information for uid %d'), $<)); }
 }
 @fowner = @fowner[2,3];
 
@@ -133,16 +140,16 @@ sub substvars {
     while ($v =~ m/\$\{([-:0-9a-z]+)\}/i) {
         # If we have consumed more from the leftover data, then
         # reset the recursive counter.
-        $count= 0 if (length($') < length($rhs));
+        $count= 0 if (length($POSTMATCH) < length($rhs));
 
         $count < $maxsubsts ||
-            &error("too many substitutions - recursive ? - in \`$v'");
+            &error(sprintf(_g("too many substitutions - recursive ? - in \`%s'"), $v));
         $lhs=$`; $vn=$1; $rhs=$';
         if (defined($substvar{$vn})) {
             $v= $lhs.$substvar{$vn}.$rhs;
             $count++;
         } else {
-            &warn("unknown substitution variable \${$vn}");
+            &warn(sprintf(_g("unknown substitution variable \${%s}"), $vn));
             $v= $lhs.$rhs;
         }
     }
@@ -159,37 +166,38 @@ sub outputclose {
 	    $v= &substvars($v);
 	}
         $v =~ m/\S/ || next; # delete whitespace-only fields
-        $v =~ m/\n\S/ && &internerr("field $f has newline then non whitespace >$v<");
-        $v =~ m/\n[ \t]*\n/ && &internerr("field $f has blank lines >$v<");
-        $v =~ m/\n$/ && &internerr("field $f has trailing newline >$v<");
+        $v =~ m/\n\S/ && &internerr(sprintf(_g("field %s has newline then non whitespace >%s<"), $f, $v));
+        $v =~ m/\n[ \t]*\n/ && &internerr(sprintf(_g("field %s has blank lines >%s<"), $f, $v));
+        $v =~ m/\n$/ && &internerr(sprintf(_g("field %s has trailing newline >%s<"), $f, $v));
 	if ($dosubstvars) {
 	   $v =~ s/,[\s,]*,/,/g;
 	   $v =~ s/^\s*,\s*//;
 	   $v =~ s/\s*,\s*$//;
 	}
         $v =~ s/\$\{\}/\$/g;
-        print("$f: $v\n") || &syserr("write error on control data");
+        print("$f: $v\n") || &syserr(_g("write error on control data"));
     }
 
-    close(STDOUT) || &syserr("write error on close control data");
+    close(STDOUT) || &syserr(_g("write error on close control data"));
 }
 
 sub parsecontrolfile {
     $controlfile="./$controlfile" if $controlfile =~ m/^\s/;
 
-    open(CDATA,"< $controlfile") || &error("cannot read control file $controlfile: $!");
+    open(CDATA,"< $controlfile") || &error(sprintf(_g("cannot read control file %s: %s"), $controlfile, $!));
     binmode(CDATA);
-    $indices= &parsecdata('C',1,"control file $controlfile");
-    $indices >= 2 || &error("control file must have at least one binary package part");
+    $indices= &parsecdata('C',1,sprintf(_g("control file %s"),$controlfile));
+    $indices >= 2 || &error(_g("control file must have at least one binary package part"));
 
     for ($i=1;$i<$indices;$i++) {
         defined($fi{"C$i Package"}) ||
-            &error("per-package paragraph $i in control info file is ".
-                   "missing Package line");
+            &error(sprintf(_g("per-package paragraph %d in control ".
+                                   "info file is missing Package line"),
+                           $i));
     }
     defined($fi{"C Source"}) ||
-        &error("source paragraph in control info file is ".
-               "missing Source line");
+        &error(_g("source paragraph in control info file is ".
+                       "missing Source line"));
 
 }
 
@@ -203,12 +211,14 @@ sub parsesubstvars {
                 next if m/^\#/ || !m/\S/;
                 s/\s*\n$//;
                 m/^(\w[-:0-9A-Za-z]*)\=/ ||
-                    &error("bad line in substvars file $varlistfile at line $.");
+                    &error(sprintf(_g("bad line in substvars file %s at line %d"),
+                                   $varlistfile, $.));
                 $substvar{$1}= $';
             }
             close(SV);
         } elsif ($! != ENOENT ) {
-            &error("unable to open substvars file $varlistfile: $!");
+            &error(sprintf(_g("unable to open substvars file %s: %s"),
+                           $varlistfile, $!));
         }
         $substvarsparsed = 1;
     }
@@ -258,7 +268,7 @@ ALTERNATE:
                 }
             }
             if (length($dep_or)) {
-		&warn("can't parse dependency $dep_and");
+		&warn(sprintf(_g("can't parse dependency %s"),$dep_and));
 		return undef;
 	    }
 	    push @or_list, [ $package, $relation, $version, \@arches ];
@@ -283,7 +293,7 @@ sub showdep {
 }
 
 sub parsechangelog {
-    defined($c=open(CDATA,"-|")) || &syserr("fork for parse changelog");
+    defined($c=open(CDATA,"-|")) || &syserr(_g("fork for parse changelog"));
     binmode(CDATA);
     if (!$c) {
         @al=($parsechangelog);
@@ -292,8 +302,8 @@ sub parsechangelog {
         push(@al,"-l$changelogfile");
         exec(@al) || &syserr("exec parsechangelog $parsechangelog");
     }
-    &parsecdata('L',0,"parsed version of changelog");
-    close(CDATA); $? && &subprocerr("parse changelog");
+    &parsecdata('L',0,_g("parsed version of changelog"));
+    close(CDATA); $? && &subprocerr(_g("parse changelog"));
 
     # XXX: Source-Version is now deprecated, remove in the future.
     $substvar{'Source-Version'}= $fi{"L Version"};
@@ -308,22 +318,22 @@ sub parsechangelog {
 sub checkpackagename {
     my $name = shift || '';
     $name =~ m/[^-+.0-9a-z]/o &&
-        &error("source package name `$name' contains illegal character `$&'");
+        &error(sprintf(_g("source package name `%s' contains illegal character `%s'"), $name, $&));
     $name =~ m/^[0-9a-z]/o ||
-        &error("source package name `$name' starts with non-alphanum");
+        &error(sprintf(_g("source package name `%s' starts with non-alphanum"), $name));
 }
 
 sub checkversion {
     my $version = shift || '';
     $version =~ m/[^-+:.0-9a-zA-Z~]/o &&
-        &error("version number contains illegal character `$&'");
+        &error(sprintf(_g("version number contains illegal character `%s'"), $&));
 }
 
 sub setsourcepackage {
     checkpackagename( $v );
     if (length($sourcepackage)) {
         $v eq $sourcepackage ||
-            &error("source package has two conflicting values - $sourcepackage and $v");
+            &error(sprintf(_g("source package has two conflicting values - %s and %s"), $sourcepackage, $v));
     } else {
         $sourcepackage= $v;
     }
@@ -332,7 +342,7 @@ sub setsourcepackage {
 sub readmd5sum {
     (my $md5sum = shift) or return;
     $md5sum =~ s/^([0-9a-f]{32})\s*\*?-?\s*\n?$/$1/o
-	|| &failure("md5sum gave bogus output `$md5sum'");
+	|| &failure(sprintf(_g("md5sum gave bogus output `%s'"), $md5sum));
     return $md5sum;
 }
 
@@ -355,10 +365,10 @@ sub parsecdata {
             $fi{"o:$source$index $cf"}= $1;
             if (lc $cf eq 'package') { $p2i{"$source $v"}= $index; }
         } elsif (m/^\s+\S/) {
-            length($cf) || &syntax("continued value line not in field");
+            length($cf) || &syntax(_g("continued value line not in field"));
             $fi{"$source$index $cf"}.= "\n$_";
         } elsif (m/^-----BEGIN PGP/ && $many<0) {
-            $many == -2 && syntax("expected blank line before PGP signature");
+            $many == -2 && syntax(_g("expected blank line before PGP signature"));
             while (<CDATA>) { last if m/^$/; }
             $many= -2;
         } elsif (m/^$/) {
@@ -368,52 +378,55 @@ sub parsecdata {
             } elsif ($many == -2) {
                 $_= <CDATA> while defined($_) && $_ =~ /^\s*$/;
                 length($_) ||
-                    &syntax("expected PGP signature, found EOF after blank line");
+                    &syntax(_g("expected PGP signature, found EOF after blank line"));
                 s/\n$//;
                 m/^-----BEGIN PGP/ ||
-                    &syntax("expected PGP signature, found something else \`$_'");
+                    &syntax(sprintf(_g("expected PGP signature, found something else \`%s'"), $_));
                 $many= -3; last;
             } else {
 		while (<CDATA>) {
 		    /^\s*$/ ||
-			&syntax("found several \`paragraphs' where only one expected");
+			&syntax(_g("found several \`paragraphs' where only one expected"));
 		}
             }
         } else {
-            &syntax("line with unknown format (not field-colon-value)");
+            &syntax(_g("line with unknown format (not field-colon-value)"));
         }
     }
-    $many == -2 && &syntax("found start of PGP body but no signature");
+    $many == -2 && &syntax(_g("found start of PGP body but no signature"));
     if (length($cf)) { $index++; }
-    $index || &syntax("empty file");
+    $index || &syntax(_g("empty file"));
     return $index;
 }
 
 sub unknown {
     my $field = $_;
-    &warn("unknown information field \`$field\' in input data in $_[0]");
+    &warn(sprintf(_g("unknown information field \`%s\' in input data in %s"), $field, $_[0]));
 }
 
 sub syntax {
-    &error("syntax error in $whatmsg at line $.: $_[0]");
+    &error(sprintf(_g("syntax error in %s at line %d: %s"), $whatmsg, $., $_[0]));
 }
 
-sub failure { die "$progname: failure: $_[0]\n"; }
-sub syserr { die "$progname: failure: $_[0]: $!\n"; }
-sub error { die "$progname: error: $_[0]\n"; }
-sub internerr { die "$progname: internal error: $_[0]\n"; }
-sub warn { if (!$quiet_warnings) { warn "$progname: warning: $_[0]\n"; } }
-sub usageerr { print(STDERR "$progname: @_\n\n"); &usageversion; exit(2); }
+sub failure { die sprintf(_g("%s: failure: %s"), $progname, $_[0])."\n"; }
+sub syserr { die sprintf(_g("%s: failure: %s: %s"), $progname, $_[0], $!)."\n"; }
+sub error { die sprintf(_g("%s: error: %s"), $progname, $_[0])."\n"; }
+sub internerr { die sprintf(_g("%s: internal error: %s"), $progname, $_[0])."\n"; }
+sub warn { if (!$quiet_warnings) { warn sprintf(_g("%s: warning: %s"), $progname, $_[0])."\n"; } }
+sub usageerr { printf(STDERR _g("%s: %s")."\n\n", $progname, "@_"); &usageversion; exit(2); }
 sub warnerror { if ($warnable_error) { &warn( @_ ); } else { &error( @_ ); } }
 
 sub subprocerr {
     local ($p) = @_;
     if (WIFEXITED($?)) {
-        die "$progname: failure: $p gave error exit status ".WEXITSTATUS($?)."\n";
+        die sprintf(_g("%s: failure: %s gave error exit status %s"),
+                    $progname, $p, WEXITSTATUS($?))."\n";
     } elsif (WIFSIGNALED($?)) {
-        die "$progname: failure: $p died from signal ".WTERMSIG($?)."\n";
+        die sprintf(_g("%s: failure: %s died from signal %s"),
+                    $progname, $p, WTERMSIG($?))."\n";
     } else {
-        die "$progname: failure: $p failed with unknown exit code $?\n";
+        die sprintf(_g("%s: failure: %s failed with unknown exit code %d"),
+                    $progname, $p, $?)."\n";
     }
 }
 

+ 19 - 16
scripts/dpkg-architecture.pl

@@ -2,8 +2,8 @@
 #
 # dpkg-architecture
 #
-# Copyright © 2004-2005 Scott James Remnant <scott@netsplit.com>,
-# Copyright © 1999 Marcus Brinkmann <brinkmd@debian.org>.
+# Copyright © 2004-2005 Scott James Remnant <scott@netsplit.com>,
+# Copyright © 1999 Marcus Brinkmann <brinkmd@debian.org>.
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -26,18 +26,21 @@ $dpkglibdir="/usr/lib/dpkg";
 push(@INC,$dpkglibdir);
 require 'controllib.pl';
 
+require 'dpkg-gettext.pl';
+textdomain("dpkg-dev");
+
 $pkgdatadir=".";
 
 sub usageversion {
-    print STDERR
-"Debian $0 $version.
+    printf STDERR _g(
+"Debian %s %s.
 Copyright (C) 2004-2005 Scott James Remnant <scott\@netsplit.com>,
 Copyright (C) 1999-2001 Marcus Brinkmann <brinkmd\@debian.org>.
 This is free software; see the GNU General Public Licence
 version 2 or later for copying conditions.  There is NO warranty.
 
 Usage:
-  $0 [<option> ...] [<action>]
+  %s [<option> ...] [<action>]
 Options:
        -a<debian-arch>    set current Debian architecture
        -t<gnu-system>     set current GNU system type
@@ -51,12 +54,12 @@ Actions:
        -s                 print command to set environment variables
        -u                 print command to unset environment variables
        -c <command>       set environment and run the command in it.
-";
+"), $0, $version, $0;
 }
 
 sub read_cputable {
     open CPUTABLE, "$pkgdatadir/cputable"
-	or &syserr("unable to open cputable");
+	or &syserr(_g("unable to open cputable"));
     while (<CPUTABLE>) {
 	if (m/^(?!\#)(\S+)\s+(\S+)\s+(\S+)/) {
 	    $cputable{$1} = $2;
@@ -69,7 +72,7 @@ sub read_cputable {
 
 sub read_ostable {
     open OSTABLE, "$pkgdatadir/ostable"
-	or &syserr("unable to open ostable");
+	or &syserr(_g("unable to open ostable"));
     while (<OSTABLE>) {
 	if (m/^(?!\#)(\S+)\s+(\S+)\s+(\S+)/) {
 	    $ostable{$1} = $2;
@@ -151,7 +154,7 @@ $deb_build_gnu_type = &debian_to_gnu($deb_build_arch);
 # Default host: Current gcc.
 $gcc = `\${CC:-gcc} -dumpmachine`;
 if ($?>>8) {
-    &warn("Couldn't determine gcc system type, falling back to default (native compilation)");
+    &warn(_g("Couldn't determine gcc system type, falling back to default (native compilation)"));
     $gcc = '';
 } else {
     chomp $gcc;
@@ -160,7 +163,7 @@ if ($?>>8) {
 if ($gcc ne '') {
     $deb_host_arch = &gnu_to_debian($gcc);
     unless (defined $deb_host_arch) {
-	&warn ("Unknown gcc system type $gcc, falling back to default (native compilation)");
+	&warn (sprintf(_g("Unknown gcc system type %s, falling back to default (native compilation)"), $gcc));
 	$gcc = '';
     } else {
 	$gcc = $deb_host_gnu_type = &debian_to_gnu($deb_host_arch);
@@ -207,23 +210,23 @@ while (@ARGV) {
     } elsif (m/^-L$/) {
        # Handled already
     } else {
-	usageerr("unknown option \`$_'");
+	usageerr(sprintf(_g("unknown option \`%s'"), $_));
     }
 }
 
 if ($req_host_arch ne '' && $req_host_gnu_type eq '') {
     $req_host_gnu_type = &debian_to_gnu ($req_host_arch);
-    die ("unknown Debian architecture $req_host_arch, you must specify \GNU system type, too") unless defined $req_host_gnu_type;
+    die (sprintf(_g("unknown Debian architecture %s, you must specify GNU system type, too"), $req_host_arch)) unless defined $req_host_gnu_type;
 }
 
 if ($req_host_gnu_type ne '' && $req_host_arch eq '') {
     $req_host_arch = &gnu_to_debian ($req_host_gnu_type);
-    die ("unknown GNU system type $req_host_gnu_type, you must specify Debian architecture, too") unless defined $req_host_arch;
+    die (sprintf(_g("unknown GNU system type %s, you must specify Debian architecture, too"), $req_host_gnu_type)) unless defined $req_host_arch;
 }
 
 if ($req_host_gnu_type ne '' && $req_host_arch ne '') {
     $dfl_host_gnu_type = &debian_to_gnu ($req_host_arch);
-    &warn("Default GNU system type $dfl_host_gnu_type for Debian arch $req_host_arch does not match specified GNU system type $req_host_gnu_type") if $dfl_host_gnu_type ne $req_host_gnu_type;
+    &warn(sprintf(_g("Default GNU system type %s for Debian arch %s does not match specified GNU system type %s"), $dfl_host_gnu_type, $req_host_arch, $req_host_gnu_type)) if $dfl_host_gnu_type ne $req_host_gnu_type;
 }
 
 $deb_host_arch = $req_host_arch if $req_host_arch ne '';
@@ -231,7 +234,7 @@ $deb_host_gnu_type = $req_host_gnu_type if $req_host_gnu_type ne '';
 
 #$gcc = `\${CC:-gcc} --print-libgcc-file-name`;
 #$gcc =~ s!^.*gcc-lib/(.*)/\d+(?:.\d+)*/libgcc.*$!$1!s;
-&warn("Specified GNU system type $deb_host_gnu_type does not match gcc system type $gcc.") if !($req_is_arch or $req_eq_arch) && ($gcc ne '') && ($gcc ne $deb_host_gnu_type);
+&warn(sprintf(_g("Specified GNU system type %s does not match gcc system type %s."), $deb_host_gnu_type, $gcc)) if !($req_is_arch or $req_eq_arch) && ($gcc ne '') && ($gcc ne $deb_host_gnu_type);
 
 # Split the Debian and GNU names
 ($deb_host_arch_os, $deb_host_arch_cpu) = &split_debian($deb_host_arch);
@@ -295,6 +298,6 @@ if ($action eq 'l') {
     if (exists $env{$req_variable_to_print}) {
         print "$env{$req_variable_to_print}\n";
     } else {
-        die "$req_variable_to_print is not a supported variable name";
+        die sprintf(_g("%s is not a supported variable name"), $req_variable_to_print);
     }
 }

+ 8 - 4
scripts/dpkg-checkbuilddeps.pl

@@ -9,8 +9,11 @@ push(@INC,$dpkglibdir);
 #my $controlfile;
 require 'controllib.pl';
 
+require 'dpkg-gettext.pl';
+textdomain("dpkg-dev");
+
 sub usage {
-	print STDERR <<EOF;
+	print STDERR _g(<<EOF);
 Usage: dpkg-checkbuilddeps [-B] [control-file]
 	-B		binary-only, ignore -Indep
 	control-file	control file to process [Default: debian/control]
@@ -62,11 +65,11 @@ if (! $binary_only && defined($fi{"C Build-Conflicts-Indep"})) {
 }
 
 if (@unmet) {
-	print STDERR "$me: Unmet build dependencies: ";
+	printf STDERR _g("%s: Unmet build dependencies: "), $me;
 	print STDERR join(" ", @unmet), "\n";
 }
 if (@conflicts) {
-	print STDERR "$me: Build conflicts: ";
+	printf STDERR _g("%s: Build conflicts: "), $me;
 	print STDERR join(" ", @conflicts), "\n";
 }
 exit 1 if @unmet || @conflicts;
@@ -139,7 +142,8 @@ sub check_line {
 	my @unmet=();
 
 	unless(defined($dep_list)) {
-	    &error("error occurred while parsing $fieldname");
+	    &error(sprintf(_g("error occurred while parsing %s"),
+	                   $fieldname));
 	}
 
 	foreach my $dep_and (@$dep_list) {

+ 16 - 13
scripts/dpkg-distaddfile.pl

@@ -11,9 +11,12 @@ $fileslistfile= 'debian/files';
 push(@INC,$dpkglibdir);
 require 'controllib.pl';
 
+require 'dpkg-gettext.pl';
+textdomain("dpkg-dev");
+
 sub usageversion {
-    print STDERR
-"Debian dpkg-distaddfile $version.  Copyright (C) 1996
+    printf STDERR _g(
+"Debian dpkg-distaddfile %s.  Copyright (C) 1996
 Ian Jackson.  This is free software; see the GNU General Public Licence
 version 2 or later for copying conditions.  There is NO warranty.
 
@@ -21,7 +24,7 @@ Usage:
   dpkg-distaddfile <filename> <section> <priority>
 Options:  -f<fileslistfile>      write files here instead of debian/files
           -h                     print this message
-";
+"), $version;
 }
 
 while (@ARGV && $ARGV[0] =~ m/^-/) {
@@ -33,30 +36,30 @@ while (@ARGV && $ARGV[0] =~ m/^-/) {
     } elsif (m/^--$/) {
         last;
     } else {
-        &usageerr("unknown option $_");
+        &usageerr(sprintf(_g("unknown option %s"), $_));
     }
 }
 
-@ARGV==3 || &usageerr("need exactly a filename, section and priority");
+@ARGV==3 || &usageerr(_g("need exactly a filename, section and priority"));
 ($file,$section,$priority)= @ARGV;
 
 ($file =~ m/\s/ || $section =~ m/\s/ || $priority =~ m/\s/) &&
-    &error("filename, section and priority may contain no whitespace");
+    &error(_g("filename, section and priority may contain no whitespace"));
 
 $fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
-open(Y,"> $fileslistfile.new") || &syserr("open new files list file");
+open(Y,"> $fileslistfile.new") || &syserr(_g("open new files list file"));
 chown(@fowner, "$fileslistfile.new") 
-		|| &syserr("chown new files list file");
+		|| &syserr(_g("chown new files list file"));
 if (open(X,"< $fileslistfile")) {
     while (<X>) {
         s/\n$//;
         next if m/^(\S+) / && $1 eq $file;
-        print(Y "$_\n") || &syserr("copy old entry to new files list file");
+        print(Y "$_\n") || &syserr(_g("copy old entry to new files list file"));
     }
 } elsif ($! != ENOENT) {
-    &syserr("read old files list file");
+    &syserr(_g("read old files list file"));
 }
 print(Y "$file $section $priority\n")
-    || &syserr("write new entry to new files list file");
-close(Y) || &syserr("close new files list file");
-rename("$fileslistfile.new",$fileslistfile) || &syserr("install new files list file");
+    || &syserr(_g("write new entry to new files list file"));
+close(Y) || &syserr(_g("close new files list file"));
+rename("$fileslistfile.new",$fileslistfile) || &syserr(gettetx("install new files list file"));

+ 51 - 47
scripts/dpkg-divert.pl

@@ -4,16 +4,20 @@ $version= '1.0.11'; # This line modified by Makefile
 $admindir= "/var/lib/dpkg"; # This line modified by Makefile
 $dpkglibdir= "../utils"; # This line modified by Makefile
 
-$enoent=`$dpkglibdir/enoent` || die "Cannot get ENOENT value from $dpkglibdir/enoent: $!";
+push (@INC, $dpkglibdir);
+require 'dpkg-gettext.pl';
+textdomain("dpkg");
+
+$enoent=`$dpkglibdir/enoent` || die sprintf(_g("Cannot get ENOENT value from %s: %s"), "$dpkglibdir/enoent", $!);
 sub ENOENT { $enoent; }
 
 sub showversion {
-    print("Debian dpkg-divert $version.\n") || &quit("failed to write version: $!");
+    printf(_g("Debian dpkg-divert %s")."\n", $version) || &quit(sprintf(_g("failed to write version: %s"), $!));
 }
 
 sub usage {
     &showversion;
-    print STDERR <<EOF
+    print STDERR _g(<<EOF)
 Copyright (C) 1995 Ian Jackson.
 Copyright (C) 2000,2001 Wichert Akkerman.
 
@@ -43,7 +47,7 @@ When adding, default is --local and --divert <original>.distrib.
 When removing, --package or --local and --divert must match if specified.
 Package preinst/postrm scripts should always specify --package and --divert.
 EOF
-        || &quit("failed to write usage: $!");
+        || &quit(sprintf(_g("failed to write usage: %s"), $!));
 }
 
 $testmode= 0;
@@ -54,7 +58,7 @@ $|=1;
 
 sub checkmanymodes {
     return unless $mode;
-    &badusage("two modes specified: $_ and --$mode");
+    &badusage(sprintf(_g("two modes specified: %s and --%s"), $_, $mode));
 }
 
 while (@ARGV) {
@@ -87,71 +91,71 @@ while (@ARGV) {
         &checkmanymodes;
         $mode= 'truename';
     } elsif (m/^--divert$/) {
-        @ARGV || &badusage("--divert needs a divert-to argument");
+        @ARGV || &badusage(_g("--divert needs a divert-to argument"));
         $divertto= shift(@ARGV);
-        $divertto =~ m/\n/ && &badusage("divert-to may not contain newlines");
+        $divertto =~ m/\n/ && &badusage(_g("divert-to may not contain newlines"));
     } elsif (m/^--package$/) {
-        @ARGV || &badusage("--package needs a package argument");
+        @ARGV || &badusage(_g("--package needs a package argument"));
         $package= shift(@ARGV);
-        $package =~ m/\n/ && &badusage("package may not contain newlines");
+        $package =~ m/\n/ && &badusage(_g("package may not contain newlines"));
     } elsif (m/^--admindir$/) {
-        @ARGV || &badusage("--admindir needs a directory argument");
+        @ARGV || &badusage(_g("--admindir needs a directory argument"));
         $admindir= shift(@ARGV);
     } else {
-        &badusage("unknown option \`$_'");
+        &badusage(sprintf(_g("unknown option \`%s'"), $_));
     }
 }
 
 $mode='add' unless $mode;
 
-open(O,"$admindir/diversions") || &quit("cannot open diversions: $!");
+open(O,"$admindir/diversions") || &quit(sprintf(_g("cannot open diversions: %s"), $!));
 while(<O>) {
     s/\n$//; push(@contest,$_);
-    $_=<O>; s/\n$// || &badfmt("missing altname");
+    $_=<O>; s/\n$// || &badfmt(_g("missing altname"));
     push(@altname,$_);
-    $_=<O>; s/\n$// || &badfmt("missing package");
+    $_=<O>; s/\n$// || &badfmt(_g("missing package"));
     push(@package,$_);
 }
 close(O);
 
 if ($mode eq 'add') {
-    @ARGV == 1 || &badusage("--add needs a single argument");
+    @ARGV == 1 || &badusage(_g("--add needs a single argument"));
     $file= $ARGV[0];
-    $file =~ m#^/# || &badusage("filename \"$file\" is not absolute");
-    $file =~ m/\n/ && &badusage("file may not contain newlines");
-	-d $file && &badusage("Cannot divert directories");
+    $file =~ m#^/# || &badusage(sprintf(_g("filename \"%s\" is not absolute"), $file));
+    $file =~ m/\n/ && &badusage(_g("file may not contain newlines"));
+	-d $file && &badusage(_g("Cannot divert directories"));
     $divertto= "$file.distrib" unless defined($divertto);
-    $divertto =~ m#^/# || &badusage("filename \"$divertto\" is not absolute");
+    $divertto =~ m#^/# || &badusage(sprintf(_g("filename \"%s\" is not absolute"), $divertto));
     $package= ':' unless defined($package);
     for ($i=0; $i<=$#contest; $i++) {
         if ($contest[$i] eq $file || $altname[$i] eq $file ||
             $contest[$i] eq $divertto || $altname[$i] eq $divertto) {
             if ($contest[$i] eq $file && $altname[$i] eq $divertto &&
                 $package[$i] eq $package) {
-                print "Leaving \`",&infon($i),"'\n" if $verbose > 0;
+                printf(_g("Leaving \`%s'")."\n", &infon($i)) if $verbose > 0;
                 exit(0);
             }
-            &quit("\`".&infoa."' clashes with \`".&infon($i)."'");
+            &quit(sprintf(_g("\`%s' clashes with \`%s'"), &infoa, &infon($i)));
         }
     }
     push(@contest,$file);
     push(@altname,$divertto);
     push(@package,$package);
-    print "Adding \`",&infon($#contest),"'\n" if $verbose > 0;
+    printf(_g("Adding \`%s'")."\n", &infon($#contest)) if $verbose > 0;
     &checkrename($file,$divertto);
     &save;
     &dorename($file,$divertto);
     exit(0);
 } elsif ($mode eq 'remove') {
-    @ARGV == 1 || &badusage("--remove needs a single argument");
+    @ARGV == 1 || &badusage(_g("--remove needs a single argument"));
     $file= $ARGV[0];
     for ($i=0; $i<=$#contest; $i++) {
         next unless $file eq $contest[$i];
-        &quit("mismatch on divert-to\n  when removing \`".&infoa."'\n  found \`".
-              &infon($i)."'") if defined($divertto) && $altname[$i] ne $divertto;
-        &quit("mismatch on package\n  when removing \`".&infoa."'\n  found \`".
-              &infon($i)."'") if defined($package) && $package[$i] ne $package;
-        print "Removing \`",&infon($i),"'\n" if $verbose > 0;
+        &quit(sprintf(_g("mismatch on divert-to\n  when removing \`%s'\n  found \`%s'"), &infoa, &infon($i)))
+              if defined($divertto) && $altname[$i] ne $divertto;
+        &quit(sprintf(_g("mismatch on package\n  when removing \`%s'\n  found \`%s'"), &infoa, &infon($i)))
+              if defined($package) && $package[$i] ne $package;
+        printf(_g("Removing \`%s'")."\n", &infon($i)) if $verbose > 0;
         $orgfile= $contest[$i];
         $orgdivertto= $altname[$i];
         @contest= (($i > 0 ? @contest[0..$i-1] : ()),
@@ -166,7 +170,7 @@ if ($mode eq 'add') {
         &save;
         exit(0);
     }
-    print "No diversion \`",&infoa,"', none removed\n" if $verbose > 0;
+    printf(_g("No diversion \`%s', none removed")."\n", &infoa) if $verbose > 0;
     exit(0);
 } elsif ($mode eq 'list') {
     @ilist= @ARGV ? @ARGV : ('*');
@@ -185,7 +189,7 @@ if ($mode eq 'add') {
     }
     exit(0);
 } elsif ($mode eq 'truename') {
-    @ARGV == 1 || &badusage("--truename needs a single argument");
+    @ARGV == 1 || &badusage(_g("--truename needs a single argument"));
     $file= $ARGV[0];
     for ($i=0; $i<=$#contest; $i++) {
 	next unless $file eq $contest[$i];
@@ -195,7 +199,7 @@ if ($mode eq 'add') {
     print $file, "\n";
     exit(0);
 } else {
-    &quit("internal error - bad mode \`$mode'");
+    &quit(sprintf(_g("internal error - bad mode \`%s'"), $mode));
 }
 
 sub infol {
@@ -209,9 +213,9 @@ sub checkrename {
     return unless $dorename;
     ($rsrc,$rdest) = @_;
     (@ssrc= lstat($rsrc)) || $! == &ENOENT ||
-        &quit("cannot stat old name \`$rsrc': $!");
+        &quit(sprintf(_g("cannot stat old name \`%s': %s"), $rsrc, $!));
     (@sdest= lstat($rdest)) || $! == &ENOENT ||
-        &quit("cannot stat new name \`$rdest': $!");
+        &quit(sprintf(_g("cannot stat new name \`%s': %s"), $rdest, $!));
     # Unfortunately we have to check for write access in both
     # places, just having +w is not enough, since people do
     # mount things RO, and we need to fail before we start
@@ -226,13 +230,13 @@ sub checkrename {
 	} elsif ($! == ENOENT) {
 		$dorename = !$dorename;
 	} else {
-		&quit("error checking \`$file': $!");
+		&quit(sprintf(_g("error checking \`%s': %s"), $file, $!));
 	}
     }
     if (@ssrc && @sdest &&
         !($ssrc[0] == $sdest[0] && $ssrc[1] == $sdest[1])) {
-        &quit("rename involves overwriting \`$rdest' with\n".
-              "  different file \`$rsrc', not allowed");
+        &quit(sprintf(_g("rename involves overwriting \`%s' with\n".
+              "  different file \`%s', not allowed"), $rdest, $rsrc));
     }
 }
 
@@ -241,33 +245,33 @@ sub dorename {
     return if $testmode;
     if (@ssrc) {
         if (@sdest) {
-            unlink($rsrc) || &quit("rename: remove duplicate old link \`$rsrc': $!");
+            unlink($rsrc) || &quit(sprintf(_g("rename: remove duplicate old link \`%s': %s"), $rsrc, $!));
         } else {
-            rename($rsrc,$rdest) || &quit("rename: rename \`$rsrc' to \`$rdest': $!");
+            rename($rsrc,$rdest) || &quit(sprintf(_g("rename: rename \`%s' to \`%s': %s"), $rsrc, $rdest, $!));
         }
     }
 }            
     
 sub save {
     return if $testmode;
-    open(N,"> $admindir/diversions-new") || &quit("create diversions-new: $!");
+    open(N,"> $admindir/diversions-new") || &quit(sprintf(_g("create diversions-new: %s"), $!));
     chmod 0644, "$admindir/diversions-new";
     for ($i=0; $i<=$#contest; $i++) {
         print(N "$contest[$i]\n$altname[$i]\n$package[$i]\n")
-            || &quit("write diversions-new: $!");
+            || &quit(sprintf(_g("write diversions-new: %s"), $!));
     }
-    close(N) || &quit("close diversions-new: $!");
+    close(N) || &quit(sprintf(_g("close diversions-new: %s"), $!));
     unlink("$admindir/diversions-old") ||
-        $! == &ENOENT || &quit("remove old diversions-old: $!");
+        $! == &ENOENT || &quit(sprintf(_g("remove old diversions-old: %s"), $!));
     link("$admindir/diversions","$admindir/diversions-old") ||
-        $! == &ENOENT || &quit("create new diversions-old: $!");
+        $! == &ENOENT || &quit(sprintf(_g("create new diversions-old: %s"), $!));
     rename("$admindir/diversions-new","$admindir/diversions")
-        || &quit("install new diversions: $!");
+        || &quit(sprintf(_g("install new diversions: %s"), $!));
 }
 
 sub infoa { &infol($file,$divertto,$package); }
 sub infon { &infol($contest[$i],$altname[$i],$package[$i]); }
 
-sub quit { print STDERR "dpkg-divert: @_\n"; exit(2); }
-sub badusage { print STDERR "dpkg-divert: @_\n\n"; print("You need --help.\n"); exit(2); }
-sub badfmt { &quit("internal error: $admindir/diversions corrupt: $_[0]"); }
+sub quit { printf STDERR _g("dpkg-divert: %s")."\n", "@_"; exit(2); }
+sub badusage { printf STDERR _g("dpkg-divert: %s")."\n\n", "@_"; print(_g("You need --help").".\n"); exit(2); }
+sub badfmt { &quit(sprintf(_g("internal error: %s corrupt: %s"), "$admindir/diversions", $_[0])); }

+ 50 - 44
scripts/dpkg-genchanges.pl

@@ -28,9 +28,12 @@ use POSIX qw(:errno_h :signal_h);
 push(@INC,$dpkglibdir);
 require 'controllib.pl';
 
+require 'dpkg-gettext.pl';
+textdomain("dpkg-dev");
+
 sub usageversion {
-    print STDERR
-"Debian dpkg-genchanges $version. 
+    printf STDERR _g(
+"Debian dpkg-genchanges %s. 
 Copyright (C) 1996 Ian Jackson.
 Copyright (C) 2000,2001 Wichert Akkerman.
 This is free software; see the GNU General Public Licence version 2 or later
@@ -59,7 +62,7 @@ Options:  -b                     binary-only build - no source files
           -D<field>=<value>      override or add a field and value
           -U<field>              remove a field
           -h                     print this message
-";
+"), $version;
 }
 
 $i=100;grep($fieldimps{$_}=$i--,
@@ -70,15 +73,15 @@ $i=100;grep($fieldimps{$_}=$i--,
 while (@ARGV) {
     $_=shift(@ARGV);
     if (m/^-b$/) {
-    	$sourceonly && &usageerr("cannot combine -b or -B and -S");
+	$sourceonly && &usageerr(_g("cannot combine -b or -B and -S"));
         $binaryonly= 1;
     } elsif (m/^-B$/) {
-    	$sourceonly && &usageerr("cannot combine -b or -B and -S");
+	$sourceonly && &usageerr(_g("cannot combine -b or -B and -S"));
 	$archspecific=1;
 	$binaryonly= 1;
-	print STDERR "$progname: arch-specific upload - not including arch-independent packages\n";
+	printf STDERR _g("%s: arch-specific upload - not including arch-independent packages")."\n", $progname;
     } elsif (m/^-S$/) {
-    	$binaryonly && &usageerr("cannot combine -b or -B and -S");
+	$binaryonly && &usageerr(_g("cannot combine -b or -B and -S"));
 	$sourceonly= 1;
     } elsif (m/^-s([iad])$/) {
         $sourcestyle= $1;
@@ -113,7 +116,7 @@ while (@ARGV) {
     } elsif (m/^-h$/) {
         &usageversion; exit(0);
     } else {
-        &usageerr("unknown option \`$_'");
+        &usageerr(sprintf(_g("unknown option \`%s'"), $_));
     }
 }
 
@@ -123,17 +126,17 @@ while (@ARGV) {
 
 if (not $sourceonly) {
     $fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
-    open(FL,"< $fileslistfile") || &syserr("cannot read files list file");
+    open(FL,"< $fileslistfile") || &syserr(_g("cannot read files list file"));
     while(<FL>) {
 	if (m/^(([-+.0-9a-z]+)_([^_]+)_([-\w]+)\.u?deb) (\S+) (\S+)$/) {
 	    defined($p2f{"$2 $4"}) &&
-		&warn("duplicate files list entry for package $2 (line $.)");
+		&warn(sprintf(_g("duplicate files list entry for package %s (line %d)"), $2, $.));
 	    $f2p{$1}= $2;
 	    $p2f{"$2 $4"}= $1;
 	    $p2f{$2}= $1;
 	    $p2ver{$2}= $3;
 	    defined($f2sec{$1}) &&
-		&warn("duplicate files list entry for file $1 (line $.)");
+		&warn(sprintf(_g("duplicate files list entry for file %s (line %d)"), $1, $.));
 	    $f2sec{$1}= $5;
 	    $f2pri{$1}= $6;
 	    push(@fileslistfiles,$1);
@@ -145,12 +148,12 @@ if (not $sourceonly) {
 	    push(@fileslistfiles,$1);
 	} elsif (m/^([-+.,_0-9a-zA-Z]+) (\S+) (\S+)$/) {
 	    defined($f2sec{$1}) &&
-		&warn("duplicate files list entry for file $1 (line $.)");
+		&warn(sprintf(_g("duplicate files list entry for file %s (line %d)"), $1, $.));
 	    $f2sec{$1}= $2;
 	    $f2pri{$1}= $3;
 	    push(@fileslistfiles,$1);
 	} else {
-	    &error("badly formed line in files list file, line $.");
+	    &error(sprintf(_g("badly formed line in files list file, line %d"), $.));
 	}
     }
     close(FL);
@@ -164,14 +167,14 @@ for $_ (keys %fi) {
 	elsif (m/^Maintainer$/i) { $f{$_}= $v; }
 	elsif (s/^X[BS]*C[BS]*-//i) { $f{$_}= $v; }
 	elsif (m/|^X[BS]+-|^Standards-Version$/i) { }
-	else { &unknown('general section of control info file'); }
+	else { &unknown(_g('general section of control info file')); }
     } elsif (s/^C(\d+) //) {
 	$i=$1; $p=$fi{"C$i Package"}; $a=$fi{"C$i Architecture"};
 	if (!defined($p2f{$p}) && not $sourceonly) {
 	    if ((debian_arch_eq('all', $a) && !$archspecific) ||
 		debian_arch_is($arch, $a) ||
 		grep(debian_arch_is($arch, $_), split(/\s+/, $a))) {
-		&warn("package $p in control file but not in files list");
+		&warn(sprintf(_g("package %s in control file but not in files list"), $p));
 		next;
 	    }
 	} else {
@@ -206,7 +209,7 @@ for $_ (keys %fi) {
 		     m/^(Recommends|Suggests|Enhances|Optional|Conflicts|Replaces)$/ ||
 		     m/^X[CS]+-/i) {
 	    } else {
-		&unknown("package's section of control info file");
+		&unknown(_g("package's section of control info file"));
 	    }
 	}
     } elsif (s/^L //) {
@@ -219,18 +222,18 @@ for $_ (keys %fi) {
         } elsif (s/^X[BS]*C[BS]*-//i) {
             $f{$_}= $v;
         } elsif (!m/^X[BS]+-/i) {
-            &unknown("parsed version of changelog");
+            &unknown(_g("parsed version of changelog"));
         }
     } elsif (m/^o:.*/) {
     } else {
-        &internerr("value from nowhere, with key >$_< and value >$v<");
+        &internerr(sprintf(_g("value from nowhere, with key >%s< and value >%s<"), $_, $v));
     }
 }
 
 if ($changesdescription) {
     $changesdescription="./$changesdescription" if $changesdescription =~ m/^\s/;
     $f{'Changes'}= '';
-    open(X,"< $changesdescription") || &syserr("read changesdescription");
+    open(X,"< $changesdescription") || &syserr(_g("read changesdescription"));
     while(<X>) {
         s/\s*\n$//;
         $_= '.' unless m/\S/;
@@ -241,19 +244,21 @@ if ($changesdescription) {
 for $p (keys %p2f) {
     my ($pp, $aa) = (split / /, $p);
     defined($p2i{"C $pp"}) ||
-        &warn("package $pp listed in files list but not in control info");
+        &warn(sprintf(_g("package %s listed in files list but not in control info"), $pp));
 }
 
 for $p (keys %p2f) {
     $f= $p2f{$p};
     $sec= $f2seccf{$f}; $sec= $sourcedefault{'Section'} if !length($sec);
-    if (!length($sec)) { $sec='-'; &warn("missing Section for binary package $p; using '-'"); }
-    $sec eq $f2sec{$f} || &error("package $p has section $sec in control file".
-                                 " but $f2sec{$f} in files list");
+    if (!length($sec)) { $sec='-'; &warn(sprintf(_g("missing Section for binary package %s; using '-'"), $p)); }
+    $sec eq $f2sec{$f} || &error(sprintf(_g("package %s has section %s in ".
+                                           "control file but %s in files list"),
+                                 $p, $sec, $f2sec{$f}));
     $pri= $f2pricf{$f}; $pri= $sourcedefault{'Priority'} if !length($pri);
     if (!length($pri)) { $pri='-'; &warn("missing Priority for binary package $p; using '-'"); }
-    $pri eq $f2pri{$f} || &error("package $p has priority $pri in control".
-                                 " file but $f2pri{$f} in files list");
+    $pri eq $f2pri{$f} || &error(sprintf(_g("package %s has priority %s in ".
+                                           "control file but %s in files list"),
+                                 $p, $pri, $f2pri{$f}));
 }
 
 # Extract version and origversion so we can add them to our fixed list
@@ -265,13 +270,13 @@ $substvar{"dpkg:Upstream-Version"} =~ s/-[^-]+$//;
 
 if (!$binaryonly) {
     $sec= $sourcedefault{'Section'};
-    if (!length($sec)) { $sec='-'; &warn("missing Section for source files"); }
+    if (!length($sec)) { $sec='-'; &warn(_g("missing Section for source files")); }
     $pri= $sourcedefault{'Priority'};
-    if (!length($pri)) { $pri='-'; &warn("missing Priority for source files"); }
+    if (!length($pri)) { $pri='-'; &warn(_g("missing Priority for source files")); }
 
     ($sversion = $substvar{'source:Version'}) =~ s/^\d+://;
     $dsc= "$uploadfilesdir/${sourcepackage}_${sversion}.dsc";
-    open(CDATA,"< $dsc") || &error("cannot open .dsc file $dsc: $!");
+    open(CDATA,"< $dsc") || &error(sprintf(_g("cannot open .dsc file %s: %s"), $dsc, $!));
     push(@sourcefiles,"${sourcepackage}_${sversion}.dsc");
     
     &parsecdata('S',-1,"source control file $dsc");
@@ -279,7 +284,7 @@ if (!$binaryonly) {
     for $file (split(/\n /,$files)) {
         next if $file eq '';
         $file =~ m/^([0-9a-f]{32})[ \t]+\d+[ \t]+([0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+)$/
-            || &error("Files field contains bad line \`$file'");
+            || &error(sprintf(_g("Files field contains bad line \`%s'"), $file));
         ($md5sum{$2},$file) = ($1,$2);
         push(@sourcefiles,$file);
     }
@@ -288,25 +293,25 @@ if (!$binaryonly) {
     if (($sourcestyle =~ m/i/ && $sversion !~ m/-(0|1|0\.1)$/ ||
          $sourcestyle =~ m/d/) &&
         grep(m/\.diff\.gz$/,@sourcefiles)) {
-        $origsrcmsg= "not including original source code in upload";
+        $origsrcmsg= _g("not including original source code in upload");
         @sourcefiles= grep(!m/\.orig\.tar\.gz$/,@sourcefiles);
     } else {
 	if ($sourcestyle =~ m/d/ && !grep(m/\.diff\.gz$/,@sourcefiles)) {
-	    &warn("Ignoring -sd option for native Debian package");
+	    &warn(_g("Ignoring -sd option for native Debian package"));
 	}
-        $origsrcmsg= "including full source code in upload";
+        $origsrcmsg= _g("including full source code in upload");
     }
 } else {
-    $origsrcmsg= "binary-only upload - not including any source code";
+    $origsrcmsg= _g("binary-only upload - not including any source code");
 }
 
 print(STDERR "$progname: $origsrcmsg\n") ||
-    &syserr("write original source message") unless $quiet;
+    &syserr(_g("write original source message")) unless $quiet;
 
 $f{'Format'}= $substvar{'Format'};
 
 if (!length($f{'Date'})) {
-    chop($date822=`822-date`); $? && subprocerr("822-date");
+    chop($date822=`date -R`); $? && subprocerr("date -R");
     $f{'Date'}= $date822;
 }
 
@@ -322,16 +327,17 @@ for $f (@sourcefiles,@fileslistfiles) {
     next if ($archspecific && debian_arch_eq('all', $p2arch{$f2p{$f}}));
     next if $filedone{$f}++;
     $uf= "$uploadfilesdir/$f";
-    open(STDIN,"< $uf") || &syserr("cannot open upload file $uf for reading");
-    (@s=stat(STDIN)) || &syserr("cannot fstat upload file $uf");
-    $size= $s[7]; $size || &warn("upload file $uf is empty");
-    $md5sum=`md5sum`; $? && subprocerr("md5sum upload file $uf");
+    open(STDIN,"< $uf") || &syserr(sprintf(_g("cannot open upload file %s for reading"), $uf));
+    (@s=stat(STDIN)) || &syserr(sprintf(_g("cannot fstat upload file %s"), $uf));
+    $size= $s[7]; $size || &warn(sprintf(_g("upload file %s is empty"), $uf));
+    $md5sum=`md5sum`; $? && subprocerr(sprintf(_g("md5sum upload file %s"), $uf));
     $md5sum =~ m/^([0-9a-f]{32})\s*-?\s*$/i ||
-        &failure("md5sum upload file $uf gave strange output \`$md5sum'");
+        &failure(sprintf(_g("md5sum upload file %s gave strange output \`%s'"), $uf, $md5sum));
     $md5sum= $1;
     defined($md5sum{$f}) && $md5sum{$f} ne $md5sum &&
-        &error("md5sum of source file $uf ($md5sum) is different from md5sum in $dsc".
-               " ($md5sum{$f})");
+        &error(sprintf(_g("md5sum of source file %s (%s) is different ".
+                          "from md5sum in %s (%s)"),
+                       $uf, $md5sum, $dsc, $md5sum{$f}));
     $f{'Files'}.= "\n $md5sum $size $f2sec{$f} $f2pri{$f} $f";
 }    
 
@@ -341,11 +347,11 @@ $f{'Maintainer'}= $forcemaint if length($forcemaint);
 $f{'Changed-By'}= $forcechangedby if length($forcechangedby);
 
 for $f (qw(Version Distribution Maintainer Changes)) {
-    defined($f{$f}) || &error("missing information for critical output field $f");
+    defined($f{$f}) || &error(sprintf(_g("missing information for critical output field %s"), $f));
 }
 
 for $f (qw(Urgency)) {
-    defined($f{$f}) || &warn("missing information for output field $f");
+    defined($f{$f}) || &warn(sprintf(_g("missing information for output field %s"), $f));
 }
 
 for $f (keys %override) { $f{&capit($f)}= $override{$f}; }

+ 42 - 36
scripts/dpkg-gencontrol.pl

@@ -15,9 +15,12 @@ use POSIX qw(:errno_h);
 push(@INC,$dpkglibdir);
 require 'controllib.pl';
 
+require 'dpkg-gettext.pl';
+textdomain("dpkg-dev");
+
 sub usageversion {
-    print STDERR
-"Debian dpkg-gencontrol $version. 
+    printf STDERR _g(
+"Debian dpkg-gencontrol %s. 
 Copyright 1996 Ian Jackson.
 Copyright 2000,2002 Wichert Akkerman.
 This is free software; see the GNU General Public Licence version 2 or later
@@ -32,7 +35,7 @@ Options:  -p<package>            print control file for package
           -v<forceversion>       set version of binary package
           -f<fileslistfile>      write files here instead of debian/files
           -P<packagebuilddir>    temporary build dir instead of debian/tmp
-	  -n<filename>           assume the package filename will be <filename>
+          -n<filename>           assume the package filename will be <filename>
           -O                     write to stdout, not .../DEBIAN/control
           -is, -ip, -isp, -ips   deprecated, ignored for compatibility
           -D<field>=<value>      override or add a field and value
@@ -40,7 +43,7 @@ Options:  -p<package>            print control file for package
           -V<name>=<value>       set a substitution variable
           -T<varlistfile>        read variables here, not debian/substvars
           -h                     print this message
-";
+"), $version;
 }
 
 $i=100;grep($fieldimps{$_}=$i--,
@@ -55,7 +58,7 @@ while (@ARGV) {
     if (m/^-p([-+0-9a-z.]+)$/) {
         $oppackage= $1;
     } elsif (m/^-p(.*)/) {
-        &error("Illegal package name \`$1'");
+        &error(sprintf(_g("Illegal package name \`%s'"), $1));
     } elsif (m/^-c/) {
         $controlfile= $';
     } elsif (m/^-l/) {
@@ -85,7 +88,7 @@ while (@ARGV) {
     } elsif (m/^-h$/) {
         &usageversion; exit(0);
     } else {
-        &usageerr("unknown option \`$_'");
+        &usageerr(sprintf(_g("unknown option \`%s'"), $_));
     }
 }
 
@@ -95,12 +98,12 @@ while (@ARGV) {
 &parsecontrolfile;
             
 if (length($oppackage)) {
-    defined($p2i{"C $oppackage"}) || &error("package $oppackage not in control info");
+    defined($p2i{"C $oppackage"}) || &error(sprintf(_g("package %s not in control info"), $oppackage));
     $myindex= $p2i{"C $oppackage"};
 } else {
     @packages= grep(m/^C /,keys %p2i);
     @packages==1 ||
-        &error("must specify package since control info has many (@packages)");
+        &error(sprintf(_g("must specify package since control info has many (%s)"), "@packages"));
     $myindex=1;
 }
 
@@ -117,7 +120,7 @@ for $_ (keys %fi) {
         elsif (s/^X[CS]*B[CS]*-//i) { $f{$_}= $v; }
 	elsif (m/^X[CS]+-|^(Standards-Version|Uploaders)$|^Build-(Depends|Conflicts)(-Indep)?$/i) { }
 	elsif (m/^Section$|^Priority$/) { $spdefault{$_}= $v; }
-        else { $_ = "C $_"; &unknown('general section of control info file'); }
+        else { $_ = "C $_"; &unknown(_g('general section of control info file')); }
     } elsif (s/^C$myindex //) {
 #print STDERR "P key >$_< value >$v<\n";
         if (m/^(Package|Description|Essential|Optional)$/) {
@@ -133,19 +136,22 @@ for $_ (keys %fi) {
             } else {
                 @archlist= split(/\s+/,$v);
 		my @invalid_archs = grep m/[^\w-]/, @archlist;
-		&warn("`".join("' `", @invalid_archs)."' are not legal ".
-		      "architecture strings.") if @invalid_archs > 1;
-		&warn("`@invalid_archs' is not a legal ".
-		      "architecture string.") if @invalid_archs == 1;
+		&warn(sprintf(ngettext(
+		                  "`%s' is not a legal architecture string.",
+		                  "`%s' are not legal architecture strings.",
+		                  scalar(@invalid_archs)),
+		              join("' `", @invalid_archs)))
+		    if @invalid_archs >= 1;
                 grep(debian_arch_is($arch, $_), @archlist) ||
-                    &error("current build architecture $arch does not".
-                           " appear in package's list (@archlist)");
+                    &error(sprintf(_g("current build architecture %s does not".
+                                      " appear in package's list (%s)"),
+                                   $arch, "@archlist"));
                 $f{$_}= $arch;
             }
         } elsif (s/^X[CS]*B[CS]*-//i) {
             $f{$_}= $v;
         } elsif (!m/^X[CS]+-/i) {
-            $_ = "C$myindex $_"; &unknown("package's section of control info file");
+            $_ = "C$myindex $_"; &unknown(_g("package's section of control info file"));
         }
     } elsif (m/^C\d+ /) {
 #print STDERR "X key >$_< value not shown<\n";
@@ -160,11 +166,11 @@ for $_ (keys %fi) {
         } elsif (s/^X[CS]*B[CS]*-//i) {
             $f{$_}= $v;
         } elsif (!m/^X[CS]+-/i) {
-            $_ = "L $_"; &unknown("parsed version of changelog");
+            $_ = "L $_"; &unknown(_g("parsed version of changelog"));
         }
     } elsif (m/o:/) {
     } else {
-        &internerr("value from nowhere, with key >$_< and value >$v<");
+        &internerr(sprintf(_g("value from nowhere, with key >%s< and value >%s<"), $_, $v));
     }
 }
 
@@ -181,7 +187,7 @@ for $_ (keys %fi) {
         if (m/^(Package|Description|Essential|Optional)$/) {
         } elsif (exists($pkg_dep_fields{$_})) {
            my $dep = parsedep(substvars($v), 1, 1);
-           &error("error occurred while parsing $_") unless defined $dep;
+           &error(sprintf(_g("error occurred while parsing %s"), $_)) unless defined $dep;
             $f{$_}= showdep($dep, 0);
         } elsif (m/^Section$|^Priority$/) {
         } elsif (m/^Architecture$/) {
@@ -202,10 +208,10 @@ for $f (qw(Section Priority)) {
 }
 
 for $f (qw(Package Version)) {
-    defined($f{$f}) || &error("missing information for output field $f");
+    defined($f{$f}) || &error(sprintf(_g("missing information for output field %s"), $f));
 }
 for $f (qw(Maintainer Description Architecture)) {
-    defined($f{$f}) || &warn("missing information for output field $f");
+    defined($f{$f}) || &warn(sprintf(_g("missing information for output field %s"), $f));
 }
 $oppackage= $f{'Package'};
 
@@ -216,14 +222,14 @@ if ($oppackage ne $sourcepackage || $verdiff) {
 }
 
 if (!defined($substvar{'Installed-Size'})) {
-    defined($c= open(DU,"-|")) || &syserr("fork for du");
+    defined($c= open(DU,"-|")) || &syserr(_g("fork for du"));
     if (!$c) {
-        chdir("$packagebuilddir") || &syserr("chdir for du to \`$packagebuilddir'");
-        exec("du","-k","-s","."); &syserr("exec du");
+        chdir("$packagebuilddir") || &syserr(sprintf(_g("chdir for du to \`%s'"), $packagebuilddir));
+        exec("du","-k","-s",".") or &syserr(_g("exec du"));
     }
     $duo=''; while (<DU>) { $duo.=$_; }
-    close(DU); $? && &subprocerr("du in \`$packagebuilddir'");
-    $duo =~ m/^(\d+)\s+\.$/ || &failure("du gave unexpected output \`$duo'");
+    close(DU); $? && &subprocerr(sprintf(_g("du in \`%s'"), $packagebuilddir));
+    $duo =~ m/^(\d+)\s+\.$/ || &failure(sprintf(_g("du gave unexpected output \`%s'"), $duo));
     $substvar{'Installed-Size'}= $1;
 }
 if (defined($substvar{'Extra-Size'})) {
@@ -237,10 +243,10 @@ for $f (keys %override) { $f{&capit($f)}= $override{$f}; }
 for $f (keys %remove) { delete $f{&capit($f)}; }
 
 $fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
-open(Y,"> $fileslistfile.new") || &syserr("open new files list file");
+open(Y,"> $fileslistfile.new") || &syserr(_g("open new files list file"));
 binmode(Y);
 chown(@fowner, "$fileslistfile.new") 
-		|| &syserr("chown new files list file");
+		|| &syserr(_g("chown new files list file"));
 if (open(X,"< $fileslistfile")) {
     binmode(X);
     while (<X>) {
@@ -249,11 +255,11 @@ if (open(X,"< $fileslistfile")) {
                 && ($1 eq $oppackage)
                 && (debian_arch_eq($2, $f{'Architecture'})
 		    || debian_arch_eq($2, 'all'));
-        print(Y "$_\n") || &syserr("copy old entry to new files list file");
+        print(Y "$_\n") || &syserr(_g("copy old entry to new files list file"));
     }
-    close(X) || &syserr("close old files list file");
+    close(X) || &syserr(_g("close old files list file"));
 } elsif ($! != ENOENT) {
-    &syserr("read old files list file");
+    &syserr(_g("read old files list file"));
 }
 $sversion=$f{'Version'};
 $sversion =~ s/^\d+://;
@@ -261,20 +267,20 @@ $forcefilename=sprintf("%s_%s_%s.deb", $oppackage,$sversion,$f{'Architecture'})
 	   unless ($forcefilename);
 print(Y &substvars(sprintf("%s %s %s\n", $forcefilename, 
                            &spfileslistvalue('Section'), &spfileslistvalue('Priority'))))
-    || &syserr("write new entry to new files list file");
-close(Y) || &syserr("close new files list file");
-rename("$fileslistfile.new",$fileslistfile) || &syserr("install new files list file");
+    || &syserr(_g("write new entry to new files list file"));
+close(Y) || &syserr(_g("close new files list file"));
+rename("$fileslistfile.new",$fileslistfile) || &syserr(_g("install new files list file"));
 
 if (!$stdout) {
     $cf= "$packagebuilddir/DEBIAN/control";
     $cf= "./$cf" if $cf =~ m/^\s/;
     open(STDOUT,"> $cf.new") ||
-        &syserr("cannot open new output control file \`$cf.new'");
+        &syserr(sprintf(_g("cannot open new output control file \`%s'"), "$cf.new"));
     binmode(STDOUT);
 }
 &outputclose(1);
 if (!$stdout) {
-    rename("$cf.new","$cf") || &syserr("cannot install output control file \`$cf'");
+    rename("$cf.new","$cf") || &syserr(sprintf(_g("cannot install output control file \`%s'"), $cf));
 }
 
 sub spfileslistvalue {

+ 37 - 0
scripts/dpkg-gettext.pl

@@ -0,0 +1,37 @@
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+# Copied from /usr/share/perl5/Debconf/Gettext.pm
+
+use strict;
+
+BEGIN {
+	eval 'use Locale::gettext';
+	if ($@) {
+		eval q{
+			sub _g {
+				return shift;
+			}
+			sub textdomain {
+			}
+			sub ngettext {
+				if ($_[2] == 1) {
+					return $_[0];
+				} else {
+					return $_[1];
+				}
+			}
+		};
+	} else {
+		eval q{
+			sub _g {
+				return gettext(shift);
+			}
+		};
+	}
+}
+
+use base qw(Exporter);
+our @EXPORT=qw(_g textdomain ngettext);
+
+1;

+ 15 - 12
scripts/dpkg-parsechangelog.pl

@@ -14,9 +14,12 @@ use POSIX qw(:errno_h);
 push(@INC,$dpkglibdir);
 require 'controllib.pl';
 
+require 'dpkg-gettext.pl';
+textdomain("dpkg-dev");
+
 sub usageversion {
-    print STDERR
-"Debian dpkg-parsechangelog $version.
+    printf STDERR _g(
+"Debian dpkg-parsechangelog %s.
 Copyright (C) 1996 Ian Jackson.
 Copyright (C) 2001 Wichert Akkerman
 This is free software; see the GNU General Public Licence
@@ -28,7 +31,7 @@ Options:  -l<changelogfile>      get per-version info from this file
           -F<changelogformat>    force change log format
           -L<libdir>             look for change log parsers in <libdir>
           -h                     print this message
-";
+"), $version;
 }
 
 @ap=();
@@ -45,37 +48,37 @@ while (@ARGV) {
     &usageerr("unknown option \`$_'");
 }
 
-@ARGV && &usageerr("$progname takes no non-option arguments");
+@ARGV && &usageerr(sprintf(_g("%s takes no non-option arguments"), $progname));
 $changelogfile= "./$changelogfile" if $changelogfile =~ m/^\s/;
 
 if (not $force and $changelogfile ne "-") {
     open(STDIN,"< $changelogfile") ||
-        &error("cannot open $changelogfile to find format: $!");
-    open(P,"tail -n 40 |") || die "cannot fork: $!\n";
+        &error(sprintf(_g("cannot open %s to find format: %s"), $changelogfile, $!));
+    open(P,"tail -n 40 |") || die sprintf(_g("cannot fork: %s"), $!)."\n";
     while(<P>) {
         next unless m/\schangelog-format:\s+([0-9a-z]+)\W/;
         $format=$1;
     }
-    close(P); $? && &subprocerr("tail of $changelogfile");
+    close(P); $? && &subprocerr(sprintf(_g("tail of %s"), $changelogfile));
 }
 
 
 for $pd (@parserpath) {
     $pa= "$pd/$format";
     if (!stat("$pa")) {
-        $! == ENOENT || &syserr("failed to check for format parser $pa");
+        $! == ENOENT || &syserr(sprintf(_g("failed to check for format parser %s"), $pa));
     } elsif (!-x _) {
-        &warn("format parser $pa not executable");
+        &warn(sprintf(_g("format parser %s not executable"), $pa));
     } else {
         $pf= $pa;
 	last;
     }
 }
         
-defined($pf) || &error("format $pa unknown");
+defined($pf) || &error(sprintf(_g("format %s unknown"), $pa));
 
 if ($changelogfile ne "-") {
-    open(STDIN,"< $changelogfile") || die "cannot open $changelogfile: $!\n";
+    open(STDIN,"< $changelogfile") || die sprintf(_g("cannot open %s: %s"), $changelogfile, $!)."\n";
 }
-exec($pf,@ap); die "cannot exec format parser: $!\n";
+exec($pf,@ap); die sprintf(_g("cannot exec format parser: %s"), $!)."\n";
 

+ 40 - 29
scripts/dpkg-scanpackages.pl

@@ -7,6 +7,11 @@ use IO::Handle;
 use IO::File;
 
 my $version= '1.2.6'; # This line modified by Makefile
+my $dpkglibdir= "."; # This line modified by Makefile
+
+push(@INC,$dpkglibdir);
+require 'dpkg-gettext.pl';
+textdomain("dpkg-dev");
 
 my %kmap= (optional         => 'suggests',
 	   recommended      => 'recommends',
@@ -53,8 +58,8 @@ my %options = (help            => 0,
 
 my $result = GetOptions(\%options,'help|h|?','udeb|u!','arch|a=s','multiversion|m!');
 
-print <<END and exit 1 if not $result or $options{help} or @ARGV < 2;
-dpkg-scanpackages [-u] [-a<arch>] [-m] binarypath overridefile [pathprefix] > Packages
+my $usage = _g(
+"dpkg-scanpackages [-u] [-a<arch>] [-m] binarypath overridefile [pathprefix] > Packages
 
  Options:
  --udeb, -u scan for udebs
@@ -62,8 +67,9 @@ dpkg-scanpackages [-u] [-a<arch>] [-m] binarypath overridefile [pathprefix] > Pa
  --multiversion, -m allow multiple versions of a single package
  --help, -h show this help
 
-END
-
+");
+print( STDERR $usage ) and exit 1 if not $result or (@ARGV < 2);
+print($usage) and exit if $options{help};
 
 my $udeb = $options{udeb};
 my $arch = $options{arch};
@@ -78,8 +84,10 @@ else {
 }
 push @find_args, '-follow';
 my ($binarydir, $override, $pathprefix) = @ARGV;
--d $binarydir or die "Binary dir $binarydir not found\n";
--e $override or die "Override file $override not found\n";
+-d $binarydir or die sprintf(_g("Binary dir %s not found"),
+                             $binarydir)."\n";
+-e $override or die sprintf(_g("Override file %s not found"),
+                            $override)."\n";
 
 $pathprefix = '' if not defined $pathprefix;
 
@@ -95,18 +103,19 @@ sub vercmp {
 my %packages;
 my $find_h = new IO::Handle;
 open($find_h,'-|','find',"$binarydir/",@find_args,'-print')
-     or die "Couldn't open $binarydir for reading: $!\n";
+     or die sprintf(_g("Couldn't open %s for reading: %s"),
+                    $binarydir, $!)."\n";
 FILE:
     while (<$find_h>) {
 	chomp;
 	my $fn = $_;
 	my $control = `dpkg-deb -I $fn control`;
 	if ($control eq "") {
-	    warn "Couldn't call dpkg-deb on $fn: $!, skipping package\n";
+	    warn sprintf(_g("Couldn't call dpkg-deb on %s: %s, skipping package"), $fn, $!)."\n";
 	    next;
 	}
 	if ($?) {
-	    warn "\`dpkg-deb -I $fn control' exited with $?, skipping package\n";
+	    warn sprintf(_g("\`dpkg-deb -I %s control' exited with %d, skipping package"), $fn, $?)."\n";
 	    next;
 	}
 	
@@ -120,39 +129,41 @@ FILE:
 	    $tv{$key}= $value;
 	}
 	$temp =~ /^\n*$/
-	    or die "Unprocessed text from $fn control file; info:\n$control / $temp\n";
+	    or die sprintf(_g("Unprocessed text from %s control file; info:\n%s / %s\n"), $fn, $control, $temp);
 	
 	defined($tv{'Package'})
-	    or die "No Package field in control file of $fn\n";
+	    or die sprintf(_g("No Package field in control file of %s"), $fn)."\n";
 	my $p= $tv{'Package'}; delete $tv{'Package'};
 	
 	if (defined($packages{$p}) and not $options{multiversion}) {
 	    foreach (@{$packages{$p}}) {
 		if (&vercmp($tv{'Version'}, $_->{'Version'})) {
-		    print(STDERR " ! Package $p (filename $fn) is repeat but newer version;\n".
-			  "   used that one and ignored data from $_->{Filename} !\n")
+		    printf(STDERR _g(
+			  " ! Package %s (filename %s) is repeat but newer version;\n".
+			  "   used that one and ignored data from %s !\n"), $p, $fn, $_->{Filename})
 			|| die $!;
 		    $packages{$p} = [];
 		} else {
-		    print(STDERR " ! Package $p (filename $fn) is repeat;\n".
-			  "   ignored that one and using data from $_->{Filename} !\n")
+		    printf(STDERR _g(
+			  " ! Package %s (filename %s) is repeat;\n".
+			  "   ignored that one and using data from %s !\n"), $p, $fn, $_->{Filename})
 			or die $!;
 		    next FILE;
 		}
 	    }
 	}
-	print(STDERR " ! Package $p (filename $fn) has Filename field!\n") || die $!
+	printf(STDERR _g(" ! Package %s (filename %s) has Filename field!\n"), $p, $fn) || die $!
 	    if defined($tv{'Filename'});
 	
 	$tv{'Filename'}= "$pathprefix$fn";
 	
 	open(C,"md5sum <$fn |") || die "$fn $!";
-	chop($_=<C>); close(C); $? and die "\`md5sum < $fn' exited with $?\n";
-	/^([0-9a-f]{32})\s*-?\s*$/ or die "Strange text from \`md5sum < $fn': \`$_'\n";
+	chop($_=<C>); close(C); $? and die sprintf(_g("\`md5sum < %s' exited with %d"), $fn, $?)."\n";
+	/^([0-9a-f]{32})\s*-?\s*$/ or die sprintf(_g("Strange text from \`md5sum < %s': \`%s'"), $fn, $_)."\n";
 	$tv{'MD5sum'}= $1;
 	
-	my @stat= stat($fn) or die "Couldn't stat $fn: $!\n";
-	$stat[7] or die "$fn is empty\n";
+	my @stat= stat($fn) or die sprintf(_g("Couldn't stat %s: %s"), $fn, $!)."\n";
+	$stat[7] or die sprintf(_g("%s is empty"), $fn)."\n";
 	$tv{'Size'}= $stat[7];
 	
 	if (defined $tv{Revision} and length($tv{Revision})) {
@@ -186,7 +197,7 @@ my (@samemaint,@changedmaint);
 
 my %overridden;
 my $override_fh = new IO::File $override,'r'
-    or die "Couldn't open override file $override: $!\n";
+    or die sprintf(_g("Couldn't open override file %s: %s"), $override, $!)."\n";
 while (<$override_fh>) {
     s/\#.*//;
     s/\s+$//;
@@ -208,7 +219,7 @@ while (<$override_fh>) {
 	       } elsif ($$package{Maintainer} eq $maintainer) {
 		   push(@samemaint,"  $p ($maintainer)\n");
 	       } else {
-		   print(STDERR " * Unconditional maintainer override for $p *\n") || die $!;
+		   printf(STDERR _g(" * Unconditional maintainer override for %s *")."\n", $p) || die $!;
 		   $$package{Maintainer}= $maintainer;
 	       }
 	  }
@@ -234,32 +245,32 @@ for my $p (sort keys %packages) {
 	 }
 	 $record .= "\n";
 	 $records_written++;
-	 print(STDOUT $record) or die "Failed when writing stdout: $!\n";
+	 print(STDOUT $record) or die sprintf(_g("Failed when writing stdout: %s"), $!)."\n";
     }
 }
-close(STDOUT) or die "Couldn't close stdout: $!\n";
+close(STDOUT) or die sprintf(_g("Couldn't close stdout: %s"), $!)."\n";
 
 my @spuriousover= grep(!defined($packages{$_}),sort keys %overridden);
 
-&writelist("** Packages in archive but missing from override file: **",
+&writelist(_g("** Packages in archive but missing from override file: **"),
            @missingover);
 if (@changedmaint) {
     print(STDERR
-          " ++ Packages in override file with incorrect old maintainer value: ++\n",
+          _g(" ++ Packages in override file with incorrect old maintainer value: ++")."\n",
           @changedmaint,
           "\n") || die $!;
 }
 if (@samemaint) {
     print(STDERR
-          " -- Packages specifying same maintainer as override file: --\n",
+          _g(" -- Packages specifying same maintainer as override file: --")."\n",
           @samemaint,
           "\n") || die $!;
 }
 if (@spuriousover) {
     print(STDERR
-          " -- Packages in override file but not in archive: --\n",
+          _g(" -- Packages in override file but not in archive: --")."\n",
           @spuriousover,
           "\n") || die $!;
 }
 
-print(STDERR " Wrote $records_written entries to output Packages file.\n") || die $!;
+printf(STDERR _g(" Wrote %s entries to output Packages file.")."\n", $records_written) || die $!;

+ 48 - 37
scripts/dpkg-scansources.pl

@@ -27,6 +27,11 @@ use strict;
 # Dependencies are by request non-existant.  I used to use the MD5 and
 # Proc::WaitStat modules.
 
+my $dpkglibdir= "."; # This line modified by Makefile
+push(@INC,$dpkglibdir);
+require 'dpkg-gettext.pl';
+textdomain("dpkg-dev");
+
 use Getopt::Long ();
 
 my $Exit = 0;
@@ -64,8 +69,8 @@ my @Option_spec = (
     'version'		=> sub { print "$Me version $Version\n"; exit },
 );
 
-my $Usage = <<EOF;
-usage: $Me [switch]... binary-dir [override-file [path-prefix]] > Sources
+my $Usage = sprintf(_g(<<EOF), $Me, $Me);
+usage: %s [switch]... binary-dir [override-file [path-prefix]] > Sources
 
 switches:
         --debug		turn debugging on
@@ -74,9 +79,9 @@ switches:
     -s, --source-override file
 			use file for additional source overrides, default
 			is regular override file with .src appended
-    	--version	show the version and exit
+        --version	show the version and exit
 
-See the man page or \`perldoc $Me\' for the full documentation.
+See the man page or \`perldoc %s\' for the full documentation.
 EOF
 
 sub debug {
@@ -130,7 +135,8 @@ sub configure_getopt {
 
 sub close_msg {
     my $name = shift;
-    return "error closing $name (\$? $?, \$! `$!')\n";
+    return sprintf(_g("error closing %s (\$? %d, \$! `%s')"),
+                   $name, $?, $!)."\n";
 }
 
 sub init {
@@ -142,7 +148,7 @@ sub load_override {
     my $file = shift;
     local $_;
 
-    open OVERRIDE, $file or xdie "can't read override file $file:";
+    open OVERRIDE, $file or xdie sprintf(_g("can't read override file %s:"), $file);
     while (<OVERRIDE>) {
     	s/#.*//;
 	next if /^\s*$/;
@@ -150,19 +156,22 @@ sub load_override {
 
 	my @data = split ' ', $_, 4;
 	unless (@data == 3 || @data == 4) {
-	    xwarn_noerror "invalid override entry at line $. (",
-			    0+@data, " fields)\n";
+	    xwarn_noerror sprintf(_g(
+	                      "invalid override entry at line %d (%d fields)"),
+	                          $., 0+@data)."\n";
 	    next;
 	}
 	my ($package, $priority, $section, $maintainer) = @data;
 	if (exists $Override{$package}) {
-	    xwarn_noerror "ignoring duplicate override entry for $package",
-	    	    	    " at line $.\n";
+	    xwarn_noerror sprintf(_g(
+	                "ignoring duplicate override entry for %s at line %d"),
+	                          $package, $.)."\n";
 	    next;
 	}
 	if (!$Priority{$priority}) {
-	    xwarn_noerror "ignoring override entry for $package,",
-	    	    	    " invalid priority $priority\n";
+	    xwarn_noerror sprintf(_g(
+	                "ignoring override entry for %s, invalid priority %s"),
+	                          $package, $priority)."\n";
 	    next;
 	}
 
@@ -180,7 +189,7 @@ sub load_override {
 	    $Override{$package}[O_MAINT_TO] = $maintainer;
 	}
     }
-    close OVERRIDE or xdie "error closing override file:";
+    close OVERRIDE or xdie _g("error closing override file:");
 }
 
 sub load_src_override {
@@ -201,7 +210,7 @@ sub load_src_override {
     debug "source override file $file";
     unless (open SRC_OVERRIDE, $file) {
 	return if !defined $user_file;
-	xdie "can't read source override file $file:";
+	xdie sprintf(_g("can't read source override file %s:"), $file);
     }
     while (<SRC_OVERRIDE>) {
     	s/#.*//;
@@ -210,22 +219,24 @@ sub load_src_override {
 
 	my @data = split ' ', $_;
 	unless (@data == 2) {
-	    xwarn_noerror "invalid source override entry at line $. (",
-	    	    	    0+@data, " fields)\n";
+	    xwarn_noerror sprintf(_g(
+	               "invalid source override entry at line %d (%d fields)"),
+	                          $., 0+@data)."\n";
 	    next;
 	}
 
 	my ($package, $section) = @data;
 	my $key = "source/$package";
 	if (exists $Override{$key}) {
-	    xwarn_noerror "ignoring duplicate source override entry",
-		    	    " for $package at line $.\n";
+	    xwarn_noerror sprintf(_g(
+	         "ignoring duplicate source override entry for %s at line %d"),
+	                          $package, $.)."\n";
 	    next;
 	}
 	$Override{$key} = [];
 	$Override{$key}[O_SECTION] = $section;
     }
-    close SRC_OVERRIDE or xdie "error closing source override file:";
+    close SRC_OVERRIDE or xdie _g("error closing source override file:");
 }
 
 # Given FILENAME (for error reporting) and STRING, drop the PGP info
@@ -239,7 +250,7 @@ sub de_pgp {
 			.*?\n
 			-----END\040PGP\040SIGNATURE-----\n
 		    //xs) {
-	    xwarn_noerror "$file has PGP start token but not end token\n";
+	    xwarn_noerror sprintf(_g("%s has PGP start token but not end token"), $file)."\n";
 	    return;
 	}
 	$s =~ s/^- //mg;
@@ -255,13 +266,13 @@ sub read_dsc {
     my ($size, $md5, $nread, $contents);
 
     unless (open FILE, $file) {
-    	xwarn_noerror "can't read $file:";
+	xwarn_noerror sprintf(_g("can't read %s:"), $file);
 	return;
     }
 
     $size = -s FILE;
     unless (defined $size) {
-	xwarn_noerror "error doing fstat on $file:";
+	xwarn_noerror sprintf(_g("error doing fstat on %s:"), $file);
 	return;
     }
 
@@ -269,7 +280,7 @@ sub read_dsc {
     do {
 	$nread = read FILE, $contents, 16*1024, length $contents;
 	unless (defined $nread) {
-	    xwarn_noerror "error reading from $file:";
+	    xwarn_noerror sprintf(_g("error reading from %s:"), $file);
 	    return;
 	}
     } while $nread > 0;
@@ -277,13 +288,13 @@ sub read_dsc {
     # Rewind the .dsc file and feed it to md5sum as stdin.
     my $pid = open MD5, '-|';
     unless (defined $pid) {
-	xwarn_noerror "can't fork:";
+	xwarn_noerror _g("can't fork:");
 	return;
     }
     if (!$pid) {
-    	open STDIN, '<&FILE'	or xdie "can't dup $file:";
-	seek STDIN, 0, 0	or xdie "can't rewind $file:";
-	exec 'md5sum'		or xdie "can't exec md5sum:";
+	open STDIN, '<&FILE' or xdie sprintf(_g("can't dup %s:"), $file);
+	seek STDIN, 0, 0     or xdie sprintf(_g("can't rewind %s:"), $file);
+	exec 'md5sum'        or xdie _g("can't exec md5sum:");
     }
     chomp($md5 = join '', <MD5>);
     unless (close MD5) {
@@ -292,12 +303,12 @@ sub read_dsc {
     }
     $md5 =~ s/ *-$//; # Remove trailing spaces and -, to work with GNU md5sum
     unless (length($md5) == 32 && $md5 !~ /[^\da-f]/i) {
-	xwarn_noerror "invalid md5 output for $file ($md5)\n";
+	xwarn_noerror sprintf(_g("invalid md5 output for %s (%s)"), $file, $md5)."\n";
 	return;
     }
 
     unless (close FILE) {
-	xwarn_noerror "error closing $file:";
+	xwarn_noerror sprintf(_g("error closing %s:"), $file);
 	return;
     }
 
@@ -322,7 +333,7 @@ sub process_dsc {
     $contents =~ s/\n\n+\Z/\n/;
 
     if ($contents =~ /^\n/ || $contents =~ /\n\n/) {
-    	xwarn_noerror "$file invalid (contains blank line)\n";
+	xwarn_noerror sprintf(_g("%s invalid (contains blank line)"), $file)."\n";
 	return;
     }
 
@@ -349,7 +360,7 @@ sub process_dsc {
 	$s =~ s/\s+$//;
 	$s =~ s/\n\s+/ /g;
 	unless ($s =~ s/^([^:\s]+):\s*//) {
-	    xwarn_noerror "invalid field in $file: $orig_field";
+	    xwarn_noerror sprintf(_g("invalid field in %s: %s"), $file, $orig_field);
 	    return;
 	}
 	my ($key, $val) = (lc $1, $s);
@@ -357,11 +368,11 @@ sub process_dsc {
 	# $source
 	if ($key eq 'source') {
 	    if (defined $source) {
-		xwarn_noerror "duplicate source field in $file\n";
+		xwarn_noerror sprintf(_g("duplicate source field in %s"), $file)."\n";
 		return;
 	    }
 	    if ($val =~ /\s/) {
-		xwarn_noerror "invalid source field in $file\n";
+		xwarn_noerror sprintf(_g("invalid source field in %s"), $file)."\n";
 		return;
 	    }
 	    $source = $val;
@@ -371,12 +382,12 @@ sub process_dsc {
 	# @binary
 	if ($key eq 'binary') {
 	    if (@binary) {
-		xwarn_noerror "duplicate binary field in $file\n";
+		xwarn_noerror sprintf(_g("duplicate binary field in %s"), $file)."\n";
 		return;
 	    }
 	    @binary = split /\s*,\s*/, $val;
 	    unless (@binary) {
-		xwarn_noerror "no binary packages specified in $file\n";
+		xwarn_noerror sprintf(_g("no binary packages specified in %s"), $file)."\n";
 		return;
 	    }
 	}
@@ -489,7 +500,7 @@ sub main {
     my (@out);
 
     init;
-    @ARGV >= 1 && @ARGV <= 3 or usage "1 to 3 args expected\n";
+    @ARGV >= 1 && @ARGV <= 3 or usage _g("1 to 3 args expected")."\n";
 
     push @ARGV, undef		if @ARGV < 2;
     push @ARGV, ''		if @ARGV < 3;
@@ -499,7 +510,7 @@ sub main {
     load_src_override $Src_override, $override;
 
     open FIND, "find \Q$dir\E -follow -name '*.dsc' -print |"
-	or xdie "can't fork:";
+	or xdie _g("can't fork:");
     while (<FIND>) {
     	chomp;
 	s-^\./+--;

+ 42 - 37
scripts/dpkg-shlibdeps.pl

@@ -26,12 +26,15 @@ my $i=0; grep($depstrength{$_}= ++$i, @depfields);
 push(@INC,$dpkglibdir);
 require 'controllib.pl';
 
+require 'dpkg-gettext.pl';
+textdomain("dpkg-dev");
+
 #use strict;
 #use warnings;
 
 sub usageversion {
-    print STDERR
-"Debian dpkg-shlibdeps $version.
+    printf STDERR _g(
+"Debian dpkg-shlibdeps %s.
 Copyright (C) 1996 Ian Jackson.
 Copyright (C) 2000 Wichert Akkerman.
 Copyright (C) 2006 Frank Lichtenheld.
@@ -50,8 +53,8 @@ Overall options (have global effect no matter where placed):
        -L<localshlibsfile>    shlibs override file, not debian/shlibs.local
        -T<varlistfile>        update variables here, not debian/substvars
        -t<type>               set package type (default is deb)
-Dependency fields recognised are ".join("/",@depfields)."
-";
+Dependency fields recognised are %s
+"), $version, join("/",@depfields);
 }
 
 my ($stdout, @exec, @execfield);
@@ -69,25 +72,25 @@ foreach (@ARGV) {
     } elsif (m/^-d/) {
 	$dependencyfield= capit($POSTMATCH);
 	defined($depstrength{$dependencyfield}) ||
-	    &warn("unrecognised dependency field \`$dependencyfield'");
+	    &warn(sprintf(_g("unrecognised dependency field \`%s'"), $dependencyfield));
     } elsif (m/^-e/) {
 	push(@exec,$POSTMATCH); push(@execfield,$dependencyfield);
     } elsif (m/^-t/) {
 	$packagetype= $POSTMATCH;
     } elsif (m/^-/) {
-	usageerr("unknown option \`$_'");
+	usageerr(sprintf(_g("unknown option \`%s'"), $_));
     } else {
 	push(@exec,$_); push(@execfield,$dependencyfield);
     }
 }
 
-@exec || usageerr("need at least one executable");
+@exec || usageerr(_g("need at least one executable"));
 
 sub isbin {
-    open (F, $_[0]) || die("unable to open '$_[0]' for test");
+    open (F, $_[0]) || die(sprintf(_g("unable to open '%s' for test"), $_[0]));
     my $d;
     if (read (F, $d, 4) != 4) {
-       die ("unable to read first four bytes of '$_[0]' as magic number");
+       die (sprintf(_g("unable to read first four bytes of '%s' as magic number"), $_[0]));
     }
     if ($d =~ /^\177ELF$/) { # ELF binary
        return 1;
@@ -100,7 +103,7 @@ sub isbin {
     } elsif (unpack ('N', $d) == 0xcafebabe) { # JAVA binary
        return 0;
     } else {
-       die("unrecognized file type for '$_[0]'");
+       die(sprintf(_g("unrecognized file type for '%s'"), $_[0]));
     }
 }
 
@@ -135,7 +138,7 @@ if (opendir(DIR, $ldconfigdir)) {
 }
 
 open CONF, '</etc/ld.so.conf' or
-    warn( "couldn't open /etc/ld.so.conf: $!" );
+    warn( sprintf(_g("couldn't open /etc/ld.so.conf: %s" ), $!));
 while( <CONF> ) {
     next if /^\s*$/;
     chomp;
@@ -153,10 +156,10 @@ for ($i=0;$i<=$#exec;$i++) {
     if (!isbin ($exec[$i])) { next; }
 
     # Now we get the direct deps of the program
-    defined(my $c= open(P,"-|")) || syserr("cannot fork for objdump");
+    defined(my $c= open(P,"-|")) || syserr(_g("cannot fork for objdump"));
     if (!$c) {
 	exec("objdump","-p","--",$exec[$i]);
-	syserr("cannot exec objdump");
+	syserr(_g("cannot exec objdump"));
     }
     while (<P>) {
 	chomp;
@@ -175,13 +178,13 @@ for ($i=0;$i<=$#exec;$i++) {
 		push(@libexec,$exec[$i]);
 	    } else {
 		m,^\s*NEEDED\s+(\S+)$,;
-		&warn("format of \`NEEDED $1' not recognized");
+		&warn(sprintf(_g("format of \`NEEDED %s' not recognized"), $1));
 	    }
 	} elsif (/^\s*RPATH\s+(\S+)\s*$/) {
 	    push @{$rpaths{$exec[$i]}}, $1;
 	}
     }
-    close(P) or subprocerr("objdump on \`$exec[$i]'");
+    close(P) or subprocerr(sprintf(_g("objdump on \`%s'"), $exec[$i]));
 }
 
 # Now: See if it is in this package.  See if it is in any other package.
@@ -243,23 +246,23 @@ if (1 || $#curshlibs >= 0) {
 my %pathpackages;
 if ($#libfiles >= 0) {
     grep(s/\[\?\*/\\$&/g, @libname);
-    defined(my $c= open(P,"-|")) || syserr("cannot fork for dpkg --search");
+    defined(my $c= open(P,"-|")) || syserr(_g("cannot fork for dpkg --search"));
     if (!$c) {
 	close STDERR; # we don't need to see dpkg's errors
 	open STDERR, "> /dev/null";
 	$ENV{LC_ALL} = "C";
 	exec("dpkg","--search","--",@libfiles);
-	syserr("cannot exec dpkg");
+	syserr(_g("cannot exec dpkg"));
     }
     while (<P>) {
 	chomp;
 	if (m/^local diversion |^diversion by/) {
-	    &warn("diversions involved - output may be incorrect");
-	    print(STDERR " $_\n") || syserr("write diversion info to stderr");
+	    &warn(_g("diversions involved - output may be incorrect"));
+	    print(STDERR " $_\n") || syserr(_g("write diversion info to stderr"));
 	} elsif (m=^(\S+(, \S+)*): (\S+)$=) {
 	    push @{$pathpackages{$LAST_PAREN_MATCH}}, split(/, /, $1);
 	} else {
-	    &warn("unknown output from dpkg --search: \`$_'");
+	    &warn(sprintf(_g("unknown output from dpkg --search: \`%s'"), $_));
 	}
     }
     close(P);
@@ -282,7 +285,7 @@ if ($#libfiles >= 0) {
 	    }
 	}
 	if (!@packages) {
-	    &warn("could not find any packages for $libfiles[$i]");
+	    &warn(sprintf(_g("could not find any packages for %s"), $libfiles[$i]));
 	} else {
 	    for my $p (@packages) {
 		scanshlibsfile("$shlibsppdir/$p$shlibsppext",
@@ -292,9 +295,11 @@ if ($#libfiles >= 0) {
 	}
 	scanshlibsfile($shlibsdefault,$libname[$i],$libsoname[$i],$libfield[$i])
 	    && next;
-	&warn("unable to find dependency information for ".
-	      "shared library $libname[$i] (soname $libsoname[$i], ".
-	      "path $libfiles[$i], dependency field $libfield[$i])");
+	&warn(sprintf(_g("unable to find dependency information for ".
+	                 "shared library %s (soname %s, ".
+	                 "path %s, dependency field %s)"),
+	              $libname[$i], $libsoname[$i],
+	              $libfiles[$i], $libfield[$i]));
     }
 
 sub format_matches {
@@ -309,10 +314,10 @@ sub get_format {
     if ($format{$file}) {
 	return $format{$file};
     } else {
-	defined(my $c= open(P,"-|")) || syserr("cannot fork for objdump");
+	defined(my $c= open(P,"-|")) || syserr(_g("cannot fork for objdump"));
 	if (!$c) {
 	    exec("objdump","-a","--",$file);
-	    syserr("cannot exec objdump");
+	    syserr(_g("cannot exec objdump"));
 	}
 	while (<P>) {
 	    chomp;
@@ -321,7 +326,7 @@ sub get_format {
 		return $format{$file};
 	    }
 	}
-	close(P) or subprocerr("objdump on \`$file'");
+	close(P) or subprocerr(sprintf(_g("objdump on \`%s'"), $file));
     }
 }
 
@@ -331,14 +336,14 @@ sub scanshlibsfile {
     my ($da,$dk);
     $fn= "./$fn" if $fn =~ m/^\s/;
     if (!open(SLF,"< $fn")) {
-        $! == ENOENT || syserr("unable to open shared libs info file \`$fn'");
+        $! == ENOENT || syserr(sprintf(_g("unable to open shared libs info file \`%s'"), $fn));
         return 0;
     }
 
     while (<SLF>) {
         s/\s*\n$//; next if m/^\#/;
         if (!m/^\s*(?:(\S+):\s+)?(\S+)\s+(\S+)/) {
-            &warn("shared libs info file \`$fn' line $.: bad line \`$_'");
+            &warn(sprintf(_g("shared libs info file \`%s' line %d: bad line \`%s'"), $fn, $., $_));
             next;
         }
         next if defined $1 && $1 ne $packagetype;
@@ -373,20 +378,20 @@ sub scanshlibsfile {
 my $fh;
 if (!$stdout) {
     open(Y,"> $varlistfile.new") ||
-        syserr("open new substvars file \`$varlistfile.new'");
+        syserr(sprintf(_g("open new substvars file \`%s'"), "$varlistfile.new"));
     unless ($REAL_USER_ID) {
 	chown(@fowner, "$varlistfile.new") ||
-	    syserr("chown of \`$varlistfile.new'");
+	    syserr(sprintf(_g("chown of \`%s'"), "$varlistfile.new"));
     }
     if (open(X,"< $varlistfile")) {
         while (<X>) {
             s/\n$//;
             next if m/^(\w[-:0-9A-Za-z]*):/ && $1 eq $varnameprefix;
             print(Y "$_\n") ||
-                syserr("copy old entry to new varlist file \`$varlistfile.new'");
+                syserr(sprintf(_g("copy old entry to new varlist file \`%s'"), "$varlistfile.new"));
         }
     } elsif ($! != ENOENT) {
-        syserr("open old varlist file \`$varlistfile' for reading");
+        syserr(sprintf(_g("open old varlist file \`%s' for reading"), $varlistfile));
     }
     $fh= 'Y';
 } else {
@@ -401,14 +406,14 @@ for my $dv (sort keys %predefdepfdep) {
 for my $lf (reverse @depfields) {
     next unless defined($defdepf{$lf});
     print($fh "$varnameprefix:$lf=$defdepf{$lf}\n")
-        || syserr("write output entry");
+        || syserr(_g("write output entry"));
 }
 for my $lf (sort keys %unkdepf) {
     print($fh "$varnameprefix:$lf=$unkdepf{$lf}\n")
-        || syserr("write userdef output entry");
+        || syserr(_g("write userdef output entry"));
 }
-close($fh) || syserr("close output");
+close($fh) || syserr(_g("close output"));
 if (!$stdout) {
     rename("$varlistfile.new",$varlistfile) ||
-        syserr("install new varlist file \`$varlistfile'");
+        syserr(sprintf(_g("install new varlist file \`%s'"), $varlistfile));
 }

File diff suppressed because it is too large
+ 287 - 261
scripts/dpkg-source.pl


+ 37 - 32
scripts/dpkg-statoverride.pl

@@ -6,14 +6,19 @@ use POSIX qw(:errno_h :signal_h);
 $admindir= "/var/lib/dpkg"; # This line modified by Makefile
 $version= '1.3.0'; # This line modified by Makefile
 
+my $dpkglibdir= "."; # This line modified by Makefile
+push (@INC, $dpkglibdir);
+require 'dpkg-gettext.pl';
+textdomain("dpkg");
+
 $verbose= 1;
 $doforce= 0;
 $doupdate= 0;
 $mode= "";
 
 sub UsageVersion {
-	print STDERR <<EOF || &quit("failed to write usage: $!");
-Debian dpkg-statoverride $version.
+	printf(STDERR _g(<<EOF), $version) || &quit(sprintf(_g("failed to write usage: %s"), $!));
+Debian dpkg-statoverride %s.
 Copyright (C) 2000 Wichert Akkerman.
 
 This is free software; see the GNU General Public Licence version 2 or later
@@ -53,7 +58,7 @@ while (@ARGV) {
 	} elsif (m/^--force$/) {
 		$doforce=1;
 	} elsif (m/^--admindir$/) {
-		@ARGV || &badusage("--admindir needs a directory argument");
+		@ARGV || &badusage(_g("--admindir needs a directory argument"));
 		$admindir= shift(@ARGV);
 	} elsif (m/^--add$/) {
 		&CheckModeConflict;
@@ -65,47 +70,47 @@ while (@ARGV) {
 		&CheckModeConflict;
 		$mode= 'list';
 	} else {
-		&badusage("unknown option \`$_'");
+		&badusage(sprintf(_g("unknown option \`%s'"), $_));
 	}
 }
 
 $dowrite=0;
 $exitcode=0;
 
-&badusage("no mode specified") unless $mode;
+&badusage(_g("no mode specified")) unless $mode;
 &ReadOverrides;
 
 if ($mode eq "add") {
-	@ARGV==4 || &badusage("--add needs four arguments");
+	@ARGV==4 || &badusage(_g("--add needs four arguments"));
 
 	$user=$ARGV[0];
 	if ($user =~ m/^#([0-9]+)$/) {
 	    $uid=$1;
-	    &badusage("illegal user $user") if ($uid<0);
+	    &badusage(sprintf(_g("illegal user %s"), $user)) if ($uid<0);
 	} else {
-	    (($name,$pw,$uid)=getpwnam($user)) || &badusage("non-existing user $user");
+	    (($name,$pw,$uid)=getpwnam($user)) || &badusage(sprintf(_g("non-existing user %s"), $user));
 	}
 
 	$group=$ARGV[1];
 	if ($group =~ m/^#([0-9]+)$/) {
 	    $gid=$1;
-	    &badusage("illegal group $group") if ($gid<0);
+	    &badusage(sprintf(_g("illegal group %s"), $group)) if ($gid<0);
 	} else {
-	    (($name,$pw,$gid)=getgrnam($group)) || &badusage("non-existing group $group");
+	    (($name,$pw,$gid)=getgrnam($group)) || &badusage(sprintf(_g("non-existing group %s"), $group));
 	}
 
 	$mode= $ARGV[2];
-	(($mode<0) or (oct($mode)>07777) or ($mode !~ m/\d+/)) && &badusage("illegal mode $mode");
+	(($mode<0) or (oct($mode)>07777) or ($mode !~ m/\d+/)) && &badusage(sprintf(_g("illegal mode %s"), $mode));
 	$file= $ARGV[3];
-	$file =~ m/\n/ && &badusage("file may not contain newlines");
-	$file =~ s,/+$,, && print STDERR "stripping trailing /\n";
+	$file =~ m/\n/ && &badusage(_g("file may not contain newlines"));
+	$file =~ s,/+$,, && print STDERR _g("stripping trailing /")."\n";
 
 	if (defined $owner{$file}) {
-		print STDERR "An override for \"$file\" already exists, ";
+		printf STDERR _g("An override for \"%s\" already exists, "), $file;
 		if ($doforce) {
-			print STDERR "but --force specified so lets ignore it.\n";
+			print STDERR _g("but --force specified so lets ignore it.")."\n";
 		} else {
-			print STDERR "aborting\n";
+			print STDERR _g("aborting")."\n";
 			exit(3);
 		}
 	}
@@ -116,18 +121,18 @@ if ($mode eq "add") {
 
 	if ($doupdate) {
 	    if (not -e $file) {
-		print STDERR "warning: --update given but $file does not exist\n";
+		printf STDERR _g("warning: --update given but %s does not exist")."\n", $file;
 	    } else {
-		chown ($uid,$gid,$file) || warn "failed to chown $file: $!\n";
-		chmod (oct($mode),$file) || warn "failed to chmod $file: $!\n";
+		chown ($uid,$gid,$file) || warn sprintf(_g("failed to chown %s: %s"), $file, $!)."\n";
+		chmod (oct($mode),$file) || warn sprintf(_g("failed to chmod %s: %s"), $file, $!)."\n";
 	    }
 	}
 } elsif ($mode eq "remove") {
-	@ARGV==1 || &badusage("--remove needs one arguments");
+	@ARGV==1 || &badusage(_g("--remove needs one arguments"));
 	$file=$ARGV[0];
-	$file =~ s,/+$,, && print STDERR "stripping trailing /\n";
+	$file =~ s,/+$,, && print STDERR _g("stripping trailing /")."\n";
 	if (not defined $owner{$file}) {
-		print STDERR "No override present.\n";
+		print STDERR _g("No override present.")."\n";
 		exit(0) if ($doforce); 
 		exit(2);
 	}
@@ -135,7 +140,7 @@ if ($mode eq "add") {
 	delete $group{$file};
 	delete $mode{$file};
 	$dowrite=1;
-	print STDERR "warning: --update is useless for --remove\n" if ($doupdate);
+	print(STDERR _g("warning: --update is useless for --remove")."\n") if ($doupdate);
 } elsif ($mode eq "list") {
 	my (@list,@ilist,$pattern,$file);
 	
@@ -144,7 +149,7 @@ if ($mode eq "add") {
 		s/\W/\\$&/g;
 		s/\\\?/./g;
 		s/\\\*/.*/g;
-		s,/+$,, && print STDERR "stripping trailing /\n";
+		s,/+$,, && print STDERR _g("stripping trailing /")."\n";
 		push(@list,"^$_\$");
 	}
 	$pat= join('|',@list);
@@ -161,13 +166,13 @@ if ($mode eq "add") {
 exit($exitcode);
 
 sub ReadOverrides {
-	open(SO,"$admindir/statoverride") || &quit("cannot open statoverride: $!");
+	open(SO,"$admindir/statoverride") || &quit(sprintf(_g("cannot open statoverride: %s"), $!));
 	while (<SO>) {
 		my ($owner,$group,$mode,$file);
 		chomp;
 
 		($owner,$group,$mode,$file)=split(' ', $_, 4);
-		die "Multiple overrides for \"$file\", aborting"
+		die sprintf(_g("Multiple overrides for \"%s\", aborting"), $file)
 			if defined $owner{$file};
 		$owner{$file}=$owner;
 		$group{$file}=$group;
@@ -180,22 +185,22 @@ sub ReadOverrides {
 sub WriteOverrides {
 	my ($file);
 
-	open(SO,">$admindir/statoverride-new") || &quit("cannot open new statoverride file: $!");
+	open(SO,">$admindir/statoverride-new") || &quit(sprintf(_g("cannot open new statoverride file: %s"), $!));
 	foreach $file (keys %owner) {
 		print SO "$owner{$file} $group{$file} $mode{$file} $file\n";
 	}
 	close(SO);
 	chmod(0644, "$admindir/statoverride-new");
 	unlink("$admindir/statoverride-old") ||
-		$! == ENOENT || &quit("error removing statoverride-old: $!");
+		$! == ENOENT || &quit(sprintf(_g("error removing statoverride-old: %s"), $!));
 	link("$admindir/statoverride","$admindir/statoverride-old") ||
-		$! == ENOENT || &quit("error creating new statoverride-old: $!");
+		$! == ENOENT || &quit(sprintf(_g("error creating new statoverride-old: %s"), $!));
 	rename("$admindir/statoverride-new","$admindir/statoverride")
-		|| &quit("error installing new statoverride: $!");
+		|| &quit(sprintf(_g("error installing new statoverride: %s"), $!));
 }
 
 
-sub quit { print STDERR "dpkg-statoverride: @_\n"; exit(2); }
-sub badusage { print STDERR "dpkg-statoverride: @_\n\n"; print("You need --help.\n"); exit(2); }
+sub quit { printf STDERR _g("dpkg-statoverride: %s")."\n", "@_"; exit(2); }
+sub badusage { printf STDERR _g("dpkg-statoverride: %s")."\n\n", "@_"; print(_g("You need --help.")."\n"); exit(2); }
 
 # vi: ts=8 sw=8 ai si cindent

+ 85 - 65
scripts/install-info.pl

@@ -1,6 +1,12 @@
 #!/usr/bin/perl --
 
 use Text::Wrap;
+use English;
+
+my $dpkglibdir = "."; # This line modified by Makefile
+push (@INC, $dpkglibdir);
+require 'dpkg-gettext.pl';
+textdomain("dpkg");
 
 # fixme: sort entries
 # fixme: send to FSF ?
@@ -8,8 +14,8 @@ use Text::Wrap;
 $version= '0.93.42.2'; # This line modified by Makefile
 sub version {
         $file = $_[0];
-        print $file <<END;
-Debian install-info $version.  Copyright (C) 1994,1995
+        printf $file _g(<<END), $version;
+Debian install-info %s.  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
@@ -17,7 +23,7 @@ END
 
 sub usage {
     $file = $_[0];
-    print $file <<END;
+    print $file _g(<<END);
 usage: install-info [--version] [--help] [--debug] [--maxwidth=nnn]
              [--section regexp title] [--infodir=xxx] [--align=nnn]
              [--calign=nnn] [--quiet] [--menuentry=xxx] [--info-dir=xxx]
@@ -68,29 +74,31 @@ while ($ARGV[0] =~ m/^--/) {
     } elsif ($_ eq '--help') {
         &usage(STDOUT); exit 0;
     } elsif ($_ eq '--debug') {
-        open(DEBUG,">&STDERR") || die "Could not open stderr for output! $!\n";
+	open(DEBUG,">&STDERR")
+	    || die sprintf(_g("Could not open stderr for output! %s"), $!)."\n";
 	$debug=1;
     } elsif ($_ eq '--section') {
         if (@ARGV < 2) {
-            print STDERR "$name: --section needs two more args\n";
+	    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( "$name: $1 deprecated(ignored)\n" );
+	warn( sprintf(_g("%s: %s deprecated(ignored)"), $name, $1)."\n" );
     } elsif (m/^--info-?dir=/) {
-	$dirfile = $' . '/dir';
+	$dirfile = $POSTMATCH . '/dir';
     } elsif (m/^--info-file=/) {
-        $filename=$';
+        $filename=$POSTMATCH;
     } elsif (m/^--menuentry=/) {
-        $menuentry=$';
+        $menuentry=$POSTMATCH;
     } elsif (m/^--description=/) {
-        $description=$';
+        $description=$POSTMATCH;
     } elsif (m/^--dir-file=/) { # for compatibility with GNU install-info
-	$dirfile = $';
+	$dirfile = $POSTMATCH;
     } else {
-        print STDERR "$name: unknown option \`$_'\n"; &usage(STDERR); exit 1;
+        printf STDERR _g("%s: unknown option \`%s'")."\n", $name, $_;
+        &usage(STDERR); exit 1;
     }
 }
 
@@ -100,14 +108,14 @@ if ( !$filename ) {
 	$filename= shift(@ARGV);
 	$name = "$name($filename)";
 }
-if (@ARGV) { print STDERR "$name: too many arguments\n"; &usage(STDERR); exit 1; }
+if (@ARGV) { printf STDERR _g("%s: too many arguments")."\n", $name; &usage(STDERR); 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);
+    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);
 }
 
-print STDERR "$name: test mode - dir file will not be updated\n"
+printf(STDERR _g("%s: test mode - dir file will not be updated")."\n", $name)
     if $nowrite && !$quiet;
 
 umask(umask(0777) & ~0444);
@@ -135,7 +143,7 @@ if (!$remove) {
 
     if (!length($description)) {
         
-        open(IF,"$filename") || die "$name: read $filename: $!\n";
+        open(IF,"$filename") || die sprintf(_g("%s: read %s: %s"), $name, $filename, $!)."\n";
         $asread='';
         while(<IF>) {
 	    m/^START-INFO-DIR-ENTRY$/ && last;
@@ -157,13 +165,11 @@ if (!$remove) {
             &dprint("multiline '$asread'");
         } elsif ($asread =~ m/^\*\s*([^:]+):(\s*\(([^\)]+)\)\.|:)\s*/) {
             $menuentry= $1;
-            $description= $';
+            $description= $POSTMATCH;
             $fileinentry = $3;
             &dprint("infile menuentry '$menuentry' description '$description'");
         } elsif (length($asread)) {
-            print STDERR <<END;
-$name: warning, ignoring confusing INFO-DIR-ENTRY in file.
-END
+            printf STDERR _g("%s: warning, ignoring confusing INFO-DIR-ENTRY in file.")."\n", $name;
         }
     }
 
@@ -172,18 +178,18 @@ END
         $infoentry =~ m/\n/;
         print "$`\n" unless $quiet;
         $infoentry =~ m/^\*\s*([^:]+):\s*\(([^\)]+)\)/ || 
-            die "$name: Invalid info entry\n"; # internal error
+            die sprintf(_g("%s: Invalid info entry"), $name)."\n"; # internal error
         $sortby= $1;
         $fileinentry= $2;
 
     } else {
-        
+
         if (!length($description)) {
-            open(IF,"$filename") || die "$name: read $filename: $!\n";
+            open(IF,"$filename") || die sprintf(_g("%s: read %s: %s"), $name, $filename, $!)."\n";
             $asread='';
             while(<IF>) {
                 if (m/^\s*[Tt]his file documents/) {
-                    $asread=$';
+                    $asread=$POSTMATCH;
                     last;
                 }
             }
@@ -198,10 +204,10 @@ END
         }
 
         if (!length($description)) {
-            print STDERR "
+            printf STDERR _g("
 No \`START-INFO-DIR-ENTRY' and no \`This file documents'.
-$name: unable to determine description for \`dir' entry - giving up
-";
+%s: unable to determine description for \`dir' entry - giving up
+"), $name;
             exit 1;
         }
 
@@ -251,36 +257,43 @@ $name: unable to determine description for \`dir' entry - giving up
 
 if (!$nowrite && ( ! -e $dirfile || ! -s _ )) {
     if (-r $backup) {
-	print STDERR "$name: no file $dirfile, retrieving backup file $backup.\n";
-	if (system ("cp $backup $dirfile")) {
-	    print STDERR "$name: copying $backup to $dirfile failed, giving up: $!\n";
+	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) {
-	    print STDERR "$name: no backup file $backup available, retrieving default file.\n";
-	    
-	    if (system("cp $default $dirfile")) {
-		print STDERR "$name: copying $default to $dirfile failed, giving up: $!\n";
+	    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 {
-	    print STDERR "$name: no backup file $backup available.\n";
-	    print STDERR "$name: no default file $default available, giving up.\n";
+	    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")) {
-    die "$name: failed to lock dir for editing! $!\n".
-        ($! == EEXIST ? "try deleting $dirfile.lock ?\n" : '');
+    printf( STDERR _g("%s: failed to lock dir for editing! %s")."\n",
+	    $name, $! );
+    printf( STDERR _g("try deleting %s?")."\n", "$dirfile.lock")
+	if $! == EEXIST;
 }
 
-open(OLD, $dirfile) || &ulquit("open $dirfile: $!");
+open(OLD,$dirfile) || &ulquit(sprintf(_g("open %s: %s"), $dirfile, $!));
 @work= <OLD>;
-eof(OLD) || &ulquit("read $dirfile: $!");
-close(OLD) || &ulquit("close $dirfile after read: $!");
+eof(OLD) || &ulquit(sprintf(_g("read %s: %s"), $dirfile, $!));
+close(OLD) || &ulquit(sprintf(_g("close %s after read: %s"), $dirfile, $!));
+
 while (($#work >= 0) && ($work[$#work] !~ m/\S/)) { $#work--; }
 
 while (@work) {
@@ -311,10 +324,10 @@ if (!$remove) {
 
     if ($i < $j) {
         if ($keepold) {
-            print "$name: existing entry for \`$target_entry' not replaced\n" unless $quiet;
+            printf(_g("%s: existing entry for \`%s' not replaced")."\n", $name, $target_entry) unless $quiet;
             $nowrite=1;
         } else {
-            print "$name: replacing existing dir entry for \`$target_entry'\n" unless $quiet;
+            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]);
@@ -327,10 +340,10 @@ if (!$remove) {
             $mss= $i+1; last;
         }
         if ($mss < 0) {
-            print "$name: creating new section \`$sectiontitle'\n" unless $quiet;
+            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.
-                print "$name: no sections yet, creating Miscellaneous section too.\n"
+                printf(_g("%s: no sections yet, creating Miscellaneous section too.")."\n", $name)
                     unless $quiet;
                 @work= ("\n", "$sectiontitle\n", "\n", "Miscellaneous:\n", @work);
                 $mss= 1;
@@ -348,7 +361,7 @@ if (!$remove) {
             $mss++;
         }
     } else {
-        print "$name: no section specified for new entry, placing at end\n"
+        printf(_g("%s: no section specified for new entry, placing at end")."\n", $name)
             unless $quiet;
         $mss= $#work+1;
     }
@@ -385,24 +398,27 @@ if (!$remove) {
 
     if ($i < $j) {
         &dprint("i=$i \$work[\$i]='$work[$i]' j=$j \$work[\$j]='$work[$j]'");
-        print "$name: deleting entry \`$match ...'\n" unless $quiet;
+        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) {
-                print "$name: empty section \`$_' not removed\n" unless $quiet;
+                printf(_g("%s: empty section \`%s' not removed")."\n", $name, $_) unless $quiet;
             } else {
                 $i--; $j++;
-                print "$name: deleting empty section \`$_'\n" unless $quiet;
+                printf(_g("%s: deleting empty section \`%s'")."\n", $name, $_) unless $quiet;
             }
         }
         @work= (@work[0..$i-1], @work[$j..$#work]);
     } else {
-        print "$name: no entry for file \`$target_entry'".
-              (length($menuentry) ? " and menu entry \`$menuentry'": '').
-              ".\n"
-            unless $quiet;
+        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;
@@ -442,33 +458,37 @@ foreach ( @work ) {
 }
 
 if (!$nowrite) {
-    open(NEW, "> $dirfile.new") || &ulquit("create $dirfile.new: $!");
-    print(NEW @head, join("\n", @newwork), "\n") ||
-        &ulquit("write $dirfile.new: $!");
-    close(NEW) || &ulquit("close $dirfile.new: $!");
+    open(NEW,"> $dirfile.new") || &ulquit(sprintf(_g("create %s: %s"), "$dirfile.new", $!));
+    print(NEW @head,join("\n",@newwork)) ||
+	&ulquit(sprintf(_g("write %s: %s"), "$dirfile.new", $!));
+    close(NEW) || &ulquit(sprintf(_g("close %s: %s"), "$dirfile.new", $!));
 
     unlink("$dirfile.old");
     link($dirfile, "$dirfile.old") ||
-        &ulquit("cannot backup old $dirfile, giving up: $!");
+	&ulquit(sprintf(_g("cannot backup old %s, giving up: %s"), $dirfile, $!));
     rename("$dirfile.new", $dirfile) ||
-        &ulquit("install new $dirfile: $!");
-    unlink("$dirfile.lock") || die "$name: unlock $dirfile: $!\n";
-    system ("cp $dirfile $backup") && warn "$name: couldn't backup $dirfile in $backup: $!\n";
+	&ulquit(sprintf(_g("install new %s: %s"), $dirfile, $!));
+
+    unlink("$dirfile.lock") ||
+	die sprintf(_g("%s: unlock %s: %s"), $name, $dirfile, $!)."\n";
+    system ('cp', $dirfile, $backup) &&
+	warn sprintf(_g("%s: couldn't backup %s in %s: %s"), $name, $dirfile, $backup, $!)."\n";
 }
 
 sub ulquit {
     unlink("$dirfile.lock") ||
-        warn "$name: warning - unable to unlock $dirfile: $!\n";
+	warn sprintf(_g("%s: warning - unable to unlock %s: %s"),
+		     $name, $dirfile, $!)."\n";
     die "$name: $_[0]\n";
 }
 
 sub checkpipe {
     return if !$pipeit || !$? || $?==0x8D00 || $?==0x0D;
-    die "$name: read $filename: $?\n";
+    die sprintf(_g("%s: read %s: %d"), $name, $filename, $?)."\n";
 }
 
 sub dprint {
-    print DEBUG "dbg: $_[0]\n" if ($debug);
+    printf(DEBUG _g("dbg: %s")."\n", $_[0]) if ($debug);
 }
 
 exit 0;

+ 124 - 118
scripts/update-alternatives.pl

@@ -3,6 +3,9 @@
 $admindir= "/var/lib/dpkg"; # This line modified by Makefile
 $dpkglibdir= "../utils"; # This line modified by Makefile
 $version= '0.93.80'; # This line modified by Makefile
+push (@INC, $dpkglibdir);
+require 'dpkg-gettext.pl';
+textdomain("dpkg");
 
 # Global variables:
 #  $alink            Alternative we are managing (ie the symlink we're making/removing) (install only)
@@ -25,12 +28,12 @@ $version= '0.93.80'; # This line modified by Makefile
 #  %priorities       Map from @version-index to priority
 #  %slavepath        Map from (@version-index,slavename) to slave-path
 
-$enoent=`$dpkglibdir/enoent` || die "Cannot get ENOENT value from $dpkglibdir/enoent: $!";
+$enoent=`$dpkglibdir/enoent` || die sprintf(_g("Cannot get ENOENT value from %s: %s"), "$dpkglibdir/enoent", $!);
 sub ENOENT { $enoent; }
 
 sub usageversion {
-    print(STDERR <<END)
-Debian update-alternatives $version.
+    printf(STDERR _g(<<END), $version)
+Debian update-alternatives %s.
 Copyright (C) 1995 Ian Jackson.
 Copyright (C) 2000-2002 Wichert Akkerman
 This is free software; see the GNU General Public Licence
@@ -54,10 +57,10 @@ Usage: update-alternatives --install <link> <name> <path> <priority>
 Options:  --verbose|--quiet  --test  --help  --version
           --altdir <directory>  --admindir <directory>
 END
-        || &quit("failed to write usage: $!");
+        || &quit(sprintf(_g("failed to write usage: %s"), $!));
 }
-sub quit { print STDERR "update-alternatives: @_\n"; exit(2); }
-sub badusage { print STDERR "update-alternatives: @_\n\n"; &usageversion; exit(2); }
+sub quit {printf STDERR _g("update-alternatives: %s")."\n", "@_"; exit(2);}
+sub badusage { printf STDERR _g("update-alternatives: %s")."\n\n", "@_"; &usageversion; exit(2); }
 
 $altdir= '/etc/alternatives';
 $admindir= $admindir . '/alternatives';
@@ -69,14 +72,14 @@ $|=1;
 
 sub checkmanymodes {
     return unless $mode;
-    &badusage("two modes specified: $_ and --$mode");
+    &badusage(sprintf(_g("two modes specified: %s and --%s"), $_, $mode));
 }
 
 while (@ARGV) {
     $_= shift(@ARGV);
     last if m/^--$/;
     if (!m/^--/) {
-        &quit("unknown argument \`$_'");
+        &quit(sprintf(_g("unknown argument \`%s'"), $_));
     } elsif (m/^--(help|version)$/) {
         &usageversion; exit(0);
     } elsif (m/^--test$/) {
@@ -87,45 +90,45 @@ while (@ARGV) {
         $verbosemode= -1;
     } elsif (m/^--install$/) {
         &checkmanymodes;
-        @ARGV >= 4 || &badusage("--install needs <link> <name> <path> <priority>");
+        @ARGV >= 4 || &badusage(_g("--install needs <link> <name> <path> <priority>"));
         ($alink,$name,$apath,$apriority,@ARGV) = @ARGV;
-        $apriority =~ m/^[-+]?\d+/ || &badusage("priority must be an integer");
+        $apriority =~ m/^[-+]?\d+/ || &badusage(_g("priority must be an integer"));
         $mode= 'install';
     } elsif (m/^--(remove|set)$/) {
         &checkmanymodes;
-        @ARGV >= 2 || &badusage("--$1 needs <name> <path>");
+        @ARGV >= 2 || &badusage(sprintf(_g("--%s needs <name> <path>"), $1));
         ($name,$apath,@ARGV) = @ARGV;
         $mode= $1;
     } elsif (m/^--(display|auto|config|list|remove-all)$/) {
         &checkmanymodes;
-        @ARGV || &badusage("--$1 needs <name>");
+        @ARGV || &badusage(sprintf(_g("--%s needs <name>"), $1));
         $mode= $1;
         $name= shift(@ARGV);
     } elsif (m/^--slave$/) {
-        @ARGV >= 3 || &badusage("--slave needs <link> <name> <path>");
+        @ARGV >= 3 || &badusage(_g("--slave needs <link> <name> <path>"));
         ($slink,$sname,$spath,@ARGV) = @ARGV;
-        defined($aslavelink{$sname}) && &badusage("slave name $sname duplicated");
-        $aslavelinkcount{$slink}++ && &badusage("slave link $slink duplicated");
+        defined($aslavelink{$sname}) && &badusage(sprintf(_g("slave name %s duplicated"), $sname));
+        $aslavelinkcount{$slink}++ && &badusage(sprintf(_g("slave link %s duplicated"), $slink));
         $aslavelink{$sname}= $slink;
         $aslavepath{$sname}= $spath;
     } elsif (m/^--altdir$/) {
-        @ARGV || &badusage("--altdir needs a <directory> argument");
+        @ARGV || &badusage(_g("--altdir needs a <directory> argument"));
         $altdir= shift(@ARGV);
     } elsif (m/^--admindir$/) {
-        @ARGV || &badusage("--admindir needs a <directory> argument");
+        @ARGV || &badusage(_g("--admindir needs a <directory> argument"));
         $admindir= shift(@ARGV);
     } elsif (m/^--all$/) {
         $mode = 'all';
     } else {
-        &badusage("unknown option \`$_'");
+        &badusage(sprintf(_g("unknown option \`%s'"), $_));
     }
 }
 
-defined($aslavelink{$name}) && &badusage("name $name is both primary and slave");
-$aslavelinkcount{$alink} && &badusage("link $link is both primary and slave");
+defined($aslavelink{$name}) && &badusage(sprintf(_g("name %s is both primary and slave"), $name));
+$aslavelinkcount{$alink} && &badusage(sprintf(_g("link %s is both primary and slave"), $alink));
 
-$mode || &badusage("need --display, --config, --set, --install, --remove, --all, --remove-all or --auto");
-$mode eq 'install' || !%aslavelink || &badusage("--slave only allowed with --install");
+$mode || &badusage(_g("need --display, --config, --set, --install, --remove, --all, --remove-all or --auto"));
+$mode eq 'install' || !%aslavelink || &badusage(_g("--slave only allowed with --install"));
 
 if ($mode eq 'all') {
     &config_all();
@@ -133,31 +136,31 @@ if ($mode eq 'all') {
 
 if (open(AF,"$admindir/$name")) {
     $manual= &gl("manflag");
-    $manual eq 'auto' || $manual eq 'manual' || &badfmt("manflag");
+    $manual eq 'auto' || $manual eq 'manual' || &badfmt(_g("manflag"));
     $link= &gl("link");
     while (($sname= &gl("sname")) ne '') {
         push(@slavenames,$sname);
-        defined($slavenum{$sname}) && &badfmt("duplicate slave $sname");
+        defined($slavenum{$sname}) && &badfmt(sprintf(_g("duplicate slave %s"), $sname));
         $slavenum{$sname}= $#slavenames;
         $slink= &gl("slink");
-        $slink eq $link && &badfmt("slave link same as main link $link");
-        $slavelinkcount{$slink}++ && &badfmt("duplicate slave link $slink");
+        $slink eq $link && &badfmt(sprintf(_g("slave link same as main link %s"), $link));
+        $slavelinkcount{$slink}++ && &badfmt(sprintf(_g("duplicate slave link %s"), $slink));
         push(@slavelinks,$slink);
     }
     while (($version= &gl("version")) ne '') {
-        defined($versionnum{$version}) && &badfmt("duplicate path $version");
+        defined($versionnum{$version}) && &badfmt(sprintf(_g("duplicate path %s"), $version));
        if ( -r $version ) {
            push(@versions,$version);
            $versionnum{$version}= $i= $#versions;
            $priority= &gl("priority");
-           $priority =~ m/^[-+]?\d+$/ || &badfmt("priority $version $priority");
+           $priority =~ m/^[-+]?\d+$/ || &badfmt(sprintf(_g("priority %s %s"), $version, $priority));
            $priorities[$i]= $priority;
            for ($j=0; $j<=$#slavenames; $j++) {
                $slavepath{$i,$j}= &gl("spath");
            }
        } else {
            # File not found - remove
-           &pr("Alternative for $name points to $version - which wasn't found.  Removing from list of alternatives.")
+           &pr(sprintf(_g("Alternative for %s points to %s - which wasn't found.  Removing from list of alternatives."), $name, $version))
              if $verbosemode > 0;
            &gl("priority");
            for ($j=0; $j<=$#slavenames; $j++) {
@@ -168,37 +171,37 @@ if (open(AF,"$admindir/$name")) {
     close(AF);
     $dataread=1;
 } elsif ($! != &ENOENT) {
-    &quit("failed to open $admindir/$name: $!");
+    &quit(sprintf(_g("failed to open %s: %s"), "$admindir/$name", $!));
 }
 
 if ($mode eq 'display') {
     if (!$dataread) {
-        &pr("No alternatives for $name.");
+        &pr(sprintf(_g("No alternatives for %s."), $name));
 	exit 1;
     } else {
-        &pr("$name - status is $manual.");
+        &pr(sprintf(_g("%s - status is %s."), $name, $manual));
         if (defined($linkname= readlink("$altdir/$name"))) {
-            &pr(" link currently points to $linkname");
+            &pr(sprintf(_g(" link currently points to %s"), $linkname));
         } elsif ($! == &ENOENT) {
-            &pr(" link currently absent");
+            &pr(_g(" link currently absent"));
         } else {
-            &pr(" link unreadable - $!");
+            &pr(sprintf(_g(" link unreadable - %s"), $!));
         }
         $best= '';
         for ($i=0; $i<=$#versions; $i++) {
             if ($best eq '' || $priorities[$i] > $bestpri) {
                 $best= $versions[$i]; $bestpri= $priorities[$i];
             }
-            &pr("$versions[$i] - priority $priorities[$i]");
+            &pr(sprintf(_g("%s - priority %s"), $versions[$i], $priorities[$i]));
             for ($j=0; $j<=$#slavenames; $j++) {
                 next unless length($tspath= $slavepath{$i,$j});
-                &pr(" slave $slavenames[$j]: $tspath");
+                &pr(sprintf(_g(" slave %s: %s"), $slavenames[$j], $tspath));
             }
         }
         if ($best eq '') {
-            &pr("No versions available.");
+            &pr(_g("No versions available."));
         } else {
-            &pr("Current \`best' version is $best.");
+            &pr(sprintf(_g("Current \`best' version is %s."), $best));
         }
     }
     exit 0;
@@ -222,7 +225,7 @@ for ($i=0; $i<=$#versions; $i++) {
 
 if ($mode eq 'config') {
     if (!$dataread) {
-	&pr("No alternatives for $name.");
+	&pr(sprintf(_g("No alternatives for %s."), $name));
     } else {
 	&config_alternatives($name);
     }
@@ -230,7 +233,7 @@ if ($mode eq 'config') {
 
 if ($mode eq 'set') {
     if (!$dataread) {
-	&pr("No alternatives for $name.");
+	&pr(sprintf(_g("No alternatives for %s."), $name));
     } else {
 	&set_alternatives($name);
     }
@@ -257,12 +260,12 @@ if (defined($linkname= readlink("$altdir/$name"))) {
 # all independent
 
 if ($mode eq 'auto') {
-    &pr("Setting up automatic selection of $name.")
+    &pr(sprintf(_g("Setting up automatic selection of %s."), $name))
       if $verbosemode > 0;
     unlink("$altdir/$name.dpkg-tmp") || $! == &ENOENT ||
-        &quit("unable to remove $altdir/$name.dpkg-tmp: $!");
+        &quit(sprintf(_g("unable to remove %s: %s"), "$altdir/$name.dpkg-tmp", $!));
     unlink("$altdir/$name") || $! == &ENOENT ||
-        &quit("unable to remove $altdir/$name.dpkg-tmp: $!");
+        &quit(sprintf(_g("unable to remove %s: %s"), "$altdir/$name", $!));
     $state= 'nonexistent';
     $manual= 'auto';
 }
@@ -273,8 +276,8 @@ if ($mode eq 'auto') {
 # mode=auto <=> state=nonexistent
 
 if ($state eq 'unexpected' && $manual eq 'auto') {
-    &pr("$altdir/$name has been changed (manually or by a script).\n".
-        "Switching to manual updates only.")
+    &pr(sprintf(_g("%s has been changed (manually or by a script).\n".
+                   "Switching to manual updates only."), "$altdir/$name"))
       if $verbosemode > 0;
     $manual= 'manual';
 }
@@ -285,16 +288,16 @@ if ($state eq 'unexpected' && $manual eq 'auto') {
 # mode=auto <=> state=nonexistent
 # state=unexpected => manual=manual
 
-&pr("Checking available versions of $name, updating links in $altdir ...\n".
-    "(You may modify the symlinks there yourself if desired - see \`man ln'.)")
+&pr(sprintf(_g("Checking available versions of %s, updating links in %s ...\n".
+    "(You may modify the symlinks there yourself if desired - see \`man ln'.)"), $name, $altdir))
   if $verbosemode > 0;
 
 if ($mode eq 'install') {
     if ($link ne $alink && $link ne '') {
-        &pr("Renaming $name link from $link to $alink.")
+        &pr(sprintf(_g("Renaming %s link from %s to %s."), $name, $link, $alink))
           if $verbosemode > 0;
         rename_mv($link,$alink) || $! == &ENOENT ||
-            &quit("unable to rename $link to $alink: $!");
+            &quit(sprintf(_g("unable to rename %s to %s: %s"), $link, $alink, $!));
     }
     $link= $alink;
     if (!defined($i= $versionnum{$apath})) {
@@ -311,12 +314,12 @@ if ($mode eq 'install') {
         $newslavelink= $aslavelink{$sname};
         $slavelinkcount{$oldslavelink}-- if $oldslavelink ne '';
         $slavelinkcount{$newslavelink}++ &&
-            &quit("slave link name $newslavelink duplicated");
+            &quit(sprintf(_g("slave link name %s duplicated"), $newslavelink));
         if ($newslavelink ne $oldslavelink && $oldslavelink ne '') {
-            &pr("Renaming $sname slave link from $oldslavelink to $newslavelink.")
+            &pr(sprintf(_g("Renaming %s slave link from %s to %s."), $sname, $oldslavelink, $newslavelink))
               if $verbosemode > 0;
             rename_mv($oldslavelink,$newslavelink) || $! == &ENOENT ||
-                &quit("unable to rename $oldslavelink to $newslavelink: $!");
+                &quit(sprintf(_g("unable to rename %s to %s: %s"), $oldslavelink, $newslavelink, $!));
         }
         $slavelinks[$j]= $newslavelink;
     }
@@ -327,7 +330,7 @@ if ($mode eq 'install') {
 
 if ($mode eq 'remove') {
     if ($manual eq "manual" and $state ne "expected" and (map { $hits += $apath eq $_ } @versions) and $hits and $linkname eq $apath) {
-    	&pr("Removing manually selected alternative - switching to auto mode");
+	&pr(_g("Removing manually selected alternative - switching to auto mode"));
 	$manual= "auto";
     }
     if (defined($i= $versionnum{$apath})) {
@@ -341,7 +344,7 @@ if ($mode eq 'remove') {
             delete $slavepath{$k,$j};
         }
     } else {
-        &pr("Alternative $apath for $name not registered, not removing.")
+        &pr(sprintf(_g("Alternative %s for %s not registered, not removing."), $apath, $name))
           if $verbosemode > 0;
     }
 }
@@ -367,12 +370,12 @@ for ($j=0; $j<=$#slavenames; $j++) {
         last if $slavepath{$i,$j} ne '';
     }
     if ($i > $#versions) {
-        &pr("Discarding obsolete slave link $slavenames[$j] ($slavelinks[$j]).")
+        &pr(sprintf(_g("Discarding obsolete slave link %s (%s)."), $slavenames[$j], $slavelinks[$j]))
           if $verbosemode > 0;
         unlink("$altdir/$slavenames[$j]") || $! == &ENOENT ||
-            &quit("unable to remove $slavenames[$j]: $!");
+            &quit(sprintf(_g("unable to remove %s: %s"), "$altdir/$slavenames[$j]", $!));
         unlink($slavelinks[$j]) || $! == &ENOENT ||
-            &quit("unable to remove $slavelinks[$j]: $!");
+            &quit(sprintf(_g("unable to remove %s: %s"), $slavelinks[$j], $!));
         $k= $#slavenames;
         $slavenum{$slavenames[$k]}= $j;
         delete $slavenum{$slavenames[$j]};
@@ -388,15 +391,15 @@ for ($j=0; $j<=$#slavenames; $j++) {
 }
         
 if ($manual eq 'manual') {
-    &pr("Automatic updates of $altdir/$name are disabled, leaving it alone.")
+    &pr(sprintf(_g("Automatic updates of %s are disabled, leaving it alone."), "$altdir/$name"))
       if $verbosemode > 0;
-    &pr("To return to automatic updates use \`update-alternatives --auto $name'.")
+    &pr(sprintf(_g("To return to automatic updates use \`update-alternatives --auto %s'."), $name))
       if $verbosemode > 0;
 } else {
     if ($state eq 'expected-inprogress') {
-        &pr("Recovering from previous failed update of $name ...");
+        &pr(sprintf(_g("Recovering from previous failed update of %s ..."), $name));
         rename_mv("$altdir/$name.dpkg-tmp","$altdir/$name") ||
-            &quit("unable to rename $altdir/$name.dpkg-tmp to $altdir/$name: $!");
+            &quit(sprintf(_g("unable to rename %s to %s: %s"), "$altdir/$name.dpkg-tmp", "$altdir/$name", $!));
         $state= 'expected';
     }
 }
@@ -409,7 +412,7 @@ if ($manual eq 'manual') {
 # manual=auto => state!=expected-inprogress && state!=unexpected
 
 open(AF,">$admindir/$name.dpkg-new") ||
-    &quit("unable to open $admindir/$name.dpkg-new for write: $!");
+    &quit(sprintf(_g("unable to open %s for write: %s"), "$admindir/$name.dpkg-new", $!));
 &paf($manual);
 &paf($link);
 for ($j=0; $j<=$#slavenames; $j++) {
@@ -429,110 +432,113 @@ for ($i=0; $i<=$#versions; $i++) {
     }
 }
 &paf('');
-close(AF) || &quit("unable to close $admindir/$name.dpkg-new: $!");
+close(AF) || &quit(sprintf(_g("unable to close %s: %s"), "$admindir/$name.dpkg-new", $!));
 
 if ($manual eq 'auto') {
     if ($best eq '') {
-        &pr("Last package providing $name ($link) removed, deleting it.")
+        &pr(sprintf(_g("Last package providing %s (%s) removed, deleting it."), $name, $link))
           if $verbosemode > 0;
         unlink("$altdir/$name") || $! == &ENOENT ||
-            &quit("unable to remove $altdir/$name: $!");
+            &quit(sprintf(_g("unable to remove %s: %s"), "$altdir/$name", $!));
         unlink("$link") || $! == &ENOENT ||
-            &quit("unable to remove $altdir/$name: $!");
+            &quit(sprintf(_g("unable to remove %s: %s"), "$link", $!));
         unlink("$admindir/$name.dpkg-new") ||
-            &quit("unable to remove $admindir/$name.dpkg-new: $!");
+            &quit(sprintf(_g("unable to remove %s: %s"), "$admindir/$name.dpkg-new", $!));
         unlink("$admindir/$name") || $! == &ENOENT ||
-            &quit("unable to remove $admindir/$name: $!");
+            &quit(sprintf(_g("unable to remove %s: %s"), "$admindir/$name", $!));
         exit(0);
     } else {
         if (!defined($linkname= readlink($link)) && $! != &ENOENT) {
-            &pr("warning: $link is supposed to be a symlink to $altdir/$name\n".
-                " (or nonexistent); however, readlink failed: $!")
+            &pr(sprintf(_g("warning: %s is supposed to be a symlink to %s\n".
+                " (or nonexistent); however, readlink failed: %s"), $link, "$altdir/$name", $!))
               if $verbosemode > 0;
         } elsif ($linkname ne "$altdir/$name") {
             unlink("$link.dpkg-tmp") || $! == &ENOENT ||
-                &quit("unable to ensure $link.dpkg-tmp nonexistent: $!");
+                &quit(sprintf(_g("unable to ensure %s nonexistent: %s"), "$link.dpkg-tmp", $!));
             symlink("$altdir/$name","$link.dpkg-tmp") ||
-                &quit("unable to make $link.dpkg-tmp a symlink to $altdir/$name: $!");
+                &quit(sprintf(_g("unable to make %s a symlink to %s: %s"), "$link.dpkg-tmp", "$altdir/$name", $!));
             rename_mv("$link.dpkg-tmp",$link) ||
-                &quit("unable to install $link.dpkg-tmp as $link: $!");
+                &quit(sprintf(_g("unable to install %s as %s: %s"), "$link.dpkg-tmp", $link, $!));
         }
         if (defined($linkname= readlink("$altdir/$name")) && $linkname eq $best) {
-            &pr("Leaving $name ($link) pointing to $best.")
+            &pr(sprintf(_g("Leaving %s (%s) pointing to %s."), $name, $link, $best))
               if $verbosemode > 0;
         } else {
-            &pr("Updating $name ($link) to point to $best.")
+            &pr(sprintf(_g("Updating %s (%s) to point to %s."), $name, $link, $best))
               if $verbosemode > 0;
         }
         unlink("$altdir/$name.dpkg-tmp") || $! == &ENOENT ||
-            &quit("unable to ensure $altdir/$name.dpkg-tmp nonexistent: $!");
+            &quit(sprintf(_g("unable to ensure %s nonexistent: %s"), "$altdir/$name.dpkg-tmp", $!));
         symlink($best,"$altdir/$name.dpkg-tmp");
     }
 }
 
 rename_mv("$admindir/$name.dpkg-new","$admindir/$name") ||
-    &quit("unable to rename $admindir/$name.dpkg-new to $admindir/$name: $!");
+    &quit(sprintf(_g("unable to rename %s to %s: %s"), "$admindir/$name.dpkg-new", "$admindir/$name", $!));
 
 if ($manual eq 'auto') {
     rename_mv("$altdir/$name.dpkg-tmp","$altdir/$name") ||
-        &quit("unable to install $altdir/$name.dpkg-tmp as $altdir/$name");
+        &quit(sprintf(_g("unable to install %s as %s"), "$altdir/$name.dpkg-tmp", "$altdir/$name"));
     for ($j=0; $j<=$#slavenames; $j++) {
         $sname= $slavenames[$j];
         $slink= $slavelinks[$j];
         if (!defined($linkname= readlink($slink)) && $! != &ENOENT) {
-            &pr("warning: $slink is supposed to be a slave symlink to\n".
-                " $altdir/$sname, or nonexistent; however, readlink failed: $!")
+            &pr(sprintf(_g("warning: %s is supposed to be a slave symlink to\n".
+                " %s, or nonexistent; however, readlink failed: %s"), $slink, "$altdir/$sname", $!))
               if $verbosemode > 0;
         } elsif ($linkname ne "$altdir/$sname") {
             unlink("$slink.dpkg-tmp") || $! == &ENOENT ||
-                &quit("unable to ensure $slink.dpkg-tmp nonexistent: $!");
+                &quit(sprintf(_g("unable to ensure %s nonexistent: %s"), "$slink.dpkg-tmp", $!));
             symlink("$altdir/$sname","$slink.dpkg-tmp") ||
-                &quit("unable to make $slink.dpkg-tmp a symlink to $altdir/$sname: $!");
+                &quit(sprintf(_g("unable to make %s a symlink to %s: %s"), "$slink.dpkg-tmp", "$altdir/$sname", $!));
             rename_mv("$slink.dpkg-tmp",$slink) ||
-                &quit("unable to install $slink.dpkg-tmp as $slink: $!");
+                &quit(sprintf(_g("unable to install %s as %s: %s"), "$slink.dpkg-tmp", $slink, $!));
         }
         $spath= $slavepath{$bestnum,$j};
         unlink("$altdir/$sname.dpkg-tmp") || $! == &ENOENT ||
-            &quit("unable to ensure $altdir/$sname.dpkg-tmp nonexistent: $!");
+            &quit(sprintf(_g("unable to ensure %s nonexistent: %s"), "$altdir/$sname.dpkg-tmp", $!));
         if ($spath eq '') {
-            &pr("Removing $sname ($slink), not appropriate with $best.")
+            &pr(sprintf(_g("Removing %s (%s), not appropriate with %s."), $sname, $slink, $best))
               if $verbosemode > 0;
             unlink("$altdir/$sname") || $! == &ENOENT ||
-                &quit("unable to remove $altdir/$sname: $!");
+                &quit(sprintf(_g("unable to remove %s: %s"), "$altdir/$sname", $!));
 	    unlink("$slink") || $! == &ENOENT ||
-	        &quit("unable to remove $slink: $!");
+	        &quit(sprintf(_g("unable to remove %s: %s"), $slink, $!));
         } else {
             if (defined($linkname= readlink("$altdir/$sname")) && $linkname eq $spath) {
-                &pr("Leaving $sname ($slink) pointing to $spath.")
+                &pr(sprintf(_g("Leaving %s (%s) pointing to %s."), $sname, $slink, $spath))
                   if $verbosemode > 0;
             } else {
-                &pr("Updating $sname ($slink) to point to $spath.")
+                &pr(sprintf(_g("Updating %s (%s) to point to %s."), $sname, $slink, $spath))
                   if $verbosemode > 0;
             }
             symlink("$spath","$altdir/$sname.dpkg-tmp") ||
-                &quit("unable to make $altdir/$sname.dpkg-tmp a symlink to $spath: $!");
+                &quit(sprintf(_g("unable to make %s a symlink to %s: %s"), "$altdir/$sname.dpkg-tmp", $spath, $!));
             rename_mv("$altdir/$sname.dpkg-tmp","$altdir/$sname") ||
-                &quit("unable to install $altdir/$sname.dpkg-tmp as $altdir/$sname: $!");
+                &quit(sprintf(_g("unable to install %s as %s: %s"), "$altdir/$sname.dpkg-tmp", "$altdir/$sname", $!));
         }
     }
 }
 
 sub config_message {
     if ($#versions == 0) {
-	print "\nThere is only 1 program which provides $name\n";
-	print "($versions[0]). Nothing to configure.\n";
+	print "\n";
+	printf _g("There is only 1 program which provides %s\n".
+	          "(%s). Nothing to configure.\n"), $name, $versions[0];
 	return;
     }
-    printf(STDOUT "\nThere are %s alternatives which provide \`$name'.\n\n", $#versions+1);
-    printf(STDOUT "  Selection    Alternative\n");
-    printf(STDOUT "-----------------------------------------------\n");
+    print STDOUT "\n";
+    printf(STDOUT _g("There are %s alternatives which provide \`%s'.\n\n".
+                     "  Selection    Alternative\n".
+                     "-----------------------------------------------\n"),
+                  $#versions+1, $name);
     for ($i=0; $i<=$#versions; $i++) {
 	printf(STDOUT "%s%s    %s        %s\n", 
 	    (readlink("$altdir/$name") eq $versions[$i]) ? '*' : ' ',
 	    ($best eq $versions[$i]) ? '+' : ' ',
 	    $i+1, $versions[$i]);
     }
-    printf(STDOUT "\nPress enter to keep the default[*], or type selection number: ");
+    printf(STDOUT "\n"._g("Press enter to keep the default[*], or type selection number: "));
 }
 
 sub config_alternatives {
@@ -546,12 +552,12 @@ sub config_alternatives {
     if ($preferred ne '') {
     	$manual = "manual";
 	$preferred--;
-	print STDOUT "Using \`$versions[$preferred]' to provide \`$name'.\n";
+	printf STDOUT _g("Using \`%s' to provide \`%s'.")."\n", $versions[$preferred], $name;
 	my $spath = $versions[$preferred];
 	symlink("$spath","$altdir/$name.dpkg-tmp") ||
-	    &quit("unable to make $altdir/$name.dpkg-tmp a symlink to $spath: $!");
+	    &quit(sprintf(_g("unable to make %s a symlink to %s: %s"), "$altdir/$name.dpkg-tmp", $spath, $!));
 	rename_mv("$altdir/$name.dpkg-tmp","$altdir/$name") ||
-	    &quit("unable to install $altdir/$name.dpkg-tmp as $altdir/$name: $!");
+	    &quit(sprintf(_g("unable to install %s as %s: %s"), "$altdir/$name.dpkg-tmp", "$altdir/$name", $!));
 	# Link slaves...
 	for( my $slnum = 0; $slnum < @slavenames; $slnum++ ) {
 	    my $slave = $slavenames[$slnum];
@@ -560,10 +566,10 @@ sub config_alternatives {
 			"$altdir/$slave.dpkg-tmp");
 		checked_mv("$altdir/$slave.dpkg-tmp", "$altdir/$slave");
 	    } else {
-		&pr("Removing $slave ($slavelinks[$slnum]), not appropriate with $versions[$preferred].")
+		&pr(sprintf(_g("Removing %s (%s), not appropriate with %s."), $slave, $slavelinks[$slnum], $versions[$preferred]))
 		    if $verbosemode > 0;
 		unlink("$altdir/$slave") || $! == &ENOENT ||
-		    &quit("unable to remove $altdir/$slave: $!");
+		    &quit(sprintf(_g("unable to remove %s: %s"), "$altdir/$slave", $!));
 	    }
 	}
 
@@ -581,13 +587,13 @@ sub set_alternatives {
      }
    }
    if($preferred == -1){
-     &quit("Cannot find alternative `$apath'.\n")
+     &quit(sprintf(_g("Cannot find alternative `%s'."), $apath)."\n")
    }
-   print STDOUT "Using \`$apath' to provide \`$name'.\n";
+   printf STDOUT _g("Using \`%s' to provide \`%s'.")."\n", $apath, $name;
    symlink("$apath","$altdir/$name.dpkg-tmp") ||
-     &quit("unable to make $altdir/$name.dpkg-tmp a symlink to $apath: $!");
+     &quit(sprintf(_g("unable to make %s a symlink to %s: %s"), "$altdir/$name.dpkg-tmp", $apath, $!));
    rename_mv("$altdir/$name.dpkg-tmp","$altdir/$name") ||
-     &quit("unable to install $altdir/$name.dpkg-tmp as $altdir/$name: $!");
+     &quit(sprintf(_g("unable to install %s as %s: %s"), "$altdir/$name.dpkg-tmp", "$altdir/$name", $!));
    # Link slaves...
    for( $slnum = 0; $slnum < @slavenames; $slnum++ ) {
      $slave = $slavenames[$slnum];
@@ -596,27 +602,27 @@ sub set_alternatives {
 		       "$altdir/$slave.dpkg-tmp");
        checked_mv("$altdir/$slave.dpkg-tmp", "$altdir/$slave");
      } else {
-       &pr("Removing $slave ($slavelinks[$slnum]), not appropriate with $versions[$preferred].")
+       &pr(sprintf(_g("Removing %s (%s), not appropriate with %s."), $slave, $slavelinks[$slnum], $versions[$preferred]))
 	 if $verbosemode > 0;
        unlink("$altdir/$slave") || $! == &ENOENT ||
-	 &quit("unable to remove $altdir/$slave: $!");
+	 &quit(sprintf(_g("unable to remove %s: %s"), "$altdir/$slave", $!));
      }
    }
 }
 
-sub pr { print(STDOUT "@_\n") || &quit("error writing stdout: $!"); }
+sub pr { print(STDOUT "@_\n") || &quit(sprintf(_g("error writing stdout: %s"), $!)); }
 sub paf {
-    $_[0] =~ m/\n/ && &quit("newlines prohibited in update-alternatives files ($_[0])");
-    print(AF "$_[0]\n") || &quit("error writing stdout: $!");
+    $_[0] =~ m/\n/ && &quit(sprintf(_g("newlines prohibited in update-alternatives files (%s)"), $_[0]));
+    print(AF "$_[0]\n") || &quit(sprintf(_g("error writing stdout: %s"), $!));
 }
 sub gl {
     $!=0; $_= <AF>;
-    length($_) || &quit("error or eof reading $admindir/$name for $_[0] ($!)");
-    s/\n$// || &badfmt("missing newline after $_[0]");
+    length($_) || &quit(sprintf(_g("error or eof reading %s for %s (%s)"), "$admindir/$name", $_[0], $!));
+    s/\n$// || &badfmt(sprintf(_g("missing newline after %s"), $_[0]));
     $_;
 }
 sub badfmt {
-    &quit("internal error: $admindir/$name corrupt: $_[0]");
+    &quit(sprintf(_g("internal error: %s corrupt: %s"), "$admindir/$name", $_[0]));
 }
 sub rename_mv {
     return (rename($_[0], $_[1]) || (system(("mv", $_[0], $_[1])) == 0));
@@ -624,15 +630,15 @@ sub rename_mv {
 sub checked_symlink {
     my ($filename, $linkname) = @_;
     symlink($filename, $linkname) ||
-	&quit("unable to make $linkname a symlink to $filename: $!");
+	&quit(sprintf(_g("unable to make %s a symlink to %s: %s"), $linkname, $filename, $!));
 }
 sub checked_mv {
     my ($source, $dest) = @_;
     rename_mv($source, $dest) ||
-	&quit("unable to install $source as $dest: $!");
+	&quit(sprintf(_g("unable to install %s as %s: %s"), $source, $dest, $!));
 }
 sub config_all {
-    opendir ADMINDIR, $admindir or die "Serious problem: $!";
+    opendir ADMINDIR, $admindir or die sprintf(_g("Serious problem: %s"), $!);
     my @filenames = grep !/^\.\.?$/, readdir ADMINDIR;
     close ADMINDIR;
     foreach my $name (@filenames) {