scripts/Dpkg/Compression/FileHandle.pm

   1 # Copyright © 2008-2010 Raphaël Hertzog <hertzog@debian.org>
   2 # Copyright © 2012-2014 Guillem Jover <guillem@debian.org>
   3 #
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 2 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  16
  17 =encoding utf8
  18
  19 =head1 NAME
  20
  21 Dpkg::Compression::FileHandle - class dealing transparently with file compression
  22
  23 =head1 SYNOPSIS
  24
  25     use Dpkg::Compression::FileHandle;
  26
  27     my ($fh, @lines);
  28
  29     $fh = Dpkg::Compression::FileHandle->new(filename => 'sample.gz');
  30     print $fh "Something\n";
  31     close $fh;
  32
  33     $fh = Dpkg::Compression::FileHandle->new();
  34     open($fh, '>', 'sample.bz2');
  35     print $fh "Something\n";
  36     close $fh;
  37
  38     $fh = Dpkg::Compression::FileHandle->new();
  39     $fh->open('sample.xz', 'w');
  40     $fh->print("Something\n");
  41     $fh->close();
  42
  43     $fh = Dpkg::Compression::FileHandle->new(filename => 'sample.gz');
  44     @lines = <$fh>;
  45     close $fh;
  46
  47     $fh = Dpkg::Compression::FileHandle->new();
  48     open($fh, '<', 'sample.bz2');
  49     @lines = <$fh>;
  50     close $fh;
  51
  52     $fh = Dpkg::Compression::FileHandle->new();
  53     $fh->open('sample.xz', 'r');
  54     @lines = $fh->getlines();
  55     $fh->close();
  56
  57 =head1 DESCRIPTION
  58
  59 Dpkg::Compression::FileHandle is a class that can be used
  60 like any filehandle and that deals transparently with compressed
  61 files. By default, the compression scheme is guessed from the filename
  62 but you can override this behavior with the method set_compression().
  63
  64 If you don't open the file explicitly, it will be auto-opened on the
  65 first read or write operation based on the filename set at creation time
  66 (or later with the set_filename() method).
  67
  68 Once a file has been opened, the filehandle must be closed before being
  69 able to open another file.
  70
  71 =cut
  72
  73 package Dpkg::Compression::FileHandle 1.01;
  74
  75 use strict;
  76 use warnings;
  77
  78 use Carp;
  79
  80 use Dpkg::Compression;
  81 use Dpkg::Compression::Process;
  82 use Dpkg::Gettext;
  83 use Dpkg::ErrorHandling;
  84
  85 use parent qw(IO::File Tie::Handle);
  86
  87 # Useful reference to understand some kludges required to
  88 # have the class behave like a filehandle
  89 # http://blog.woobling.org/2009/10/are-filehandles-objects.html
  90
  91 =head1 STANDARD FUNCTIONS
  92
  93 The standard functions acting on filehandles should accept a
  94 Dpkg::Compression::FileHandle object transparently including
  95 open() (only when using the variant with 3 parameters), close(),
  96 binmode(), eof(), fileno(), getc(), print(), printf(), read(),
  97 sysread(), say(), write(), syswrite(), seek(), sysseek(), tell().
  98
  99 Note however that seek() and sysseek() will only work on uncompressed
 100 files as compressed files are really pipes to the compressor programs
 101 and you can't seek on a pipe.
 102
 103 =head1 FileHandle METHODS
 104
 105 The class inherits from L<IO::File> so all methods that work on this
 106 class should work for Dpkg::Compression::FileHandle too. There
 107 may be exceptions though.
 108
 109 =head1 PUBLIC METHODS
 110
 111 =over 4
 112
 113 =item $fh = Dpkg::Compression::FileHandle->new(%opts)
 114
 115 Creates a new filehandle supporting on-the-fly compression/decompression.
 116 Supported options are "filename", "compression", "compression_level" (see
 117 respective set_* functions) and "add_comp_ext". If "add_comp_ext"
 118 evaluates to true, then the extension corresponding to the selected
 119 compression scheme is automatically added to the recorded filename. It's
 120 obviously incompatible with automatic detection of the compression method.
 121
 122 =cut
 123
 124 # Class methods
 125 sub new {
 126     my ($this, %opts) = @_;
 127     my $class = ref($this) || $this;
 128     my $self = IO::File->new();
 129     # Tying is required to overload the open functions and to auto-open
 130     # the file on first read/write operation
 131     tie *$self, $class, $self; ## no critic (Miscellanea::ProhibitTies)
 132     bless $self, $class;
 133     # Initializations
 134     *$self->{compression} = 'auto';
 135     *$self->{compressor} = Dpkg::Compression::Process->new();
 136     *$self->{add_comp_ext} = $opts{add_compression_extension} ||
 137         $opts{add_comp_ext} || 0;
 138     *$self->{allow_sigpipe} = 0;
 139     if (exists $opts{filename}) {
 140         $self->set_filename($opts{filename});
 141     }
 142     if (exists $opts{compression}) {
 143         $self->set_compression($opts{compression});
 144     }
 145     if (exists $opts{compression_level}) {
 146         $self->set_compression_level($opts{compression_level});
 147     }
 148     return $self;
 149 }
 150
 151 =item $fh->ensure_open($mode, %opts)
 152
 153 Ensure the file is opened in the requested mode ("r" for read and "w" for
 154 write). The options are passed down to the compressor's spawn() call, if one
 155 is used. Opens the file with the recorded filename if needed. If the file
 156 is already open but not in the requested mode, then it errors out.
 157
 158 =cut
 159
 160 sub ensure_open {
 161     my ($self, $mode, %opts) = @_;
 162     if (exists *$self->{mode}) {
 163         return if *$self->{mode} eq $mode;
 164         croak "ensure_open requested incompatible mode: $mode";
 165     } else {
 166         # Sanitize options.
 167         delete $opts{from_pipe};
 168         delete $opts{from_file};
 169         delete $opts{to_pipe};
 170         delete $opts{to_file};
 171
 172         if ($mode eq 'w') {
 173             $self->_open_for_write(%opts);
 174         } elsif ($mode eq 'r') {
 175             $self->_open_for_read(%opts);
 176         } else {
 177             croak "invalid mode in ensure_open: $mode";
 178         }
 179     }
 180 }
 181
 182 ##
 183 ## METHODS FOR TIED HANDLE
 184 ##
 185 sub TIEHANDLE {
 186     my ($class, $self) = @_;
 187     return $self;
 188 }
 189
 190 sub WRITE {
 191     my ($self, $scalar, $length, $offset) = @_;
 192     $self->ensure_open('w');
 193     return *$self->{file}->write($scalar, $length, $offset);
 194 }
 195
 196 sub READ {
 197     my ($self, $scalar, $length, $offset) = @_;
 198     $self->ensure_open('r');
 199     return *$self->{file}->read($scalar, $length, $offset);
 200 }
 201
 202 sub READLINE {
 203     my ($self) = shift;
 204     $self->ensure_open('r');
 205     return *$self->{file}->getlines() if wantarray;
 206     return *$self->{file}->getline();
 207 }
 208
 209 sub OPEN {
 210     my ($self, @args) = @_;
 211
 212     if (scalar @args == 2) {
 213         my ($mode, $filename) = @args;
 214         $self->set_filename($filename);
 215         if ($mode eq '>') {
 216             $self->_open_for_write();
 217         } elsif ($mode eq '<') {
 218             $self->_open_for_read();
 219         } else {
 220             croak 'Dpkg::Compression::FileHandle does not support ' .
 221                   "open() mode $mode";
 222         }
 223     } else {
 224         croak 'Dpkg::Compression::FileHandle only supports open() ' .
 225               'with 3 parameters';
 226     }
 227     return 1; # Always works (otherwise errors out)
 228 }
 229
 230 sub CLOSE {
 231     my ($self, @args) = @_;
 232     my $ret = 1;
 233     if (defined *$self->{file}) {
 234         $ret = *$self->{file}->close(@args) if *$self->{file}->opened();
 235     } else {
 236         $ret = 0;
 237     }
 238     $self->_cleanup();
 239     return $ret;
 240 }
 241
 242 sub FILENO {
 243     my ($self, @args) = @_;
 244
 245     return *$self->{file}->fileno(@args) if defined *$self->{file};
 246     return;
 247 }
 248
 249 sub EOF {
 250     # Since perl 5.12, an integer parameter is passed describing how the
 251     # function got called, just ignore it.
 252     my ($self, $param, @args) = @_;
 253
 254     return *$self->{file}->eof(@args) if defined *$self->{file};
 255     return 1;
 256 }
 257
 258 sub SEEK {
 259     my ($self, @args) = @_;
 260
 261     return *$self->{file}->seek(@args) if defined *$self->{file};
 262     return 0;
 263 }
 264
 265 sub TELL {
 266     my ($self, @args) = @_;
 267
 268     return *$self->{file}->tell(@args) if defined *$self->{file};
 269     return -1;
 270 }
 271
 272 sub BINMODE {
 273     my ($self, @args) = @_;
 274
 275     return *$self->{file}->binmode(@args) if defined *$self->{file};
 276     return;
 277 }
 278
 279 ##
 280 ## NORMAL METHODS
 281 ##
 282
 283 =item $fh->set_compression($comp)
 284
 285 Defines the compression method used. $comp should one of the methods supported by
 286 L<Dpkg::Compression> or "none" or "auto". "none" indicates that the file is
 287 uncompressed and "auto" indicates that the method must be guessed based
 288 on the filename extension used.
 289
 290 =cut
 291
 292 sub set_compression {
 293     my ($self, $method) = @_;
 294     if ($method ne 'none' and $method ne 'auto') {
 295         *$self->{compressor}->set_compression($method);
 296     }
 297     *$self->{compression} = $method;
 298 }
 299
 300 =item $fh->set_compression_level($level)
 301
 302 Indicate the desired compression level. It should be a value accepted
 303 by the function compression_is_valid_level() of L<Dpkg::Compression>.
 304
 305 =cut
 306
 307 sub set_compression_level {
 308     my ($self, $level) = @_;
 309     *$self->{compressor}->set_compression_level($level);
 310 }
 311
 312 =item $fh->set_filename($name, [$add_comp_ext])
 313
 314 Use $name as filename when the file must be opened/created. If
 315 $add_comp_ext is passed, it indicates whether the default extension
 316 of the compression method must be automatically added to the filename
 317 (or not).
 318
 319 =cut
 320
 321 sub set_filename {
 322     my ($self, $filename, $add_comp_ext) = @_;
 323     *$self->{filename} = $filename;
 324     # Automatically add compression extension to filename
 325     if (defined($add_comp_ext)) {
 326         *$self->{add_comp_ext} = $add_comp_ext;
 327     }
 328     my $comp_ext_regex = compression_get_file_extension_regex();
 329     if (*$self->{add_comp_ext} and $filename =~ /\.$comp_ext_regex$/) {
 330         warning('filename %s already has an extension of a compressed file ' .
 331                 'and add_comp_ext is active', $filename);
 332     }
 333 }
 334
 335 =item $file = $fh->get_filename()
 336
 337 Returns the filename that would be used when the filehandle must
 338 be opened (both in read and write mode). This function errors out
 339 if "add_comp_ext" is enabled while the compression method is set
 340 to "auto". The returned filename includes the extension of the compression
 341 method if "add_comp_ext" is enabled.
 342
 343 =cut
 344
 345 sub get_filename {
 346     my $self = shift;
 347     my $comp = *$self->{compression};
 348     if (*$self->{add_comp_ext}) {
 349         if ($comp eq 'auto') {
 350             croak 'automatic detection of compression is ' .
 351                   'incompatible with add_comp_ext';
 352         } elsif ($comp eq 'none') {
 353             return *$self->{filename};
 354         } else {
 355             return *$self->{filename} . '.' .
 356                    compression_get_file_extension($comp);
 357         }
 358     } else {
 359         return *$self->{filename};
 360     }
 361 }
 362
 363 =item $ret = $fh->use_compression()
 364
 365 Returns "0" if no compression is used and the compression method used
 366 otherwise. If the compression is set to "auto", the value returned
 367 depends on the extension of the filename obtained with the get_filename()
 368 method.
 369
 370 =cut
 371
 372 sub use_compression {
 373     my $self = shift;
 374     my $comp = *$self->{compression};
 375     if ($comp eq 'none') {
 376         return 0;
 377     } elsif ($comp eq 'auto') {
 378         $comp = compression_guess_from_filename($self->get_filename());
 379         *$self->{compressor}->set_compression($comp) if $comp;
 380     }
 381     return $comp;
 382 }
 383
 384 =item $real_fh = $fh->get_filehandle()
 385
 386 Returns the real underlying filehandle. Useful if you want to pass it
 387 along in a derived class.
 388
 389 =cut
 390
 391 sub get_filehandle {
 392     my $self = shift;
 393     return *$self->{file} if exists *$self->{file};
 394 }
 395
 396 ## INTERNAL METHODS
 397
 398 sub _open_for_write {
 399     my ($self, %opts) = @_;
 400     my $filehandle;
 401
 402     croak 'cannot reopen an already opened compressed file'
 403         if exists *$self->{mode};
 404
 405     if ($self->use_compression()) {
 406         *$self->{compressor}->compress(from_pipe => \$filehandle,
 407             to_file => $self->get_filename(), %opts);
 408     } else {
 409         CORE::open($filehandle, '>', $self->get_filename)
 410             or syserr(g_('cannot write %s'), $self->get_filename());
 411     }
 412     *$self->{mode} = 'w';
 413     *$self->{file} = $filehandle;
 414 }
 415
 416 sub _open_for_read {
 417     my ($self, %opts) = @_;
 418     my $filehandle;
 419
 420     croak 'cannot reopen an already opened compressed file'
 421         if exists *$self->{mode};
 422
 423     if ($self->use_compression()) {
 424         *$self->{compressor}->uncompress(to_pipe => \$filehandle,
 425                 from_file => $self->get_filename(), %opts);
 426         *$self->{allow_sigpipe} = 1;
 427     } else {
 428         CORE::open($filehandle, '<', $self->get_filename)
 429             or syserr(g_('cannot read %s'), $self->get_filename());
 430     }
 431     *$self->{mode} = 'r';
 432     *$self->{file} = $filehandle;
 433 }
 434
 435 sub _cleanup {
 436     my $self = shift;
 437     my $cmdline = *$self->{compressor}{cmdline} // '';
 438     *$self->{compressor}->wait_end_process(nocheck => *$self->{allow_sigpipe});
 439     if (*$self->{allow_sigpipe}) {
 440         require POSIX;
 441         unless (($? == 0) || (POSIX::WIFSIGNALED($?) &&
 442                               (POSIX::WTERMSIG($?) == POSIX::SIGPIPE()))) {
 443             subprocerr($cmdline);
 444         }
 445         *$self->{allow_sigpipe} = 0;
 446     }
 447     delete *$self->{mode};
 448     delete *$self->{file};
 449 }
 450
 451 =back
 452
 453 =head1 DERIVED CLASSES
 454
 455 If you want to create a class that inherits from
 456 Dpkg::Compression::FileHandle you must be aware that
 457 the object is a reference to a GLOB that is returned by Symbol::gensym()
 458 and as such it's not a HASH.
 459
 460 You can store internal data in a hash but you have to use
 461 C<*$self->{...}> to access the associated hash like in the example below:
 462
 463     sub set_option {
 464         my ($self, $value) = @_;
 465         *$self->{option} = $value;
 466     }
 467
 468 =head1 CHANGES
 469
 470 =head2 Version 1.01 (dpkg 1.17.11)
 471
 472 New argument: $fh->ensure_open() accepts an %opts argument.
 473
 474 =head2 Version 1.00 (dpkg 1.15.6)
 475
 476 Mark the module as public.
 477
 478 =cut
 479 1;