From 4dced80cecfa084e43e44a448543362388743724 Mon Sep 17 00:00:00 2001 From: Guillem Jover Date: Thu, 18 Oct 2007 04:22:09 +0300 Subject: [PATCH] Dpkg::ErrorHandling: Add support for format strings --- ChangeLog | 9 + debian/changelog | 1 + scripts/Dpkg/ErrorHandling.pm | 68 +++-- scripts/controllib.pl | 48 ++-- scripts/dpkg-architecture.pl | 15 +- scripts/dpkg-buildpackage.pl | 14 +- scripts/dpkg-checkbuilddeps.pl | 3 +- scripts/dpkg-distaddfile.pl | 2 +- scripts/dpkg-genchanges.pl | 65 ++--- scripts/dpkg-gencontrol.pl | 49 ++-- scripts/dpkg-gensymbols.pl | 18 +- scripts/dpkg-parsechangelog.pl | 13 +- scripts/dpkg-shlibdeps.pl | 53 ++-- scripts/dpkg-source.pl | 447 ++++++++++++++++++--------------- 14 files changed, 463 insertions(+), 342 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1b4e1958..e2b63712 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2007-10-18 Guillem Jover + + * scripts/Dpkg/ErrorHandling.pm (report): New function. + (warning, warnerror, failure, syserr, error, internerr, unknown) + (usageerr): Use report instead of sprintf. Accept a format string + with variable number of arguments. Fix all callers. + (subprocerr): Use failure instead of die and sprintf. Accept a + format string with variable number of arguments. Fix all callers. + 2007-10-18 Guillem Jover * scripts/dpkg-buildpackage.pl (mustsetvar): Pass $text to sprintf diff --git a/debian/changelog b/debian/changelog index d8028141..3c953357 100644 --- a/debian/changelog +++ b/debian/changelog @@ -44,6 +44,7 @@ dpkg (1.14.8) UNRELEASED; urgency=low * Use shipped perl modules when calling perl programs at build time. * Switch perl programs to use the new Dpkg/ErrorHandling module. * Switch perl programs to use the new Dpkg/Arch module. + * Add support for format strings in Dpkg::ErrorHandling functions. [ Updated dpkg translations ] * Polish (Robert Luberda). diff --git a/scripts/Dpkg/ErrorHandling.pm b/scripts/Dpkg/ErrorHandling.pm index 663927ab..8297859f 100644 --- a/scripts/Dpkg/ErrorHandling.pm +++ b/scripts/Dpkg/ErrorHandling.pm @@ -10,19 +10,20 @@ our @EXPORT_OK = qw(warning warnerror error failure unknown syserr internerr our $warnable_error = 1; our $quiet_warnings = 0; -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 report(@) +{ + my ($type, $msg) = (shift, shift); + + $msg = sprintf($msg, @_) if (@_); + return "$progname: $type: $msg\n"; +} -sub warning +sub warning($;@) { - if (!$quiet_warnings) { - warn sprintf(_g("%s: warning: %s"), $progname, $_[0])."\n"; - } + warn report(_g("warning"), @_) if (!$quiet_warnings); } -sub warnerror +sub warnerror(@) { if ($warnable_error) { warning(@_); @@ -31,28 +32,53 @@ sub warnerror } } -sub unknown { +sub failure($;@) +{ + die report(_g("failure"), @_); +} + +sub syserr($;@) +{ + my $msg = shift; + die report(_g("failure"), "$msg: $!", @_); +} + +sub error($;@) +{ + die report(_g("error"), @_); +} + +sub internerr($;@) +{ + die report(_g("internal error"), @_); +} + +sub unknown($) +{ + # XXX: implicit argument my $field = $_; - warning(sprintf(_g("unknown information field '%s' in input data in %s"), - $field, $_[0])); + warning(_g("unknown information field '%s' in input data in %s"), + $field, $_[0]); } -sub subprocerr { - my ($p) = @_; +sub subprocerr(@) +{ + my ($p) = (shift); + + $p = sprintf($p, @_) if (@_); + require POSIX; + if (POSIX::WIFEXITED($?)) { - die sprintf(_g("%s: failure: %s gave error exit status %s"), - $progname, $p, POSIX::WEXITSTATUS($?))."\n"; + failure(_g("%s gave error exit status %s"), $p, POSIX::WEXITSTATUS($?)); } elsif (POSIX::WIFSIGNALED($?)) { - die sprintf(_g("%s: failure: %s died from signal %s"), - $progname, $p, POSIX::WTERMSIG($?))."\n"; + failure(_g("%s died from signal %s"), $p, POSIX::WTERMSIG($?)); } else { - die sprintf(_g("%s: failure: %s failed with unknown exit code %d"), - $progname, $p, $?)."\n"; + failure(_g("%s failed with unknown exit code %d"), $p, $?); } } -sub usageerr +sub usageerr(@) { printf(STDERR "%s: %s\n\n", $progname, "@_"); # XXX: access to main namespace diff --git a/scripts/controllib.pl b/scripts/controllib.pl index 5cd55eb2..ee65d2cc 100755 --- a/scripts/controllib.pl +++ b/scripts/controllib.pl @@ -68,7 +68,8 @@ sub getfowner die(sprintf(_g('unable to get login information for username "%s"'), $getlogin)); } } else { - warning(sprintf(_g('no utmp entry available and LOGNAME not defined; using uid of process (%d)'), $<)); + warning(_g('no utmp entry available and LOGNAME not defined; ' . + 'using uid of process (%d)'), $<); @fowner = getpwuid($<); if (!@fowner) { die (sprintf(_g('unable to get login information for uid %d'), $<)); @@ -97,13 +98,13 @@ sub substvars { $count= 0 if (length($POSTMATCH) < length($rhs)); $count < $maxsubsts || - &error(sprintf(_g("too many substitutions - recursive ? - in \`%s'"), $v)); + error(_g("too many substitutions - recursive ? - in \`%s'"), $v); $lhs=$`; $vn=$1; $rhs=$'; if (defined($substvar{$vn})) { $v= $lhs.$substvar{$vn}.$rhs; $count++; } else { - warning(sprintf(_g("unknown substitution variable \${%s}"), $vn)); + warning(_g("unknown substitution variable \${%s}"), $vn); $v= $lhs.$rhs; } } @@ -150,9 +151,13 @@ sub outputclose { $v= &substvars($v); } $v =~ m/\S/ || next; # delete whitespace-only fields - $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)); + $v =~ m/\n\S/ && + internerr(_g("field %s has newline then non whitespace >%s<"), + $f, $v); + $v =~ m/\n[ \t]*\n/ && + internerr(_g("field %s has blank lines >%s<"), $f, $v); + $v =~ m/\n$/ && + internerr(_g("field %s has trailing newline >%s<"), $f, $v); if (defined($varlistfile)) { $v =~ s/,[\s,]*,/,/g; $v =~ s/^\s*,\s*//; @@ -170,7 +175,8 @@ sub parsecontrolfile { $controlfile="./$controlfile" if $controlfile =~ m/^\s/; - open(CDATA,"< $controlfile") || &error(sprintf(_g("cannot read control file %s: %s"), $controlfile, $!)); + open(CDATA, "< $controlfile") || + error(_g("cannot read control file %s: %s"), $controlfile, $!); binmode(CDATA); my $indices = parsecdata(\*CDATA, 'C', 1, sprintf(_g("control file %s"), $controlfile)); @@ -178,9 +184,8 @@ sub parsecontrolfile { for (my $i = 1; $i < $indices; $i++) { defined($fi{"C$i Package"}) || - &error(sprintf(_g("per-package paragraph %d in control ". - "info file is missing Package line"), - $i)); + error(_g("per-package paragraph %d in control " . + "info file is missing Package line"), $i); } defined($fi{"C Source"}) || &error(_g("source paragraph in control info file is ". @@ -200,14 +205,13 @@ sub parsesubstvars { next if m/^\#/ || !m/\S/; s/\s*\n$//; m/^(\w[-:0-9A-Za-z]*)\=/ || - &error(sprintf(_g("bad line in substvars file %s at line %d"), - $varlistfile, $.)); + error(_g("bad line in substvars file %s at line %d"), + $varlistfile, $.); $substvar{$1}= $'; } close(SV); } elsif ($! != ENOENT ) { - &error(sprintf(_g("unable to open substvars file %s: %s"), - $varlistfile, $!)); + error(_g("unable to open substvars file %s: %s"), $varlistfile, $!); } $substvarsparsed = 1; } @@ -258,7 +262,7 @@ ALTERNATE: } } if (length($dep_or)) { - warning(sprintf(_g("can't parse dependency %s"), $dep_and)); + warning(_g("can't parse dependency %s"), $dep_and); return undef; } push @or_list, [ $package, $relation, $version, \@arches ]; @@ -329,15 +333,16 @@ sub init_substvar_arch() sub checkpackagename { my $name = shift || ''; $name =~ m/[^-+.0-9a-z]/o && - &error(sprintf(_g("source package name `%s' contains illegal character `%s'"), $name, $&)); + error(_g("source package name `%s' contains illegal character `%s'"), + $name, $&); $name =~ m/^[0-9a-z]/o || - &error(sprintf(_g("source package name `%s' starts with non-alphanum"), $name)); + error(_g("source package name `%s' starts with non-alphanum"), $name); } sub checkversion { my $version = shift || ''; $version =~ m/[^-+:.0-9a-zA-Z~]/o && - &error(sprintf(_g("version number contains illegal character `%s'"), $&)); + error(_g("version number contains illegal character `%s'"), $&); } sub setsourcepackage { @@ -346,7 +351,8 @@ sub setsourcepackage { checkpackagename( $v ); if (defined($sourcepackage)) { $v eq $sourcepackage || - &error(sprintf(_g("source package has two conflicting values - %s and %s"), $sourcepackage, $v)); + error(_g("source package has two conflicting values - %s and %s"), + $sourcepackage, $v); } else { $sourcepackage= $v; } @@ -355,7 +361,7 @@ sub setsourcepackage { sub readmd5sum { (my $md5sum = shift) or return; $md5sum =~ s/^([0-9a-f]{32})\s*\*?-?\s*\n?$/$1/o - || &failure(sprintf(_g("md5sum gave bogus output `%s'"), $md5sum)); + || failure(_g("md5sum gave bogus output `%s'"), $md5sum); return $md5sum; } @@ -424,7 +430,7 @@ sub parsecdata { } sub syntax { - &error(sprintf(_g("syntax error in %s at line %d: %s"), $whatmsg, $., $_[0])); + error(_g("syntax error in %s at line %d: %s"), $whatmsg, $., $_[0]); } 1; diff --git a/scripts/dpkg-architecture.pl b/scripts/dpkg-architecture.pl index e59ad14d..e44d50ff 100755 --- a/scripts/dpkg-architecture.pl +++ b/scripts/dpkg-architecture.pl @@ -97,7 +97,8 @@ if ($gcc ne '') { my (@deb_host_archtriplet) = gnutriplet_to_debtriplet($gcc); $deb_host_arch = debtriplet_to_debarch(@deb_host_archtriplet); unless (defined $deb_host_arch) { - warning(sprintf(_g("Unknown gcc system type %s, falling back to default (native compilation)"), $gcc)); + warning(_g("Unknown gcc system type %s, falling back to default " . + "(native compilation)"), $gcc); $gcc = ''; } else { $gcc = $deb_host_gnu_type = debtriplet_to_gnutriplet(@deb_host_archtriplet); @@ -151,7 +152,7 @@ while (@ARGV) { &version; exit 0; } else { - usageerr(sprintf(_g("unknown option \`%s'"), $_)); + usageerr(_g("unknown option \`%s'"), $_); } } @@ -170,7 +171,10 @@ if ($req_host_gnu_type ne '' && $req_host_arch ne '') { die (sprintf(_g("unknown default GNU system type for Debian architecture %s"), $req_host_arch)) unless defined $dfl_host_gnu_type; - warning(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; + warning(_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 ''; @@ -178,7 +182,10 @@ $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; -warning(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); +warning(_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 my ($deb_host_arch_abi, $deb_host_arch_os, $deb_host_arch_cpu) = debarch_to_debtriplet($deb_host_arch); diff --git a/scripts/dpkg-buildpackage.pl b/scripts/dpkg-buildpackage.pl index 578dc717..cd626733 100755 --- a/scripts/dpkg-buildpackage.pl +++ b/scripts/dpkg-buildpackage.pl @@ -156,7 +156,7 @@ while (@ARGV) { } elsif (/^-nc$/) { $noclean = 1; if ($sourceonly) { - usageerr(sprintf(_g("cannot combine %s and %s"), '-nc', '-S')); + usageerr(_g("cannot combine %s and %s"), '-nc', '-S'); } unless ($binaryonly) { $binaryonly = '-b'; @@ -166,20 +166,20 @@ while (@ARGV) { @checkbuilddep_args = (); $binarytarget = 'binary'; if ($sourceonly) { - usageerr(sprintf(_g("cannot combine %s and %s"), '-b', '-S')); + usageerr(_g("cannot combine %s and %s"), '-b', '-S'); } } elsif (/^-B$/) { $binaryonly = '-B'; @checkbuilddep_args = ('-B'); $binarytarget = 'binary-arch'; if ($sourceonly) { - usageerr(sprintf(_g("cannot combine %s and %s"), '-B', '-S')); + usageerr(_g("cannot combine %s and %s"), '-B', '-S'); } } elsif (/^-S$/) { $sourceonly = '-S'; $checkbuilddep = 0; if ($binaryonly) { - usageerr(sprintf(_g("cannot combine %s and %s"), $binaryonly, '-S')); + usageerr(_g("cannot combine %s and %s"), $binaryonly, '-S'); } } elsif (/^-v(.*)$/) { $since = $1; @@ -196,7 +196,7 @@ while (@ARGV) { $warnable_error = 0; push @passopts, '-E'; } else { - usageerr(sprintf(_g("unknown option or argument %s"), $_)); + usageerr(_g("unknown option or argument %s"), $_); } } @@ -211,7 +211,7 @@ if ($< == 0) { "package, specify a command with the -r option, " . "or run this as root")); } else { - error(sprintf(_g("gain-root-commmand '%s' not found"), $rootcommand)); + error(_g("gain-root-commmand '%s' not found"), $rootcommand); } } } @@ -266,7 +266,7 @@ close CHANGELOG or subprocerr('dpkg-parsechangelog'); sub mustsetvar { my ($var, $text) = @_; - error(sprintf(_g("unable to determine %s"), $text)) + error(_g("unable to determine %s"), $text) unless defined($var); print "$progname: $text $var\n"; diff --git a/scripts/dpkg-checkbuilddeps.pl b/scripts/dpkg-checkbuilddeps.pl index db28b104..e82b46b1 100755 --- a/scripts/dpkg-checkbuilddeps.pl +++ b/scripts/dpkg-checkbuilddeps.pl @@ -150,8 +150,7 @@ sub check_line { my @unmet=(); unless(defined($dep_list)) { - &error(sprintf(_g("error occurred while parsing %s"), - $fieldname)); + error(_g("error occurred while parsing %s"), $fieldname); } foreach my $dep_and (@$dep_list) { diff --git a/scripts/dpkg-distaddfile.pl b/scripts/dpkg-distaddfile.pl index 584ac667..8ea66951 100755 --- a/scripts/dpkg-distaddfile.pl +++ b/scripts/dpkg-distaddfile.pl @@ -51,7 +51,7 @@ while (@ARGV && $ARGV[0] =~ m/^-/) { } elsif (m/^--$/) { last; } else { - &usageerr(sprintf(_g("unknown option \`%s'"), $_)); + usageerr(_g("unknown option \`%s'"), $_); } } diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl index 107c9cfc..5b577aac 100755 --- a/scripts/dpkg-genchanges.pl +++ b/scripts/dpkg-genchanges.pl @@ -157,7 +157,7 @@ while (@ARGV) { } elsif (m/^--version$/) { &version; exit(0); } else { - &usageerr(sprintf(_g("unknown option \`%s'"), $_)); + usageerr(_g("unknown option \`%s'"), $_); } } @@ -170,13 +170,15 @@ if (not $sourceonly) { while() { if (m/^(([-+.0-9a-z]+)_([^_]+)_([-\w]+)\.u?deb) (\S+) (\S+)$/) { defined($p2f{"$2 $4"}) && - warning(sprintf(_g("duplicate files list entry for package %s (line %d)"), $2, $.)); + warning(_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}) && - warning(sprintf(_g("duplicate files list entry for file %s (line %d)"), $1, $.)); + warning(_g("duplicate files list entry for file %s (line %d)"), + $1, $.); $f2sec{$1}= $5; $f2pri{$1}= $6; push(@fileslistfiles,$1); @@ -188,12 +190,13 @@ if (not $sourceonly) { push(@fileslistfiles,$1); } elsif (m/^([-+.,_0-9a-zA-Z]+) (\S+) (\S+)$/) { defined($f2sec{$1}) && - warning(sprintf(_g("duplicate files list entry for file %s (line %d)"), $1, $.)); + warning(_g("duplicate files list entry for file %s (line %d)"), + $1, $.); $f2sec{$1}= $2; $f2pri{$1}= $3; push(@fileslistfiles,$1); } else { - &error(sprintf(_g("badly formed line in files list file, line %d"), $.)); + error(_g("badly formed line in files list file, line %d"), $.); } } close(FL); @@ -224,7 +227,8 @@ for $_ (keys %fi) { if (!defined($p2f{$p}) && not $sourceonly) { if ((debarch_eq('all', $a) && !$archspecific) || grep(debarch_is($host_arch, $_), split(/\s+/, $a))) { - warning(sprintf(_g("package %s in control file but not in files list"), $p)); + warning(_g("package %s in control file but not in files list"), + $p); next; } } else { @@ -277,7 +281,8 @@ for $_ (keys %fi) { } } elsif (m/^o:.*/) { } else { - &internerr(sprintf(_g("value from nowhere, with key >%s< and value >%s<"), $_, $v)); + internerr(_g("value from nowhere, with key >%s< and value >%s<"), + $_, $v); } } @@ -295,7 +300,8 @@ if ($changesdescription) { for my $p (keys %p2f) { my ($pp, $aa) = (split / /, $p); defined($p2i{"C $pp"}) || - warning(sprintf(_g("package %s listed in files list but not in control info"), $pp)); + warning(_g("package %s listed in files list but not in control info"), + $pp); } for my $p (keys %p2f) { @@ -305,20 +311,20 @@ for my $p (keys %p2f) { $sec = $sourcedefault{'Section'} if !defined($sec); if (!defined($sec)) { $sec = '-'; - warning(sprintf(_g("missing Section for binary package %s; using '-'"), $p)); + warning(_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})); + $sec eq $f2sec{$f} || error(_g("package %s has section %s in " . + "control file but %s in files list"), + $p, $sec, $f2sec{$f}); my $pri = $f2pricf{$f}; $pri = $sourcedefault{'Priority'} if !defined($pri); if (!defined($pri)) { $pri = '-'; - warning(sprintf(_g("missing Priority for binary package %s; using '-'"), $p)); + warning(_g("missing Priority for binary package %s; using '-'"), $p); } - $pri eq $f2pri{$f} || &error(sprintf(_g("package %s has priority %s in ". - "control file but %s in files list"), - $p, $pri, $f2pri{$f})); + $pri eq $f2pri{$f} || error(_g("package %s has priority %s in " . + "control file but %s in files list"), + $p, $pri, $f2pri{$f}); } &init_substvars; @@ -340,7 +346,7 @@ if (!$binaryonly) { (my $sversion = $substvar{'source:Version'}) =~ s/^\d+://; $dsc= "$uploadfilesdir/${sourcepackage}_${sversion}.dsc"; - open(CDATA,"< $dsc") || &error(sprintf(_g("cannot open .dsc file %s: %s"), $dsc, $!)); + open(CDATA,"< $dsc") || error(_g("cannot open .dsc file %s: %s"), $dsc, $!); push(@sourcefiles,"${sourcepackage}_${sversion}.dsc"); parsecdata(\*CDATA, 'S', -1, sprintf(_g("source control file %s"), $dsc)); @@ -349,7 +355,7 @@ if (!$binaryonly) { for my $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(sprintf(_g("Files field contains bad line \`%s'"), $file)); + || error(_g("Files field contains bad line \`%s'"), $file); ($md5sum{$2},$file) = ($1,$2); push(@sourcefiles,$file); } @@ -399,19 +405,20 @@ for my $f (@sourcefiles, @fileslistfiles) { next if ($archspecific && debarch_eq('all', $p2arch{$f2p{$f}})); next if $filedone{$f}++; my $uf = "$uploadfilesdir/$f"; - open(STDIN,"< $uf") || &syserr(sprintf(_g("cannot open upload file %s for reading"), $uf)); - (my @s = stat(STDIN)) || syserr(sprintf(_g("cannot fstat upload file %s"), $uf)); + open(STDIN, "< $uf") || + syserr(_g("cannot open upload file %s for reading"), $uf); + (my @s = stat(STDIN)) || syserr(_g("cannot fstat upload file %s"), $uf); my $size = $s[7]; - $size || warn(sprintf(_g("upload file %s is empty"), $uf)); + $size || warning(_g("upload file %s is empty"), $uf); my $md5sum = `md5sum`; - $? && subprocerr(sprintf(_g("md5sum upload file %s"), $uf)); + $? && subprocerr(_g("md5sum upload file %s"), $uf); $md5sum =~ m/^([0-9a-f]{32})\s*-?\s*$/i || - &failure(sprintf(_g("md5sum upload file %s gave strange output \`%s'"), $uf, $md5sum)); + failure(_g("md5sum upload file %s gave strange output \`%s'"), + $uf, $md5sum); $md5sum= $1; defined($md5sum{$f}) && $md5sum{$f} ne $md5sum && - &error(sprintf(_g("md5sum of source file %s (%s) is different ". - "from md5sum in %s (%s)"), - $uf, $md5sum, $dsc, $md5sum{$f})); + error(_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"; } @@ -424,11 +431,13 @@ $f{'Maintainer'} = $forcemaint if defined($forcemaint); $f{'Changed-By'} = $forcechangedby if defined($forcechangedby); for my $f (qw(Version Distribution Maintainer Changes)) { - defined($f{$f}) || &error(sprintf(_g("missing information for critical output field %s"), $f)); + defined($f{$f}) || + error(_g("missing information for critical output field %s"), $f); } for my $f (qw(Urgency)) { - defined($f{$f}) || warning(sprintf(_g("missing information for output field %s"), $f)); + defined($f{$f}) || + warning(_g("missing information for output field %s"), $f); } for my $f (keys %override) { diff --git a/scripts/dpkg-gencontrol.pl b/scripts/dpkg-gencontrol.pl index 4cae8e7b..9135da1b 100755 --- a/scripts/dpkg-gencontrol.pl +++ b/scripts/dpkg-gencontrol.pl @@ -86,7 +86,7 @@ while (@ARGV) { if (m/^-p([-+0-9a-z.]+)$/) { $oppackage= $1; } elsif (m/^-p(.*)/) { - &error(sprintf(_g("Illegal package name \`%s'"), $1)); + error(_g("Illegal package name \`%s'"), $1); } elsif (m/^-c/) { $controlfile= $'; } elsif (m/^-l/) { @@ -118,7 +118,7 @@ while (@ARGV) { } elsif (m/^--version$/) { &version; exit(0); } else { - &usageerr(sprintf(_g("unknown option \`%s'"), $_)); + usageerr(_g("unknown option \`%s'"), $_); } } @@ -129,12 +129,14 @@ parsecontrolfile($controlfile); my $myindex; if (defined($oppackage)) { - defined($p2i{"C $oppackage"}) || &error(sprintf(_g("package %s not in control info"), $oppackage)); + defined($p2i{"C $oppackage"}) || + error(_g("package %s not in control info"), $oppackage); $myindex= $p2i{"C $oppackage"}; } else { my @packages = grep(m/^C /, keys %p2i); @packages==1 || - &error(sprintf(_g("must specify package since control info has many (%s)"), "@packages")); + error(_g("must specify package since control info has many (%s)"), + "@packages"); $myindex=1; } @@ -179,17 +181,15 @@ for $_ (keys %fi) { } else { my @archlist = split(/\s+/, $v); my @invalid_archs = grep m/[^\w-]/, @archlist; - warning(sprintf(ngettext( - "`%s' is not a legal architecture string.", - "`%s' are not legal architecture strings.", - scalar(@invalid_archs)), - join("' `", @invalid_archs))) + warning(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(debarch_is($host_arch, $_), @archlist) || - error(sprintf(_g("current host architecture '%s' does " . - "not appear in package's architecture " . - "list (%s)"), - $host_arch, "@archlist")); + error(_g("current host architecture '%s' does not " . + "appear in package's architecture list (%s)"), + $host_arch, "@archlist"); $f{$_} = $host_arch; } } elsif (s/^X[CS]*B[CS]*-//i) { @@ -214,7 +214,7 @@ for $_ (keys %fi) { } } elsif (m/o:/) { } else { - &internerr(sprintf(_g("value from nowhere, with key >%s< and value >%s<"), $_, $v)); + internerr(_g("value from nowhere, with key >%s< and value >%s<"), $_, $v); } } @@ -232,7 +232,8 @@ for $_ (keys %fi) { if (s/^C$myindex //) { if (exists($pkg_dep_fields{$_})) { my $dep = parsedep(substvars($v), 1, 1); - &error(sprintf(_g("error occurred while parsing %s"), $_)) unless defined $dep; + error(_g("error occurred while parsing %s"), $_) + unless defined $dep; $f{$_}= showdep($dep, 0); } } @@ -245,10 +246,10 @@ for my $f (qw(Section Priority)) { } for my $f (qw(Package Version)) { - defined($f{$f}) || &error(sprintf(_g("missing information for output field %s"), $f)); + defined($f{$f}) || error(_g("missing information for output field %s"), $f); } for my $f (qw(Maintainer Description Architecture)) { - defined($f{$f}) || warning(sprintf(_g("missing information for output field %s"), $f)); + defined($f{$f}) || warning(_g("missing information for output field %s"), $f); } $oppackage= $f{'Package'}; @@ -262,15 +263,18 @@ if ($oppackage ne $sourcepackage || $verdiff) { if (!defined($substvar{'Installed-Size'})) { defined(my $c = open(DU, "-|")) || syserr(_g("fork for du")); if (!$c) { - chdir("$packagebuilddir") || &syserr(sprintf(_g("chdir for du to \`%s'"), $packagebuilddir)); + chdir("$packagebuilddir") || + syserr(_g("chdir for du to \`%s'"), $packagebuilddir); exec("du","-k","-s",".") or &syserr(_g("exec du")); } my $duo = ''; while () { $duo .= $_; } - close(DU); $? && &subprocerr(sprintf(_g("du in \`%s'"), $packagebuilddir)); - $duo =~ m/^(\d+)\s+\.$/ || &failure(sprintf(_g("du gave unexpected output \`%s'"), $duo)); + close(DU); + $? && subprocerr(_g("du in \`%s'"), $packagebuilddir); + $duo =~ m/^(\d+)\s+\.$/ || + failure(_g("du gave unexpected output \`%s'"), $duo); $substvar{'Installed-Size'}= $1; } if (defined($substvar{'Extra-Size'})) { @@ -321,7 +325,7 @@ if (!$stdout) { $cf= "$packagebuilddir/DEBIAN/control"; $cf= "./$cf" if $cf =~ m/^\s/; open(STDOUT,"> $cf.new") || - &syserr(sprintf(_g("cannot open new output control file \`%s'"), "$cf.new")); + syserr(_g("cannot open new output control file \`%s'"), "$cf.new"); binmode(STDOUT); } @@ -329,7 +333,8 @@ set_field_importance(@control_fields); outputclose($varlistfile); if (!$stdout) { - rename("$cf.new","$cf") || &syserr(sprintf(_g("cannot install output control file \`%s'"), $cf)); + rename("$cf.new", "$cf") || + syserr(_g("cannot install output control file \`%s'"), $cf); } sub spfileslistvalue { diff --git a/scripts/dpkg-gensymbols.pl b/scripts/dpkg-gensymbols.pl index 27cb33a8..8186e14c 100755 --- a/scripts/dpkg-gensymbols.pl +++ b/scripts/dpkg-gensymbols.pl @@ -88,7 +88,7 @@ while (@ARGV) { push @files, glob($file); } } elsif (m/^-p(.*)/) { - &error(sprintf(_g("Illegal package name \`%s'"), $1)); + error(_g("Illegal package name \`%s'"), $1); } elsif (m/^-P(.*)$/) { $packagebuilddir = $1; $packagebuilddir =~ s{/+$}{}; @@ -101,7 +101,7 @@ while (@ARGV) { } elsif (m/^--version$/) { &version; exit(0); } else { - &usageerr(sprintf(_g("unknown option \`%s'"), $_)); + usageerr(_g("unknown option \`%s'"), $_); } } @@ -113,7 +113,8 @@ if (not defined($oppackage)) { parsecontrolfile($controlfile); my @packages = grep(m/^C /, keys %p2i); @packages==1 || - &error(sprintf(_g("must specify package since control info has many (%s)"), "@packages")); + error(_g("must specify package since control info has many (%s)"), + "@packages"); $oppackage = $packages[0]; $oppackage =~ s/^C //; } @@ -140,7 +141,7 @@ if (not scalar @files) { $libdir =~ s{/+}{/}g; next if not -d $libdir; opendir(DIR, "$libdir") || - syserr(sprintf(_g("Can't read directory %s: %s"), $libdir, $!)); + syserr(_g("Can't read directory %s: %s"), $libdir, $!); push @files, grep { /(\.so\.|\.so$)/ && -f $_ && Dpkg::Shlibs::Objdump::is_elf($_); @@ -155,7 +156,7 @@ foreach my $file (@files) { print "Scanning $file for symbol information\n" if $debug; my $objid = $od->parse($file); unless (defined($objid) && $objid) { - warning(sprintf(_g("Objdump couldn't parse %s\n"), $file)); + warning(_g("Objdump couldn't parse %s\n"), $file); next; } my $object = $od->get_object($objid); @@ -222,10 +223,11 @@ if ($compare) { $md5_after->addfile($after); if ($md5_before->hexdigest() ne $md5_after->hexdigest()) { if (defined($ref_symfile->{file})) { - warning(sprintf(_g("%s doesn't match completely %s\n"), - $output, $ref_symfile->{file})); + warning(_g("%s doesn't match completely %s\n"), + $output, $ref_symfile->{file}); } else { - warning(sprintf(_g("no debian/symbols file used as basis for generating %s\n"), $output)); + warning(_g("no debian/symbols file used as basis for generating %s\n"), + $output); } my ($a, $b) = ($before->filename, $after->filename); system("diff", "-u", $a, $b) if -x "/usr/bin/diff"; diff --git a/scripts/dpkg-parsechangelog.pl b/scripts/dpkg-parsechangelog.pl index a95f2136..64340c06 100755 --- a/scripts/dpkg-parsechangelog.pl +++ b/scripts/dpkg-parsechangelog.pl @@ -62,18 +62,19 @@ while (@ARGV) { &usageerr("unknown option \`$_'"); } -@ARGV && &usageerr(sprintf(_g("%s takes no non-option arguments"), $progname)); +@ARGV && usageerr(_g("%s takes no non-option arguments"), $progname); $changelogfile= "./$changelogfile" if $changelogfile =~ m/^\s/; if (not $force and $changelogfile ne "-") { open(STDIN,"< $changelogfile") || - &error(sprintf(_g("cannot open %s to find format: %s"), $changelogfile, $!)); + error(_g("cannot open %s to find format: %s"), $changelogfile, $!); open(P,"tail -n 40 |") || die sprintf(_g("cannot fork: %s"), $!)."\n"; while(

) { next unless m/\schangelog-format:\s+([0-9a-z]+)\W/; $format=$1; } - close(P); $? && &subprocerr(sprintf(_g("tail of %s"), $changelogfile)); + close(P); + $? && subprocerr(_g("tail of %s"), $changelogfile); } my ($pa, $pf); @@ -81,16 +82,16 @@ my ($pa, $pf); for my $pd (@parserpath) { $pa= "$pd/$format"; if (!stat("$pa")) { - $! == ENOENT || &syserr(sprintf(_g("failed to check for format parser %s"), $pa)); + $! == ENOENT || syserr(_g("failed to check for format parser %s"), $pa); } elsif (!-x _) { - warning(sprintf(_g("format parser %s not executable"), $pa)); + warning(_g("format parser %s not executable"), $pa); } else { $pf= $pa; last; } } -defined($pf) || &error(sprintf(_g("format %s unknown"), $pa)); +defined($pf) || error(_g("format %s unknown"), $pa); if ($changelogfile ne "-") { open(STDIN,"< $changelogfile") || die sprintf(_g("cannot open %s: %s"), $changelogfile, $!)."\n"; diff --git a/scripts/dpkg-shlibdeps.pl b/scripts/dpkg-shlibdeps.pl index 7f9c381e..e152e0ff 100755 --- a/scripts/dpkg-shlibdeps.pl +++ b/scripts/dpkg-shlibdeps.pl @@ -57,12 +57,11 @@ foreach (@ARGV) { } elsif (m/^--admindir=(.*)$/) { $admindir = $1; -d $admindir || - error(sprintf(_g("administrative directory '%s' does not exist"), - $admindir)); + error(_g("administrative directory '%s' does not exist"), $admindir); } elsif (m/^-d(.*)$/) { $dependencyfield= capit($1); defined($depstrength{$dependencyfield}) || - warning(sprintf(_g("unrecognised dependency field \`%s'"), $dependencyfield)); + warning(_g("unrecognised dependency field \`%s'"), $dependencyfield); } elsif (m/^-e(.*)$/) { $exec{$1} = $dependencyfield; } elsif (m/^--ignore-missing-info$/) { @@ -74,7 +73,7 @@ foreach (@ARGV) { } elsif (m/^-x(.*)$/) { push @exclude, $1; } elsif (m/^-/) { - usageerr(sprintf(_g("unknown option \`%s'"), $_)); + usageerr(_g("unknown option \`%s'"), $_); } else { $exec{$_} = $dependencyfield; } @@ -97,7 +96,9 @@ foreach my $file (keys %exec) { my %libfiles; foreach my $soname (@sonames) { my $lib = my_find_library($soname, $obj->{RPATH}, $obj->{format}, $file); - failure(sprintf(_g("couldn't find library %s (note: only packages with 'shlibs' files are looked into)."), $soname)) unless defined($lib); + failure(_g("couldn't find library %s (note: only packages with " . + "'shlibs' files are looked into)."), $soname) + unless defined($lib); $libfiles{$lib} = $soname if defined($lib); } my $file2pkg = find_packages(keys %libfiles); @@ -141,9 +142,9 @@ foreach my $file (keys %exec) { my $libobj = $dumplibs_wo_symfile->get_object($id); # Only try to generate a dependency for libraries with a SONAME if ($libobj->is_public_library() and not add_shlibs_dep($soname, $pkg)) { - failure(sprintf( - _g("No dependency information found for %s (used by %s)."), - $soname, $file)) unless $ignore_missing_info; + failure(_g("No dependency information found for %s " . + "(used by %s)."), $soname, $file) + unless $ignore_missing_info; } } } @@ -185,9 +186,9 @@ foreach my $file (keys %exec) { my $print_name = $name; # Drop the default suffix for readability $print_name =~ s/\@Base$//; - warning(sprintf( - _g("symbol %s used by %s found in none of the libraries."), - $print_name, $file)) unless $sym->{weak}; + warning(_g("symbol %s used by %s found in none of the " . + "libraries."), $print_name, $file) + unless $sym->{weak}; } } else { $used_sonames{$syminfo->{soname}}++; @@ -197,9 +198,8 @@ foreach my $file (keys %exec) { # Warn about un-NEEDED libraries foreach my $soname (@sonames) { unless ($used_sonames{$soname}) { - warning(sprintf( - _g("%s shouldn't be linked with %s (it uses none of its symbols)."), - $file, $soname)); + warning(_g("%s shouldn't be linked with %s (it uses none of its " . + "symbols)."), $file, $soname); } } } @@ -210,13 +210,14 @@ if ($stdout) { $fh = \*STDOUT; } else { open(NEW, ">", "$varlistfile.new") || - syserr(sprintf(_g("open new substvars file \`%s'"), "$varlistfile.new")); + syserr(_g("open new substvars file \`%s'"), "$varlistfile.new"); if (-e $varlistfile) { open(OLD, "<", $varlistfile) || - syserr(sprintf(_g("open old varlist file \`%s' for reading"), $varlistfile)); + syserr(_g("open old varlist file \`%s' for reading"), $varlistfile); foreach my $entry (grep { not m/^\Q$varnameprefix\E:/ } ()) { print(NEW $entry) || - syserr(sprintf(_g("copy old entry to new varlist file \`%s'"), "$varlistfile.new")); + syserr(_g("copy old entry to new varlist file \`%s'"), + "$varlistfile.new"); } close(OLD); } @@ -275,7 +276,7 @@ foreach my $field (reverse @depfields) { if (!$stdout) { close($fh); rename("$varlistfile.new",$varlistfile) || - syserr(sprintf(_g("install new varlist file \`%s'"), $varlistfile)); + syserr(_g("install new varlist file \`%s'"), $varlistfile); } ## @@ -350,19 +351,21 @@ sub extract_from_shlibs { } elsif ($soname =~ /^(.*)-(.*)\.so$/) { $libname = $1; $libversion = $2; } else { - warning(sprintf(_g("Can't extract name and version from library name \`%s'"), $soname)); + warning(_g("Can't extract name and version from library name \`%s'"), + $soname); return; } # Open shlibs file $shlibfile = "./$shlibfile" if $shlibfile =~ m/^\s/; - open(SHLIBS, "<", $shlibfile) - || syserr(sprintf(_g("unable to open shared libs info file \`%s'"), $shlibfile)); + open(SHLIBS, "<", $shlibfile) || + syserr(_g("unable to open shared libs info file \`%s'"), $shlibfile); my $dep; while () { s/\s*\n$//; next if m/^\#/; if (!m/^\s*(?:(\S+):\s+)?(\S+)\s+(\S+)\s+(\S.*\S)\s*$/) { - warning(sprintf(_g("shared libs info file \`%s' line %d: bad line \`%s'"), $shlibfile, $., $_)); + warning(_g("shared libs info file \`%s' line %d: bad line \`%s'"), + $shlibfile, $., $_); next; } if (($libname eq $2) && ($libversion eq $3)) { @@ -400,8 +403,8 @@ sub find_symbols_file { sub symfile_has_soname { my ($file, $soname) = @_; - open(SYM_FILE, "<", $file) - || syserr(sprintf(_g("cannot open file %s"), $file)); + open(SYM_FILE, "<", $file) || + syserr(_g("cannot open file %s"), $file); my $result = 0; while () { if (/^\Q$soname\E /) { @@ -470,7 +473,7 @@ sub find_packages { } elsif (m/^([^:]+): (\S+)$/) { $pkgmatch->{$2} = [ split(/, /, $1) ]; } else { - warning(sprintf(_g("unknown output from dpkg --search: '%s'"), $_)); + warning(_g("unknown output from dpkg --search: '%s'"), $_); } } close(DPKG); diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl index 95baed57..0e9c61ec 100755 --- a/scripts/dpkg-source.pl +++ b/scripts/dpkg-source.pl @@ -220,14 +220,14 @@ while (@ARGV && $ARGV[0] =~ m/^-/) { } elsif (m/^-Z/) { $compression = $POSTMATCH; $comp_ext = $comp_ext{$compression}; - usageerr(sprintf(_g("%s is not a supported compression"), $compression)) + usageerr(_g("%s is not a supported compression"), $compression) unless $comp_supported{$compression}; } elsif (m/^-z/) { $comp_level = $POSTMATCH; - usageerr(sprintf(_g("%s is not a compression level"), $comp_level)) + usageerr(_g("%s is not a compression level"), $comp_level) unless $comp_level =~ /^([1-9]|fast|best)$/; } elsif (m/^-s([akpursnAKPUR])$/) { - warning(sprintf(_g("-s%s option overrides earlier -s%s option"), $1, $sourcestyle)) + warning(_g("-s%s option overrides earlier -s%s option"), $1, $sourcestyle) if $sourcestyle ne 'X'; $sourcestyle= $1; } elsif (m/^-c/) { @@ -268,7 +268,7 @@ while (@ARGV && $ARGV[0] =~ m/^-/) { } elsif (m/^--$/) { last; } else { - &usageerr(sprintf(_g("unknown option \`%s'"), $_)); + usageerr(_g("unknown option \`%s'"), $_); } } @@ -280,14 +280,15 @@ if ($opmode eq 'build') { $sourcestyle =~ y/X/A/; $sourcestyle =~ m/[akpursnAKPUR]/ || - &usageerr(sprintf(_g("source handling style -s%s not allowed with -b"), $sourcestyle)); + usageerr(_g("source handling style -s%s not allowed with -b"), + $sourcestyle); @ARGV || &usageerr(_g("-b needs a directory")); @ARGV<=2 || &usageerr(_g("-b takes at most a directory and an orig source argument")); my $dir = shift(@ARGV); $dir= "./$dir" unless $dir =~ m:^/:; $dir =~ s,/*$,,; - stat($dir) || &error(sprintf(_g("cannot stat directory %s: %s"), $dir, $!)); - -d $dir || &error(sprintf(_g("directory argument %s is not a directory"), $dir)); + stat($dir) || error(_g("cannot stat directory %s: %s"), $dir, $!); + -d $dir || error(_g("directory argument %s is not a directory"), $dir); $changelogfile= "$dir/debian/changelog" unless defined($changelogfile); $controlfile= "$dir/debian/control" unless defined($controlfile); @@ -316,7 +317,8 @@ if ($opmode eq 'build') { elsif (m/^Uploaders$/i) { ($f{$_}= $v) =~ s/[\r\n]//g; } elsif (m/^Build-(Depends|Conflicts)(-Indep)?$/i) { my $dep = parsedep($v, 1); - &error(sprintf(_g("error occurred while parsing %s"), $_)) unless defined $dep; + error(_g("error occurred while parsing %s"), $_) + unless defined $dep; $f{$_}= showdep($dep, 1); } elsif (s/^X[BC]*S[BC]*-//i) { $f{$_}= $v; } @@ -340,11 +342,13 @@ if ($opmode eq 'build') { @sourcearch= ('any'); } else { for my $a (split(/\s+/, $v)) { - &error(sprintf(_g("`%s' is not a legal architecture string"), $a)) + error(_g("`%s' is not a legal architecture string"), + $a) unless $a =~ /^[\w-]+$/; - &error(sprintf(_g("architecture %s only allowed on its own". - " (list for package %s is `%s')"), $a, $p, $a)) - if grep($a eq $_, 'any','all'); + error(_g("architecture %s only allowed on its " . + "own (list for package %s is `%s')"), + $a, $p, $a) + if grep($a eq $_, 'any','all'); push(@sourcearch,$a) unless $archadded{$a}++; } } @@ -374,7 +378,8 @@ if ($opmode eq 'build') { } } elsif (m/^o:.*/) { } else { - &internerr(sprintf(_g("value from nowhere, with key >%s< and value >%s<"), $_, $v)); + internerr(_g("value from nowhere, with key >%s< and value >%s<"), + $_, $v); } } @@ -384,11 +389,12 @@ if ($opmode eq 'build') { } for my $f (qw(Version)) { - defined($f{$f}) || &error(sprintf(_g("missing information for critical output field %s"), $f)); + defined($f{$f}) || + error(_g("missing information for critical output field %s"), $f); } for my $f (qw(Maintainer Architecture Standards-Version)) { defined($f{$f}) || - warning(sprintf(_g("missing information for output field %s"), $f)); + warning(_g("missing information for output field %s"), $f); } defined($sourcepackage) || &error(_g("unable to determine source package name !")); $f{'Source'}= $sourcepackage; @@ -410,47 +416,53 @@ if ($opmode eq 'build') { if (@ARGV) { my $origarg = shift(@ARGV); if (length($origarg)) { - stat($origarg) || &error(sprintf(_g("cannot stat orig argument %s: %s"), $origarg, $!)); + stat($origarg) || + error(_g("cannot stat orig argument %s: %s"), $origarg, $!); if (-d _) { $origdir= $origarg; $origdir= "./$origdir" unless $origdir =~ m,^/,; $origdir =~ s,/*$,,; $sourcestyle =~ y/aA/rR/; $sourcestyle =~ m/[ursURS]/ || - &error(sprintf(_g("orig argument is unpacked but source handling style". - " -s%s calls for packed (.orig.tar.)"), $sourcestyle)); + error(_g("orig argument is unpacked but source handling " . + "style -s%s calls for packed (.orig.tar.)"), + $sourcestyle); } elsif (-f _) { $origtargz= $origarg; $sourcestyle =~ y/aA/pP/; $sourcestyle =~ m/[kpsKPS]/ || - &error(sprintf(_g("orig argument is packed but source handling style". - " -s%s calls for unpacked (.orig/)"), $sourcestyle)); + error(_g("orig argument is packed but source handling " . + "style -s%s calls for unpacked (.orig/)"), + $sourcestyle); } else { &error("orig argument $origarg is not a plain file or directory"); } } else { $sourcestyle =~ y/aA/nn/; $sourcestyle =~ m/n/ || - &error(sprintf(_g("orig argument is empty (means no orig, no diff)". - " but source handling style -s%s wants something"), $sourcestyle)); + error(_g("orig argument is empty (means no orig, no diff) " . + "but source handling style -s%s wants something"), + $sourcestyle); } } elsif ($sourcestyle =~ m/[aA]/) { my @origtargz = map { "$basename.orig.tar.$comp_ext{$_}" } ($compression, @comp_supported); foreach my $origtar (@origtargz) { if (stat($origtar)) { - -f _ || &error(sprintf(_g("packed orig `%s' exists but is not a plain file"), $origtar)); + -f _ || error(_g("packed orig `%s' exists but is not a plain file"), + $origtar); $sourcestyle =~ y/aA/pP/; $origtargz = $origtar; last; } elsif ($! != ENOENT) { - &syserr(sprintf(_g("unable to stat putative packed orig `%s'"), $origtar)); + syserr(_g("unable to stat putative packed orig `%s'"), $origtar); } } if (!$origtargz) { if (stat($origdir)) { - -d _ || &error(sprintf(_g("unpacked orig `%s' exists but is not a directory"), $origdir)); + -d _ || error(_g("unpacked orig `%s' exists but is not a directory"), + $origdir); $sourcestyle =~ y/aA/rR/; } elsif ($! != ENOENT) { - &syserr(sprintf(_g("unable to stat putative unpacked orig `%s'"), $origdir)); + syserr(_g("unable to stat putative unpacked orig `%s'"), $origdir); } else { $sourcestyle =~ y/aA/nn/; } @@ -462,8 +474,8 @@ if ($opmode eq 'build') { $dirbase =~ s,[^/]+$,,; my $dirname = $&; $dirname eq $basedirname || - warning(sprintf(_g("source directory '%s' is not " . - "- '%s'"), $dir, $basedirname)); + warning(_g("source directory '%s' is not " . + "- '%s'"), $dir, $basedirname); my $tarname; my $tardirname; @@ -476,15 +488,16 @@ if ($opmode eq 'build') { $origdirbase =~ s,[^/]+$,,; $origdirname= $&; $origdirname eq "$basedirname.orig" || - warning(sprintf(_g(".orig directory name %s is not " . - "- (wanted %s)"), - $origdirname, "$basedirname.orig")); + warning(_g(".orig directory name %s is not " . + "- (wanted %s)"), + $origdirname, "$basedirname.orig"); $tardirbase= $origdirbase; $tardirname= $origdirname; $tarname= $origtargz || "$basename.orig.tar.$comp_ext"; $tarname =~ /$basename.orig.tar.($comp_regex)/ || - warning(sprintf(_g(".orig.tar name %s is not _" . - ".orig.tar (wanted %s)"), $tarname, "$basename.orig.tar.$comp_regex")); + warning(_g(".orig.tar name %s is not _" . + ".orig.tar (wanted %s)"), + $tarname, "$basename.orig.tar.$comp_regex"); if (($1 ne 'gz') && ($f{'Format'} < 2)) { $f{'Format'} = '2.0' }; } else { $tardirbase= $dirbase; $tardirname= $dirname; @@ -495,10 +508,10 @@ if ($opmode eq 'build') { if (stat($tarname)) { $sourcestyle =~ m/[nUR]/ || - &error(sprintf(_g("tarfile `%s' already exists, not overwriting,". - " giving up; use -sU or -sR to override"), $tarname)); + error(_g("tarfile `%s' already exists, not overwriting, " . + "giving up; use -sU or -sR to override"), $tarname); } elsif ($! != ENOENT) { - &syserr(sprintf(_g("unable to check for existence of `%s'"), $tarname)); + syserr(_g("unable to check for existence of `%s'"), $tarname); } printf(_g("%s: building %s in %s")."\n", @@ -509,7 +522,8 @@ if ($opmode eq 'build') { &forkgzipwrite($newtar); defined(my $c2 = fork) || syserr(_g("fork for tar")); if (!$c2) { - chdir($tardirbase) || &syserr(sprintf(_g("chdir to above (orig) source %s"), $tardirbase)); + chdir($tardirbase) || + syserr(_g("chdir to above (orig) source %s"), $tardirbase); open(STDOUT,">&GZIP") || &syserr(_g("reopen gzip for tar")); # FIXME: put `--' argument back when tar is fixed exec('tar',@tar_ignore,'-cf','-',$tardirname) or &syserr(_g("exec tar")); @@ -519,9 +533,10 @@ if ($opmode eq 'build') { $c2 == waitpid($c2,0) || &syserr(_g("wait for tar")); $? && !(WIFSIGNALED($c2) && WTERMSIG($c2) == SIGPIPE) && subprocerr("tar"); rename($newtar,$tarname) || - &syserr(sprintf(_g("unable to rename `%s' (newly created) to `%s'"), $newtar, $tarname)); + syserr(_g("unable to rename `%s' (newly created) to `%s'"), + $newtar, $tarname); chmod(0666 &~ umask(), $tarname) || - &syserr(sprintf(_g("unable to change permission of `%s'"), $tarname)); + syserr(_g("unable to change permission of `%s'"), $tarname); } else { @@ -537,13 +552,15 @@ if ($opmode eq 'build') { if (stat($origdir)) { $sourcestyle =~ m/[KP]/ || - &error(sprintf(_g("orig dir `%s' already exists, not overwriting,". - " giving up; use -sA, -sK or -sP to override"), $origdir)); + error(_g("orig dir `%s' already exists, not overwriting, ". + "giving up; use -sA, -sK or -sP to override"), + $origdir); push @exit_handlers, sub { erasedir($origdir) }; erasedir($origdir); pop @exit_handlers; } elsif ($! != ENOENT) { - &syserr(sprintf(_g("unable to check for existence of orig dir `%s'"), $origdir)); + syserr(_g("unable to check for existence of orig dir `%s'"), + $origdir); } $expectprefix= $origdir; $expectprefix =~ s,^\./,,; @@ -552,15 +569,15 @@ if ($opmode eq 'build') { # which we can still handle anyway. # checktarsane($origtargz,$expectprefix); mkdir("$origtargz.tmp-nest",0755) || - &syserr(sprintf(_g("unable to create `%s'"), "$origtargz.tmp-nest")); + syserr(_g("unable to create `%s'"), "$origtargz.tmp-nest"); push @exit_handlers, sub { erasedir("$origtargz.tmp-nest") }; extracttar($origtargz,"$origtargz.tmp-nest",$expectprefix_dirname); rename("$origtargz.tmp-nest/$expectprefix_dirname",$expectprefix) || - &syserr(sprintf(_g("unable to rename `%s' to `%s'"), - "$origtargz.tmp-nest/$expectprefix_dirname", - $expectprefix)); + syserr(_g("unable to rename `%s' to `%s'"), + "$origtargz.tmp-nest/$expectprefix_dirname", + $expectprefix); rmdir("$origtargz.tmp-nest") || - &syserr(sprintf(_g("unable to remove `%s'"), "$origtargz.tmp-nest")); + syserr(_g("unable to remove `%s'"), "$origtargz.tmp-nest"); pop @exit_handlers; } @@ -576,7 +593,7 @@ if ($opmode eq 'build') { defined(my $c2 = open(FIND, "-|")) || syserr(_g("fork for find")); if (!$c2) { - chdir($dir) || &syserr(sprintf(_g("chdir to %s for find"), $dir)); + chdir($dir) || syserr(_g("chdir to %s for find"), $dir); exec('find','.','-print0') or &syserr(_g("exec find")); } $/= "\0"; @@ -586,16 +603,16 @@ if ($opmode eq 'build') { $fn =~ s/\0$//; next file if $fn =~ m/$diff_ignore_regexp/o; $fn =~ s,^\./,,; - lstat("$dir/$fn") || &syserr(sprintf(_g("cannot stat file %s"), "$dir/$fn")); + lstat("$dir/$fn") || syserr(_g("cannot stat file %s"), "$dir/$fn"); my $mode = S_IMODE((lstat(_))[2]); my $size = (lstat(_))[7]; if (-l _) { $type{$fn}= 'symlink'; checktype($origdir, $fn, '-l') || next; defined(my $n = readlink("$dir/$fn")) || - &syserr(sprintf(_g("cannot read link %s"), "$dir/$fn")); + syserr(_g("cannot read link %s"), "$dir/$fn"); defined(my $n2 = readlink("$origdir/$fn")) || - &syserr(sprintf(_g("cannot read orig link %s"), "$origdir/$fn")); + syserr(_g("cannot read orig link %s"), "$origdir/$fn"); $n eq $n2 || &unrepdiff2(sprintf(_g("symlink to %s"), $n2), sprintf(_g("symlink to %s"), $n)); } elsif (-f _) { @@ -603,17 +620,21 @@ if ($opmode eq 'build') { $type{$fn}= 'plain file'; if (!lstat("$origdir/$fn")) { - $! == ENOENT || &syserr(sprintf(_g("cannot stat orig file %s"), "$origdir/$fn")); + $! == ENOENT || + syserr(_g("cannot stat orig file %s"), "$origdir/$fn"); $ofnread= '/dev/null'; if( !$size ) { - warning(sprintf(_g("newly created empty file '%s' will not be represented in diff"), $fn)); + warning(_g("newly created empty file '%s' will not " . + "be represented in diff"), $fn); } else { if( $mode & ( S_IXUSR | S_IXGRP | S_IXOTH ) ) { - warning(sprintf(_g("executable mode %04o of '%s' will not be represented in diff"), $mode, $fn)) + warning(_g("executable mode %04o of '%s' will " . + "not be represented in diff"), $mode, $fn) unless $fn eq 'debian/rules'; } if( $mode & ( S_ISUID | S_ISGID | S_ISVTX ) ) { - warning(sprintf(_g("special mode %04o of '%s' will not be represented in diff"), $mode, $fn)); + warning(_g("special mode %04o of '%s' will not " . + "be represented in diff"), $mode, $fn); } } } elsif (-f _) { @@ -644,11 +665,12 @@ if ($opmode eq 'build') { } elsif (m/^[-+\@ ]/) { $difflinefound=1; } elsif (m/^\\ No newline at end of file$/) { - warning(sprintf(_g("file %s has no final newline " . - "(either original or modified version)"), $fn)); + warning(_g("file %s has no final newline (either " . + "original or modified version)"), $fn); } else { s/\n$//; - &internerr(sprintf(_g("unknown line from diff -u on %s: `%s'"), $fn, $_)); + internerr(_g("unknown line from diff -u on %s: `%s'"), + $fn, $_); } print(GZIP $_) || &syserr(_g("failed to write to compression pipe")); } @@ -659,7 +681,7 @@ if ($opmode eq 'build') { &unrepdiff(_g("diff gave 1 but no diff lines found")); } } else { - subprocerr(sprintf(_g("diff on %s"), "$dir/$fn")); + subprocerr(_g("diff on %s"), "$dir/$fn"); } } elsif (-p _) { $type{$fn}= 'pipe'; @@ -669,8 +691,8 @@ if ($opmode eq 'build') { } elsif (-d _) { $type{$fn}= 'directory'; if (!lstat("$origdir/$fn")) { - $! == ENOENT - || &syserr(sprintf(_g("cannot stat orig file %s"), "$origdir/$fn")); + $! == ENOENT || + syserr(_g("cannot stat orig file %s"), "$origdir/$fn"); } elsif (! -d _) { &unrepdiff2(_g('not a directory'), _g('directory')); @@ -683,13 +705,14 @@ if ($opmode eq 'build') { close(GZIP) || &syserr(_g("finish write to compression pipe")); &reapgzip; rename($newdiffgz, $diffname) || - &syserr(sprintf(_g("unable to rename `%s' (newly created) to `%s'"), $newdiffgz, $diffname)); + syserr(_g("unable to rename `%s' (newly created) to `%s'"), + $newdiffgz, $diffname); chmod(0666 &~ umask(), $diffname) || - &syserr(sprintf(_g("unable to change permission of `%s'"), $diffname)); + syserr(_g("unable to change permission of `%s'"), $diffname); defined($c2= open(FIND,"-|")) || &syserr(_g("fork for 2nd find")); if (!$c2) { - chdir($origdir) || &syserr(sprintf(_g("chdir to %s for 2nd find"), $origdir)); + chdir($origdir) || syserr(_g("chdir to %s for 2nd find"), $origdir); exec('find','.','-print0') or &syserr(_g("exec 2nd find")); } $/= "\0"; @@ -698,13 +721,14 @@ if ($opmode eq 'build') { next if $fn =~ m/$diff_ignore_regexp/o; $fn =~ s,^\./,,; next if defined($type{$fn}); - lstat("$origdir/$fn") || &syserr(sprintf(_g("cannot check orig file %s"), "$origdir/$fn")); + lstat("$origdir/$fn") || + syserr(_g("cannot check orig file %s"), "$origdir/$fn"); if (-f _) { - warning(sprintf(_g("ignoring deletion of file %s"), $fn)); + warning(_g("ignoring deletion of file %s"), $fn); } elsif (-d _) { - warning(sprintf(_g("ignoring deletion of directory %s"), $fn)); + warning(_g("ignoring deletion of directory %s"), $fn); } elsif (-l _) { - warning(sprintf(_g("ignoring deletion of symlink %s"), $fn)); + warning(_g("ignoring deletion of symlink %s"), $fn); } else { &unrepdiff2(_g('not a file, directory or link'), _g('nonexistent')); @@ -723,15 +747,15 @@ if ($opmode eq 'build') { printf(_g("%s: building %s in %s")."\n", $progname, $sourcepackage, "$basenamerev.dsc") || &syserr(_g("write building message")); - open(STDOUT,"> $basenamerev.dsc") || &syserr(sprintf(_g("create %s"), "$basenamerev.dsc")); + open(STDOUT, "> $basenamerev.dsc") || + syserr(_g("create %s"), "$basenamerev.dsc"); set_field_importance(@dsc_fields); outputclose($varlistfile); if ($ur) { printf(STDERR _g("%s: unrepresentable changes to source")."\n", - $progname) - || &syserr(sprintf(_g("write error msg: %s"), $!)); + $progname) || syserr(_g("write error msg: %s"), $!); exit(1); } exit(0); @@ -740,7 +764,8 @@ if ($opmode eq 'build') { $sourcestyle =~ y/X/p/; $sourcestyle =~ m/[pun]/ || - &usageerr(sprintf(_g("source handling style -s%s not allowed with -x"), $sourcestyle)); + usageerr(_g("source handling style -s%s not allowed with -x"), + $sourcestyle); @ARGV>=1 || &usageerr(_g("-x needs at least one argument, the .dsc")); @ARGV<=2 || &usageerr(_g("-x takes no more than two arguments")); @@ -755,11 +780,11 @@ if ($opmode eq 'build') { my $newdirectory; if (@ARGV) { $newdirectory= shift(@ARGV); - ! -e $newdirectory || &error(sprintf(_g("unpack target exists: %s"), $newdirectory)); + ! -e $newdirectory || error(_g("unpack target exists: %s"), $newdirectory); } my $is_signed = 0; - open(DSC,"< $dsc") || &error(sprintf(_g("cannot open .dsc file %s: %s"), $dsc, $!)); + open(DSC, "< $dsc") || error(_g("cannot open .dsc file %s: %s"), $dsc, $!); while () { next if /^\s*$/o; $is_signed = 1 if /^-----BEGIN PGP SIGNED MESSAGE-----$/o; @@ -779,29 +804,30 @@ if ($opmode eq 'build') { my $gpg_status = $? >> 8; if ($gpg_status) { print STDERR join("",@gpg_output); - &error(sprintf(_g("failed to verify signature on %s"), $dsc)) + error(_g("failed to verify signature on %s"), $dsc) if ($gpg_status == 1); } } else { - warning(sprintf(_g("could not verify signature on %s since gpg isn't installed"), $dsc)); + warning(_g("could not verify signature on %s since gpg isn't installed"), + $dsc); } } else { - warning(sprintf(_g("extracting unsigned source package (%s)"), $dsc)); + warning(_g("extracting unsigned source package (%s)"), $dsc); } - open(CDATA,"< $dsc") || &error(sprintf(_g("cannot open .dsc file %s: %s"), $dsc, $!)); + open(CDATA, "< $dsc") || error(_g("cannot open .dsc file %s: %s"), $dsc, $!); parsecdata(\*CDATA, 'S', -1, sprintf(_g("source control file %s"), $dsc)); close(CDATA); for my $f (qw(Source Version Files)) { defined($fi{"S $f"}) || - &error(sprintf(_g("missing critical source control field %s"), $f)); + error(_g("missing critical source control field %s"), $f); } my $dscformat = $def_dscformat; if (defined $fi{'S Format'}) { if (not handleformat($fi{'S Format'})) { - &error(sprintf(_g("Unsupported format of .dsc file (%s)"), $fi{'S Format'})); + error(_g("Unsupported format of .dsc file (%s)"), $fi{'S Format'}); } $dscformat=$fi{'S Format'}; } @@ -829,16 +855,17 @@ if ($opmode eq 'build') { for my $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(sprintf(_g("Files field contains bad line `%s'"), $file)); + || error(_g("Files field contains bad line `%s'"), $file); ($md5sum{$3},$size{$3},$file) = ($1,$2,$3); local $_ = $file; - &error(sprintf(_g("Files field contains invalid filename `%s'"), $file)) + error(_g("Files field contains invalid filename `%s'"), $file) unless s/^\Q$sourcepackage\E_\Q$baseversion\E(?=[.-])// and s/\.$comp_regex$//; s/^-\Q$revision\E(?=\.)// if length $revision; - &error(sprintf(_g("repeated file type - files `%s' and `%s'"), $seen{$_}, $file)) if $seen{$_}; + error(_g("repeated file type - files `%s' and `%s'"), $seen{$_}, $file) + if $seen{$_}; $seen{$_} = $file; checkstats($dscdir, $file); @@ -851,7 +878,7 @@ if ($opmode eq 'build') { } elsif (/^\.diff$/) { $difffile = $file; } else { - &error(sprintf(_g("unrecognised file type - `%s'"), $file)); + error(_g("unrecognised file type - `%s'"), $file); } } @@ -862,10 +889,13 @@ if ($opmode eq 'build') { warning(_g("native package with .orig.tar")) unless $seen{'.tar'} or $seen{"-$revision.tar"}; } else { - warning(_g("no upstream tarfile in Files field")) unless $seen{'.orig.tar'}; + warning(_g("no upstream tarfile in Files field")) + unless $seen{'.orig.tar'}; if ($dscformat =~ /^1\./) { - warning(sprintf(_g("multiple upstream tarballs in %s format dsc"), $dscformat)) if @tarfiles > 1; - warning(sprintf(_g("debian.tar in %s format dsc"), $dscformat)) if $debianfile; + warning(_g("multiple upstream tarballs in %s format dsc"), $dscformat) + if @tarfiles > 1; + warning(_g("debian.tar in %s format dsc"), $dscformat) + if $debianfile; } } @@ -881,7 +911,7 @@ if ($opmode eq 'build') { &erasedir($newdirectory); ! -e "$expectprefix" || rename("$expectprefix","$newdirectory.tmp-keep") - || &syserr(sprintf(_g("unable to rename `%s' to `%s'"), $expectprefix, "$newdirectory.tmp-keep")); + || syserr(_g("unable to rename `%s' to `%s'"), $expectprefix, "$newdirectory.tmp-keep"); push @tarfiles, $debianfile if $debianfile; for my $tarfile (@tarfiles) @@ -900,13 +930,13 @@ if ($opmode eq 'build') { my $tmp = "$target.tmp-nest"; (my $t = $target) =~ s!.*/!!; - mkdir($tmp,0700) || &syserr(sprintf(_g("unable to create `%s'"), $tmp)); + mkdir($tmp, 0700) || syserr(_g("unable to create `%s'"), $tmp); printf(_g("%s: unpacking %s")."\n", $progname, $tarfile); extracttar("$dscdir/$tarfile",$tmp,$t); rename("$tmp/$t",$target) - || &syserr(sprintf(_g("unable to rename `%s' to `%s'"), "$tmp/$t", $target)); + || syserr(_g("unable to rename `%s' to `%s'"), "$tmp/$t", $target); rmdir($tmp) - || &syserr(sprintf(_g("unable to remove `%s'"), $tmp)); + || syserr(_g("unable to remove `%s'"), $tmp); # for the first tar file: if ($tarfile eq $tarfiles[0] and !$native) @@ -914,7 +944,8 @@ if ($opmode eq 'build') { # -sp: copy the .orig.tar.gz if required if ($sourcestyle =~ /p/) { stat("$dscdir/$tarfile") || - &syserr(sprintf(_g("failed to stat `%s' to see if need to copy"), "$dscdir/$tarfile")); + syserr(_g("failed to stat `%s' to see if need to copy"), + "$dscdir/$tarfile"); my ($dsctardev, $dsctarino) = stat _; my $copy_required; @@ -925,8 +956,8 @@ if ($opmode eq 'build') { $dumptarino != $dsctarino); } else { $! == ENOENT || - syserr(sprintf(_g("failed to check destination `%s'". - " to see if need to copy"), $tarfile)); + syserr(_g("failed to check destination `%s' " . + "to see if need to copy"), $tarfile); $copy_required = 1; } @@ -972,13 +1003,14 @@ if ($opmode eq 'build') { for my $dircreatep (split("/", $dircreate)) { $dircreatem .= $dircreatep . "/"; if (!lstat($dircreatem)) { - $! == ENOENT || &syserr(sprintf(_g("cannot stat %s"), $dircreatem)); + $! == ENOENT || syserr(_g("cannot stat %s"), $dircreatem); mkdir($dircreatem,0777) - || &syserr(sprintf(_g("failed to create %s subdirectory"), $dircreatem)); + || syserr(_g("failed to create %s subdirectory"), $dircreatem); } else { - -d _ || &error(sprintf(_g("diff patches file in directory `%s'," - ." but %s isn't a directory !"), $dircreate, $dircreatem)); + -d _ || error(_g("diff patches file in directory `%s', " . + "but %s isn't a directory !"), + $dircreate, $dircreatem); } } } @@ -986,12 +1018,14 @@ if ($opmode eq 'build') { if ($newdirectory ne $expectprefix) { rename($expectprefix,$newdirectory) || - &syserr(sprintf(_g("failed to rename newly-extracted %s to %s"), $expectprefix, $newdirectory)); + syserr(_g("failed to rename newly-extracted %s to %s"), + $expectprefix, $newdirectory); # rename the copied .orig directory ! -e "$newdirectory.tmp-keep" || rename("$newdirectory.tmp-keep",$expectprefix) - || &syserr(sprintf(_g("failed to rename saved %s to %s"), "$newdirectory.tmp-keep", $expectprefix)); + || syserr(_g("failed to rename saved %s to %s"), + "$newdirectory.tmp-keep", $expectprefix); } for my $patch (@patches) { @@ -1000,13 +1034,13 @@ if ($opmode eq 'build') { &forkgzipread($patch); *DIFF = *GZIP; } else { - open DIFF, $patch or &error(sprintf(_g("can't open diff `%s'"), $patch)); + open DIFF, $patch or error(_g("can't open diff `%s'"), $patch); } defined(my $c2 = fork) || syserr(_g("fork for patch")); if (!$c2) { open(STDIN,"<&DIFF") || &syserr(_g("reopen gzip for patch")); - chdir($newdirectory) || &syserr(sprintf(_g("chdir to %s for patch"), $newdirectory)); + chdir($newdirectory) || syserr(_g("chdir to %s for patch"), $newdirectory); $ENV{'LC_ALL'}= 'C'; $ENV{'LANG'}= 'C'; exec('patch','-s','-t','-F','0','-N','-p1','-u', @@ -1022,19 +1056,20 @@ if ($opmode eq 'build') { my $now = time; for $fn (keys %filepatched) { my $ftr = "$newdirectory/" . substr($fn, length($expectprefix) + 1); - utime($now, $now, $ftr) || &syserr(sprintf(_g("cannot change timestamp for %s"), $ftr)); + utime($now, $now, $ftr) || + syserr(_g("cannot change timestamp for %s"), $ftr); $ftr.= ".dpkg-orig"; - unlink($ftr) || &syserr(sprintf(_g("remove patch backup file %s"), $ftr)); + unlink($ftr) || syserr(_g("remove patch backup file %s"), $ftr); } if (!(my @s = lstat("$newdirectory/debian/rules"))) { - $! == ENOENT || &syserr(sprintf(_g("cannot stat %s"), "$newdirectory/debian/rules")); - warning(sprintf(_g("%s does not exist"), "$newdirectory/debian/rules")); + $! == ENOENT || syserr(_g("cannot stat %s"), "$newdirectory/debian/rules"); + warning(_g("%s does not exist"), "$newdirectory/debian/rules"); } elsif (-f _) { chmod($s[2] | 0111, "$newdirectory/debian/rules") || - &syserr(sprintf(_g("cannot make %s executable"), "$newdirectory/debian/rules")); + syserr(_g("cannot make %s executable"), "$newdirectory/debian/rules"); } else { - warning(sprintf(_g("%s is not a plain file"), "$newdirectory/debian/rules")); + warning(_g("%s is not a plain file"), "$newdirectory/debian/rules"); } my $execmode = 0777 & ~umask; @@ -1045,7 +1080,8 @@ if ($opmode eq 'build') { for $fn (@filesinarchive) { $fn=~ s,^$expectprefix,$newdirectory,; - (my @s = lstat($fn)) || syserr(sprintf(_g("cannot stat extracted object `%s'"), $fn)); + (my @s = lstat($fn)) || + syserr(_g("cannot stat extracted object `%s'"), $fn); my $mode = $s[2]; my $newmode; @@ -1056,12 +1092,13 @@ if ($opmode eq 'build') { } elsif (-p _) { $newmode= $fifomode; } elsif (!-l _) { - &internerr(sprintf(_g("unknown object `%s' after extract (mode 0%o)"), $fn, $mode)); + internerr(_g("unknown object `%s' after extract (mode 0%o)"), + $fn, $mode); } else { next; } next if ($mode & 07777) == $newmode; chmod($newmode,$fn) || - &syserr(sprintf(_g("cannot change mode of `%s' to 0%o from 0%o"), - $fn,$newmode,$mode)); + syserr(_g("cannot change mode of `%s' to 0%o from 0%o"), + $fn, $newmode, $mode); } exit(0); } @@ -1071,12 +1108,14 @@ sub checkstats { my ($f) = @_; my @s; my $m; - open(STDIN,"< $dscdir/$f") || &syserr(sprintf(_g("cannot read %s"), "$dscdir/$f")); - (@s= stat(STDIN)) || &syserr(sprintf(_g("cannot fstat %s"), "$dscdir/$f")); - $s[7] == $size{$f} || &error(sprintf(_g("file %s has size %s instead of expected %s"), $f, $s[7], $size{$f})); + open(STDIN, "< $dscdir/$f") || syserr(_g("cannot read %s"), "$dscdir/$f"); + (@s = stat(STDIN)) || syserr(_g("cannot fstat %s"), "$dscdir/$f"); + $s[7] == $size{$f} || error(_g("file %s has size %s instead of expected %s"), + $f, $s[7], $size{$f}); $m= `md5sum`; $? && subprocerr("md5sum $f"); $m =~ s/\n$//; $m = readmd5sum( $m ); - $m eq $md5sum{$f} || &error(sprintf(_g("file %s has md5sum %s instead of expected %s"), $f, $m, $md5sum{$f})); + $m eq $md5sum{$f} || error(_g("file %s has md5sum %s instead of expected %s"), + $f, $m, $md5sum{$f}); open(STDIN," .*//; } @@ -1216,7 +1254,8 @@ sub checktarsane { my @tarfields = split(' ', $_, 6); if (@tarfields < 6) { - &error (sprintf(_g("tarfile `%s' contains incomplete entry `%s'"), $tarfileread, $_)."\n"); + error(_g("tarfile `%s' contains incomplete entry `%s'\n"), + $tarfileread, $_); } my $tarfn = deoctify ($tarfields[5]); @@ -1239,15 +1278,16 @@ sub checktarsane { && (substr ($fn, 0, 99) eq substr ($tarfn, 0, 99))) { # this file doesn't match because cpio truncated the name # to the first 100 characters. let it slide for now. - warning(sprintf(_g("filename '%s' was truncated by cpio;" . - " unable to check full pathname"), $pname)); + warning(_g("filename '%s' was truncated by cpio; unable " . + "to check full pathname"), $pname); # Since it didn't match, later checks will not be able # to stat this file, so we replace it with the filename # fetched from tar. $filesinarchive[$efix-1] = $tarfn; } else { - &error (sprintf(_g("tarfile `%s' contains unexpected object". - " listed by tar as `%s'; expected `%s'"), $tarfileread, $_, $pname)); + error(_g("tarfile `%s' contains unexpected object listed " . + "by tar as `%s'; expected `%s'"), $tarfileread, $_, + $pname); } } @@ -1255,22 +1295,23 @@ sub checktarsane { # we still can't allow files to expand into /../ # need to check for multiple dots on some operating systems if ($tarfn =~ m/[.]{2,}/) { - &error (sprintf(_g("tarfile `%s' contains object with". - "/../ in its name (%s)"), $tarfileread, $pname)); + error(_g("tarfile `%s' contains object with /../ in its " . + "name (%s)"), $tarfileread, $pname); } if ($tarfn =~ /\.dpkg-orig$/) { - &error (sprintf(_g("tarfile `%s' contains file with name ending in .dpkg-orig"), $tarfileread)); + error(_g("tarfile `%s' contains file with name ending in .dpkg-orig"), + $tarfileread); } if ($mode =~ /[sStT]/ && $type ne 'd') { - &error (sprintf(_g("tarfile `%s' contains setuid, setgid". - " or sticky object `%s'"), $tarfileread, $pname)); + error(_g("tarfile `%s' contains setuid, setgid or sticky " . + "object `%s'"), $tarfileread, $pname); } if ($tarfn eq "$tarprefix/debian" && $type ne 'd') { - &error (sprintf(_g("tarfile `%s' contains object `debian'". - " that isn't a directory"), $tarfileread)); + error(_g("tarfile `%s' contains object `debian' that isn't ". + "a directory"), $tarfileread); } if ($type eq 'd') { $tarfn =~ s,/$,,; } @@ -1278,8 +1319,9 @@ sub checktarsane { my $dirname = $tarfn; if (($dirname =~ s,/[^/]+$,,) && (! defined ($dirincluded{$dirname}))) { - &warnerror (sprintf(_g("tarfile `%s' contains object `%s' but its containing ". - "directory `%s' does not precede it"), $tarfileread, $pname, $dirname)); + warnerror(_g("tarfile `%s' contains object `%s' but its " . + "containing directory `%s' does not precede it"), + $tarfileread, $pname, $dirname); $dirincluded{$dirname} = 1; } if ($type eq 'd') { $dirincluded{$tarfn} = 1; } @@ -1303,7 +1345,7 @@ sub checkdiff &forkgzipread($diff); *DIFF = *GZIP; } else { - open DIFF, $diff or &error(sprintf(_g("can't open diff `%s'"), $diff)); + open DIFF, $diff or error(_g("can't open diff `%s'"), $diff); } $/="\n"; $_ = ; @@ -1315,27 +1357,32 @@ sub checkdiff last HUNK unless defined ($_ = ); } # read file header (---/+++ pair) - s/\n$// or &error(sprintf(_g("diff `%s' is missing trailing newline"), $diff)); - s/^--- // or &error(sprintf(_g("expected ^--- in line %d of diff `%s'"), $., $diff)); + s/\n$// or error(_g("diff `%s' is missing trailing newline"), $diff); + s/^--- // or + error(_g("expected ^--- in line %d of diff `%s'"), $., $diff); s/\t.*//; $_ eq '/dev/null' or s!^(\./)?[^/]+/!$expectprefix/! or - &error(sprintf(_g("diff `%s' patches file with no subdirectory"), $diff)); + error(_g("diff `%s' patches file with no subdirectory"), $diff); /\.dpkg-orig$/ and - &error(sprintf(_g("diff `%s' patches file with name ending .dpkg-orig"), $diff)); + error(_g("diff `%s' patches file with name ending .dpkg-orig"), + $diff); $fn = $_; (defined($_= ) and s/\n$//) or - &error(sprintf(_g("diff `%s' finishes in middle of ---/+++ (line %d)"), $diff, $.)); + error(_g("diff `%s' finishes in middle of ---/+++ (line %d)"), + $diff, $.); s/\t.*//; - (s/^\+\+\+ // and s!^(\./)?[^/]+/!!) - or &error(sprintf(_g("line after --- isn't as expected in diff `%s' (line %d)"), $diff, $.)); + (s/^\+\+\+ // and s!^(\./)?[^/]+/!!) or + error(_g("line after --- isn't as expected in diff `%s' (line %d)"), + $diff, $.); if ($fn eq '/dev/null') { $fn = "$expectprefix/$_"; } else { - $_ eq substr($fn, length($expectprefix)+1) - or &error(sprintf(_g("line after --- isn't as expected in diff `%s' (line %d)"), $diff, $.)); + $_ eq substr($fn, length($expectprefix) + 1) or + error(_g("line after --- isn't as expected in diff `%s' (line %d)"), + $diff, $.); } my $dirname = $fn; @@ -1343,35 +1390,41 @@ sub checkdiff $dirtocreate{$dirname} = 1; } defined($notfileobject{$fn}) && - &error(sprintf(_g("diff `%s' patches something which is not a plain file"), $diff)); + error(_g("diff `%s' patches something which is not a plain file"), + $diff); defined($filepatched{$fn}) && $filepatched{$fn} eq $diff && - error(sprintf(_g("diff patches file %s twice"), $fn)); + error(_g("diff patches file %s twice"), $fn); $filepatched{$fn} = $diff; # read hunks my $hunk = 0; while (defined($_ = ) && !(/^--- / or /^Index:/)) { # read hunk header (@@) - s/\n$// or &error(sprintf(_g("diff `%s' is missing trailing newline"), $diff)); + s/\n$// or error(_g("diff `%s' is missing trailing newline"), $diff); next if /^\\ No newline/; /^@@ -\d+(,(\d+))? \+\d+(,(\d+))? @\@( .*)?$/ or - &error(sprintf(_g("Expected ^\@\@ in line %d of diff `%s'"), $., $diff)); + error(_g("Expected ^\@\@ in line %d of diff `%s'"), $., $diff); my ($olines, $nlines) = ($1 ? $2 : 1, $3 ? $4 : 1); ++$hunk; # read hunk while ($olines || $nlines) { - defined($_ = ) or &error(sprintf(_g("unexpected end of diff `%s'"), $diff)); - s/\n$// or &error(sprintf(_g("diff `%s' is missing trailing newline"), $diff)); + defined($_ = ) or + error(_g("unexpected end of diff `%s'"), $diff); + s/\n$// or + error(_g("diff `%s' is missing trailing newline"), $diff); next if /^\\ No newline/; if (/^ /) { --$olines; --$nlines; } elsif (/^-/) { --$olines; } elsif (/^\+/) { --$nlines; } - else { &error(sprintf(_g("expected [ +-] at start of line %d of diff `%s'"), $., $diff)); } + else { + error(_g("expected [ +-] at start of line %d of diff `%s'"), + $., $diff); + } } } - $hunk or &error(sprintf(_g("expected ^\@\@ at line %d of diff `%s'"), $., $diff)); + $hunk or error(_g("expected ^\@\@ at line %d of diff `%s'"), $., $diff); } close(DIFF); @@ -1386,7 +1439,8 @@ sub extracttar { if (!$c2) { open(STDIN,"<&GZIP") || &syserr(_g("reopen gzip for tar -xkf -")); &cpiostderr; - chdir($dirchdir) || &syserr(sprintf(_g("cannot chdir to `%s' for tar extract"), $dirchdir)); + chdir($dirchdir) || + syserr(_g("cannot chdir to `%s' for tar extract"), $dirchdir); exec('tar','--no-same-owner','--no-same-permissions', '-xkf','-') or &syserr(_g("exec tar -xkf -")); } @@ -1423,28 +1477,27 @@ sub extracttar { system 'chmod','-R',$modes_set,'--',$dirchdir; $? && subprocerr("chmod -R $modes_set $dirchdir"); - opendir(D,"$dirchdir") || &syserr(sprintf(_g("Unable to open dir %s"), $dirchdir)); + opendir(D, "$dirchdir") || syserr(_g("Unable to open dir %s"), $dirchdir); my @dirchdirfiles = grep($_ ne "." && $_ ne "..", readdir(D)); - closedir(D) || &syserr(sprintf(_g("Unable to close dir %s"), $dirchdir)); + closedir(D) || syserr(_g("Unable to close dir %s"), $dirchdir); if (@dirchdirfiles==1 && -d "$dirchdir/$dirchdirfiles[0]") { rename("$dirchdir/$dirchdirfiles[0]", "$dirchdir/$newtopdir") || - &syserr(sprintf(_g("Unable to rename %s to %s"), - "$dirchdir/$dirchdirfiles[0]", - "$dirchdir/$newtopdir")); + syserr(_g("Unable to rename %s to %s"), + "$dirchdir/$dirchdirfiles[0]", + "$dirchdir/$newtopdir"); } else { mkdir("$dirchdir/$newtopdir.tmp", 0777) or - &syserr(sprintf(_g("Unable to mkdir %s"), - "$dirchdir/$newtopdir.tmp")); + syserr(_g("Unable to mkdir %s"), "$dirchdir/$newtopdir.tmp"); for (@dirchdirfiles) { rename("$dirchdir/$_", "$dirchdir/$newtopdir.tmp/$_") or - &syserr(sprintf(_g("Unable to rename %s to %s"), - "$dirchdir/$_", - "$dirchdir/$newtopdir.tmp/$_")); + syserr(_g("Unable to rename %s to %s"), + "$dirchdir/$_", + "$dirchdir/$newtopdir.tmp/$_"); } rename("$dirchdir/$newtopdir.tmp", "$dirchdir/$newtopdir") or - &syserr(sprintf(_g("Unable to rename %s to %s"), - "$dirchdir/$newtopdir.tmp", - "$dirchdir/$newtopdir")); + syserr(_g("Unable to rename %s to %s"), + "$dirchdir/$newtopdir.tmp", + "$dirchdir/$newtopdir"); } } @@ -1460,7 +1513,7 @@ sub checktype { &unrepdiff2(_g("nonexistent"),$type{$fn}); } else { my $v = eval("$type _ ? 2 : 1"); - $v || internerr(sprintf(_g("checktype %s (%s)"), "$@", $type)); + $v || internerr(_g("checktype %s (%s)"), "$@", $type); return 1 if $v == 2; &unrepdiff2(_g("something else"),$type{$fn}); } @@ -1502,14 +1555,14 @@ sub forkgzipwrite { } elsif ($_[0] =~ /\.lzma\.new\..{6}$/) { @prog = qw(lzma); } else { - &error(sprintf(_g("unknown compression type on file %s"), $_[0])); + error(_g("unknown compression type on file %s"), $_[0]); } my $level = "-$comp_level"; $level = "--$comp_level" if $comp_level =~ /best|fast/; push @prog, $level; - open(GZIPFILE,">", $_[0]) || &syserr(sprintf(_g("create file %s"), $_[0])); + open(GZIPFILE, ">", $_[0]) || syserr(_g("create file %s"), $_[0]); pipe(GZIPREAD,GZIP) || &syserr(_g("pipe for gzip")); defined($cgz= fork) || &syserr(_g("fork for gzip")); if (!$cgz) { @@ -1533,17 +1586,17 @@ sub forkgzipread { } elsif ($_[0] =~ /\.lzma$/) { $prog = 'unlzma'; } else { - &error(sprintf(_g("unknown compression type on file %s"), $_[0])); + error(_g("unknown compression type on file %s"), $_[0]); } - open(GZIPFILE,"<", $_[0]) || &syserr(sprintf(_g("read file %s"), $_[0])); - pipe(GZIP,GZIPWRITE) || &syserr(sprintf(_g("pipe for %s"), $prog)); - defined($cgz= fork) || &syserr(sprintf(_g("fork for %s"), $prog)); + open(GZIPFILE, "<", $_[0]) || syserr(_g("read file %s"), $_[0]); + pipe(GZIP, GZIPWRITE) || syserr(_g("pipe for %s"), $prog); + defined($cgz = fork) || syserr(_g("fork for %s"), $prog); if (!$cgz) { - open(STDOUT,">&",\*GZIPWRITE) || &syserr(sprintf(_g("reopen %s pipe"), $prog)); + open(STDOUT, ">&", \*GZIPWRITE) || syserr(_g("reopen %s pipe"), $prog); close(GZIPWRITE); close(GZIP); open(STDIN,"<&",\*GZIPFILE) || &syserr(_g("reopen input file")); - exec({ $prog } $prog) or &syserr(sprintf(_g("exec %s"), $prog)); + exec({ $prog } $prog) or syserr(_g("exec %s"), $prog); } close(GZIPWRITE); $gzipsigpipeok= 1; @@ -1560,8 +1613,8 @@ my %added_files; sub addfile { my ($filename)= @_; $added_files{$filename}++ && - &internerr( sprintf(_g("tried to add file `%s' twice"), $filename)); - stat($filename) || &syserr(sprintf(_g("could not stat output file `%s'"), $filename)); + internerr(_g("tried to add file `%s' twice"), $filename); + stat($filename) || syserr(_g("could not stat output file `%s'"), $filename); my $size = (stat _)[7]; my $md5sum= `md5sum <$filename`; $? && &subprocerr("md5sum $filename"); @@ -1582,7 +1635,7 @@ sub deoctify { foreach (@_) { /^(\d{3})/ or next; - &failure(sprintf(_g("bogus character `\\%s' in `%s'"), $1, $fn)."\n") + failure(_g("bogus character `\\%s' in `%s'") . "\n", $1, $fn) if oct($1) > 255; $_= pack("c", oct($1)) . $POSTMATCH; } -- 2.39.5