Browse Source

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.
Raphaël Hertzog 16 years ago
parent
commit
11a793f29a

+ 319 - 38
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;

+ 4 - 8
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()

+ 24 - 21
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

+ 27 - 34
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);
 }
 

+ 4 - 8
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;

+ 6 - 12
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.