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.

1 files changed, 319 insertions, 38 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;