瀏覽代碼

Make all perl scripts use strict and warnings, to ease catching errors.

Guillem Jover 19 年之前
父節點
當前提交
e597c04043

+ 22 - 0
ChangeLog

@@ -1,3 +1,25 @@
+2007-04-11  Guillem Jover  <guillem@debian.org>
+
+	* scripts/dpkg-parsechangelog.pl: Use static and warnings. Declare
+	variables with 'my'.
+	* scripts/dpkg-scansources.pl: Likewise.
+	* scripts/controllib.pl: Likewise. Globals with 'our'.
+	* scripts/822-date.pl: Likewise.
+	* scripts/dpkg-architecture.pl: Likewise.
+	* scripts/dpkg-checkbuilddeps.pl: Likewise.
+	* scripts/dpkg-distaddfile.pl: Likewise.
+	* scripts/dpkg-genchanges.pl: Likewise.
+	* scripts/dpkg-gencontrol.pl: Likewise.
+	* scripts/dpkg-shlibdeps.pl: Likewise.
+	* scripts/dpkg-source.pl: Likewise.
+	* scripts/controllib.pl (parsecdata): Use 'my' instead of 'local'.
+	(subprocerr): Likewise.
+	(debian_arch_fix): Likewise.
+	* scripts/dpkg-architecture.pl (debian_to_gnu): Likewise.
+	(gnu_to_debian): Likewise.
+	* scripts/controllib.pl (getfowner): Remove redundant closures of
+	STDIN.
+
 2007-04-11  Guillem Jover  <guillem@debian.org>
 2007-04-11  Guillem Jover  <guillem@debian.org>
 
 
 	* scripts/controllib.pl (@pkg_dep_fields): Reorder fields by
 	* scripts/controllib.pl (@pkg_dep_fields): Reorder fields by

+ 0 - 3
TODO

@@ -12,9 +12,6 @@ lenny
 1.14.0
 1.14.0
 ------
 ------
 
 
- * All perl scripts using strict and warnings, I've a patch already for this,
-   just needs some review.
-
  * Support udeb natively:
  * Support udeb natively:
    - Add field Package-Type and friends.
    - Add field Package-Type and friends.
    - Generate proper Packages files. (#383916)
    - Generate proper Packages files. (#383916)

+ 1 - 1
debian/changelog

@@ -11,7 +11,7 @@ dpkg (1.14.0) UNRELEASED; urgency=low
   * Do not bail out in dpkg when building without start-stop-daemon support,
   * Do not bail out in dpkg when building without start-stop-daemon support,
     by checking if the macro value is true instead of it being defined.
     by checking if the macro value is true instead of it being defined.
     Thanks to Mark Rosenstand.
     Thanks to Mark Rosenstand.
-  * Make some perl scripts use static and warnings, to ease catching errors.
+  * Make all perl scripts use strict and warnings, to ease catching errors.
   * Add a missing newline to a warning message in dpkg. Closes: #390914
   * Add a missing newline to a warning message in dpkg. Closes: #390914
     Thanks to Ian Jackson.
     Thanks to Ian Jackson.
   * Fix typo in variable name in dpkg-source which was causing it to not
   * Fix typo in variable name in dpkg-source which was causing it to not

+ 1 - 1
scripts/822-date.pl

@@ -3,7 +3,7 @@
 use strict;
 use strict;
 use warnings;
 use warnings;
 
 
-my $dpkglibdir = "."; # This line modified by Makefile
+our $dpkglibdir = "."; # This line modified by Makefile
 push(@INC, $dpkglibdir);
 push(@INC, $dpkglibdir);
 require 'dpkg-gettext.pl';
 require 'dpkg-gettext.pl';
 textdomain("dpkg-dev");
 textdomain("dpkg-dev");

+ 35 - 18
scripts/changelog/debian.pl

@@ -4,26 +4,32 @@
 #  -v<version>
 #  -v<version>
 #   changes since <version>
 #   changes since <version>
 
 
-$dpkglibdir= ".";
-$version= '1.3.0'; # This line modified by Makefile
+use strict;
+use warnings;
 
 
-$controlfile= 'debian/control';
-$changelogfile= 'debian/changelog';
-$fileslistfile= 'debian/files';
+our $progname;
+our $version = '1.3.0'; # This line modified by Makefile
+our $dpkglibdir = "."; # This line modified by Makefile
 
 
 push(@INC,$dpkglibdir);
 push(@INC,$dpkglibdir);
 require 'controllib.pl';
 require 'controllib.pl';
 
 
+our %f;
+
 require 'dpkg-gettext.pl';
 require 'dpkg-gettext.pl';
 textdomain("dpkg-dev");
 textdomain("dpkg-dev");
 
 
-$progname= "parsechangelog/$progname";
-
-$since='';
+my $controlfile = 'debian/control';
+my $changelogfile = 'debian/changelog';
+my $fileslistfile = 'debian/files';
+my $since = '';
+my %mapkv = (); # XXX: for future use
 
 
 my @changelog_fields = qw(Source Version Distribution Urgency Maintainer
 my @changelog_fields = qw(Source Version Distribution Urgency Maintainer
                           Date Closes Changes);
                           Date Closes Changes);
 
 
+$progname = "parsechangelog/$progname";
+
 
 
 sub version {
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
     printf _g("Debian %s version %s.\n"), $progname, $version;
@@ -63,11 +69,12 @@ while (@ARGV) {
     }
     }
 }
 }
 
 
