use strict;
use warnings;
+use Dpkg::Source::CompressedFile;
use Dpkg::Source::Compressor;
use Dpkg::Compression;
use Dpkg::Gettext;
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();
}
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 {
$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);
--- /dev/null
+# 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;
use Dpkg::Compression;
use Dpkg::Gettext;
use Dpkg::IPC;
-use Dpkg::ErrorHandling qw(error syserr warning);
+use Dpkg::ErrorHandling qw(error);
use POSIX;
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;
}
$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"}});
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"};
}
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
my @tar_ignore;
my $substvars = Dpkg::Substvars->new();
-my $compressor = Dpkg::Source::Compressor->new();
use POSIX;
use Fcntl qw (:mode);
|| &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) {
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);
}
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/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
projects / dpkg / commitdiff