From 1d37bbf2b713fbc3aa89554016a2a81aaaa248f2 Mon Sep 17 00:00:00 2001 From: Raphael Hertzog Date: Thu, 21 Feb 2008 00:12:40 +0100 Subject: [PATCH] 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 | 77 ++------------ scripts/Dpkg/Source/CompressedFile.pm | 141 ++++++++++++++++++++++++++ scripts/Dpkg/Source/Compressor.pm | 98 +++++------------- scripts/Makefile.am | 1 + scripts/dpkg-source.pl | 14 ++- scripts/po/POTFILES.in | 1 + 6 files changed, 186 insertions(+), 146 deletions(-) create mode 100644 scripts/Dpkg/Source/CompressedFile.pm diff --git a/scripts/Dpkg/Source/Archiver.pm b/scripts/Dpkg/Source/Archiver.pm index ef390a05..5f761bf2 100644 --- a/scripts/Dpkg/Source/Archiver.pm +++ b/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); diff --git a/scripts/Dpkg/Source/CompressedFile.pm b/scripts/Dpkg/Source/CompressedFile.pm new file mode 100644 index 00000000..94fdce93 --- /dev/null +++ b/scripts/Dpkg/Source/CompressedFile.pm @@ -0,0 +1,141 @@ +# Copyright 2008 Raphaël Hertzog + +# 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; diff --git a/scripts/Dpkg/Source/Compressor.pm b/scripts/Dpkg/Source/Compressor.pm index c489b2d5..1843a2fb 100644 --- a/scripts/Dpkg/Source/Compressor.pm +++ b/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"}; } diff --git a/scripts/Makefile.am b/scripts/Makefile.am index c447c4c5..eef3e35b 100644 --- a/scripts/Makefile.am +++ b/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 diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl index 79d1dae0..0759c9e9 100755 --- a/scripts/dpkg-source.pl +++ b/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); } diff --git a/scripts/po/POTFILES.in b/scripts/po/POTFILES.in index 8cda4723..e15cfe06 100644 --- a/scripts/po/POTFILES.in +++ b/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 -- 2.39.5