-%mapkv=(); # for future use
-$i=1;grep($urgencies{$_}=$i++,
-          qw(low medium high critical emergency));
+my %urgencies;
+my $i = 1;
+grep($urgencies{$_} = $i++, qw(low medium high critical emergency));
 
 
-$expect='first heading';
+my $expect = 'first heading';
+my $blanklines;
 
 
 while (<STDIN>) {
 while (<STDIN>) {
     s/\s*\n$//;
     s/\s*\n$//;
@@ -86,18 +93,26 @@ while (<STDIN>) {
         } else {
         } else {
             &clerror(sprintf(_g("found start of entry where expected %s"), $expect));
             &clerror(sprintf(_g("found start of entry where expected %s"), $expect));
         }
         }
-        $rhs= $'; $rhs =~ s/^\s+//;
-        undef %kvdone;
-        for $kv (split(/\s*,\s*/,$rhs)) {
+	my $rhs = $';
+	$rhs =~ s/^\s+//;
+	my %kvdone;
+	for my $kv (split(/\s*,\s*/, $rhs)) {
             $kv =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i ||
             $kv =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i ||
                 &clerror(sprintf(_g("bad key-value after \`;': \`%s'"), $kv));
                 &clerror(sprintf(_g("bad key-value after \`;': \`%s'"), $kv));
-            $k=(uc substr($1,0,1)).(lc substr($1,1)); $v=$2;
+	    my $k = (uc substr($1, 0, 1)).(lc substr($1, 1));
+	    my $v = $2;
             $kvdone{$k}++ && &clwarn(sprintf(_g("repeated key-value %s"), $k));
             $kvdone{$k}++ && &clwarn(sprintf(_g("repeated key-value %s"), $k));
             if ($k eq 'Urgency') {
             if ($k eq 'Urgency') {
                 $v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i ||
                 $v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i ||
                     &clerror(_g("badly formatted urgency value"));
                     &clerror(_g("badly formatted urgency value"));
-                $newurg= lc $1;
-                $newurgn= $urgencies{lc $1}; $newcomment= $2;
+
+		my $newurg = lc $1;
+		my $oldurg;
+		my $newurgn = $urgencies{lc $1};
+		my $oldurgn;
+		my $newcomment = $2;
+		my $oldcomment;
+
                 $newurgn ||
                 $newurgn ||
                     &clwarn(sprintf(_g("unknown urgency value %s - comparing very low"), $newurg));
                     &clwarn(sprintf(_g("unknown urgency value %s - comparing very low"), $newurg));
                 if (defined($f{'Urgency'})) {
                 if (defined($f{'Urgency'})) {
@@ -158,6 +173,8 @@ $expect eq 'next heading or eof' || die sprintf(_g("found eof where expected %s"
 $f{'Changes'} =~ s/\n$//;
 $f{'Changes'} =~ s/\n$//;
 $f{'Changes'} =~ s/^/\n/;
 $f{'Changes'} =~ s/^/\n/;
 
 
+my @closes;
+
 while ($f{'Changes'} =~ /closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/ig) {
 while ($f{'Changes'} =~ /closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/ig) {
   push(@closes, $& =~ /\#?\s?(\d+)/g);
   push(@closes, $& =~ /\#?\s?(\d+)/g);
 }
 }

+ 61 - 37
scripts/controllib.pl

@@ -1,42 +1,50 @@
 #!/usr/bin/perl
 #!/usr/bin/perl
 
 
+use strict;
+use warnings;
+
 use English;
 use English;
+use POSIX qw(:errno_h);
+
+our $dpkglibdir;
 
 
-$dpkglibdir= "."; # This line modified by Makefile
 push(@INC,$dpkglibdir);
 push(@INC,$dpkglibdir);
 require 'dpkg-gettext.pl';
 require 'dpkg-gettext.pl';
 textdomain("dpkg-dev");
 textdomain("dpkg-dev");
 
 
-# Global variables:
-# $v                - value parameter to function
-# $sourcepackage    - name of sourcepackage
-# %fi               - map of fields values. keys are of the form "S# key"
-#                     where S is source (L is changelog, C is control)
-#                     and # is an index
-# %p2i              - map from datafile+packagename to index in controlfile
-#                     (used if multiple packages can be listed). Key is
-#                     "S key" where S is the source and key is the packagename
-# %substvar         - map with substitution variables
+our $sourcepackage; # - name of sourcepackage
+our %f;             # - fields ???
+our %fi;            # - map of fields values. keys are of the form "S# key"
+                    #   where S is source (L is changelog, C is control)
+                    #   and # is an index
+our %fieldimps;
+our %p2i;           # - map from datafile+packagename to index in controlfile
+                    #   (used if multiple packages can be listed). Key is
+                    #   "S key" where S is the source and key is the packagename
+
+my $maxsubsts = 50;
+our %substvar;      # - map with substitution variables
 
 
-$parsechangelog= 'dpkg-parsechangelog';
+my $parsechangelog = 'dpkg-parsechangelog';
 
 
-@pkg_dep_fields = qw(Pre-Depends Depends Recommends Suggests Enhances
-                     Conflicts Replaces Provides);
-@src_dep_fields = qw(Build-Depends Build-Depends-Indep
-                     Build-Conflicts Build-Conflicts-Indep);
+our @pkg_dep_fields = qw(Pre-Depends Depends Recommends Suggests Enhances
+                         Conflicts Replaces Provides);
+our @src_dep_fields = qw(Build-Depends Build-Depends-Indep
+                         Build-Conflicts Build-Conflicts-Indep);
 
 
-$maxsubsts=50;
-$warnable_error= 1;
-$quiet_warnings = 0;
+our $warnable_error = 1;
+our $quiet_warnings = 0;
+
+our $version;
+our $progname = $0;
+$progname = $& if $progname =~ m,[^/]+$,;
 
 
-$progname= $0; $progname= $& if $progname =~ m,[^/]+$,;
 
 
 sub getfowner
 sub getfowner
 {
 {
-    $getlogin = getlogin();
+    my $getlogin = getlogin();
     if (!defined($getlogin)) {
     if (!defined($getlogin)) {
 	open(SAVEIN, "<&STDIN");
 	open(SAVEIN, "<&STDIN");
-	close(STDIN);
 	open(STDIN, "<&STDERR");
 	open(STDIN, "<&STDERR");
 
 
 	$getlogin = getlogin();
 	$getlogin = getlogin();
@@ -47,7 +55,6 @@ sub getfowner
     }
     }
     if (!defined($getlogin)) {
     if (!defined($getlogin)) {
 	open(SAVEIN, "<&STDIN");
 	open(SAVEIN, "<&STDIN");
-	close(STDIN);
 	open(STDIN, "<&STDOUT");
 	open(STDIN, "<&STDOUT");
 
 
 	$getlogin = getlogin();
 	$getlogin = getlogin();
@@ -57,6 +64,7 @@ sub getfowner
 	close(SAVEIN);
 	close(SAVEIN);
     }
     }
 
 
+    my @fowner;
     if (defined($ENV{'LOGNAME'})) {
     if (defined($ENV{'LOGNAME'})) {
 	@fowner = getpwnam($ENV{'LOGNAME'});
 	@fowner = getpwnam($ENV{'LOGNAME'});
 	if (!@fowner) {
 	if (!@fowner) {
@@ -100,7 +108,7 @@ sub capit {
 
 
 sub debian_arch_fix
 sub debian_arch_fix
 {
 {
-    local ($os, $cpu) = @_;
+    my ($os, $cpu) = @_;
 
 
     if ($os eq "linux") {
     if ($os eq "linux") {
 	return $cpu;
 	return $cpu;
@@ -149,8 +157,11 @@ sub debian_arch_is {
 
 
 sub substvars {
 sub substvars {
     my ($v) = @_;
     my ($v) = @_;
-    my ($lhs,$vn,$rhs,$count);
-    $count=0;
+    my $lhs;
+    my $vn;
+    my $rhs = '';
+    my $count = 0;
+
     while ($v =~ m/\$\{([-:0-9a-z]+)\}/i) {
     while ($v =~ m/\$\{([-:0-9a-z]+)\}/i) {
         # If we have consumed more from the leftover data, then
         # If we have consumed more from the leftover data, then
         # reset the recursive counter.
         # reset the recursive counter.
@@ -196,12 +207,14 @@ sub sort_field_by_importance($$)
 sub outputclose {
 sub outputclose {
     my ($varlistfile) = @_;
     my ($varlistfile) = @_;
 
 
-    for $f (keys %f) { $substvar{"F:$f"}= $f{$f}; }
+    for my $f (keys %f) {
+	$substvar{"F:$f"} = $f{$f};
+    }
 
 
     &parsesubstvars($varlistfile) if (defined($varlistfile));
     &parsesubstvars($varlistfile) if (defined($varlistfile));
 
 
-    for $f (sort sort_field_by_importance keys %f) {
-        $v= $f{$f};
+    for my $f (sort sort_field_by_importance keys %f) {
+	my $v = $f{$f};
 	if (defined($varlistfile)) {
 	if (defined($varlistfile)) {
 	    $v= &substvars($v);
 	    $v= &substvars($v);
 	}
 	}
@@ -232,7 +245,7 @@ sub parsecontrolfile {
 			     sprintf(_g("control file %s"), $controlfile));
 			     sprintf(_g("control file %s"), $controlfile));
     $indices >= 2 || &error(_g("control file must have at least one binary package part"));
     $indices >= 2 || &error(_g("control file must have at least one binary package part"));
 
 
-    for ($i=1;$i<$indices;$i++) {
+    for (my $i = 1; $i < $indices; $i++) {
         defined($fi{"C$i Package"}) ||
         defined($fi{"C$i Package"}) ||
             &error(sprintf(_g("per-package paragraph %d in control ".
             &error(sprintf(_g("per-package paragraph %d in control ".
                                    "info file is missing Package line"),
                                    "info file is missing Package line"),
@@ -293,6 +306,7 @@ ALTERNATE:
                         $seen_arch=1;
                         $seen_arch=1;
                         next;
                         next;
                     } elsif ($arch =~ /^!/) {
                     } elsif ($arch =~ /^!/) {
+			my $not_arch;
 			($not_arch = $arch) =~ s/^!//;
 			($not_arch = $arch) =~ s/^!//;
 
 
 			if (debian_arch_is($host_arch, $not_arch)) {
 			if (debian_arch_is($host_arch, $not_arch)) {
@@ -338,7 +352,7 @@ sub showdep {
 sub parsechangelog {
 sub parsechangelog {
     my ($changelogfile, $changelogformat, $since) = @_;
     my ($changelogfile, $changelogformat, $since) = @_;
 
 
-    defined($c=open(CDATA,"-|")) || &syserr(_g("fork for parse changelog"));
+    defined(my $c = open(CDATA, "-|")) || syserr(_g("fork for parse changelog"));
     if ($c) {
     if ($c) {
 	binmode(CDATA);
 	binmode(CDATA);
 	parsecdata(\*CDATA, 'L', 0, _g("parsed version of changelog"));
 	parsecdata(\*CDATA, 'L', 0, _g("parsed version of changelog"));
@@ -346,7 +360,7 @@ sub parsechangelog {
 	$? && subprocerr(_g("parse changelog"));
 	$? && subprocerr(_g("parse changelog"));
     } else {
     } else {
 	binmode(STDOUT);
 	binmode(STDOUT);
-        @al=($parsechangelog);
+	my @al = ($parsechangelog);
         push(@al,"-l$changelogfile");
         push(@al,"-l$changelogfile");
         push(@al, "-F$changelogformat") if defined($changelogformat);
         push(@al, "-F$changelogformat") if defined($changelogformat);
         push(@al, "-v$since") if defined($since);
         push(@al, "-v$since") if defined($since);
@@ -369,6 +383,7 @@ sub init_substvars
     $substvar{'source:Upstream-Version'} = $fi{"L Version"};
     $substvar{'source:Upstream-Version'} = $fi{"L Version"};
     $substvar{'source:Upstream-Version'} =~ s/-[^-]*$//;
     $substvar{'source:Upstream-Version'} =~ s/-[^-]*$//;
 
 
+    # FIXME: this needs all progs using controllib to set $version as 'our'.
     # We expect the calling program to set $version.
     # We expect the calling program to set $version.
     $substvar{"dpkg:Version"} = $version;
     $substvar{"dpkg:Version"} = $version;
     $substvar{"dpkg:Upstream-Version"} = $version;
     $substvar{"dpkg:Upstream-Version"} = $version;
@@ -413,20 +428,29 @@ sub readmd5sum {
     return $md5sum;
     return $md5sum;
 }
 }
 
 
+# XXX: Should not be a global!!
+my $whatmsg;
+
 sub parsecdata {
 sub parsecdata {
-    local ($cdata, $source, $many, $whatmsg) = @_;
+    my ($cdata, $source, $many);
+    ($cdata, $source, $many, $whatmsg) = @_;
+
     # many=0: ordinary control data like output from dpkg-parsechangelog
     # many=0: ordinary control data like output from dpkg-parsechangelog
     # many=1: many paragraphs like in source control file
     # many=1: many paragraphs like in source control file
     # many=-1: single paragraph of control data optionally signed
     # many=-1: single paragraph of control data optionally signed
-    local ($index,$cf,$paraborder);
-    $index=''; $cf=''; $paraborder=1;
+
+    my $index = '';
+    my $cf = '';
+    my $paraborder = 1;
+
     while (<$cdata>) {
     while (<$cdata>) {
         s/\s*\n$//;
         s/\s*\n$//;
 	next if (m/^$/ and $paraborder);
 	next if (m/^$/ and $paraborder);
 	next if (m/^#/);
 	next if (m/^#/);
 	$paraborder=0;
 	$paraborder=0;
         if (m/^(\S+)\s*:\s*(.*)$/) {
         if (m/^(\S+)\s*:\s*(.*)$/) {
-            $cf=$1; $v=$2;
+	    $cf = $1;
+	    my $v = $2;
             $cf= &capit($cf);
             $cf= &capit($cf);
             $fi{"$source$index $cf"}= $v;
             $fi{"$source$index $cf"}= $v;
             $fi{"o:$source$index $cf"}= $1;
             $fi{"o:$source$index $cf"}= $1;
@@ -507,7 +531,7 @@ sub warnerror
 }
 }
 
 
 sub subprocerr {
 sub subprocerr {
-    local ($p) = @_;
+    my ($p) = @_;
     require POSIX;
     require POSIX;
     if (POSIX::WIFEXITED($?)) {
     if (POSIX::WIFEXITED($?)) {
         die sprintf(_g("%s: failure: %s gave error exit status %s"),
         die sprintf(_g("%s: failure: %s gave error exit status %s"),

+ 46 - 35
scripts/dpkg-architecture.pl

@@ -19,16 +19,20 @@
 # along with this program; if not, write to the Free Software
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
 
 
-$version="1.0.0"; # This line modified by Makefile
+use strict;
+use warnings;
+
+our $progname;
+our $version = "1.0.0"; # This line modified by Makefile
+our $dpkglibdir = "."; # This line modified by Makefile
 
 
-$dpkglibdir = ".";
 push(@INC,$dpkglibdir);
 push(@INC,$dpkglibdir);
 require 'controllib.pl';
 require 'controllib.pl';
 
 
 require 'dpkg-gettext.pl';
 require 'dpkg-gettext.pl';
 textdomain("dpkg-dev");
 textdomain("dpkg-dev");
 
 
-$pkgdatadir = "..";
+my $pkgdatadir = "..";
 
 
 sub version {
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
     printf _g("Debian %s version %s.\n"), $progname, $version;
@@ -66,6 +70,10 @@ Actions:
 "), $progname;
 "), $progname;
 }
 }
 
 
+my (@cpu, @os);
+my (%cputable, %ostable);
+my (%cputable_re, %ostable_re);
+
 sub read_cputable {
 sub read_cputable {
     open CPUTABLE, "$pkgdatadir/cputable"
     open CPUTABLE, "$pkgdatadir/cputable"
 	or &syserr(_g("unable to open cputable"));
 	or &syserr(_g("unable to open cputable"));
@@ -103,8 +111,8 @@ sub split_debian {
 }
 }
 
 
 sub debian_to_gnu {
 sub debian_to_gnu {
-    local ($arch) = @_;
-    local ($os, $cpu) = &split_debian($arch);
+    my ($arch) = @_;
+    my ($os, $cpu) = split_debian($arch);
 
 
     return undef unless exists($cputable{$cpu}) && exists($ostable{$os});
     return undef unless exists($cputable{$cpu}) && exists($ostable{$os});
     return join("-", $cputable{$cpu}, $ostable{$os});
     return join("-", $cputable{$cpu}, $ostable{$os});
@@ -118,19 +126,18 @@ sub split_gnu {
 }
 }
 
 
 sub gnu_to_debian {
 sub gnu_to_debian {
-    local ($gnu) = @_;
-    local ($cpu, $os);
-    local ($a);
+    my ($gnu) = @_;
+    my ($cpu, $os);
 
 
-    local ($gnu_cpu, $gnu_os) = &split_gnu($gnu);
-    foreach $_cpu (@cpu) {
+    my ($gnu_cpu, $gnu_os) = split_gnu($gnu);
+    foreach my $_cpu (@cpu) {
 	if ($gnu_cpu =~ /^$cputable_re{$_cpu}$/) {
 	if ($gnu_cpu =~ /^$cputable_re{$_cpu}$/) {
 	    $cpu = $_cpu;
 	    $cpu = $_cpu;
 	    last;
 	    last;
 	}
 	}
     }
     }
 
 
-    foreach $_os (@os) {
+    foreach my $_os (@os) {
 	if ($gnu_os =~ /^(.*-)?$ostable_re{$_os}$/) {
 	if ($gnu_os =~ /^(.*-)?$ostable_re{$_os}$/) {
 	    $os = $_os;
 	    $os = $_os;
 	    last;
 	    last;
@@ -146,8 +153,8 @@ sub gnu_to_debian {
 
 
 # Check for -L
 # Check for -L
 if (grep { m/^-L$/ } @ARGV) {
 if (grep { m/^-L$/ } @ARGV) {
-    foreach $os (@os) {
-	foreach $cpu (@cpu) {
+    foreach my $os (@os) {
+	foreach my $cpu (@cpu) {
 	    print debian_arch_fix($os, $cpu)."\n";
 	    print debian_arch_fix($os, $cpu)."\n";
 	}
 	}
     }
     }
@@ -156,12 +163,12 @@ if (grep { m/^-L$/ } @ARGV) {
 
 
 # Set default values:
 # Set default values:
 
 
-chomp ($deb_build_arch = `dpkg --print-architecture`);
+chomp (my $deb_build_arch = `dpkg --print-architecture`);
 &syserr("dpkg --print-architecture failed") if $?>>8;
 &syserr("dpkg --print-architecture failed") if $?>>8;
-$deb_build_gnu_type = &debian_to_gnu($deb_build_arch);
+my $deb_build_gnu_type = debian_to_gnu($deb_build_arch);
 
 
 # Default host: Current gcc.
 # Default host: Current gcc.
-$gcc = `\${CC:-gcc} -dumpmachine`;
+my $gcc = `\${CC:-gcc} -dumpmachine`;
 if ($?>>8) {
 if ($?>>8) {
     warning(_g("Couldn't determine gcc system type, falling back to default (native compilation)"));
     warning(_g("Couldn't determine gcc system type, falling back to default (native compilation)"));
     $gcc = '';
     $gcc = '';
@@ -169,6 +176,9 @@ if ($?>>8) {
     chomp $gcc;
     chomp $gcc;
 }
 }
 
 
+my $deb_host_arch = undef;
+my $deb_host_gnu_type;
+
 if ($gcc ne '') {
 if ($gcc ne '') {
     $deb_host_arch = &gnu_to_debian($gcc);
     $deb_host_arch = &gnu_to_debian($gcc);
     unless (defined $deb_host_arch) {
     unless (defined $deb_host_arch) {
@@ -185,13 +195,14 @@ if (!defined($deb_host_arch)) {
 }
 }
 
 
 
 
-$req_host_arch = '';
-$req_host_gnu_type = '';
-$req_build_gnu_type = '';
-$req_eq_arch = '';
-$req_is_arch = '';
-$action='l';
-$force=0;
+my $req_host_arch = '';
+my $req_host_gnu_type = '';
+my $req_build_gnu_type = '';
+my $req_eq_arch = '';
+my $req_is_arch = '';
+my $req_variable_to_print;
+my $action = 'l';
+my $force = 0;
 
 
 while (@ARGV) {
 while (@ARGV) {
     $_=shift(@ARGV);
     $_=shift(@ARGV);
@@ -240,7 +251,7 @@ if ($req_host_gnu_type ne '' && $req_host_arch eq '') {
 }
 }
 
 
 if ($req_host_gnu_type ne '' && $req_host_arch ne '') {
 if ($req_host_gnu_type ne '' && $req_host_arch ne '') {
-    $dfl_host_gnu_type = &debian_to_gnu ($req_host_arch);
+    my $dfl_host_gnu_type = debian_to_gnu($req_host_arch);
     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(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;
 }
 }
 
 
@@ -252,12 +263,12 @@ $deb_host_gnu_type = $req_host_gnu_type if $req_host_gnu_type ne '';
 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(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
 # Split the Debian and GNU names
-($deb_host_arch_os, $deb_host_arch_cpu) = &split_debian($deb_host_arch);
-($deb_build_arch_os, $deb_build_arch_cpu) = &split_debian($deb_build_arch);
-($deb_host_gnu_cpu, $deb_host_gnu_system) = &split_gnu($deb_host_gnu_type);
-($deb_build_gnu_cpu, $deb_build_gnu_system) = &split_gnu($deb_build_gnu_type);
+my ($deb_host_arch_os, $deb_host_arch_cpu) = split_debian($deb_host_arch);
+my ($deb_build_arch_os, $deb_build_arch_cpu) = split_debian($deb_build_arch);
+my ($deb_host_gnu_cpu, $deb_host_gnu_system) = split_gnu($deb_host_gnu_type);
+my ($deb_build_gnu_cpu, $deb_build_gnu_system) = split_gnu($deb_build_gnu_type);
 
 
-%env = ();
+my %env = ();
 if (!$force) {
 if (!$force) {
     $deb_build_arch = $ENV{DEB_BUILD_ARCH} if (exists $ENV{DEB_BUILD_ARCH});
     $deb_build_arch = $ENV{DEB_BUILD_ARCH} if (exists $ENV{DEB_BUILD_ARCH});
     $deb_build_arch_os = $ENV{DEB_BUILD_ARCH_OS} if (exists $ENV{DEB_BUILD_ARCH_OS});
     $deb_build_arch_os = $ENV{DEB_BUILD_ARCH_OS} if (exists $ENV{DEB_BUILD_ARCH_OS});
@@ -273,10 +284,10 @@ if (!$force) {
     $deb_host_gnu_type = $ENV{DEB_HOST_GNU_TYPE} if (exists $ENV{DEB_HOST_GNU_TYPE});
     $deb_host_gnu_type = $ENV{DEB_HOST_GNU_TYPE} if (exists $ENV{DEB_HOST_GNU_TYPE});
 }
 }
 
 
-@ordered = qw(DEB_BUILD_ARCH DEB_BUILD_ARCH_OS DEB_BUILD_ARCH_CPU
-	      DEB_BUILD_GNU_CPU DEB_BUILD_GNU_SYSTEM DEB_BUILD_GNU_TYPE
-	      DEB_HOST_ARCH DEB_HOST_ARCH_OS DEB_HOST_ARCH_CPU
-	      DEB_HOST_GNU_CPU DEB_HOST_GNU_SYSTEM DEB_HOST_GNU_TYPE);
+my @ordered = qw(DEB_BUILD_ARCH DEB_BUILD_ARCH_OS DEB_BUILD_ARCH_CPU
+                 DEB_BUILD_GNU_CPU DEB_BUILD_GNU_SYSTEM DEB_BUILD_GNU_TYPE
+                 DEB_HOST_ARCH DEB_HOST_ARCH_OS DEB_HOST_ARCH_CPU
+                 DEB_HOST_GNU_CPU DEB_HOST_GNU_SYSTEM DEB_HOST_GNU_TYPE);
 
 
 $env{'DEB_BUILD_ARCH'}=$deb_build_arch;
 $env{'DEB_BUILD_ARCH'}=$deb_build_arch;
 $env{'DEB_BUILD_ARCH_OS'}=$deb_build_arch_os;
 $env{'DEB_BUILD_ARCH_OS'}=$deb_build_arch_os;
@@ -292,11 +303,11 @@ $env{'DEB_HOST_GNU_SYSTEM'}=$deb_host_gnu_system;
 $env{'DEB_HOST_GNU_TYPE'}=$deb_host_gnu_type;
 $env{'DEB_HOST_GNU_TYPE'}=$deb_host_gnu_type;
 
 
 if ($action eq 'l') {
 if ($action eq 'l') {
-    foreach $k (@ordered) {
+    foreach my $k (@ordered) {
 	print "$k=$env{$k}\n";
 	print "$k=$env{$k}\n";
     }
     }
 } elsif ($action eq 's') {
 } elsif ($action eq 's') {
-    foreach $k (@ordered) {
+    foreach my $k (@ordered) {
 	print "$k=$env{$k}; ";
 	print "$k=$env{$k}; ";
     }
     }
     print "export ".join(" ",@ordered)."\n";
     print "export ".join(" ",@ordered)."\n";

+ 8 - 2
scripts/dpkg-checkbuilddeps.pl

@@ -1,14 +1,20 @@
 #!/usr/bin/perl
 #!/usr/bin/perl
 # GPL copyright 2001 by Joey Hess <joeyh@debian.org>
 # GPL copyright 2001 by Joey Hess <joeyh@debian.org>
 
 
-#use strict;
+use strict;
+use warnings;
+
+our $progname;
+our $dpkglibdir = "/usr/lib/dpkg"; # This line modified by Makefile
+
 use Getopt::Long;
 use Getopt::Long;
 
 
-my $dpkglibdir="/usr/lib/dpkg";
 my $admindir = "/var/lib/dpkg";
 my $admindir = "/var/lib/dpkg";
 push(@INC,$dpkglibdir);
 push(@INC,$dpkglibdir);
 require 'controllib.pl';
 require 'controllib.pl';
 
 
+our %fi;
+
 require 'dpkg-gettext.pl';
 require 'dpkg-gettext.pl';
 textdomain("dpkg-dev");
 textdomain("dpkg-dev");
 
 

+ 10 - 5
scripts/dpkg-distaddfile.pl

@@ -1,19 +1,24 @@
 #!/usr/bin/perl
 #!/usr/bin/perl
 
 
-$dpkglibdir= ".";
-$version= '1.3.0'; # This line modified by Makefile
+use strict;
+use warnings;
+
+our $progname;
+our $version = '1.3.0'; # This line modified by Makefile
+our $dpkglibdir = "."; # This line modified by Makefile
 
 
 use POSIX;
 use POSIX;
 use POSIX qw(:errno_h :signal_h);
 use POSIX qw(:errno_h :signal_h);
 
 
-$fileslistfile= 'debian/files';
-
 push(@INC,$dpkglibdir);
 push(@INC,$dpkglibdir);
 require 'controllib.pl';
 require 'controllib.pl';
 
 
 require 'dpkg-gettext.pl';
 require 'dpkg-gettext.pl';
 textdomain("dpkg-dev");
 textdomain("dpkg-dev");
 
 
+my $fileslistfile = 'debian/files';
+
+
 sub version {
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
 
@@ -53,7 +58,7 @@ while (@ARGV && $ARGV[0] =~ m/^-/) {
 }
 }
 
 
 @ARGV==3 || &usageerr(_g("need exactly a filename, section and priority"));
 @ARGV==3 || &usageerr(_g("need exactly a filename, section and priority"));
-($file,$section,$priority)= @ARGV;
+my ($file, $section, $priority) = @ARGV;
 
 
 ($file =~ m/\s/ || $section =~ m/\s/ || $priority =~ m/\s/) &&
 ($file =~ m/\s/ || $section =~ m/\s/ || $priority =~ m/\s/) &&
     &error(_g("filename, section and priority may contain no whitespace"));
     &error(_g("filename, section and priority may contain no whitespace"));

+ 98 - 46
scripts/dpkg-genchanges.pl

@@ -1,26 +1,11 @@
 #!/usr/bin/perl
 #!/usr/bin/perl
 
 
-$dpkglibdir= "."; # This line modified by Makefile
-$version= '1.3.0'; # This line modified by Makefile
-
-$controlfile= 'debian/control';
-$changelogfile= 'debian/changelog';
-$fileslistfile= 'debian/files';
-$varlistfile= 'debian/substvars';
-$uploadfilesdir= '..';
-$sourcestyle= 'i';
-$quiet= 0;
-
-# Other global variables used:
-# %f2p             - file to package map
-# %p2f             - package to file map
-#                    has entries for both "packagename" and "packagename architecture"
-# %p2ver           - package to version map
-# %f2sec           - file to section map
-# %f2pri           - file to priority map
-# %sourcedefault   - default values as taken from source (used for Section,
-#                    Priority and Maintainer)
-# $changedby       - person who created this package (as listed in changelog)
+use strict;
+use warnings;
+
+our $progname;
+our $version = '1.3.0'; # This line modified by Makefile
+our $dpkglibdir = "."; # This line modified by Makefile
 
 
 use POSIX;
 use POSIX;
 use POSIX qw(:errno_h :signal_h);
 use POSIX qw(:errno_h :signal_h);
@@ -28,6 +13,13 @@ use POSIX qw(:errno_h :signal_h);
 push(@INC,$dpkglibdir);
 push(@INC,$dpkglibdir);
 require 'controllib.pl';
 require 'controllib.pl';
 
 
+our (%f, %fi);
+our %p2i;
+our %fieldimps;
+our %substvar;
+our $sourcepackage;
+our $host_arch;
+
 require 'dpkg-gettext.pl';
 require 'dpkg-gettext.pl';
 textdomain("dpkg-dev");
 textdomain("dpkg-dev");
 
 
@@ -35,6 +27,45 @@ my @changes_fields = qw(Format Date Source Binary Architecture Version
                         Distribution Urgency Maintainer Changed-By
                         Distribution Urgency Maintainer Changed-By
                         Description Closes Changes Files);
                         Description Closes Changes Files);
 
 
+my $controlfile = 'debian/control';
+my $changelogfile = 'debian/changelog';
+my $changelogformat;
+my $fileslistfile = 'debian/files';
+my $varlistfile = 'debian/substvars';
+my $uploadfilesdir = '..';
+my $sourcestyle = 'i';
+my $quiet = 0;
+
+my %f2p;           # - file to package map
+my %p2f;           # - package to file map, has entries for both "packagename"
+                   #   and "packagename architecture"
+my %p2ver;         # - package to version map
+my %p2arch;
+my %f2sec;         # - file to section map
+my %f2seccf;
+my %f2pri;         # - file to priority map
+my %f2pricf;
+my %sourcedefault; # - default values as taken from source (used for Section,
+                   #   Priority and Maintainer)
+
+my @descriptions;
+my @sourcefiles;
+my @fileslistfiles;
+
+my %md5sum;        # - md5sum to file map
+my %remove;        # - fields to remove
+my %override;
+my %archadded;
+my @archvalues;
+my $dsc;
+my $changesdescription;
+my $sourceonly;
+my $binaryonly;
+my $archspecific;
+my $forcemaint;
+my $forcechangedby;
+my $since;
+
 
 
 sub version {
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
     printf _g("Debian %s version %s.\n"), $progname, $version;
@@ -171,7 +202,8 @@ if (not $sourceonly) {
 }
 }
 
 
 for $_ (keys %fi) {
 for $_ (keys %fi) {
-    $v= $fi{$_};
+    my $v = $fi{$_};
+
     if (s/^C //) {
     if (s/^C //) {
 	if (m/^Source$/) {
 	if (m/^Source$/) {
 	    setsourcepackage($v);
 	    setsourcepackage($v);
@@ -182,8 +214,11 @@ for $_ (keys %fi) {
 	elsif (m/|^X[BS]+-|^Standards-Version$/i) { }
 	elsif (m/|^X[BS]+-|^Standards-Version$/i) { }
 	else { &unknown(_g('general section of control info file')); }
 	else { &unknown(_g('general section of control info file')); }
     } elsif (s/^C(\d+) //) {
     } elsif (s/^C(\d+) //) {
+	my $i = $1;
+	my $p = $fi{"C$i Package"};
+	my $a = $fi{"C$i Architecture"};
 	my $host_arch = get_host_arch();
 	my $host_arch = get_host_arch();
-	$i=$1; $p=$fi{"C$i Package"}; $a=$fi{"C$i Architecture"};
+
 	if (!defined($p2f{$p}) && not $sourceonly) {
 	if (!defined($p2f{$p}) && not $sourceonly) {
 	    if ((debian_arch_eq('all', $a) && !$archspecific) ||
 	    if ((debian_arch_eq('all', $a) && !$archspecific) ||
 		debian_arch_is($host_arch, $a) ||
 		debian_arch_is($host_arch, $a) ||
@@ -192,8 +227,9 @@ for $_ (keys %fi) {
 		next;
 		next;
 	    }
 	    }
 	} else {
 	} else {
+	    my $f = $p2f{$p};
 	    $p2arch{$p}=$a;
 	    $p2arch{$p}=$a;
-	    $f=$p2f{$p};
+
 	    if (m/^Description$/) {
 	    if (m/^Description$/) {
 		$v=$` if $v =~ m/\n/;
 		$v=$` if $v =~ m/\n/;
 		if ($f =~ m/\.udeb$/) {
 		if ($f =~ m/\.udeb$/) {
@@ -255,15 +291,16 @@ if ($changesdescription) {
     }
     }
 }
 }
 
 
-for $p (keys %p2f) {
+for my $p (keys %p2f) {
     my ($pp, $aa) = (split / /, $p);
     my ($pp, $aa) = (split / /, $p);
     defined($p2i{"C $pp"}) ||
     defined($p2i{"C $pp"}) ||
 	warning(sprintf(_g("package %s listed in files list but not in control info"), $pp));
 	warning(sprintf(_g("package %s listed in files list but not in control info"), $pp));
 }
 }
 
 
-for $p (keys %p2f) {
-    $f= $p2f{$p};
-    $sec = $f2seccf{$f};
+for my $p (keys %p2f) {
+    my $f = $p2f{$p};
+
+    my $sec = $f2seccf{$f};
     $sec = $sourcedefault{'Section'} if !defined($sec);
     $sec = $sourcedefault{'Section'} if !defined($sec);
     if (!defined($sec)) {
     if (!defined($sec)) {
 	$sec = '-';
 	$sec = '-';
@@ -272,7 +309,7 @@ for $p (keys %p2f) {
     $sec eq $f2sec{$f} || &error(sprintf(_g("package %s has section %s in ".
     $sec eq $f2sec{$f} || &error(sprintf(_g("package %s has section %s in ".
                                            "control file but %s in files list"),
                                            "control file but %s in files list"),
                                  $p, $sec, $f2sec{$f}));
                                  $p, $sec, $f2sec{$f}));
-    $pri = $f2pricf{$f};
+    my $pri = $f2pricf{$f};
     $pri = $sourcedefault{'Priority'} if !defined($pri);
     $pri = $sourcedefault{'Priority'} if !defined($pri);
     if (!defined($pri)) {
     if (!defined($pri)) {
 	$pri = '-';
 	$pri = '-';
@@ -286,35 +323,40 @@ for $p (keys %p2f) {
 &init_substvars;
 &init_substvars;
 init_substvar_arch();
 init_substvar_arch();
 
 
+my $origsrcmsg;
+
 if (!$binaryonly) {
 if (!$binaryonly) {
-    $sec= $sourcedefault{'Section'};
+    my $sec = $sourcedefault{'Section'};
     if (!defined($sec)) {
     if (!defined($sec)) {
 	$sec = '-';
 	$sec = '-';
 	warning(_g("missing Section for source files"));
 	warning(_g("missing Section for source files"));
     }
     }
-    $pri= $sourcedefault{'Priority'};
+    my $pri = $sourcedefault{'Priority'};
     if (!defined($pri)) {
     if (!defined($pri)) {
 	$pri = '-';
 	$pri = '-';
 	warning(_g("missing Priority for source files"));
 	warning(_g("missing Priority for source files"));
     }
     }
 
 
-    ($sversion = $substvar{'source:Version'}) =~ s/^\d+://;
+    (my $sversion = $substvar{'source:Version'}) =~ s/^\d+://;
     $dsc= "$uploadfilesdir/${sourcepackage}_${sversion}.dsc";
     $dsc= "$uploadfilesdir/${sourcepackage}_${sversion}.dsc";
     open(CDATA,"< $dsc") || &error(sprintf(_g("cannot open .dsc file %s: %s"), $dsc, $!));
     open(CDATA,"< $dsc") || &error(sprintf(_g("cannot open .dsc file %s: %s"), $dsc, $!));
     push(@sourcefiles,"${sourcepackage}_${sversion}.dsc");
     push(@sourcefiles,"${sourcepackage}_${sversion}.dsc");
 
 
     parsecdata(\*CDATA, 'S', -1, sprintf(_g("source control file %s"), $dsc));
     parsecdata(\*CDATA, 'S', -1, sprintf(_g("source control file %s"), $dsc));
 
 
-    $files= $fi{'S Files'};
-    for $file (split(/\n /,$files)) {
+    my $files = $fi{'S Files'};
+    for my $file (split(/\n /, $files)) {
         next if $file eq '';
         next if $file eq '';
         $file =~ m/^([0-9a-f]{32})[ \t]+\d+[ \t]+([0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+)$/
         $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(sprintf(_g("Files field contains bad line \`%s'"), $file));
         ($md5sum{$2},$file) = ($1,$2);
         ($md5sum{$2},$file) = ($1,$2);
         push(@sourcefiles,$file);
         push(@sourcefiles,$file);
     }
     }
-    for $f (@sourcefiles) { $f2sec{$f}= $sec; $f2pri{$f}= $pri; }
-    
+    for my $f (@sourcefiles) {
+	$f2sec{$f} = $sec;
+	$f2pri{$f} = $pri;
+    }
+
     if (($sourcestyle =~ m/i/ && $sversion !~ m/-(0|1|0\.1)$/ ||
     if (($sourcestyle =~ m/i/ && $sversion !~ m/-(0|1|0\.1)$/ ||
          $sourcestyle =~ m/d/) &&
          $sourcestyle =~ m/d/) &&
         grep(m/\.diff\.gz$/,@sourcefiles)) {
         grep(m/\.diff\.gz$/,@sourcefiles)) {
@@ -336,7 +378,8 @@ print(STDERR "$progname: $origsrcmsg\n") ||
 $f{'Format'}= $substvar{'Format'};
 $f{'Format'}= $substvar{'Format'};
 
 
 if (!defined($f{'Date'})) {
 if (!defined($f{'Date'})) {
-    chop($date822=`date -R`); $? && subprocerr("date -R");
+    chop(my $date822 = `date -R`);
+    $? && subprocerr("date -R");
     $f{'Date'}= $date822;
     $f{'Date'}= $date822;
 }
 }
 
 
@@ -348,14 +391,19 @@ $f{'Architecture'}= join(' ',@archvalues);
 $f{'Description'}= "\n ".join("\n ",sort @descriptions);
 $f{'Description'}= "\n ".join("\n ",sort @descriptions);
 
 
 $f{'Files'}= '';
 $f{'Files'}= '';
-for $f (@sourcefiles,@fileslistfiles) {
+
+my %filedone;
+
+for my $f (@sourcefiles, @fileslistfiles) {
     next if ($archspecific && debian_arch_eq('all', $p2arch{$f2p{$f}}));
     next if ($archspecific && debian_arch_eq('all', $p2arch{$f2p{$f}}));
     next if $filedone{$f}++;
     next if $filedone{$f}++;
-    $uf= "$uploadfilesdir/$f";
+    my $uf = "$uploadfilesdir/$f";
     open(STDIN,"< $uf") || &syserr(sprintf(_g("cannot open upload file %s for reading"), $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 || warning(sprintf(_g("upload file %s is empty"), $uf));
-    $md5sum=`md5sum`; $? && subprocerr(sprintf(_g("md5sum upload file %s"), $uf));
+    (my @s = stat(STDIN)) || syserr(sprintf(_g("cannot fstat upload file %s"), $uf));
+    my $size = $s[7];
+    $size || warn(sprintf(_g("upload file %s is empty"), $uf));
+    my $md5sum = `md5sum`;
+    $? && subprocerr(sprintf(_g("md5sum upload file %s"), $uf));
     $md5sum =~ m/^([0-9a-f]{32})\s*-?\s*$/i ||
     $md5sum =~ m/^([0-9a-f]{32})\s*-?\s*$/i ||
         &failure(sprintf(_g("md5sum upload file %s gave strange output \`%s'"), $uf, $md5sum));
         &failure(sprintf(_g("md5sum upload file %s gave strange output \`%s'"), $uf, $md5sum));
     $md5sum= $1;
     $md5sum= $1;
@@ -374,16 +422,20 @@ if ($f{'Version'} ne $substvar{'source:Version'}) {
 $f{'Maintainer'} = $forcemaint if defined($forcemaint);
 $f{'Maintainer'} = $forcemaint if defined($forcemaint);
 $f{'Changed-By'} = $forcechangedby if defined($forcechangedby);
 $f{'Changed-By'} = $forcechangedby if defined($forcechangedby);
 
 
-for $f (qw(Version Distribution Maintainer Changes)) {
+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(sprintf(_g("missing information for critical output field %s"), $f));
 }
 }
 
 
-for $f (qw(Urgency)) {
+for my $f (qw(Urgency)) {
     defined($f{$f}) || warning(sprintf(_g("missing information for output field %s"), $f));
     defined($f{$f}) || warning(sprintf(_g("missing information for output field %s"), $f));
 }
 }
 
 
-for $f (keys %override) { $f{&capit($f)}= $override{$f}; }
-for $f (keys %remove) { delete $f{&capit($f)}; }
+for my $f (keys %override) {
+    $f{capit($f)} = $override{$f};
+}
+for my $f (keys %remove) {
+    delete $f{capit($f)};
+}
 
 
 set_field_importance(@changes_fields);
 set_field_importance(@changes_fields);
 outputclose();
 outputclose();

+ 56 - 22
scripts/dpkg-gencontrol.pl

@@ -1,13 +1,10 @@
 #!/usr/bin/perl
 #!/usr/bin/perl
 
 
-$dpkglibdir= "."; # This line modified by Makefile
-$version= '1.3.0'; # This line modified by Makefile
+use strict;
+use warnings;
 
 
-$controlfile= 'debian/control';
-$changelogfile= 'debian/changelog';
-$fileslistfile= 'debian/files';
-$varlistfile= 'debian/substvars';
-$packagebuilddir= 'debian/tmp';
+our $dpkglibdir = "."; # This line modified by Makefile
+our $version = '1.3.0'; # This line modified by Makefile
 
 
 use POSIX;
 use POSIX;
 use POSIX qw(:errno_h);
 use POSIX qw(:errno_h);
@@ -15,6 +12,15 @@ use POSIX qw(:errno_h);
 push(@INC,$dpkglibdir);
 push(@INC,$dpkglibdir);
 require 'controllib.pl';
 require 'controllib.pl';
 
 
+our $progname;
+our %substvar;
+our (%f, %fi);
+our %fieldimps;
+our %p2i;
+our @pkg_dep_fields;
+our $sourcepackage;
+our $host_arch;
+
 require 'dpkg-gettext.pl';
 require 'dpkg-gettext.pl';
 textdomain("dpkg-dev");
 textdomain("dpkg-dev");
 
 
@@ -22,6 +28,22 @@ my @control_fields = (qw(Package Source Version Architecture Essential Origin
                          Bugs Maintainer Installed-Size), @pkg_dep_fields,
                          Bugs Maintainer Installed-Size), @pkg_dep_fields,
                       qw(Section Priority Description));
                       qw(Section Priority Description));
 
 
+my $controlfile = 'debian/control';
+my $changelogfile = 'debian/changelog';
+my $changelogformat;
+my $fileslistfile = 'debian/files';
+my $varlistfile = 'debian/substvars';
+my $packagebuilddir = 'debian/tmp';
+
+my $sourceversion;
+my $forceversion;
+my $forcefilename;
+my $stdout;
+my %remove;
+my %override;
+my (%spvalue, %spdefault);
+my $oppackage;
+
 
 
 sub version {
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
     printf _g("Debian %s version %s.\n"), $progname, $version;
@@ -106,11 +128,13 @@ parsechangelog($changelogfile, $changelogformat);
 parsesubstvars($varlistfile);
 parsesubstvars($varlistfile);
 parsecontrolfile($controlfile);
 parsecontrolfile($controlfile);
 
 
+my $myindex;
+
 if (defined($oppackage)) {
 if (defined($oppackage)) {
     defined($p2i{"C $oppackage"}) || &error(sprintf(_g("package %s not in control info"), $oppackage));
     defined($p2i{"C $oppackage"}) || &error(sprintf(_g("package %s not in control info"), $oppackage));
     $myindex= $p2i{"C $oppackage"};
     $myindex= $p2i{"C $oppackage"};
 } else {
 } else {
-    @packages= grep(m/^C /,keys %p2i);
+    my @packages = grep(m/^C /, keys %p2i);
     @packages==1 ||
     @packages==1 ||
         &error(sprintf(_g("must specify package since control info has many (%s)"), "@packages"));
         &error(sprintf(_g("must specify package since control info has many (%s)"), "@packages"));
     $myindex=1;
     $myindex=1;
@@ -121,7 +145,8 @@ if (defined($oppackage)) {
 my %pkg_dep_fields = map { $_ => 1 } @pkg_dep_fields;
 my %pkg_dep_fields = map { $_ => 1 } @pkg_dep_fields;
 
 
 for $_ (keys %fi) {
 for $_ (keys %fi) {
-    $v= $fi{$_};
+    my $v = $fi{$_};
+
     if (s/^C //) {
     if (s/^C //) {
 #print STDERR "G key >$_< value >$v<\n";
 #print STDERR "G key >$_< value >$v<\n";
 	if (m/^(Origin|Bugs|Maintainer)$/) {
 	if (m/^(Origin|Bugs|Maintainer)$/) {
@@ -148,7 +173,7 @@ for $_ (keys %fi) {
 	    } elsif (debian_arch_is($host_arch, $v)) {
 	    } elsif (debian_arch_is($host_arch, $v)) {
 		$f{$_} = $host_arch;
 		$f{$_} = $host_arch;
             } else {
             } else {
-                @archlist= split(/\s+/,$v);
+		my @archlist = split(/\s+/, $v);
 		my @invalid_archs = grep m/[^\w-]/, @archlist;
 		my @invalid_archs = grep m/[^\w-]/, @archlist;
 		warning(sprintf(ngettext(
 		warning(sprintf(ngettext(
 		                  "`%s' is not a legal architecture string.",
 		                  "`%s' is not a legal architecture string.",
@@ -194,7 +219,8 @@ $f{'Version'} = $forceversion if defined($forceversion);
 init_substvar_arch();
 init_substvar_arch();
 
 
 for $_ (keys %fi) {
 for $_ (keys %fi) {
-    $v= $fi{$_};
+    my $v = $fi{$_};
+
     if (s/^C //) {
     if (s/^C //) {
     } elsif (s/^C$myindex //) {
     } elsif (s/^C$myindex //) {
         if (m/^(Package|Description|Essential|Optional)$/) {
         if (m/^(Package|Description|Essential|Optional)$/) {
@@ -215,33 +241,36 @@ for $_ (keys %fi) {
 }
 }
 
 
 
 
-for $f (qw(Section Priority)) {
+for my $f (qw(Section Priority)) {
     $spvalue{$f} = $spdefault{$f} unless defined($spvalue{$f});
     $spvalue{$f} = $spdefault{$f} unless defined($spvalue{$f});
     $f{$f} = $spvalue{$f} if defined($spvalue{$f});
     $f{$f} = $spvalue{$f} if defined($spvalue{$f});
 }
 }
 
 
-for $f (qw(Package Version)) {
+for my $f (qw(Package Version)) {
     defined($f{$f}) || &error(sprintf(_g("missing information for output field %s"), $f));
     defined($f{$f}) || &error(sprintf(_g("missing information for output field %s"), $f));
 }
 }
-for $f (qw(Maintainer Description Architecture)) {
+for my $f (qw(Maintainer Description Architecture)) {
     defined($f{$f}) || warning(sprintf(_g("missing information for output field %s"), $f));
     defined($f{$f}) || warning(sprintf(_g("missing information for output field %s"), $f));
 }
 }
 $oppackage= $f{'Package'};
 $oppackage= $f{'Package'};
 
 
-$verdiff = $f{'Version'} ne $substvar{'source:Version'} or
-           $f{'Version'} ne $sourceversion;
+my $verdiff = $f{'Version'} ne $substvar{'source:Version'} ||
+              $f{'Version'} ne $sourceversion;
 if ($oppackage ne $sourcepackage || $verdiff) {
 if ($oppackage ne $sourcepackage || $verdiff) {
     $f{'Source'}= $sourcepackage;
     $f{'Source'}= $sourcepackage;
     $f{'Source'}.= " ($substvar{'source:Version'})" if $verdiff;
     $f{'Source'}.= " ($substvar{'source:Version'})" if $verdiff;
 }
 }
 
 
 if (!defined($substvar{'Installed-Size'})) {
 if (!defined($substvar{'Installed-Size'})) {
-    defined($c= open(DU,"-|")) || &syserr(_g("fork for du"));
+    defined(my $c = open(DU, "-|")) || syserr(_g("fork for du"));
     if (!$c) {
     if (!$c) {
         chdir("$packagebuilddir") || &syserr(sprintf(_g("chdir for du to \`%s'"), $packagebuilddir));
         chdir("$packagebuilddir") || &syserr(sprintf(_g("chdir for du to \`%s'"), $packagebuilddir));
         exec("du","-k","-s",".") or &syserr(_g("exec du"));
         exec("du","-k","-s",".") or &syserr(_g("exec du"));
     }
     }
-    $duo=''; while (<DU>) { $duo.=$_; }
+    my $duo = '';
+    while (<DU>) {
+	$duo .= $_;
+    }
     close(DU); $? && &subprocerr(sprintf(_g("du in \`%s'"), $packagebuilddir));
     close(DU); $? && &subprocerr(sprintf(_g("du in \`%s'"), $packagebuilddir));
     $duo =~ m/^(\d+)\s+\.$/ || &failure(sprintf(_g("du gave unexpected output \`%s'"), $duo));
     $duo =~ m/^(\d+)\s+\.$/ || &failure(sprintf(_g("du gave unexpected output \`%s'"), $duo));
     $substvar{'Installed-Size'}= $1;
     $substvar{'Installed-Size'}= $1;
@@ -253,8 +282,12 @@ if (defined($substvar{'Installed-Size'})) {
     $f{'Installed-Size'}= $substvar{'Installed-Size'};
     $f{'Installed-Size'}= $substvar{'Installed-Size'};
 }
 }
 
 
-for $f (keys %override) { $f{&capit($f)}= $override{$f}; }
-for $f (keys %remove) { delete $f{&capit($f)}; }
+for my $f (keys %override) {
+    $f{capit($f)} = $override{$f};
+}
+for my $f (keys %remove) {
+    delete $f{capit($f)};
+}
 
 
 $fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
 $fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
 open(Y,"> $fileslistfile.new") || &syserr(_g("open new files list file"));
 open(Y,"> $fileslistfile.new") || &syserr(_g("open new files list file"));
@@ -275,7 +308,7 @@ if (open(X,"< $fileslistfile")) {
 } elsif ($! != ENOENT) {
 } elsif ($! != ENOENT) {
     &syserr(_g("read old files list file"));
     &syserr(_g("read old files list file"));
 }
 }
-$sversion=$f{'Version'};
+my $sversion = $f{'Version'};
 $sversion =~ s/^\d+://;
 $sversion =~ s/^\d+://;
 $forcefilename=sprintf("%s_%s_%s.deb", $oppackage,$sversion,$f{'Architecture'})
 $forcefilename=sprintf("%s_%s_%s.deb", $oppackage,$sversion,$f{'Architecture'})
 	   unless ($forcefilename);
 	   unless ($forcefilename);
@@ -285,6 +318,7 @@ print(Y &substvars(sprintf("%s %s %s\n", $forcefilename,
 close(Y) || &syserr(_g("close new files list file"));
 close(Y) || &syserr(_g("close new files list file"));
 rename("$fileslistfile.new",$fileslistfile) || &syserr(_g("install new files list file"));
 rename("$fileslistfile.new",$fileslistfile) || &syserr(_g("install new files list file"));
 
 
+my $cf;
 if (!$stdout) {
 if (!$stdout) {
     $cf= "$packagebuilddir/DEBIAN/control";
     $cf= "$packagebuilddir/DEBIAN/control";
     $cf= "./$cf" if $cf =~ m/^\s/;
     $cf= "./$cf" if $cf =~ m/^\s/;
@@ -301,7 +335,7 @@ if (!$stdout) {
 }
 }
 
 
 sub spfileslistvalue {
 sub spfileslistvalue {
-    $r= $spvalue{$_[0]};
+    my $r = $spvalue{$_[0]};
     $r = '-' if !defined($r);
     $r = '-' if !defined($r);
     return $r;
     return $r;
 }
 }

+ 17 - 8
scripts/dpkg-parsechangelog.pl

@@ -1,12 +1,11 @@
 #!/usr/bin/perl
 #!/usr/bin/perl
 
 
-$dpkglibdir= "/usr/lib/dpkg";
-$version= '1.3.0'; # This line modified by Makefile
+use strict;
+use warnings;
 
 
-$format='debian';
-$changelogfile='debian/changelog';
-@parserpath= ("/usr/local/lib/dpkg/parsechangelog",
-              "$dpkglibdir/parsechangelog");
+our $progname;
+our $version = '1.3.0'; # This line modified by Makefile
+our $dpkglibdir = "/usr/lib/dpkg"; # This line modified by Makefile
 
 
 use POSIX;
 use POSIX;
 use POSIX qw(:errno_h);
 use POSIX qw(:errno_h);
@@ -17,6 +16,15 @@ require 'controllib.pl';
 require 'dpkg-gettext.pl';
 require 'dpkg-gettext.pl';
 textdomain("dpkg-dev");
 textdomain("dpkg-dev");
 
 
+my $format ='debian';
+my $changelogfile = 'debian/changelog';
+my @parserpath = ("/usr/local/lib/dpkg/parsechangelog",
+                  "$dpkglibdir/parsechangelog");
+
+my $libdir;	# XXX: Not used!?
+my $force;
+
+
 sub version {
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
 
@@ -44,7 +52,7 @@ Options:
 "), $progname;
 "), $progname;
 }
 }
 
 
-@ap=();
+my @ap = ();
 while (@ARGV) {
 while (@ARGV) {
     last unless $ARGV[0] =~ m/^-/;
     last unless $ARGV[0] =~ m/^-/;
     $_= shift(@ARGV);
     $_= shift(@ARGV);
@@ -73,8 +81,9 @@ if (not $force and $changelogfile ne "-") {
     close(P); $? && &subprocerr(sprintf(_g("tail of %s"), $changelogfile));
     close(P); $? && &subprocerr(sprintf(_g("tail of %s"), $changelogfile));
 }
 }
 
 
+my ($pa, $pf);
 
 
-for $pd (@parserpath) {
+for my $pd (@parserpath) {
     $pa= "$pd/$format";
     $pa= "$pd/$format";
     if (!stat("$pa")) {
     if (!stat("$pa")) {
         $! == ENOENT || &syserr(sprintf(_g("failed to check for format parser %s"), $pa));
         $! == ENOENT || &syserr(sprintf(_g("failed to check for format parser %s"), $pa));

+ 6 - 4
scripts/dpkg-scansources.pl

@@ -1,8 +1,7 @@
-#!/usr/bin/perl -w
-use strict;
-
+#!/usr/bin/perl
+#
 # $Id$
 # $Id$
-
+#
 # Copyright 1999 Roderick Schertler
 # Copyright 1999 Roderick Schertler
 # Copyright 2002 Wichert Akkerman <wakkerma@debian.org>
 # Copyright 2002 Wichert Akkerman <wakkerma@debian.org>
 #
 #
@@ -27,6 +26,9 @@ use strict;
 # Proc::WaitStat modules.
 # Proc::WaitStat modules.
 
 
 
 
+use strict;
+use warnings;
+
 my $dpkglibdir= "."; # This line modified by Makefile
 my $dpkglibdir= "."; # This line modified by Makefile
 push(@INC,$dpkglibdir);
 push(@INC,$dpkglibdir);
 require 'dpkg-gettext.pl';
 require 'dpkg-gettext.pl';

+ 6 - 2
scripts/dpkg-shlibdeps.pl

@@ -3,9 +3,13 @@
 # dpkg-shlibdeps
 # dpkg-shlibdeps
 # $Id$
 # $Id$
 
 
-my $dpkglibdir="/usr/lib/dpkg";
+use strict;
+use warnings;
+
+our $progname;
+our $version = "1.4.1.19"; # This line modified by Makefile
+our $dpkglibdir = "/usr/lib/dpkg";
 my $admindir = "/var/lib/dpkg";
 my $admindir = "/var/lib/dpkg";
-my $version="1.4.1.19"; # This line modified by Makefile
 
 
 use English;
 use English;
 use POSIX qw(:errno_h :signal_h);
 use POSIX qw(:errno_h :signal_h);

+ 139 - 66
scripts/dpkg-source.pl

@@ -1,14 +1,25 @@
 #! /usr/bin/perl
 #! /usr/bin/perl
 
 
-my $dpkglibdir = ".";
-my $version = "1.3.0"; # This line modified by Makefile
+use strict;
+use warnings;
+
+our $progname;
+our $version = "1.3.0"; # This line modified by Makefile
+our $dpkglibdir = "."; # This line modified by Makefile
 
 
 my @filesinarchive;
 my @filesinarchive;
 my %dirincluded;
 my %dirincluded;
 my %notfileobject;
 my %notfileobject;
 my $fn;
 my $fn;
+my $ur;
+
+my $varlistfile;
+my $controlfile;
+my $changelogfile;
+my $changelogformat;
 
 
-$diff_ignore_default_regexp = '
+my $diff_ignore_regexp = '';
+my $diff_ignore_default_regexp = '
 # Ignore general backup files
 # Ignore general backup files
 (?:^|/).*~$|
 (?:^|/).*~$|
 # Ignore emacs recovery files
 # Ignore emacs recovery files
@@ -27,21 +38,41 @@ $diff_ignore_default_regexp = '
 $diff_ignore_default_regexp =~ s/^#.*$//mg;
 $diff_ignore_default_regexp =~ s/^#.*$//mg;
 $diff_ignore_default_regexp =~ s/\n//sg;
 $diff_ignore_default_regexp =~ s/\n//sg;
 
 
-$sourcestyle = 'X';
-$min_dscformat = 1;
-$max_dscformat = 2;
-$def_dscformat = "1.0"; # default format for -b
+my $sourcestyle = 'X';
+my $min_dscformat = 1;
+my $max_dscformat = 2;
+my $def_dscformat = "1.0"; # default format for -b
+
+my $expectprefix;
+
+# Packages
+my %remove;
+my %override;
+
+# Files
+my %md5sum;
+my %size;
+my %type;		 # used by checktype
+my %filepatched;	 # used by checkdiff
+my %dirtocreate;	 # used by checkdiff
+
+my @tar_ignore;
 
 
 use POSIX;
 use POSIX;
 use Fcntl qw (:mode);
 use Fcntl qw (:mode);
 use File::Temp qw (tempfile);
 use File::Temp qw (tempfile);
 use Cwd;
 use Cwd;
 
 
-use strict 'refs';
-
 push (@INC, $dpkglibdir);
 push (@INC, $dpkglibdir);
 require 'controllib.pl';
 require 'controllib.pl';
 
 
+our (%f, %fi, %fieldimps);
+our $sourcepackage;
+our $warnable_error;
+our $quiet_warnings;
+our %substvar;
+our @src_dep_fields;
+
 require 'dpkg-gettext.pl';
 require 'dpkg-gettext.pl';
 textdomain("dpkg-dev");
 textdomain("dpkg-dev");
 
 
@@ -124,6 +155,8 @@ sub handleformat {
 }
 }
 
 
 
 
+my $opmode;
+
 while (@ARGV && $ARGV[0] =~ m/^-/) {
 while (@ARGV && $ARGV[0] =~ m/^-/) {
     $_=shift(@ARGV);
     $_=shift(@ARGV);
     if (m/^-b$/) {
     if (m/^-b$/) {
@@ -181,7 +214,7 @@ if ($opmode eq 'build') {
 
 
     @ARGV || &usageerr(_g("-b needs a directory"));
     @ARGV || &usageerr(_g("-b needs a directory"));
     @ARGV<=2 || &usageerr(_g("-b takes at most a directory and an orig source argument"));
     @ARGV<=2 || &usageerr(_g("-b takes at most a directory and an orig source argument"));
-    $dir= shift(@ARGV);
+    my $dir = shift(@ARGV);
     $dir= "./$dir" unless $dir =~ m:^/:; $dir =~ s,/*$,,;
     $dir= "./$dir" unless $dir =~ m:^/:; $dir =~ s,/*$,,;
     stat($dir) || &error(sprintf(_g("cannot stat directory %s: %s"), $dir, $!));
     stat($dir) || &error(sprintf(_g("cannot stat directory %s: %s"), $dir, $!));
     -d $dir || &error(sprintf(_g("directory argument %s is not a directory"), $dir));
     -d $dir || &error(sprintf(_g("directory argument %s is not a directory"), $dir));
@@ -194,9 +227,14 @@ if ($opmode eq 'build') {
     $f{"Format"}=$def_dscformat;
     $f{"Format"}=$def_dscformat;
     &init_substvars;
     &init_substvars;
 
 
-    $archspecific=0;
+    my @sourcearch;
+    my $archspecific = 0; # XXX: Not used?!
+    my %packageadded;
+    my @binarypackages;
+
     for $_ (keys %fi) {
     for $_ (keys %fi) {
-        $v= $fi{$_};
+        my $v = $fi{$_};
+
         if (s/^C //) {
         if (s/^C //) {
 	    if (m/^Source$/i) {
 	    if (m/^Source$/i) {
 		setsourcepackage($v);
 		setsourcepackage($v);
@@ -212,7 +250,8 @@ if ($opmode eq 'build') {
             elsif (m/^(Section|Priority|Files|Bugs)$/i || m/^X[BC]+-/i) { }
             elsif (m/^(Section|Priority|Files|Bugs)$/i || m/^X[BC]+-/i) { }
             else { &unknown(_g('general section of control info file')); }
             else { &unknown(_g('general section of control info file')); }
         } elsif (s/^C(\d+) //) {
         } elsif (s/^C(\d+) //) {
-            $i=$1; $p=$fi{"C$i Package"};
+	    my $i = $1;
+	    my $p = $fi{"C$i Package"};
             push(@binarypackages,$p) unless $packageadded{$p}++;
             push(@binarypackages,$p) unless $packageadded{$p}++;
             if (m/^Architecture$/) {
             if (m/^Architecture$/) {
                 if (debian_arch_eq($v, 'any')) {
                 if (debian_arch_eq($v, 'any')) {
@@ -224,10 +263,12 @@ if ($opmode eq 'build') {
                         @sourcearch= ('any');
                         @sourcearch= ('any');
                     }
                     }
                 } else {
                 } else {
-		    if (grep($sourcearch[0] eq $_, 'any','all'))  {
+		    if (@sourcearch && grep($sourcearch[0] eq $_, 'any', 'all')) {
 			@sourcearch= ('any');
 			@sourcearch= ('any');
 		    } else {
 		    } else {
-			for $a (split(/\s+/, $v)) {
+			my %archadded;
+
+			for my $a (split(/\s+/, $v)) {
 			    &error(sprintf(_g("`%s' is not a legal architecture string"), $a))
 			    &error(sprintf(_g("`%s' is not a legal architecture string"), $a))
 				unless $a =~ /^[\w-]+$/;
 				unless $a =~ /^[\w-]+$/;
                             &error(sprintf(_g("architecture %s only allowed on its own".
                             &error(sprintf(_g("architecture %s only allowed on its own".
@@ -267,30 +308,36 @@ if ($opmode eq 'build') {
     }
     }
 
 
     $f{'Binary'}= join(', ',@binarypackages);
     $f{'Binary'}= join(', ',@binarypackages);
-    for $f (keys %override) { $f{&capit($f)}= $override{$f}; }
+    for my $f (keys %override) {
+	$f{capit($f)} = $override{$f};
+    }
 
 
-    for $f (qw(Version)) {
+    for my $f (qw(Version)) {
         defined($f{$f}) || &error(sprintf(_g("missing information for critical output field %s"), $f));
         defined($f{$f}) || &error(sprintf(_g("missing information for critical output field %s"), $f));
     }
     }
-    for $f (qw(Maintainer Architecture Standards-Version)) {
+    for my $f (qw(Maintainer Architecture Standards-Version)) {
 	defined($f{$f}) ||
 	defined($f{$f}) ||
 	    warning(sprintf(_g("missing information for output field %s"), $f));
 	    warning(sprintf(_g("missing information for output field %s"), $f));
     }
     }
     defined($sourcepackage) || &error(_g("unable to determine source package name !"));
     defined($sourcepackage) || &error(_g("unable to determine source package name !"));
     $f{'Source'}= $sourcepackage;
     $f{'Source'}= $sourcepackage;
-    for $f (keys %remove) { delete $f{&capit($f)}; }
+    for my $f (keys %remove) {
+	delete $f{capit($f)};
+    }
 
 
-    $version= $f{'Version'};
-    $version =~ s/^\d+://; $upstreamversion= $version; $upstreamversion =~ s/-[^-]*$//;
-    $basenamerev= $sourcepackage.'_'.$version;
-    $basename= $sourcepackage.'_'.$upstreamversion;
-    $basedirname= $basename;
+    my $version = $f{'Version'};
+    $version =~ s/^\d+://;
+    my $upstreamversion = $version;
+    $upstreamversion =~ s/-[^-]*$//;
+    my $basenamerev = $sourcepackage.'_'.$version;
+    my $basename = $sourcepackage.'_'.$upstreamversion;
+    my $basedirname = $basename;
     $basedirname =~ s/_/-/;
     $basedirname =~ s/_/-/;
 
 
-    $origdir= "$dir.orig";
-    $origtargz= "$basename.orig.tar.gz";
+    my $origdir = "$dir.orig";
+    my $origtargz = "$basename.orig.tar.gz";
     if (@ARGV) {
     if (@ARGV) {
-        $origarg= shift(@ARGV);
+        my $origarg = shift(@ARGV);
         if (length($origarg)) {
         if (length($origarg)) {
             stat($origarg) || &error(sprintf(_g("cannot stat orig argument %s: %s"), $origarg, $!));
             stat($origarg) || &error(sprintf(_g("cannot stat orig argument %s: %s"), $origarg, $!));
             if (-d _) {
             if (-d _) {
@@ -332,13 +379,23 @@ if ($opmode eq 'build') {
             $sourcestyle =~ y/aA/nn/;
             $sourcestyle =~ y/aA/nn/;
         }
         }
     }
     }
-    $dirbase= $dir; $dirbase =~ s,/?$,,; $dirbase =~ s,[^/]+$,,; $dirname= $&;
+
+    my $dirbase = $dir;
+    $dirbase =~ s,/?$,,;
+    $dirbase =~ s,[^/]+$,,;
+    my $dirname = $&;
     $dirname eq $basedirname ||
     $dirname eq $basedirname ||
 	warning(sprintf(_g("source directory '%s' is not <sourcepackage>" .
 	warning(sprintf(_g("source directory '%s' is not <sourcepackage>" .
 	                   "-<upstreamversion> '%s'"), $dir, $basedirname));
 	                   "-<upstreamversion> '%s'"), $dir, $basedirname));
 
 
+    my $tarname;
+    my $tardirname;
+    my $tardirbase;
+    my $origdirname;
+
     if ($sourcestyle ne 'n') {
     if ($sourcestyle ne 'n') {
-        $origdirbase= $origdir; $origdirbase =~ s,/?$,,;
+	my $origdirbase = $origdir;
+	$origdirbase =~ s,/?$,,;
         $origdirbase =~ s,[^/]+$,,; $origdirname= $&;
         $origdirbase =~ s,[^/]+$,,; $origdirname= $&;
 
 
         $origdirname eq "$basedirname.orig" ||
         $origdirname eq "$basedirname.orig" ||
@@ -372,7 +429,7 @@ if ($opmode eq 'build') {
 	my ($ntfh, $newtar) = tempfile( "$tarname.new.XXXXXX",
 	my ($ntfh, $newtar) = tempfile( "$tarname.new.XXXXXX",
 					DIR => &getcwd, UNLINK => 0 );
 					DIR => &getcwd, UNLINK => 0 );
         &forkgzipwrite($newtar);
         &forkgzipwrite($newtar);
-        defined($c2= fork) || &syserr(_g("fork for tar"));
+	defined(my $c2 = fork) || syserr(_g("fork for tar"));
         if (!$c2) {
         if (!$c2) {
             chdir($tardirbase) || &syserr(sprintf(_g("chdir to above (orig) source %s"), $tardirbase));
             chdir($tardirbase) || &syserr(sprintf(_g("chdir to above (orig) source %s"), $tardirbase));
             open(STDOUT,">&GZIP") || &syserr(_g("reopen gzip for tar"));
             open(STDOUT,">&GZIP") || &syserr(_g("reopen gzip for tar"));
@@ -412,7 +469,7 @@ if ($opmode eq 'build') {
         }
         }
 
 
         $expectprefix= $origdir; $expectprefix =~ s,^\./,,;
         $expectprefix= $origdir; $expectprefix =~ s,^\./,,;
-	$expectprefix_dirname = $origdirname;
+	my $expectprefix_dirname = $origdirname;
 # tar checking is disabled, there are too many broken tar archives out there
 # tar checking is disabled, there are too many broken tar archives out there
 # which we can still handle anyway.
 # which we can still handle anyway.
 #        checktarsane($origtargz,$expectprefix);
 #        checktarsane($origtargz,$expectprefix);
@@ -438,7 +495,7 @@ if ($opmode eq 'build') {
 					DIR => &getcwd, UNLINK => 0 );
 					DIR => &getcwd, UNLINK => 0 );
         &forkgzipwrite($newdiffgz);
         &forkgzipwrite($newdiffgz);
 
 
-        defined($c2= open(FIND,"-|")) || &syserr(_g("fork for find"));
+	defined(my $c2 = open(FIND, "-|")) || syserr(_g("fork for find"));
         if (!$c2) {
         if (!$c2) {
             chdir($dir) || &syserr(sprintf(_g("chdir to %s for find"), $dir));
             chdir($dir) || &syserr(sprintf(_g("chdir to %s for find"), $dir));
             exec('find','.','-print0') or &syserr(_g("exec find"));
             exec('find','.','-print0') or &syserr(_g("exec find"));
@@ -455,13 +512,15 @@ if ($opmode eq 'build') {
             if (-l _) {
             if (-l _) {
                 $type{$fn}= 'symlink';
                 $type{$fn}= 'symlink';
 		checktype($origdir, $fn, '-l') || next;
 		checktype($origdir, $fn, '-l') || next;
-                defined($n= readlink("$dir/$fn")) ||
+		defined(my $n = readlink("$dir/$fn")) ||
                     &syserr(sprintf(_g("cannot read link %s"), "$dir/$fn"));
                     &syserr(sprintf(_g("cannot read link %s"), "$dir/$fn"));
-                defined($n2= readlink("$origdir/$fn")) ||
+		defined(my $n2 = readlink("$origdir/$fn")) ||
                     &syserr(sprintf(_g("cannot read orig link %s"), "$origdir/$fn"));
                     &syserr(sprintf(_g("cannot read orig link %s"), "$origdir/$fn"));
                 $n eq $n2 || &unrepdiff2(sprintf(_g("symlink to %s"), $n2),
                 $n eq $n2 || &unrepdiff2(sprintf(_g("symlink to %s"), $n2),
                                          sprintf(_g("symlink to %s"), $n));
                                          sprintf(_g("symlink to %s"), $n));
             } elsif (-f _) {
             } elsif (-f _) {
+		my $ofnread;
+
                 $type{$fn}= 'plain file';
                 $type{$fn}= 'plain file';
                 if (!lstat("$origdir/$fn")) {
                 if (!lstat("$origdir/$fn")) {
                     $! == ENOENT || &syserr(sprintf(_g("cannot stat orig file %s"), "$origdir/$fn"));
                     $! == ENOENT || &syserr(sprintf(_g("cannot stat orig file %s"), "$origdir/$fn"));
@@ -480,7 +539,7 @@ if ($opmode eq 'build') {
                                 _g("plain file"));
                                 _g("plain file"));
                     next;
                     next;
                 }
                 }
-                defined($c3= open(DIFFGEN,"-|")) || &syserr(_g("fork for diff"));
+		defined(my $c3 = open(DIFFGEN, "-|")) || syserr(_g("fork for diff"));
                 if (!$c3) {
                 if (!$c3) {
 		    $ENV{'LC_ALL'}= 'C';
 		    $ENV{'LC_ALL'}= 'C';
 		    $ENV{'LANG'}= 'C';
 		    $ENV{'LANG'}= 'C';
@@ -490,7 +549,7 @@ if ($opmode eq 'build') {
                          '-L',"$basedirname/$fn",
                          '-L',"$basedirname/$fn",
                          '--',"$ofnread","$dir/$fn") or &syserr(_g("exec diff"));
                          '--',"$ofnread","$dir/$fn") or &syserr(_g("exec diff"));
                 }
                 }
-                $difflinefound= 0;
+		my $difflinefound = 0;
                 $/= "\n";
                 $/= "\n";
                 while (<DIFFGEN>) {
                 while (<DIFFGEN>) {
                     if (m/^binary/i) {
                     if (m/^binary/i) {
@@ -509,6 +568,7 @@ if ($opmode eq 'build') {
                     print(GZIP $_) || &syserr(_g("failed to write to gzip"));
                     print(GZIP $_) || &syserr(_g("failed to write to gzip"));
                 }
                 }
                 close(DIFFGEN); $/= "\0";
                 close(DIFFGEN); $/= "\0";
+		my $es;
                 if (WIFEXITED($?) && (($es=WEXITSTATUS($?))==0 || $es==1)) {
                 if (WIFEXITED($?) && (($es=WEXITSTATUS($?))==0 || $es==1)) {
                     if ($es==1 && !$difflinefound) {
                     if ($es==1 && !$difflinefound) {
                         &unrepdiff(_g("diff gave 1 but no diff lines found"));
                         &unrepdiff(_g("diff gave 1 but no diff lines found"));
@@ -599,12 +659,15 @@ if ($opmode eq 'build') {
 
 
     @ARGV>=1 || &usageerr(_g("-x needs at least one argument, the .dsc"));
     @ARGV>=1 || &usageerr(_g("-x needs at least one argument, the .dsc"));
     @ARGV<=2 || &usageerr(_g("-x takes no more than two arguments"));
     @ARGV<=2 || &usageerr(_g("-x takes no more than two arguments"));
-    $dsc= shift(@ARGV);
+    my $dsc = shift(@ARGV);
     $dsc= "./$dsc" unless $dsc =~ m:^/:;
     $dsc= "./$dsc" unless $dsc =~ m:^/:;
     ! -d $dsc
     ! -d $dsc
 	|| &usageerr(_g("-x needs the .dsc file as first argument, not a directory"));
 	|| &usageerr(_g("-x needs the .dsc file as first argument, not a directory"));
-    $dscdir= $dsc; $dscdir= "./$dscdir" unless $dsc =~ m,^/|^\./,;
+    my $dscdir = $dsc;
+    $dscdir = "./$dscdir" unless $dsc =~ m,^/|^\./,;
     $dscdir =~ s,/[^/]+$,,;
     $dscdir =~ s,/[^/]+$,,;
+
+    my $newdirectory;
     if (@ARGV) {
     if (@ARGV) {
 	$newdirectory= shift(@ARGV);
 	$newdirectory= shift(@ARGV);
 	! -e $newdirectory || &error(sprintf(_g("unpack target exists: %s"), $newdirectory));
 	! -e $newdirectory || &error(sprintf(_g("unpack target exists: %s"), $newdirectory));
@@ -645,7 +708,7 @@ if ($opmode eq 'build') {
     parsecdata(\*CDATA, 'S', -1, sprintf(_g("source control file %s"), $dsc));
     parsecdata(\*CDATA, 'S', -1, sprintf(_g("source control file %s"), $dsc));
     close(CDATA);
     close(CDATA);
 
 
-    for $f (qw(Source Version Files)) {
+    for my $f (qw(Source Version Files)) {
         defined($fi{"S $f"}) ||
         defined($fi{"S $f"}) ||
             &error(sprintf(_g("missing critical source control field %s"), $f));
             &error(sprintf(_g("missing critical source control field %s"), $f));
     }
     }
@@ -658,10 +721,13 @@ if ($opmode eq 'build') {
         $dscformat=$fi{'S Format'};
         $dscformat=$fi{'S Format'};
     }
     }
 
 
-    $sourcepackage = $fi{'S Source'};
+    $sourcepackage = $fi{'S Source'}; # XXX: should use setsourcepackage??
     checkpackagename( $sourcepackage );
     checkpackagename( $sourcepackage );
 
 
-    $version= $fi{'S Version'};
+    my $version = $fi{'S Version'};
+    my $baseversion;
+    my $revision;
+
     checkversion( $version );
     checkversion( $version );
     $version =~ s/^\d+://;
     $version =~ s/^\d+://;
     if ($version =~ m/-([^-]+)$/) {
     if ($version =~ m/-([^-]+)$/) {
@@ -670,12 +736,12 @@ if ($opmode eq 'build') {
         $baseversion= $version; $revision= '';
         $baseversion= $version; $revision= '';
     }
     }
 
 
-    $files = $fi{'S Files'};
+    my $files = $fi{'S Files'};
     my @tarfiles;
     my @tarfiles;
     my $difffile;
     my $difffile;
     my $debianfile;
     my $debianfile;
     my %seen;
     my %seen;
-    for $file (split(/\n /,$files)) {
+    for my $file (split(/\n /, $files)) {
         next if $file eq '';
         next if $file eq '';
         $file =~ m/^([0-9a-f]{32})[ \t]+(\d+)[ \t]+([0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+)$/
         $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(sprintf(_g("Files field contains bad line `%s'"), $file));
@@ -766,7 +832,10 @@ if ($opmode eq 'build') {
 	    if ($sourcestyle =~ /p/) {
 	    if ($sourcestyle =~ /p/) {
 		stat("$dscdir/$tarfile") ||
 		stat("$dscdir/$tarfile") ||
 		    &syserr(sprintf(_g("failed to stat `%s' to see if need to copy"), "$dscdir/$tarfile"));
 		    &syserr(sprintf(_g("failed to stat `%s' to see if need to copy"), "$dscdir/$tarfile"));
-		($dsctardev,$dsctarino) = stat _;
+
+		my ($dsctardev, $dsctarino) = stat _;
+		my ($dumptardev, $dumptarino);
+
 		if (!stat($tarfile)) {
 		if (!stat($tarfile)) {
 		    $! == ENOENT || &syserr(sprintf(_g("failed to check destination `%s'".
 		    $! == ENOENT || &syserr(sprintf(_g("failed to check destination `%s'".
 					    " to see if need to copy"), $tarfile));
 					    " to see if need to copy"), $tarfile));
@@ -810,9 +879,9 @@ if ($opmode eq 'build') {
 	push @patches, map "$newdirectory/debian/patches/$_", sort @p;
 	push @patches, map "$newdirectory/debian/patches/$_", sort @p;
     }
     }
 
 
-    for $dircreate (keys %dirtocreate) {
-	$dircreatem= "";
-	for $dircreatep (split("/", $dircreate)) {
+    for my $dircreate (keys %dirtocreate) {
+	my $dircreatem = "";
+	for my $dircreatep (split("/", $dircreate)) {
 	    $dircreatem .= $dircreatep . "/";
 	    $dircreatem .= $dircreatep . "/";
 	    if (!lstat($dircreatem)) {
 	    if (!lstat($dircreatem)) {
 		$! == ENOENT || &syserr(sprintf(_g("cannot stat %s"), $dircreatem));
 		$! == ENOENT || &syserr(sprintf(_g("cannot stat %s"), $dircreatem));
@@ -846,7 +915,7 @@ if ($opmode eq 'build') {
 	    open DIFF, $patch or &error(sprintf(_g("can't open diff `%s'"), $patch));
 	    open DIFF, $patch or &error(sprintf(_g("can't open diff `%s'"), $patch));
 	}
 	}
 
 
-        defined($c2= fork) || &syserr(_g("fork for patch"));
+	defined(my $c2 = fork) || syserr(_g("fork for patch"));
         if (!$c2) {
         if (!$c2) {
             open(STDIN,"<&DIFF") || &syserr(_g("reopen gzip for patch"));
             open(STDIN,"<&DIFF") || &syserr(_g("reopen gzip for patch"));
             chdir($newdirectory) || &syserr(sprintf(_g("chdir to %s for patch"), $newdirectory));
             chdir($newdirectory) || &syserr(sprintf(_g("chdir to %s for patch"), $newdirectory));
@@ -864,13 +933,13 @@ if ($opmode eq 'build') {
 
 
     my $now = time;
     my $now = time;
     for $fn (keys %filepatched) {
     for $fn (keys %filepatched) {
-	$ftr= "$newdirectory/".substr($fn,length($expectprefix)+1);
+	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(sprintf(_g("cannot change timestamp for %s"), $ftr));
 	$ftr.= ".dpkg-orig";
 	$ftr.= ".dpkg-orig";
 	unlink($ftr) || &syserr(sprintf(_g("remove patch backup file %s"), $ftr));
 	unlink($ftr) || &syserr(sprintf(_g("remove patch backup file %s"), $ftr));
     }
     }
 
 
-    if (!(@s= lstat("$newdirectory/debian/rules"))) {
+    if (!(my @s = lstat("$newdirectory/debian/rules"))) {
 	$! == ENOENT || &syserr(sprintf(_g("cannot stat %s"), "$newdirectory/debian/rules"));
 	$! == ENOENT || &syserr(sprintf(_g("cannot stat %s"), "$newdirectory/debian/rules"));
 	warning(sprintf(_g("%s does not exist"), "$newdirectory/debian/rules"));
 	warning(sprintf(_g("%s does not exist"), "$newdirectory/debian/rules"));
     } elsif (-f _) {
     } elsif (-f _) {
@@ -880,15 +949,18 @@ if ($opmode eq 'build') {
 	warning(sprintf(_g("%s is not a plain file"), "$newdirectory/debian/rules"));
 	warning(sprintf(_g("%s is not a plain file"), "$newdirectory/debian/rules"));
     }
     }
 
 
-    $execmode= 0777 & ~umask;
-    (@s= stat('.')) || &syserr(_g("cannot stat `.'"));
-    $dirmode= $execmode | ($s[2] & 02000);
-    $plainmode= $execmode & ~0111;
-    $fifomode= ($plainmode & 0222) | (($plainmode & 0222) << 1);
+    my $execmode = 0777 & ~umask;
+    (my @s = stat('.')) || syserr(_g("cannot stat `.'"));
+    my $dirmode = $execmode | ($s[2] & 02000);
+    my $plainmode = $execmode & ~0111;
+    my $fifomode = ($plainmode & 0222) | (($plainmode & 0222) << 1);
+
     for $fn (@filesinarchive) {
     for $fn (@filesinarchive) {
 	$fn=~ s,^$expectprefix,$newdirectory,;
 	$fn=~ s,^$expectprefix,$newdirectory,;
-        (@s= lstat($fn)) || &syserr(sprintf(_g("cannot stat extracted object `%s'"), $fn));
-        $mode= $s[2];
+	(my @s = lstat($fn)) || syserr(sprintf(_g("cannot stat extracted object `%s'"), $fn));
+	my $mode = $s[2];
+	my $newmode;
+
         if (-d _) {
         if (-d _) {
             $newmode= $dirmode;
             $newmode= $dirmode;
         } elsif (-f _) {
         } elsif (-f _) {
@@ -935,8 +1007,6 @@ sub erasedir {
     &failure(sprintf(_g("rm -rf failed to remove `%s'"), $dir));
     &failure(sprintf(_g("rm -rf failed to remove `%s'"), $dir));
 }
 }
 
 
-use strict 'vars';
-
 sub checktarcpio {
 sub checktarcpio {
 
 
     my ($tarfileread, $wpfx) = @_;
     my ($tarfileread, $wpfx) = @_;
@@ -1137,8 +1207,6 @@ sub checktarsane {
     %notfileobject = map { s/^$tarsubst/$wpfx/; $_=>1 } (keys %notfileobject);
     %notfileobject = map { s/^$tarsubst/$wpfx/; $_=>1 } (keys %notfileobject);
 }
 }
 
 
-no strict 'vars';
-
 # check diff for sanity, find directories to create as a side effect
 # check diff for sanity, find directories to create as a side effect
 sub checkdiff
 sub checkdiff
 {
 {
@@ -1182,7 +1250,7 @@ sub checkdiff
 		or &error(sprintf(_g("line after --- isn't as expected in diff `%s' (line %d)"), $diff, $.));
 		or &error(sprintf(_g("line after --- isn't as expected in diff `%s' (line %d)"), $diff, $.));
 	}
 	}
 
 
-	$dirname = $fn;
+	my $dirname = $fn;
 	if ($dirname =~ s,/[^/]+$,, && !defined($dirincluded{$dirname})) {
 	if ($dirname =~ s,/[^/]+$,, && !defined($dirincluded{$dirname})) {
 	    $dirtocreate{$dirname} = 1;
 	    $dirtocreate{$dirname} = 1;
 	}
 	}
@@ -1225,7 +1293,7 @@ sub checkdiff
 sub extracttar {
 sub extracttar {
     my ($tarfileread,$dirchdir,$newtopdir) = @_;
     my ($tarfileread,$dirchdir,$newtopdir) = @_;
     &forkgzipread("$tarfileread");
     &forkgzipread("$tarfileread");
-    defined($c2= fork) || &syserr(_g("fork for tar -xkf -"));
+    defined(my $c2 = fork) || syserr(_g("fork for tar -xkf -"));
     if (!$c2) {
     if (!$c2) {
         open(STDIN,"<&GZIP") || &syserr(_g("reopen gzip for tar -xkf -"));
         open(STDIN,"<&GZIP") || &syserr(_g("reopen gzip for tar -xkf -"));
         &cpiostderr;
         &cpiostderr;
@@ -1238,7 +1306,7 @@ sub extracttar {
     &reapgzip;
     &reapgzip;
 
 
     opendir(D,"$dirchdir") || &syserr(sprintf(_g("Unable to open dir %s"), $dirchdir));
     opendir(D,"$dirchdir") || &syserr(sprintf(_g("Unable to open dir %s"), $dirchdir));
-    @dirchdirfiles = grep($_ ne "." && $_ ne "..",readdir(D));
+    my @dirchdirfiles = grep($_ ne "." && $_ ne "..", readdir(D));
     closedir(D) || &syserr(sprintf(_g("Unable to close dir %s"), $dirchdir));
     closedir(D) || &syserr(sprintf(_g("Unable to close dir %s"), $dirchdir));
     if (@dirchdirfiles==1 && -d "$dirchdir/$dirchdirfiles[0]") {
     if (@dirchdirfiles==1 && -d "$dirchdir/$dirchdirfiles[0]") {
 	rename("$dirchdir/$dirchdirfiles[0]", "$dirchdir/$newtopdir") ||
 	rename("$dirchdir/$dirchdirfiles[0]", "$dirchdir/$newtopdir") ||
@@ -1273,7 +1341,8 @@ sub checktype {
     if (!lstat("$dir/$fn")) {
     if (!lstat("$dir/$fn")) {
         &unrepdiff2(_g("nonexistent"),$type{$fn});
         &unrepdiff2(_g("nonexistent"),$type{$fn});
     } else {
     } else {
-        $v= eval("$_[0] _ ? 2 : 1"); $v || &internerr(sprintf(_g("checktype %s (%s)"), "$@", $_[0]));
+	my $v = eval("$type _ ? 2 : 1");
+	$v || internerr(sprintf(_g("checktype %s (%s)"), "$@", $type));
         return 1 if $v == 2;
         return 1 if $v == 2;
         &unrepdiff2(_g("something else"),$type{$fn});
         &unrepdiff2(_g("something else"),$type{$fn});
     }
     }
@@ -1301,6 +1370,10 @@ sub unrepdiff2 {
     $ur++;
     $ur++;
 }
 }
 
 
+# FIXME: Local to *gzip* funcs
+my $cgz;
+my $gzipsigpipeok;
+
 sub forkgzipwrite {
 sub forkgzipwrite {
     open(GZIPFILE,"> $_[0]") || &syserr(sprintf(_g("create file %s"), $_[0]));
     open(GZIPFILE,"> $_[0]") || &syserr(sprintf(_g("create file %s"), $_[0]));
     pipe(GZIPREAD,GZIP) || &syserr(_g("pipe for gzip"));
     pipe(GZIPREAD,GZIP) || &syserr(_g("pipe for gzip"));
@@ -1353,7 +1426,7 @@ sub addfile {
     $added_files{$filename}++ &&
     $added_files{$filename}++ &&
 	&internerr( sprintf(_g("tried to add file `%s' twice"), $filename));
 	&internerr( sprintf(_g("tried to add file `%s' twice"), $filename));
     stat($filename) || &syserr(sprintf(_g("could not stat output file `%s'"), $filename));
     stat($filename) || &syserr(sprintf(_g("could not stat output file `%s'"), $filename));
-    $size= (stat _)[7];
+    my $size = (stat _)[7];
     my $md5sum= `md5sum <$filename`;
     my $md5sum= `md5sum <$filename`;
     $? && &subprocerr("md5sum $filename");
     $? && &subprocerr("md5sum $filename");
     $md5sum = readmd5sum( $md5sum );
     $md5sum = readmd5sum( $md5sum );