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