From: Raphael Hertzog Date: Wed, 20 Feb 2008 19:55:19 +0000 (+0100) Subject: Dpkg::Source: don't handle the compression level explicitely X-Git-Url: https://err.no/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=dec4b74c5838663d25f49870b7c282bfe565bf7c;p=dpkg 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 6a05c97e..ef390a05 100644 --- 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 78e9f00f..c489b2d5 100644 --- 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 118098f3..79d1dae0 100755 --- 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"; - $_ = ; + $/ = "\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 ($_ = ); + 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($_= ) 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($_ = ) && !(/^--- / 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($_ = ) 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)= @_;