Index: third_party/dpkg-dev/scripts/Dpkg/Compression/FileHandle.pm |
diff --git a/third_party/dpkg-dev/scripts/Dpkg/Compression/FileHandle.pm b/third_party/dpkg-dev/scripts/Dpkg/Compression/FileHandle.pm |
new file mode 100644 |
index 0000000000000000000000000000000000000000..a214ea4a2099c90826ed09356cee0df372df2901 |
--- /dev/null |
+++ b/third_party/dpkg-dev/scripts/Dpkg/Compression/FileHandle.pm |
@@ -0,0 +1,451 @@ |
+# 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 |
+# 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, see <https://www.gnu.org/licenses/>. |
+ |
+package Dpkg::Compression::FileHandle; |
+ |
+use strict; |
+use warnings; |
+ |
+our $VERSION = '1.00'; |
+ |
+use Dpkg::Compression; |
+use Dpkg::Compression::Process; |
+use Dpkg::Gettext; |
+use Dpkg::ErrorHandling; |
+ |
+use Carp; |
+use POSIX qw(:signal_h :sys_wait_h); |
+ |
+use parent 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 |
+ |
+=encoding utf8 |
+ |
+=head1 NAME |
+ |
+Dpkg::Compression::FileHandle - object dealing transparently with file compression |
+ |
+=head1 SYNOPSIS |
+ |
+ use Dpkg::Compression::FileHandle; |
+ |
+ $fh = Dpkg::Compression::FileHandle->new(filename => 'sample.gz'); |
+ print $fh "Something\n"; |
+ close $fh; |
+ |
+ $fh = Dpkg::Compression::FileHandle->new(); |
+ open($fh, '>', 'sample.bz2'); |
+ print $fh "Something\n"; |
+ close $fh; |
+ |
+ $fh = Dpkg::Compression::FileHandle->new(); |
+ $fh->open('sample.xz', 'w'); |
+ $fh->print("Something\n"); |
+ $fh->close(); |
+ |
+ $fh = Dpkg::Compression::FileHandle->new(filename => 'sample.gz'); |
+ my @lines = <$fh>; |
+ close $fh; |
+ |
+ $fh = Dpkg::Compression::FileHandle->new(); |
+ open($fh, '<', 'sample.bz2'); |
+ my @lines = <$fh>; |
+ close $fh; |
+ |
+ $fh = Dpkg::Compression::FileHandle->new(); |
+ $fh->open('sample.xz', 'r'); |
+ my @lines = $fh->getlines(); |
+ $fh->close(); |
+ |
+=head1 DESCRIPTION |
+ |
+Dpkg::Compression::FileHandle 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 explicitly, 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::FileHandle 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::FileHandle too. There |
+may be exceptions though. |
+ |
+=head1 PUBLIC METHODS |
+ |
+=over 4 |
+ |
+=item my $fh = Dpkg::Compression::FileHandle->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 = 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; |
+ # Initializations |
+ *$self->{compression} = 'auto'; |
+ *$self->{compressor} = Dpkg::Compression::Process->new(); |
+ *$self->{add_comp_ext} = $args{add_compression_extension} || |
+ $args{add_comp_ext} || 0; |
+ *$self->{allow_sigpipe} = 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; |
+} |
+ |
+=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; |
+ croak "ensure_open requested incompatible mode: $mode"; |
+ } else { |
+ if ($mode eq 'w') { |
+ $self->open_for_write(); |
+ } elsif ($mode eq 'r') { |
+ $self->open_for_read(); |
+ } else { |
+ croak "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 { |
+ croak 'Dpkg::Compression::FileHandle does not support ' . |
+ "open() mode $mode"; |
+ } |
+ } else { |
+ croak 'Dpkg::Compression::FileHandle only supports open() ' . |
+ 'with 3 parameters'; |
+ } |
+ return 1; # Always works (otherwise errors out) |
+} |
+ |
+sub CLOSE { |
+ my ($self) = shift; |
+ my $ret = 1; |
+ if (defined *$self->{file}) { |
+ $ret = *$self->{file}->close(@_) if *$self->{file}->opened(); |
+ } else { |
+ $ret = 0; |
+ } |
+ $self->cleanup(); |
+ return $ret; |
+} |
+ |
+sub FILENO { |
+ my ($self) = shift; |
+ return *$self->{file}->fileno(@_) if defined *$self->{file}; |
+ return; |
+} |
+ |
+sub EOF { |
+ # Since perl 5.12, an integer parameter is passed describing how the |
+ # function got called, just ignore it. |
+ my ($self, $param) = (shift, shift); |
+ return *$self->{file}->eof(@_) if defined *$self->{file}; |
+ return 1; |
+} |
+ |
+sub SEEK { |
+ my ($self) = shift; |
+ return *$self->{file}->seek(@_) if defined *$self->{file}; |
+ return 0; |
+} |
+ |
+sub TELL { |
+ my ($self) = shift; |
+ return *$self->{file}->tell(@_) if defined *$self->{file}; |
+ return -1; |
+} |
+ |
+sub BINMODE { |
+ my ($self) = shift; |
+ return *$self->{file}->binmode(@_) if defined *$self->{file}; |
+ return; |
+} |
+ |
+## |
+## NORMAL METHODS |
+## |
+ |
+=item $fh->set_compression($comp) |
+ |
+Defines the compression method used. $comp should one of the methods supported by |
+B<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->{compression} = $method; |
+} |
+ |
+=item $fh->set_compression_level($level) |
+ |
+Indicate the desired compression level. It should be a value accepted |
+by the function C<compression_is_valid_level> of B<Dpkg::Compression>. |
+ |
+=cut |
+ |
+sub set_compression_level { |
+ my ($self, $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; |
+ # Automatically add compression extension to filename |
+ if (defined($add_comp_ext)) { |
+ *$self->{add_comp_ext} = $add_comp_ext; |
+ } |
+ my $comp_ext_regex = compression_get_file_extension_regex(); |
+ if (*$self->{add_comp_ext} and $filename =~ /\.$comp_ext_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 enabled 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}) { |
+ if ($comp eq 'auto') { |
+ croak 'automatic detection of compression is ' . |
+ 'incompatible with add_comp_ext'; |
+ } elsif ($comp eq 'none') { |
+ return *$self->{filename}; |
+ } else { |
+ return *$self->{filename} . '.' . |
+ compression_get_property($comp, 'file_ext'); |
+ } |
+ } else { |
+ 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) = @_; |
+ my $comp = *$self->{compression}; |
+ if ($comp eq 'none') { |
+ return 0; |
+ } elsif ($comp eq 'auto') { |
+ $comp = compression_guess_from_filename($self->get_filename()); |
+ *$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) = @_; |
+ error("Can't reopen an already opened compressed file") if exists *$self->{mode}; |
+ my $filehandle; |
+ if ($self->use_compression()) { |
+ *$self->{compressor}->compress(from_pipe => \$filehandle, |
+ to_file => $self->get_filename()); |
+ } else { |
+ CORE::open($filehandle, '>', $self->get_filename) |
+ or syserr(_g('cannot write %s'), $self->get_filename()); |
+ } |
+ *$self->{mode} = 'w'; |
+ *$self->{file} = $filehandle; |
+} |
+ |
+sub open_for_read { |
+ my ($self) = @_; |
+ error("Can't reopen an already opened compressed file") if exists *$self->{mode}; |
+ my $filehandle; |
+ if ($self->use_compression()) { |
+ *$self->{compressor}->uncompress(to_pipe => \$filehandle, |
+ from_file => $self->get_filename()); |
+ *$self->{allow_sigpipe} = 1; |
+ } else { |
+ CORE::open($filehandle, '<', $self->get_filename) |
+ or syserr(_g('cannot read %s'), $self->get_filename()); |
+ } |
+ *$self->{mode} = 'r'; |
+ *$self->{file} = $filehandle; |
+} |
+ |
+sub cleanup { |
+ my ($self) = @_; |
+ 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::FileHandle 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; |