Create Dpkg::Source::CompressedFile as spinoff of Dpkg::Source::Compressor

* scripts/Dpkg/Source/Compressor.pm: Drom from this object
all filename related code and move it ...
* scripts/Dpkg/Source/CompressedFile.pm: ...here. This
object is a named file and it handles either explicit
compression (call to set_compression()) or implicit compression
(compression type is guessed from the filename). It offers
open_for_write() and open_for_read() to write into/read from
a data stream that is compressed/uncompressed on the fly.
* scripts/Dpkg/Source/Archiver.pm: Make it based on
CompressedFile and simplify code.
* scripts/dpkg-source.pl: Adapt code to the new interface of
the Compressor object.
* scripts/Makefile.am, scripts/po/POTFILES.in: register new
file CompressedFile.pm.

scripts/Dpkg/Source/Archiver.pm

@@ -19,6 +19,7 @@ package Dpkg::Source::Archiver;
 use strict;
 use warnings;
 
+use Dpkg::Source::CompressedFile;
 use Dpkg::Source::Compressor;
 use Dpkg::Compression;
 use Dpkg::Gettext;
@@ -30,65 +31,19 @@ use File::Temp qw(tempdir);
 use File::Path qw(rmtree mkpath);
 use File::Basename qw(basename);
 
-sub new {
-    my ($this, %args) = @_;
-    my $class = ref($this) || $this;
-    my $self = {};
-    bless $self, $class;
-    if (exists $args{"compression"}) {
-	$self->use_compression($args{"compression"});
-    }
-    if (exists $args{"filename"}) {
-	$self->set_filename($args{"filename"});
-    }
-    return $self;
-}
-
-sub reset {
-    my ($self) = @_;
-    %{$self} = ();
-}
-
-sub use_compression {
-    my ($self, $method) = @_;
-    error(_g("%s is not a supported compression method"), $method)
-	    unless $comp_supported{$method};
-    $self->{"compression"} = $method;
-}
-
-sub set_filename {
-    my ($self, $filename) = @_;
-    $self->{"filename"} = $filename;
-    # Check if compression is used
-    my $comp = get_compression_from_filename($filename);
-    $self->use_compression($comp) if $comp;
-}
-
-sub get_filename {
-    my $self = shift;
-    return $self->{"filename"};
-}
+use base 'Dpkg::Source::CompressedFile';
 
 sub create {
     my ($self, %opts) = @_;
     $opts{"options"} ||= [];
     my %fork_opts;
-    # Prepare stuff that handles the output of tar
-    if ($self->{"compression"}) {
-	$self->{"compressor"} = Dpkg::Source::Compressor->new(
-	    compressed_filename => $self->get_filename(),
-	    compression => $self->{"compression"},
-	);
-	$self->{"compressor"}->compress(from_pipe => \$fork_opts{"to_handle"});
-    } else {
-	$fork_opts{"to_file"} = $self->get_filename();
-    }
-    # Prepare input to tar
+    # Redirect input/output appropriately
+    $fork_opts{"to_handle"} = $self->open_for_write();
     $fork_opts{"from_pipe"} = \$self->{'tar_input'};
     # Call tar creation process
-    $fork_opts{'exec'} = [ 'tar', '--null', '-T', '-', @{$opts{"options"}}, '-cf', '-' ];
+    $fork_opts{'exec'} = [ 'tar', '--null', '-T', '-',
+			   @{$opts{"options"}}, '-cf', '-' ];
     $self->{"pid"} = fork_and_exec(%fork_opts);
-    binmode($self->{'tar_input'});
     $self->{"cwd"} = getcwd();
 }
 
