Dpkg::Source: don't handle the compression level explicitely

* scripts/Dpkg/Source/Archiver.pm: Drop set_compression_level() and always
use the default compression level (from Dpkg::Source::Compressor).
* scripts/Dpkg/Source/Compressor.pm: New set_default_compression() and
set_default_compression_level() to change the default values of those
parameters.
* scripts/dpkg-source.pl: Change the default compression and the default
compression level globally. Replace forkgzipread(), forkgzipwrite() and
reapgzip() by direct usage of Dpkg::Source::Compressor in a way that it
inherits the compression level automatically. Also simplify some
subprocess execution by using Dpkg::IPC::fork_and_exec().

scripts/Dpkg/Source/Archiver.pm

@@ -38,9 +38,6 @@ sub new {
     if (exists $args{"compression"}) {
 	$self->use_compression($args{"compression"});
     }
-    if (exists $args{"compression_level"}) {
-	$self->set_compression_level($args{"compression_level"});
-    }
     if (exists $args{"filename"}) {
 	$self->set_filename($args{"filename"});
     }
@@ -59,23 +56,12 @@ sub use_compression {
     $self->{"compression"} = $method;
 }
 
-sub set_compression_level {
-    my ($self, $level) = @_;
-    error(_g("%s is not a compression level"), $level)
-	    unless $level =~ /^([1-9]|fast|best)$/;
-    $self->{"compression_level"} = $level;
-}
-
 sub set_filename {
     my ($self, $filename) = @_;
     $self->{"filename"} = $filename;
     # Check if compression is used
-    foreach my $comp (@comp_supported) {
-	if ($filename =~ /^(.*)\.\Q$comp_ext{$comp}\E$/) {
-	    $self->use_compression($comp);
-	    last;
-	}
-    }
+    my $comp = get_compression_from_filename($filename);
+    $self->use_compression($comp) if $comp;
 }
 
 sub get_filename {
@@ -93,10 +79,6 @@ sub create {
 	    compressed_filename => $self->get_filename(),
 	    compression => $self->{"compression"},
 	);
-	if ($self->{"compression_level"}) {
-	    $self->{"compressor"}->set_compression_level(
-		$self->{"compression_level"});
-	}
 	$self->{"compressor"}->compress(from_pipe => \$fork_opts{"to_handle"});
     } else {
 	$fork_opts{"to_file"} = $self->get_filename();

scripts/Dpkg/Source/Compressor.pm

@@ -29,6 +29,22 @@ use POSIX;
 our $default_compression = "gzip";
 our $default_compression_level = 9;
 
+# Class methods
+sub set_default_compression {
+    my ($self, $method) = @_;
+    error(_g("%s is not a supported compression"), $method)
+	    unless $comp_supported{$method};
+    $default_compression = $method;
+}
+
+sub set_default_compression_level {
+    my ($self, $level) = @_;
+    error(_g("%s is not a compression level"), $level)
+	    unless $level =~ /^([1-9]|fast|best)$/;
+    $default_compression_level = $level;
+}
+
+# Object methods
 sub new {
     my ($this, %args) = @_;
     my $class = ref($this) || $this;

scripts/dpkg-source.pl

@@ -21,6 +21,7 @@ use Dpkg::Vars;
 use Dpkg::Changelog qw(parse_changelog);
 use Dpkg::Source::Compressor;
 use Dpkg::Source::Archiver;
+use Dpkg::IPC;
 
 my @filesinarchive;
 my %dirincluded;
@@ -232,10 +233,12 @@ while (@ARGV && $ARGV[0] =~ m/^-/) {
 	$comp_ext = $comp_ext{$compression};
 	usageerr(_g("%s is not a supported compression"), $compression)
 	    unless $comp_supported{$compression};
+	Dpkg::Source::Compressor->set_default_compression($compression);
     } elsif (m/^-z/) {
 	$comp_level = $POSTMATCH;
 	usageerr(_g("%s is not a compression level"), $comp_level)
 	    unless $comp_level =~ /^([1-9]|fast|best)$/;
+	Dpkg::Source::Compressor->set_default_compression_level($comp_level);
     } elsif (m/^-s([akpursnAKPUR])$/) {
 	warning(_g("-s%s option overrides earlier -s%s option"), $1, $sourcestyle)
 	    if $sourcestyle ne 'X';
@@ -649,7 +652,10 @@ if ($opmode eq 'build') {
             || &syserr(_g("write building diff message"));
 	my ($ndfh, $newdiffgz) = tempfile( "$diffname.new.XXXXXX",
 					DIR => &getcwd, UNLINK => 0 );
-        &forkgzipwrite($newdiffgz);
+	my $compressor = Dpkg::Source::Compressor->new(
+	    compressed_filename => $newdiffgz);
+	my $diff_handle;
+	$compressor->compress(from_pipe => \$diff_handle);
 
 	defined(my $c2 = open(FIND, "-|")) || syserr(_g("fork for find"));
         if (!$c2) {
@@ -732,7 +738,7 @@ if ($opmode eq 'build') {
 			internerr(_g("unknown line from diff -u on %s: `%s'"),
 			          $fn, $_);
                     }
-		    print(GZIP $_) || &syserr(_g("failed to write to compression pipe"));
+		    print($diff_handle $_) || syserr(_g("failed to write to compression pipe"));
                 }
                 close(DIFFGEN); $/= "\0";
 		my $es;
@@ -762,8 +768,8 @@ if ($opmode eq 'build') {
             }
         }
         close(FIND); $? && subprocerr("find on $dir");
-	close(GZIP) || &syserr(_g("finish write to compression pipe"));
-        &reapgzip;
+	close($diff_handle) || syserr(_g("finish write to compression pipe"));
+        $compressor->wait_end_process();
 	rename($newdiffgz, $diffname) ||
 	    syserr(_g("unable to rename `%s' (newly created) to `%s'"),
 	           $newdiffgz, $diffname);
@@ -1118,27 +1124,24 @@ if ($opmode eq 'build') {
 
     for my $patch (@patches) {
 	printf(_g("%s: applying %s")."\n", $progname, $patch);
+	my ($diff_handle, $compressor);
 	if ($patch =~ /\.$comp_regex$/) {
-	    &forkgzipread($patch);
-	    *DIFF = *GZIP;
+	    $compressor = Dpkg::Source::Compressor->new(filename => $patch);
+	    $compressor->uncompress(to_pipe => \$diff_handle);
 	} else {
-	    open DIFF, $patch or error(_g("can't open diff `%s'"), $patch);
+	    open $diff_handle, $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(_g("chdir to %s for patch"), $newdirectory);
-	    $ENV{'LC_ALL'}= 'C';
-	    $ENV{'LANG'}= 'C';
-            exec('patch','-s','-t','-F','0','-N','-p1','-u',
-                 '-V','never','-g0','-b','-z','.dpkg-orig') or &syserr(_g("exec patch"));
-        }
-        close(DIFF);
-        $c2 == waitpid($c2,0) || &syserr(_g("wait for patch"));
-        $? && subprocerr("patch");
+	fork_and_exec(
+	    'exec' => [ 'patch', '-s', '-t', '-F', '0', '-N', '-p1', '-u',
+	                '-V', 'never', '-g0', '-b', '-z', '.dpkg-orig' ],
+	    'chdir' => $newdirectory,
+	    env => { LC_ALL => 'C', LANG => 'C' },
+	    wait_child => 1,
+	    from_handle => $diff_handle
+	);
 
-	&reapgzip if $patch =~ /\.$comp_regex$/;
+	$compressor->wait_end_process() if $patch =~ /\.$comp_regex$/;
     }
 
     my $now = time;
@@ -1215,20 +1218,21 @@ sub erasedir {
 sub checkdiff
 {
     my $diff = shift;
+    my ($diff_handle, $compressor);
     if ($diff =~ /\.$comp_regex$/) {
-	&forkgzipread($diff);
-	*DIFF = *GZIP;
+	$compressor = Dpkg::Source::Compressor->new(filename => $diff);
+	$compressor->uncompress(to_pipe => \$diff_handle);
     } else {
-	open DIFF, $diff or error(_g("can't open diff `%s'"), $diff);
+	open $diff_handle, $diff or error(_g("can't open diff `%s'"), $diff);
     }
-    $/="\n";
-    $_ = <DIFF>;
+    $/ = "\n";
+    $_ = <$diff_handle>;
 
   HUNK:
-    while (defined($_) || !eof(DIFF)) {
+    while (defined($_) || !eof($diff_handle)) {
 	# skip cruft leading up to patch (if any)
 	until (/^--- /) {
-	    last HUNK unless defined ($_ = <DIFF>);
+	    last HUNK unless defined ($_ = <$diff_handle>);
 	}
 	# read file header (---/+++ pair)
 	s/\n$// or error(_g("diff `%s' is missing trailing newline"), $diff);
@@ -1242,7 +1246,7 @@ sub checkdiff
 	          $diff);
 	$fn = $_;
 
-	(defined($_= <DIFF>) and s/\n$//) or
+	(defined($_= <$diff_handle>) and s/\n$//) or
 	    error(_g("diff `%s' finishes in middle of ---/+++ (line %d)"),
 	          $diff, $.);
 
@@ -1274,7 +1278,7 @@ sub checkdiff
 
 	# read hunks
 	my $hunk = 0;
-	while (defined($_ = <DIFF>) && !(/^--- / or /^Index:/)) {
+	while (defined($_ = <$diff_handle>) && !(/^--- / or /^Index:/)) {
 	    # read hunk header (@@)
 	    s/\n$// or error(_g("diff `%s' is missing trailing newline"), $diff);
 	    next if /^\\ No newline/;
@@ -1284,7 +1288,7 @@ sub checkdiff
 	    ++$hunk;
 	    # read hunk
 	    while ($olines || $nlines) {
-		defined($_ = <DIFF>) or
+		defined($_ = <$diff_handle>) or
 		    error(_g("unexpected end of diff `%s'"), $diff);
 		s/\n$// or
 		    error(_g("diff `%s' is missing trailing newline"), $diff);
@@ -1300,9 +1304,9 @@ sub checkdiff
 	}
 	$hunk or error(_g("expected ^\@\@ at line %d of diff `%s'"), $., $diff);
     }
-    close(DIFF);
+    close($diff_handle);
     
-    &reapgzip if $diff =~ /\.$comp_regex$/;
+    $compressor->wait_end_process() if $diff =~ /\.$comp_regex$/;
 }
 
 sub checktype {
@@ -1340,30 +1344,6 @@ sub unrepdiff2 {
     $ur++;
 }
 
-sub forkgzipwrite {
-    $compressor->set_compressed_filename($_[0]);
-    $compressor->set_compression_level($comp_level);
-
-    my $handle;
-    $compressor->compress(from_pipe => \$handle);
-    open(GZIP, ">>&=", $handle) || syserr(_g("cannot associate handle"));
-    close($handle);
-}
-
-sub forkgzipread {
-    $compressor->set_compressed_filename($_[0]);
-    $compressor->set_compression_level($comp_level);
-
-    my $handle;
-    $compressor->uncompress(to_pipe => \$handle);
-    open(GZIP, "<&=", $handle) || syserr(_g("cannot associate handle"));
-    close($handle);
-}
-
-sub reapgzip {
-    $compressor->wait_end_process();
-}
-
 my %added_files;
 sub addfile {
     my ($fields, $filename)= @_;