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().

diff --git a/scripts/Dpkg/Source/Archiver.pm b/scripts/Dpkg/Source/Archiver.pm
index 6a05c97e29305031298e9cb638ab5c97a3aefc02..ef390a05b74479406ad71743126208475beea9ff 100644 (file)
--- a/scripts/Dpkg/Source/Archiver.pm
+++ b/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();

diff --git a/scripts/Dpkg/Source/Compressor.pm b/scripts/Dpkg/Source/Compressor.pm
index 78e9f00f05c819622a74c147a988fbef5235eecc..c489b2d57a5f2023c00e815460b3bc2d569632bd 100644 (file)
--- a/scripts/Dpkg/Source/Compressor.pm
+++ b/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;

diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl
index 118098f3c1372c6945fe691f56cdb62a5b5a1fdd..79d1dae097c3dfcf60d11439a32cdc910535d557 100755 (executable)
--- a/scripts/dpkg-source.pl
+++ b/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)= @_;