summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRaphaël Hertzog <hertzog@debian.org>2010-01-21 21:08:31 +0100
committerRaphaël Hertzog <hertzog@debian.org>2010-01-22 01:50:03 +0100
commit11a793f29a1b13065dc146ae203a8184a4bce780 (patch)
tree30c2d94c1570f465cad6f0e328aa4ef7a85d06d6
parent31bde76e009e2a18c8813fe61816ee9719f2228d (diff)
downloaddpkg-11a793f29a1b13065dc146ae203a8184a4bce780.tar.gz
Dpkg::Compression::CompressedFile: update API
Change the Dpkg::Compression::CompressedFile API to make it behave like a normal filehandle. Update all users of the object to use the new API.
-rw-r--r--scripts/Dpkg/Compression/CompressedFile.pm357
-rw-r--r--scripts/Dpkg/Index.pm12
-rw-r--r--scripts/Dpkg/Source/Archive.pm45
-rw-r--r--scripts/Dpkg/Source/Patch.pm61
-rwxr-xr-xscripts/dpkg-scanpackages.pl12
-rwxr-xr-xscripts/dpkg-scansources.pl18
6 files changed, 384 insertions, 121 deletions
diff --git a/scripts/Dpkg/Compression/CompressedFile.pm b/scripts/Dpkg/Compression/CompressedFile.pm
index c7eae1352..1a85ba059 100644
--- a/scripts/Dpkg/Compression/CompressedFile.pm
+++ b/scripts/Dpkg/Compression/CompressedFile.pm
@@ -1,4 +1,4 @@
-# Copyright © 2008 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2010 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
@@ -22,20 +22,112 @@ use Dpkg::Compression;
use Dpkg::Compression::Compressor;
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
-use POSIX;
+use POSIX qw(WIFSIGNALED WTERMSIG SIGPIPE);
+
+use base qw(FileHandle Tie::Handle);
+
+# Useful reference to understand some kludges required to
+# have the object behave like a filehandle
+# http://blog.woobling.org/2009/10/are-filehandles-objects.html
+
+=head1 NAME
+
+Dpkg::Compression::CompressedFile - object dealing transparently with file compression
+
+=head1 SYNOPSIS
+
+ use Dpkg::Compression::CompressedFile;
+
+ $fh = Dpkg::Compression::CompressedFile->new(filename=>"sample.gz");
+ print $fh "Something\n";
+ close $fh;
+
+ $fh = Dpkg::Compression::CompressedFile->new();
+ open($fh, ">", "sample.bz2");
+ print $fh "Something\n";
+ close $fh;
+
+ $fh = Dpkg::Compression::CompressedFile->new();
+ $fh->open("sample.xz", "w");
+ $fh->print("Something\n");
+ $fh->close();
+
+ $fh = Dpkg::Compression::CompressedFile->new(filename=>"sample.gz");
+ my @lines = <$fh>;
+ close $fh;
+
+ $fh = Dpkg::Compression::CompressedFile->new();
+ open($fh, "<", "sample.bz2");
+ my @lines = <$fh>;
+ close $fh;
+
+ $fh = Dpkg::Compression::CompressedFile->new();
+ $fh->open("sample.xz", "r");
+ my @lines = $fh->getlines();
+ $fh->close();
+
+=head1 DESCRIPTION
+
+Dpkg::Compression::CompressedFile is an object that can be used
+like any filehandle and that deals transparently with compressed
+files. By default, the compression scheme is guessed from the filename
+but you can override this behaviour with the method C<set_compression>.
+
+If you don't open the file explicitely, it will be auto-opened on the
+first read or write operation based on the filename set at creation time
+(or later with the C<set_filename> method).
+
+Once a file has been opened, the filehandle must be closed before being
+able to open another file.
+
+=head1 STANDARD FUNCTIONS
+
+The standard functions acting on filehandles should accept a
+Dpkg::Compression::CompressedFile object transparently including
+C<open> (only when using the variant with 3 parameters), C<close>,
+C<binmode>, C<eof>, C<fileno>, C<getc>, C<print>, C<printf>, C<read>,
+C<sysread>, C<say>, C<write>, C<syswrite>, C<seek>, C<sysseek>, C<tell>.
+
+Note however that C<seek> and C<sysseek> will only work on uncompressed
+files as compressed files are really pipes to the compressor programs
+and you can't seek on a pipe.
+
+=head1 FileHandle METHODS
+
+The object inherits from FileHandle so all methods that work on this
+object should work for Dpkg::Compression::CompressedFile too. There
+may be exceptions though.
+
+=head1 PUBLIC METHODS
+
+=over 4
+
+=item my $fh = Dpkg::Compression::CompressedFile->new(%opts)
+
+Creates a new filehandle supporting on-the-fly compression/decompression.
+Supported options are "filename", "compression", "compression_level" (see
+respective set_* functions) and "add_comp_ext". If "add_comp_ext"
+evaluates to true, then the extension corresponding to the selected
+compression scheme is automatically added to the recorded filename. It's
+obviously incompatible with automatic detection of the compression method.
+
+=cut
# Object methods
sub new {
my ($this, %args) = @_;
my $class = ref($this) || $this;
- my $self = {
- "compression" => "auto"
- };
+ my $self = FileHandle->new();
+ # Tying is required to overload the open functions and to auto-open
+ # the file on first read/write operation
+ tie *$self, $class, $self;
bless $self, $class;
- $self->{"compressor"} = Dpkg::Compression::Compressor->new();
- $self->{"add_comp_ext"} = $args{"add_compression_extension"} ||
+ # Initializations
+ *$self->{"compression"} = "auto";
+ *$self->{"compressor"} = Dpkg::Compression::Compressor->new();
+ *$self->{"add_comp_ext"} = $args{"add_compression_extension"} ||
$args{"add_comp_ext"} || 0;
- $self->{"allow_sigpipe"} = 0;
+ *$self->{"allow_sigpipe"} = 0;
if (exists $args{"filename"}) {
$self->set_filename($args{"filename"});
}
@@ -48,102 +140,291 @@ sub new {
return $self;
}
-sub reset {
- my ($self) = @_;
- %{$self} = ();
+=item $fh->ensure_open($mode)
+
+Ensure the file is opened in the requested mode ("r" for read and "w" for
+write). Opens the file with the recorded filename if needed. If the file
+is already open but not in the requested mode, then it errors out.
+
+=cut
+
+sub ensure_open {
+ my ($self, $mode) = @_;
+ if (exists *$self->{"mode"}) {
+ return if *$self->{"mode"} eq $mode;
+ internerr("ensure_open requested incompatible mode: $mode");
+ } else {
+ if ($mode eq "w") {
+ $self->open_for_write();
+ } elsif ($mode eq "r") {
+ $self->open_for_read();
+ } else {
+ internerr("invalid mode in ensure_open: $mode");
+ }
+ }
+}
+
+##
+## METHODS FOR TIED HANDLE
+##
+sub TIEHANDLE {
+ my ($class, $self) = @_;
+ return $self;
+}
+
+sub WRITE {
+ my ($self, $scalar, $length, $offset) = @_;
+ $self->ensure_open("w");
+ return *$self->{'file'}->write($scalar, $length, $offset);
+}
+
+sub READ {
+ my ($self, $scalar, $length, $offset) = @_;
+ $self->ensure_open("r");
+ return *$self->{'file'}->read($scalar, $length, $offset);
+}
+
+sub READLINE {
+ my ($self) = shift;
+ $self->ensure_open("r");
+ return *$self->{"file"}->getlines() if wantarray;
+ return *$self->{"file"}->getline();
+}
+
+sub OPEN {
+ my ($self) = shift;
+ if (scalar(@_) == 2) {
+ my ($mode, $filename) = @_;
+ $self->set_filename($filename);
+ if ($mode eq ">") {
+ $self->open_for_write();
+ } elsif ($mode eq "<") {
+ $self->open_for_read();
+ } else {
+ internerr("Unsupported open mode on Dpkg::Compression::CompressedFile: $mode");
+ }
+ } else {
+ internerr("Dpkg::Compression::CompressedFile only supports open() with 3 parameters");
+ }
+ return 1; # Always works (otherwise errors out)
+}
+
+sub CLOSE {
+ my ($self) = shift;
+ my $ret = 1;
+ $ret = *$self->{'file'}->close(@_) if *$self->{'file'}->opened();
+ $self->cleanup();
+ return $ret;
+}
+
+sub FILENO {
+ my ($self) = shift;
+ return *$self->{"file"}->fileno(@_);
+}
+
+sub EOF {
+ my ($self) = shift;
+ return *$self->{"file"}->eof(@_);
+}
+
+sub SEEK {
+ my ($self) = shift;
+ return *$self->{"file"}->seek(@_);
+}
+
+sub TELL {
+ my ($self) = shift;
+ return *$self->{"file"}->tell(@_);
}
+sub BINMODE {
+ my ($self) = shift;
+ return *$self->{"file"}->binmode(@_);
+}
+
+##
+## NORMAL METHODS
+##
+
+=item $fh->set_compression($comp)
+
+Defines the compression method used. $comp should one of the methods supported by
+Dpkg::Compression or "none" or "auto". "none" indicates that the file is
+uncompressed and "auto" indicates that the method must be guessed based
+on the filename extension used.
+
+=cut
+
sub set_compression {
my ($self, $method) = @_;
if ($method ne "none" and $method ne "auto") {
- $self->{"compressor"}->set_compression($method);
+ *$self->{"compressor"}->set_compression($method);
}
- $self->{"compression"} = $method;
+ *$self->{"compression"} = $method;
}
+=item $fh->set_compression_level($level)
+
+Indicate the desired compression level. It should a value supported by
+the B<set_compression_level> method of B<Dpkg::Compression::Compressor>.
+
+=cut
+
sub set_compression_level {
my ($self, $level) = @_;
- $self->{"compressor"}->set_compression_level($level);
+ *$self->{"compressor"}->set_compression_level($level);
}
+=item $fh->set_filename($name, [$add_comp_ext])
+
+Use $name as filename when the file must be opened/created. If
+$add_comp_ext is passed, it indicates whether the default extension
+of the compression method must be automatically added to the filename
+(or not).
+
+=cut
+
sub set_filename {
my ($self, $filename, $add_comp_ext) = @_;
- $self->{"filename"} = $filename;
+ *$self->{"filename"} = $filename;
# Automatically add compression extension to filename
if (defined($add_comp_ext)) {
- $self->{"add_comp_ext"} = $add_comp_ext;
+ *$self->{"add_comp_ext"} = $add_comp_ext;
}
- if ($self->{"add_comp_ext"} and $filename =~ /\.$comp_regex$/) {
+ 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);
}
}
+=item my $file = $fh->get_filename()
+
+Returns the filename that would be used when the filehandle must
+be opened (both in read and write mode). This function errors out
+if "add_comp_ext" is enableactivated while the compression method is set
+to "auto". The returned filename includes the extension of the compression
+method if "add_comp_ext" is enabled.
+
+=cut
+
sub get_filename {
my $self = shift;
- my $comp = $self->{"compression"};
- if ($self->{'add_comp_ext'}) {
+ my $comp = *$self->{"compression"};
+ if (*$self->{'add_comp_ext'}) {
if ($comp eq "auto") {
internerr("automatic detection of compression is " .
"incompatible with add_comp_ext");
} elsif ($comp eq "none") {
- return $self->{"filename"};
+ return *$self->{"filename"};
} else {
- return $self->{"filename"} . "." . $comp_ext{$comp};
+ return *$self->{"filename"} . "." . $comp_ext{$comp};
}
} else {
- return $self->{"filename"};
+ return *$self->{"filename"};
}
}
+=item $ret = $fh->use_compression()
+
+Returns "0" if no compression is used and the compression method used
+otherwise. If the compression is set to "auto", the value returned
+depends on the extension of the filename obtained with the B<get_filename>
+method.
+
+=cut
+
sub use_compression {
- my ($self, $update) = @_;
- my $comp = $self->{"compression"};
+ my ($self) = @_;
+ 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;
+ *$self->{"compressor"}->set_compression($comp) if $comp;
}
return $comp;
}
+=item my $real_fh = $fh->get_filehandle()
+
+Returns the real underlying filehandle. Useful if you want to pass it
+along in a derived object.
+
+=cut
+
+sub get_filehandle {
+ my ($self) = @_;
+ return *$self->{"file"} if exists *$self->{"file"};
+}
+
+## INTERNAL METHODS
+
sub open_for_write {
my ($self) = @_;
- my $handle;
+ error("Can't reopen an already opened compressed file") if exists *$self->{"mode"};
+ my $filehandle;
if ($self->use_compression()) {
- $self->{'compressor'}->compress(from_pipe => \$handle,
+ *$self->{'compressor'}->compress(from_pipe => \$filehandle,
to_file => $self->get_filename());
} else {
- open($handle, '>', $self->get_filename()) ||
+ CORE::open($filehandle, ">", $self->get_filename) ||
syserr(_g("cannot write %s"), $self->get_filename());
}
- return $handle;
+ *$self->{"mode"} = "w";
+ *$self->{"file"} = $filehandle;
}
sub open_for_read {
my ($self) = @_;
- my $handle;
+ error("Can't reopen an already opened compressed file") if exists *$self->{"mode"};
+ my $filehandle;
if ($self->use_compression()) {
- $self->{'compressor'}->uncompress(to_pipe => \$handle,
+ *$self->{'compressor'}->uncompress(to_pipe => \$filehandle,
from_file => $self->get_filename());
- $self->{'allow_sigpipe'} = 1;
+ *$self->{'allow_sigpipe'} = 1;
} else {
- open($handle, '<', $self->get_filename()) ||
+ CORE::open($filehandle, "<", $self->get_filename) ||
syserr(_g("cannot read %s"), $self->get_filename());
}
- return $handle;
+ *$self->{"mode"} = "r";
+ *$self->{"file"} = $filehandle;
}
-sub cleanup_after_open {
+sub cleanup {
my ($self) = @_;
- my $cmdline = $self->{"compressor"}{"cmdline"} || "";
- $self->{"compressor"}->wait_end_process(nocheck => $self->{'allow_sigpipe'});
- if ($self->{'allow_sigpipe'}) {
+ my $cmdline = *$self->{"compressor"}{"cmdline"} || "";
+ *$self->{"compressor"}->wait_end_process(nocheck => *$self->{'allow_sigpipe'});
+ if (*$self->{'allow_sigpipe'}) {
unless (($? == 0) || (WIFSIGNALED($?) && (WTERMSIG($?) == SIGPIPE))) {
subprocerr($cmdline);
}
+ *$self->{'allow_sigpipe'} = 0;
}
+ delete *$self->{"mode"};
+ delete *$self->{"file"};
}
+=back
+
+=head1 DERIVED OBJECTS
+
+If you want to create an object that inherits from
+Dpkg::Compression::CompressedFile you must be aware that
+the object is a reference to a GLOB that is returned by Symbol::gensym()
+and as such it's not a HASH.
+
+You can store internal data in a hash but you have to use
+C<*$self->{...}> to access the associated hash like in the example below:
+
+ sub set_option {
+ my ($self, $value) = @_;
+ *$self->{"option"} = $value;
+ }
+
+
+=head1 AUTHOR
+
+Raphaël Hertzog <hertzog@debian.org>
+
+=cut
1;
diff --git a/scripts/Dpkg/Index.pm b/scripts/Dpkg/Index.pm
index d2e86dc99..7d8b47bc4 100644
--- a/scripts/Dpkg/Index.pm
+++ b/scripts/Dpkg/Index.pm
@@ -156,10 +156,8 @@ parsed. Handles compressed files transparently based on their extensions.
sub load {
my ($self, $file) = @_;
my $cf = Dpkg::Compression::CompressedFile->new(filename => $file);
- my $fh = $cf->open_for_read();
- my $res = $self->parse($fh, $file);
- $cf->cleanup_after_open();
- close($fh) || syserr(_g("cannot close %s"), $file);
+ my $res = $self->parse($cf, $file);
+ close($cf) || syserr(_g("cannot close %s"), $file);
return $res;
}
@@ -192,10 +190,8 @@ based on their extensions.
sub save {
my ($self, $file) = @_;
my $cf = Dpkg::Compression::CompressedFile->new(filename => $file);
- my $fh = $cf->open_for_write();
- $self->output($fh);
- $cf->cleanup_after_open();
- close($fh) || syserr(_g("cannot close %s"), $file);
+ $self->output($cf);
+ close($cf) || syserr(_g("cannot close %s"), $file);
}
=item my $item = $index->new_item()
diff --git a/scripts/Dpkg/Source/Archive.pm b/scripts/Dpkg/Source/Archive.pm
index 3d0dcce96..202071873 100644
--- a/scripts/Dpkg/Source/Archive.pm
+++ b/scripts/Dpkg/Source/Archive.pm
@@ -38,33 +38,35 @@ sub create {
# Possibly run tar from another directory
if ($opts{"chdir"}) {
$fork_opts{"chdir"} = $opts{"chdir"};
- $self->{"chdir"} = $opts{"chdir"};
+ *$self->{"chdir"} = $opts{"chdir"};
}
# Redirect input/output appropriately
- $fork_opts{"to_handle"} = $self->open_for_write();
- $fork_opts{"from_pipe"} = \$self->{'tar_input'};
+ $self->ensure_open("w");
+ $fork_opts{"to_handle"} = $self->get_filehandle();
+ $fork_opts{"from_pipe"} = \*$self->{'tar_input'};
# Call tar creation process
$fork_opts{"delete_env"} = [ "TAR_OPTIONS" ];
$fork_opts{'exec'} = [ 'tar', '--null', '-T', '-', '--numeric-owner',
'--owner', '0', '--group', '0',
@{$opts{"options"}}, '-cf', '-' ];
- $self->{"pid"} = fork_and_exec(%fork_opts);
- $self->{"cwd"} = getcwd();
+ *$self->{"pid"} = fork_and_exec(%fork_opts);
+ *$self->{"cwd"} = getcwd();
}
sub _add_entry {
my ($self, $file) = @_;
- internerr("call create() first") unless $self->{"tar_input"};
- $file = $2 if ($file =~ /^\Q$self->{'cwd'}\E\/(.+)$/); # Relative names
- print({ $self->{'tar_input'} } "$file\0") ||
+ my $cwd = *$self->{'cwd'};
+ internerr("call create() first") unless *$self->{"tar_input"};
+ $file = $2 if ($file =~ /^\Q$cwd\E\/(.+)$/); # Relative names
+ print({ *$self->{'tar_input'} } "$file\0") ||
syserr(_g("write on tar input"));
}
sub add_file {
my ($self, $file) = @_;
my $testfile = $file;
- if ($self->{"chdir"}) {
- $testfile = File::Spec->catfile($self->{"chdir"}, $file);
+ if (*$self->{"chdir"}) {
+ $testfile = File::Spec->catfile(*$self->{"chdir"}, $file);
}
internerr("add_file() doesn't handle directories") if not -l $testfile and -d _;
$self->_add_entry($file);
@@ -73,8 +75,8 @@ sub add_file {
sub add_directory {
my ($self, $file) = @_;
my $testfile = $file;
- if ($self->{"chdir"}) {
- $testfile = File::Spec->catdir($self->{"chdir"}, $file);
+ if (*$self->{"chdir"}) {
+ $testfile = File::Spec->catdir(*$self->{"chdir"}, $file);
}
internerr("add_directory() only handles directories") unless not -l $testfile and -d _;
$self->_add_entry($file);
@@ -82,13 +84,13 @@ sub add_directory {
sub finish {
my ($self) = @_;
- close($self->{'tar_input'}) or syserr(_g("close on tar input"));
- wait_child($self->{'pid'}, cmdline => 'tar -cf -');
- delete $self->{'pid'};
- delete $self->{'tar_input'};
- delete $self->{'cwd'};
- delete $self->{'chdir'};
- $self->cleanup_after_open();
+ close(*$self->{'tar_input'}) or syserr(_g("close on tar input"));
+ wait_child(*$self->{'pid'}, cmdline => 'tar -cf -');
+ delete *$self->{'pid'};
+ delete *$self->{'tar_input'};
+ delete *$self->{'cwd'};
+ delete *$self->{'chdir'};
+ $self->close();
}
sub extract {
@@ -114,14 +116,15 @@ sub extract {
}
# Prepare stuff that handles the input of tar
- $fork_opts{"from_handle"} = $self->open_for_read();
+ $self->ensure_open("r");
+ $fork_opts{"from_handle"} = $self->get_filehandle();
# Call tar extraction process
$fork_opts{"delete_env"} = [ "TAR_OPTIONS" ];
$fork_opts{'exec'} = [ 'tar', '--no-same-owner', '--no-same-permissions',
@{$opts{"options"}}, '-xkf', '-' ];
fork_and_exec(%fork_opts);
- $self->cleanup_after_open();
+ $self->close();
# Fix permissions on extracted files because tar insists on applying
# our umask _to the original permissions_ rather than mostly-ignoring
diff --git a/scripts/Dpkg/Source/Patch.pm b/scripts/Dpkg/Source/Patch.pm
index e1b3dc24f..b7ba69dfd 100644
--- a/scripts/Dpkg/Source/Patch.pm
+++ b/scripts/Dpkg/Source/Patch.pm
@@ -19,7 +19,6 @@ use strict;
use warnings;
use Dpkg;
-use Dpkg::Compression::CompressedFile;
use Dpkg::Compression::Compressor;
use Dpkg::Compression;
use Dpkg::Gettext;
@@ -40,9 +39,9 @@ use base 'Dpkg::Compression::CompressedFile';
sub create {
my ($self, %opts) = @_;
- $self->{'handle'} = $self->open_for_write();
- $self->{'errors'} = 0;
- $self->{'empty'} = 1;
+ $self->ensure_open("w"); # Creates the file
+ *$self->{'errors'} = 0;
+ *$self->{'empty'} = 1;
if ($opts{'old'} and $opts{'new'}) {
$opts{'old'} = "/dev/null" unless -e $opts{'old'};
$opts{'new'} = "/dev/null" unless -e $opts{'new'};
@@ -59,7 +58,7 @@ sub create {
sub set_header {
my ($self, $header) = @_;
- $self->{'header'} = $header;
+ *$self->{'header'} = $header;
}
sub add_diff_file {
@@ -121,12 +120,11 @@ sub add_diff_file {
chomp;
error(_g("unknown line from diff -u on %s: `%s'"), $new, $_);
}
- if ($self->{'empty'} and defined($self->{'header'})) {
- print { $self->{'handle'} } $self->{'header'} or
- syserr(_g("failed to write"));
- $self->{'empty'} = 0;
+ if (*$self->{'empty'} and defined(*$self->{'header'})) {
+ print $self *$self->{'header'} or syserr(_g("failed to write"));
+ *$self->{'empty'} = 0;
}
- print({ $self->{'handle'} } $_) || syserr(_g("failed to write"));
+ print $self $_ || syserr(_g("failed to write"));
}
close($diffgen) or syserr("close on diff pipe");
wait_child($diff_pid, nocheck => 1,
@@ -259,16 +257,13 @@ sub add_diff_directory {
sub finish {
my ($self) = @_;
- close($self->{'handle'}) ||
- syserr(_g("cannot close %s"), $self->get_filename());
- delete $self->{'handle'};
- $self->cleanup_after_open();
- return not $self->{'errors'};
+ close($self) || syserr(_g("cannot close %s"), $self->get_filename());
+ return not *$self->{'errors'};
}
sub register_error {
my ($self) = @_;
- $self->{'errors'}++;
+ *$self->{'errors'}++;
}
sub _fail_with_msg {
my ($self, $file, $msg) = @_;
@@ -290,7 +285,6 @@ sub analyze {
my ($self, $destdir, %opts) = @_;
my $diff = $self->get_filename();
- my $diff_handle = $self->open_for_read();
my %filepatched;
my %dirtocreate;
my $diff_count = 0;
@@ -313,14 +307,14 @@ sub analyze {
$header =~ s/\s.*// unless ($header =~ s/\t.*//);
return $header;
}
- $_ = getline($diff_handle);
+ $_ = getline($self);
HUNK:
- while (defined($_) || not eof($diff_handle)) {
+ while (defined($_) || not eof($self)) {
my ($fn, $fn2);
# skip comments leading up to patch (if any)
until (/^--- /) {
- last HUNK if not defined($_ = getline($diff_handle));
+ last HUNK if not defined($_ = getline($self));
}
$diff_count++;
# read file header (---/+++ pair)
@@ -335,7 +329,7 @@ sub analyze {
error(_g("diff `%s' patches file with name ending .dpkg-orig"), $diff);
}
- unless (defined($_ = getline($diff_handle))) {
+ unless (defined($_ = getline($self))) {
error(_g("diff `%s' finishes in middle of ---/+++ (line %d)"), $diff, $.);
}
unless (s/^\+\+\+ //) {
@@ -380,14 +374,14 @@ sub analyze {
# read hunks
my $hunk = 0;
- while (defined($_ = getline($diff_handle))) {
+ while (defined($_ = getline($self))) {
# read hunk header (@@)
next if /^\\ No newline/;
last unless (/^@@ -\d+(,(\d+))? \+\d+(,(\d+))? @\@( .*)?$/);
my ($olines, $nlines) = ($1 ? $2 : 1, $3 ? $4 : 1);
# read hunk
while ($olines || $nlines) {
- unless (defined($_ = getline($diff_handle))) {
+ unless (defined($_ = getline($self))) {
if (($olines == $nlines) and ($olines < 3)) {
warning(_g("unexpected end of diff `%s'"), $diff);
last;
@@ -411,14 +405,13 @@ sub analyze {
error(_g("expected ^\@\@ at line %d of diff `%s'"), $., $diff);
}
}
- close($diff_handle);
+ close($self);
unless ($diff_count) {
warning(_g("diff `%s' doesn't contain any patch"), $diff);
}
- $self->cleanup_after_open();
- $self->{'analysis'}{$destdir}{"dirtocreate"} = \%dirtocreate;
- $self->{'analysis'}{$destdir}{"filepatched"} = \%filepatched;
- return $self->{'analysis'}{$destdir};
+ *$self->{'analysis'}{$destdir}{"dirtocreate"} = \%dirtocreate;
+ *$self->{'analysis'}{$destdir}{"filepatched"} = \%filepatched;
+ return *$self->{'analysis'}{$destdir};
}
sub prepare_apply {
@@ -445,16 +438,16 @@ sub apply {
my $analysis = $self->analyze($destdir, %opts);
$self->prepare_apply($analysis, %opts);
# Apply the patch
- my $diff_handle = $self->open_for_read();
+ $self->ensure_open("r");
fork_and_exec(
'exec' => [ 'patch', @{$opts{"options"}} ],
'chdir' => $destdir,
'env' => { LC_ALL => 'C', LANG => 'C' },
'delete_env' => [ 'POSIXLY_CORRECT' ], # ensure expected patch behaviour
'wait_child' => 1,
- 'from_handle' => $diff_handle
+ 'from_handle' => $self->get_filehandle(),
);
- $self->cleanup_after_open();
+ $self->close();
# Reset the timestamp of all the patched files
# and remove .dpkg-orig files
my $now = $opts{"timestamp"} || time;
@@ -484,21 +477,21 @@ sub check_apply {
my $analysis = $self->analyze($destdir, %opts);
$self->prepare_apply($analysis, %opts);
# Apply the patch
- my $diff_handle = $self->open_for_read();
+ $self->ensure_open("r");
my $error;
my $patch_pid = fork_and_exec(
'exec' => [ 'patch', @{$opts{"options"}} ],
'chdir' => $destdir,
'env' => { LC_ALL => 'C', LANG => 'C' },
'delete_env' => [ 'POSIXLY_CORRECT' ], # ensure expected patch behaviour
- 'from_handle' => $diff_handle,
+ 'from_handle' => $self->get_filehandle(),
'to_file' => '/dev/null',
'error_to_file' => '/dev/null',
);
wait_child($patch_pid, nocheck => 1);
my $exit = WEXITSTATUS($?);
subprocerr("patch --dry-run") unless WIFEXITED($?);
- $self->cleanup_after_open();
+ $self->close();
return ($exit == 0);
}
diff --git a/scripts/dpkg-scanpackages.pl b/scripts/dpkg-scanpackages.pl
index 7f4d23656..9ab2b978b 100755
--- a/scripts/dpkg-scanpackages.pl
+++ b/scripts/dpkg-scanpackages.pl
@@ -88,9 +88,8 @@ sub load_override
{
my $override = shift;
my $comp_file = Dpkg::Compression::CompressedFile->new(filename => $override);
- my $override_fh = $comp_file->open_for_read();
- while (<$override_fh>) {
+ while (<$comp_file>) {
s/\#.*//;
s/\s+$//;
next unless $_;
@@ -128,17 +127,15 @@ sub load_override
$overridden{$p} = 1;
}
- close($override_fh);
- $comp_file->cleanup_after_open();
+ close($comp_file);
}
sub load_override_extra
{
my $extra_override = shift;
my $comp_file = Dpkg::Compression::CompressedFile->new(filename => $extra_override);
- my $override_fh = $comp_file->open_for_read();
- while (<$override_fh>) {
+ while (<$comp_file>) {
s/\#.*//;
s/\s+$//;
next unless $_;
@@ -152,8 +149,7 @@ sub load_override_extra
}
}
- close($override_fh);
- $comp_file->cleanup_after_open();
+ close($comp_file);
}
usage() and exit 1 if not $result;
diff --git a/scripts/dpkg-scansources.pl b/scripts/dpkg-scansources.pl
index 5dab85c7d..1a66a69e9 100755
--- a/scripts/dpkg-scansources.pl
+++ b/scripts/dpkg-scansources.pl
@@ -111,8 +111,7 @@ sub load_override {
local $_;
my $comp_file = Dpkg::Compression::CompressedFile->new(filename => $file);
- my $override_fh = $comp_file->open_for_read();
- while (<$override_fh>) {
+ while (<$comp_file>) {
s/#.*//;
next if /^\s*$/;
s/\s+$//;
@@ -149,8 +148,7 @@ sub load_override {
$Override{$package}[O_MAINT_TO] = $maintainer;
}
}
- close($override_fh);
- $comp_file->cleanup_after_open();
+ close($comp_file);
}
sub load_src_override {
@@ -177,8 +175,7 @@ sub load_src_override {
debug "source override file $file";
my $comp_file = Dpkg::Compression::CompressedFile->new(filename => $file);
- my $override_fh = $comp_file->open_for_read();
- while (<$override_fh>) {
+ while (<$comp_file>) {
s/#.*//;
next if /^\s*$/;
s/\s+$//;
@@ -200,17 +197,15 @@ sub load_src_override {
$Override{$key} = [];
$Override{$key}[O_SECTION] = $section;
}
- close($override_fh);
- $comp_file->cleanup_after_open();
+ close($comp_file);
}
sub load_override_extra
{
my $extra_override = shift;
my $comp_file = Dpkg::Compression::CompressedFile->new(filename => $extra_override);
- my $override_fh = $comp_file->open_for_read();
- while (<$override_fh>) {
+ while (<$comp_file>) {
s/\#.*//;
s/\s+$//;
next unless $_;
@@ -218,8 +213,7 @@ sub load_override_extra
my ($p, $field, $value) = split(/\s+/, $_, 3);
$Extra_Override{$p}{$field} = $value;
}
- close($override_fh);
- $comp_file->cleanup_after_open();
+ close($comp_file);
}
# Given PREFIX and DSC-FILE, process the file and returns the fields.