@@ -116,11 +71,10 @@ sub close {
     my ($self) = @_;
     close($self->{'tar_input'}) or syserr(_g("close on tar input"));
     wait_child($self->{'pid'}, cmdline => 'tar -cf -');
-    $self->{'compressor'}->wait_end_process() if $self->{'compressor'};
     delete $self->{'pid'};
     delete $self->{'tar_input'};
     delete $self->{'cwd'};
-    delete $self->{'compressor'};
+    $self->cleanup_after_open();
 }
 
 sub extract {
@@ -134,24 +88,13 @@ sub extract {
     $fork_opts{"chdir"} = $tmp;
 
     # Prepare stuff that handles the input of tar
-    if ($self->{"compression"}) {
-	$self->{"compressor"} = Dpkg::Source::Compressor->new(
-	    compressed_filename => $self->get_filename(),
-	    compression => $self->{"compression"},
-	);
-	$self->{"compressor"}->uncompress(to_pipe => \$fork_opts{"from_handle"});
-    } else {
-	$fork_opts{"from_file"} = $self->get_filename();
-    }
+    $fork_opts{"from_handle"} = $self->open_for_read();
 
     # Call tar extraction process
     $fork_opts{'exec'} = [ 'tar', '--no-same-owner', '--no-same-permissions',
-	    @{$opts{"options"}}, '-xkf', '-' ];
+                           @{$opts{"options"}}, '-xkf', '-' ];
     fork_and_exec(%fork_opts);
-
-    # Clean up compressor
-    $self->{'compressor'}->wait_end_process() if $self->{'compressor'};
-    delete $self->{'compressor'};
+    $self->cleanup_after_open();
 
     # Fix permissions on extracted files...
     my ($mode, $modes_set, $i, $j);

scripts/Dpkg/Source/CompressedFile.pm

@@ -0,0 +1,141 @@
+# Copyright 2008 Raphaël Hertzog <hertzog@debian.org>
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package Dpkg::Source::CompressedFile;
+
+use strict;
+use warnings;
+
+use Dpkg::Compression;
+use Dpkg::Source::Compressor;
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling qw(error syserr warning);
+
+# Object methods
+sub new {
+    my ($this, %args) = @_;
+    my $class = ref($this) || $this;
+    my $self = {
+	"compression" => "auto"
+    };
+    bless $self, $class;
+    $self->{"compressor"} = Dpkg::Source::Compressor->new();
+    $self->{"add_comp_ext"} = $args{"add_compression_extension"} ||
+	    $args{"add_comp_ext"} || 0;
+    if (exists $args{"filename"}) {
+	$self->set_filename($args{"filename"});
+    }
+    if (exists $args{"compression"}) {
+	$self->set_compression($args{"compression"});
+    }
+    if (exists $args{"compression_level"}) {
+	$self->set_compression_level($args{"compression_level"});
+    }
+    return $self;
+}
+
+sub reset {
+    my ($self) = @_;
+    %{$self} = ();
+}
+
+sub set_compression {
+    my ($self, $method) = @_;
+    if ($method ne "none" and $method ne "auto") {
+	$self->{"compressor"}->set_compression($method);
+    }
+    $self->{"compression"} = $method;
+}
+
+sub set_compression_level {
+    my ($self, $level) = @_;
+    $self->{"compressor"}->set_compression_level($level);
+}
+
+sub set_filename {
+    my ($self, $filename, $add_comp_ext) = @_;
+    $self->{"filename"} = $filename;
+    # Automatically add compression extension to filename
+    if (defined($add_comp_ext)) {
+	$self->{"add_comp_ext"} = $add_comp_ext;
+    }
+    if ($self->{"add_comp_ext"} and $filename =~ /\.$comp_regex$/) {
+	warning("filename %s already has an extension of a compressed file " .
+	        "and add_comp_ext is active", $filename);
+    }
+}
+
+sub get_filename {
+    my $self = shift;
+    my $comp = $self->{"compression"};
+    if ($self->{'add_comp_ext'}) {
+	if ($comp eq "auto") {
+	    error("automatic detection of compression is " .
+	          "incompatible with add_comp_ext");
+	} elsif ($comp eq "none") {
+	    return $self->{"filename"};
+	} else {
+	    return $self->{"filename"} . "." . $comp_ext{$comp};
+	}
+    } else {
+	return $self->{"filename"};
+    }
+}
+
+sub use_compression {
+    my ($self, $update) = @_;
+    my $comp = $self->{"compression"};
+    if ($comp eq "none") {
+	return 0;
+    } elsif ($comp eq "auto") {
+	$comp = get_compression_from_filename($self->get_filename());
+	$self->{"compressor"}->set_compression($comp) if $comp;
+    }
+    return $comp;
+}
+
+sub open_for_write {
+    my ($self) = @_;
+    my $handle;
+    if ($self->use_compression()) {
+	$self->{'compressor'}->compress(from_pipe => \$handle,
+		to_file => $self->get_filename());
+    } else {
+	open($handle, '>', $self->get_filename()) ||
+		syserr(_g("cannot write %s"), $self->get_filename());
+    }
+    return $handle;
+}
+
+sub open_for_read {
+    my ($self) = @_;
+    my $handle;
+    if ($self->use_compression()) {
+	$self->{'compressor'}->uncompress(to_pipe => \$handle,
+		from_file => $self->get_filename());
+    } else {
+	open($handle, '<', $self->get_filename()) ||
+		syserr(_g("cannot read %s"), $self->get_filename());
+    }
+    return $handle;
+}
+
+sub cleanup_after_open {
+    my ($self) = @_;
+    $self->{"compressor"}->wait_end_process();
+}
+
+1;

scripts/Dpkg/Source/Compressor.pm

@@ -22,7 +22,7 @@ use warnings;
 use Dpkg::Compression;
 use Dpkg::Gettext;
 use Dpkg::IPC;
-use Dpkg::ErrorHandling qw(error syserr warning);
+use Dpkg::ErrorHandling qw(error);
 
 use POSIX;
 
@@ -48,26 +48,11 @@ sub set_default_compression_level {
 sub new {
     my ($this, %args) = @_;
     my $class = ref($this) || $this;
-    my $self = {
-	"compression" => $default_compression,
-	"compression_level" => $default_compression_level,
-    };
+    my $self = {};
     bless $self, $class;
-    if (exists $args{"compression"}) {
-	$self->set_compression($args{"compression"});
-    }
-    if (exists $args{"compression_level"}) {
-	$self->set_compression_level($args{"compression_level"});
-    }
-    if (exists $args{"filename"}) {
-	$self->set_filename($args{"filename"});
-    }
-    if (exists $args{"uncompressed_filename"}) {
-	$self->set_uncompressed_filename($args{"uncompressed_filename"});
-    }
-    if (exists $args{"compressed_filename"}) {
-	$self->set_compressed_filename($args{"compressed_filename"});
-    }
+    $self->set_compression($args{"compression"} || $default_compression);
+    $self->set_compression_level($args{"compression_level"} ||
+	    $default_compression_level);
     return $self;
 }
 
@@ -85,39 +70,6 @@ sub set_compression_level {
     $self->{"compression_level"} = $level;
 }
 
-sub set_filename {
-    my ($self, $filename) = @_;
-    my $comp = get_compression_from_filename($filename);
-    if ($comp) {
-	$self->set_compression($comp);
-	$self->set_compressed_filename($filename);
-    } else {
-	error(_g("unknown compression type on file %s"), $filename);
-    }
-}
-
-sub set_compressed_filename {
-    my ($self, $filename) = @_;
-    $self->{"compressed_filename"} = $filename;
-}
-
-sub set_uncompressed_filename {
-    my ($self, $filename) = @_;
-    warning(_g("uncompressed filename %s has an extension of a compressed file"),
-	    $filename) if $filename =~ /\.$comp_regex$/;
-    $self->{"uncompressed_filename"} = $filename;
-}
-
-sub get_filename {
-    my $self = shift;
-    if ($self->{"compressed_filename"}) {
-	return $self->{"compressed_filename"};
-    } elsif ($self->{"uncompressed_filename"}) {
-	return $self->{"uncompressed_filename"} . "." .
-	       $comp_ext{$self->{"compression"}};
-    }
-}
-
 sub get_compress_cmdline {
     my ($self) = @_;
     my @prog = ($comp_prog{$self->{"compression"}});
@@ -133,41 +85,45 @@ sub get_uncompress_cmdline {
     return ($comp_decomp_prog{$self->{"compression"}});
 }
 
-sub compress {
+sub _sanity_check {
     my ($self, %opts) = @_;
-    unless($opts{"from_file"} or $opts{"from_handle"} or $opts{"from_pipe"}) {
-	error("compress() needs a from_{file,handle,pipe} parameter");
-    }
-    unless($opts{"to_file"} or $opts{"to_handle"} or $opts{"to_pipe"}) {
-	$opts{"to_file"} = $self->get_filename();
-    }
+    # Check for proper cleaning before new start
     error(_g("Dpkg::Source::Compressor can only start one subprocess at a time"))
 	    if $self->{"pid"};
+    # Check options
+    my $to = my $from = 0;
+    foreach (qw(file handle string pipe)) {
+        $to++ if $opts{"to_$_"};
+        $from++ if $opts{"from_$_"};
+    }
+    error("exactly one to_* parameter is needed") if $to != 1;
+    error("exactly one from_* parameter is needed") if $from != 1;
+    return %opts;
+}
+
+sub compress {
+    my $self = shift;
+    my %opts = $self->_sanity_check(@_);
     my @prog = $self->get_compress_cmdline();
     $opts{"exec"} = \@prog;
     $self->{"cmdline"} = "@prog";
     $self->{"pid"} = fork_and_exec(%opts);
+    delete $self->{"pid"} if $opts{"to_string"}; # wait_child already done
 }
 
 sub uncompress {
-    my ($self, %opts) = @_;
-    unless($opts{"from_file"} or $opts{"from_handle"} or $opts{"from_pipe"}) {
-	$opts{"from_file"} = $self->get_filename();
-    }
-    unless($opts{"to_file"} or $opts{"to_handle"} or $opts{"to_pipe"}) {
-	error("uncompress() needs a to_{file,handle,pipe} parameter");
-    }
-    error(_g("Dpkg::Source::Compressor can only start one subprocess at a time"))
-	    if $self->{"pid"};
+    my $self = shift;
+    my %opts = $self->_sanity_check(@_);
     my @prog = $self->get_uncompress_cmdline();
-    $self->{"cmdline"} = "@prog";
     $opts{"exec"} = \@prog;
+    $self->{"cmdline"} = "@prog";
     $self->{"pid"} = fork_and_exec(%opts);
+    delete $self->{"pid"} if $opts{"to_string"}; # wait_child already done
 }
 
 sub wait_end_process {
     my ($self) = @_;
-    wait_child($self->{"pid"}, cmdline => $self->{"cmdline"});
+    wait_child($self->{"pid"}, cmdline => $self->{"cmdline"}) if $self->{'pid'};
     delete $self->{"pid"};
     delete $self->{"cmdline"};
 }

scripts/Makefile.am

@@ -106,6 +106,7 @@ nobase_dist_perllib_DATA = \
 	Dpkg/Vars.pm \
 	Dpkg/Version.pm \
 	Dpkg/Source/Archiver.pm \
+	Dpkg/Source/CompressedFile.pm \
 	Dpkg/Source/Compressor.pm \
 	Dpkg/Source/VCS/git.pm \
 	Dpkg.pm

scripts/dpkg-source.pl

@@ -111,7 +111,6 @@ my %dirtocreate;	 # used by checkdiff
 my @tar_ignore;
 
 my $substvars = Dpkg::Substvars->new();
-my $compressor = Dpkg::Source::Compressor->new();
 
 use POSIX;
 use Fcntl qw (:mode);
@@ -652,10 +651,9 @@ if ($opmode eq 'build') {
             || &syserr(_g("write building diff message"));
 	my ($ndfh, $newdiffgz) = tempfile( "$diffname.new.XXXXXX",
 					DIR => &getcwd, UNLINK => 0 );
-	my $compressor = Dpkg::Source::Compressor->new(
-	    compressed_filename => $newdiffgz);
+	my $compressor = Dpkg::Source::Compressor->new();
 	my $diff_handle;
-	$compressor->compress(from_pipe => \$diff_handle);
+	$compressor->compress(from_pipe => \$diff_handle, to_file => $newdiffgz);
 
 	defined(my $c2 = open(FIND, "-|")) || syserr(_g("fork for find"));
         if (!$c2) {
@@ -1126,8 +1124,8 @@ if ($opmode eq 'build') {
 	printf(_g("%s: applying %s")."\n", $progname, $patch);
 	my ($diff_handle, $compressor);
 	if ($patch =~ /\.$comp_regex$/) {
-	    $compressor = Dpkg::Source::Compressor->new(filename => $patch);
-	    $compressor->uncompress(to_pipe => \$diff_handle);
+	    $compressor = Dpkg::Source::Compressor->new();
+	    $compressor->uncompress(from_file => $patch, to_pipe => \$diff_handle);
 	} else {
 	    open $diff_handle, $patch or error(_g("can't open diff `%s'"), $patch);
 	}
@@ -1220,8 +1218,8 @@ sub checkdiff
     my $diff = shift;
     my ($diff_handle, $compressor);
     if ($diff =~ /\.$comp_regex$/) {
-	$compressor = Dpkg::Source::Compressor->new(filename => $diff);
-	$compressor->uncompress(to_pipe => \$diff_handle);
+	$compressor = Dpkg::Source::Compressor->new();
+	$compressor->uncompress(from_file => $diff, to_pipe => \$diff_handle);
     } else {
 	open $diff_handle, $diff or error(_g("can't open diff `%s'"), $diff);
     }

scripts/po/POTFILES.in

@@ -28,6 +28,7 @@ scripts/Dpkg/Shlibs.pm
 scripts/Dpkg/Shlibs/Objdump.pm
 scripts/Dpkg/Shlibs/SymbolFile.pm
 scripts/Dpkg/Source/Archiver.pm
+scripts/Dpkg/Source/CompressedFile.pm
 scripts/Dpkg/Source/Compressor.pm
 scripts/Dpkg/Source/VCS/git.pm
 scripts/Dpkg/Substvars.pm