File Coverage

File:Dpkg/Compression/FileHandle.pm
Coverage:68.4%

linestmtbrancondsubpodtimecode
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
17package Dpkg::Compression::FileHandle;
18
19
24
24
24
871
15
321
use strict;
20
24
24
24
37
14
643
use warnings;
21
22our $VERSION = '1.01';
23
24
24
24
24
46
27
571
use Carp;
25
26
24
24
24
3544
20
756
use Dpkg::Compression;
27
24
24
24
4348
21
368
use Dpkg::Compression::Process;
28
24
24
24
50
23
518
use Dpkg::Gettext;
29
24
24
24
49
11
621
use Dpkg::ErrorHandling;
30
31
24
24
24
44
16
69
use parent qw(IO::File Tie::Handle);
32
33# Useful reference to understand some kludges required to
34# have the class behave like a filehandle
35# http://blog.woobling.org/2009/10/are-filehandles-objects.html
36
37=encoding utf8
38
39 - 122
=head1 NAME

Dpkg::Compression::FileHandle - class dealing transparently with file compression

=head1 SYNOPSIS

    use Dpkg::Compression::FileHandle;

    my ($fh, @lines);

    $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');
    @lines = <$fh>;
    close $fh;

    $fh = Dpkg::Compression::FileHandle->new();
    open($fh, '<', 'sample.bz2');
    @lines = <$fh>;
    close $fh;

    $fh = Dpkg::Compression::FileHandle->new();
    $fh->open('sample.xz', 'r');
    @lines = $fh->getlines();
    $fh->close();

=head1 DESCRIPTION

Dpkg::Compression::FileHandle is a class 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 class inherits from IO::File so all methods that work on this
class should work for Dpkg::Compression::FileHandle too. There
may be exceptions though.

=head1 PUBLIC METHODS

=over 4

=item $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
123
124# Class methods
125sub new {
126
168
1
259
    my ($this, %args) = @_;
127
168
605
    my $class = ref($this) || $this;
128
168
534
    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
168
3716
    tie *$self, $class, $self; ## no critic (Miscellanea::ProhibitTies)
132
168
186
    bless $self, $class;
133    # Initializations
134
168
356
    *$self->{compression} = 'auto';
135
168
513
    *$self->{compressor} = Dpkg::Compression::Process->new();
136    *$self->{add_comp_ext} = $args{add_compression_extension} ||
137
168
801
            $args{add_comp_ext} || 0;
138
168
197
    *$self->{allow_sigpipe} = 0;
139
168
210
    if (exists $args{filename}) {
140
23
72
        $self->set_filename($args{filename});
141    }
142
168
187
    if (exists $args{compression}) {
143
0
0
        $self->set_compression($args{compression});
144    }
145
168
173
    if (exists $args{compression_level}) {
146
0
0
        $self->set_compression_level($args{compression_level});
147    }
148
168
267
    return $self;
149}
150
151 - 158
=item $fh->ensure_open($mode, %opts)

Ensure the file is opened in the requested mode ("r" for read and "w" for
write). The options are passed down to the compressor's spawn() call, if one
is used. 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
159
160sub ensure_open {
161
14859
1
9624
    my ($self, $mode, %opts) = @_;
162
14859
10146
    if (exists *$self->{mode}) {
163
14831
12225
        return if *$self->{mode} eq $mode;
164
0
0
        croak "ensure_open requested incompatible mode: $mode";
165    } else {
166        # Sanitize options.
167
28
33
        delete $opts{from_pipe};
168
28
28
        delete $opts{from_file};
169
28
29
        delete $opts{to_pipe};
170
28
28
        delete $opts{to_file};
171
172
28
58
        if ($mode eq 'w') {
173
0
0
            $self->_open_for_write(%opts);
174        } elsif ($mode eq 'r') {
175
28
132
            $self->_open_for_read(%opts);
176        } else {
177
0
0
            croak "invalid mode in ensure_open: $mode";
178        }
179    }
180}
181
182##
183## METHODS FOR TIED HANDLE
184##
185sub TIEHANDLE {
186
168
217
    my ($class, $self) = @_;
187
168
275
    return $self;
188}
189
190sub WRITE {
191
4683
16314
    my ($self, $scalar, $length, $offset) = @_;
192
4683
4101
    $self->ensure_open('w');
193
4683
4119
    return *$self->{file}->write($scalar, $length, $offset);
194}
195
196sub READ {
197
0
0
    my ($self, $scalar, $length, $offset) = @_;
198
0
0
    $self->ensure_open('r');
199
0
0
    return *$self->{file}->read($scalar, $length, $offset);
200}
201
202sub READLINE {
203
10169
5882
    my ($self) = shift;
204
10169
8335
    $self->ensure_open('r');
205
10169
911258
    return *$self->{file}->getlines() if wantarray;
206
10160
16146
    return *$self->{file}->getline();
207}
208
209sub OPEN {
210
145
436
    my ($self) = shift;
211
145
173
    if (scalar(@_) == 2) {
212
145
138
        my ($mode, $filename) = @_;
213
145
239
        $self->set_filename($filename);
214
145
186
        if ($mode eq '>') {
215
25
33
            $self->_open_for_write();
216        } elsif ($mode eq '<') {
217
120
131
            $self->_open_for_read();
218        } else {
219
0
0
            croak 'Dpkg::Compression::FileHandle does not support ' .
220                  "open() mode $mode";
221        }
222    } else {
223
0
0
        croak 'Dpkg::Compression::FileHandle only supports open() ' .
224              'with 3 parameters';
225    }
226
141
411
    return 1; # Always works (otherwise errors out)
227}
228
229sub CLOSE {
230
142
248
    my ($self) = shift;
231
142
134
    my $ret = 1;
232
142
162
    if (defined *$self->{file}) {
233
142
290
        $ret = *$self->{file}->close(@_) if *$self->{file}->opened();
234    } else {
235
0
0
        $ret = 0;
236    }
237
142
2161
    $self->_cleanup();
238
142
276
    return $ret;
239}
240
241sub FILENO {
242
0
0
    my ($self) = shift;
243
0
0
    return *$self->{file}->fileno(@_) if defined *$self->{file};
244
0
0
    return;
245}
246
247sub EOF {
248    # Since perl 5.12, an integer parameter is passed describing how the
249    # function got called, just ignore it.
250
5
11
    my ($self, $param) = (shift, shift);
251
5
44
    return *$self->{file}->eof(@_) if defined *$self->{file};
252
0
0
    return 1;
253}
254
255sub SEEK {
256
0
0
    my ($self) = shift;
257
0
0
    return *$self->{file}->seek(@_) if defined *$self->{file};
258
0
0
    return 0;
259}
260
261sub TELL {
262
0
0
    my ($self) = shift;
263
0
0
    return *$self->{file}->tell(@_) if defined *$self->{file};
264
0
0
    return -1;
265}
266
267sub BINMODE {
268
11
10
    my ($self) = shift;
269
11
17
    return *$self->{file}->binmode(@_) if defined *$self->{file};
270
0
0
    return;
271}
272
273##
274## NORMAL METHODS
275##
276
277 - 284
=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
285
286sub set_compression {
287
0
1
0
    my ($self, $method) = @_;
288
0
0
    if ($method ne 'none' and $method ne 'auto') {
289
0
0
        *$self->{compressor}->set_compression($method);
290    }
291
0
0
    *$self->{compression} = $method;
292}
293
294 - 299
=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
300
301sub set_compression_level {
302
0
1
0
    my ($self, $level) = @_;
303
0
0
    *$self->{compressor}->set_compression_level($level);
304}
305
306 - 313
=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
314
315sub set_filename {
316
168
1
194
    my ($self, $filename, $add_comp_ext) = @_;
317
168
181
    *$self->{filename} = $filename;
318    # Automatically add compression extension to filename
319
168
185
    if (defined($add_comp_ext)) {
320
0
0
        *$self->{add_comp_ext} = $add_comp_ext;
321    }
322
168
179
    my $comp_ext_regex = compression_get_file_extension_regex();
323
168
281
    if (*$self->{add_comp_ext} and $filename =~ /\.$comp_ext_regex$/) {
324
0
0
        warning('filename %s already has an extension of a compressed file ' .
325                'and add_comp_ext is active', $filename);
326    }
327}
328
329 - 337
=item $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
338
339sub get_filename {
340
370
1
263
    my $self = shift;
341
370
398
    my $comp = *$self->{compression};
342
370
485
    if (*$self->{add_comp_ext}) {
343
0
0
        if ($comp eq 'auto') {
344
0
0
            croak 'automatic detection of compression is ' .
345                  'incompatible with add_comp_ext';
346        } elsif ($comp eq 'none') {
347
0
0
            return *$self->{filename};
348        } else {
349
0
0
            return *$self->{filename} . '.' .
350                   compression_get_property($comp, 'file_ext');
351        }
352    } else {
353
370
2790
        return *$self->{filename};
354    }
355}
356
357 - 364
=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
365
366sub use_compression {
367
173
1
121
    my $self = shift;
368
173
148
    my $comp = *$self->{compression};
369
173
249
    if ($comp eq 'none') {
370
0
0
        return 0;
371    } elsif ($comp eq 'auto') {
372
173
194
        $comp = compression_guess_from_filename($self->get_filename());
373
173
210
        *$self->{compressor}->set_compression($comp) if $comp;
374    }
375
173
255
    return $comp;
376}
377
378 - 383
=item $real_fh = $fh->get_filehandle()

Returns the real underlying filehandle. Useful if you want to pass it
along in a derived class.

=cut
384
385sub get_filehandle {
386
7
1
10
    my $self = shift;
387
7
29
    return *$self->{file} if exists *$self->{file};
388}
389
390## INTERNAL METHODS
391
392sub _open_for_write {
393
25
33
    my ($self, %opts) = @_;
394
25
11
    my $filehandle;
395
396    croak 'cannot reopen an already opened compressed file'
397
25
22
        if exists *$self->{mode};
398
399
25
34
    if ($self->use_compression()) {
400
9
18
        *$self->{compressor}->compress(from_pipe => \$filehandle,
401                to_file => $self->get_filename(), %opts);
402    } else {
403
16
34
        CORE::open($filehandle, '>', $self->get_filename)
404            or syserr(g_('cannot write %s'), $self->get_filename());
405    }
406
23
130
    *$self->{mode} = 'w';
407
23
133
    *$self->{file} = $filehandle;
408}
409
410sub _open_for_read {
411
148
143
    my ($self, %opts) = @_;
412
148
89
    my $filehandle;
413
414    croak 'cannot reopen an already opened compressed file'
415
148
186
        if exists *$self->{mode};
416
417
148
207
    if ($self->use_compression()) {
418
5
11
        *$self->{compressor}->uncompress(to_pipe => \$filehandle,
419                from_file => $self->get_filename(), %opts);
420
3
13
        *$self->{allow_sigpipe} = 1;
421    } else {
422
143
329
        CORE::open($filehandle, '<', $self->get_filename)
423            or syserr(g_('cannot read %s'), $self->get_filename());
424    }
425
146
263
    *$self->{mode} = 'r';
426
146
263
    *$self->{file} = $filehandle;
427}
428
429sub _cleanup {
430
142
99
    my $self = shift;
431
142
379
    my $cmdline = *$self->{compressor}{cmdline} // '';
432
142
312
    *$self->{compressor}->wait_end_process(nocheck => *$self->{allow_sigpipe});
433
142
165
    if (*$self->{allow_sigpipe}) {
434
3
27
        require POSIX;
435
3
13
        unless (($? == 0) || (POSIX::WIFSIGNALED($?) &&
436                              (POSIX::WTERMSIG($?) == POSIX::SIGPIPE()))) {
437
0
0
            subprocerr($cmdline);
438        }
439
3
3
        *$self->{allow_sigpipe} = 0;
440    }
441
142
145
    delete *$self->{mode};
442
142
238
    delete *$self->{file};
443}
444
445=back
446
447 - 472
=head1 DERIVED CLASSES

If you want to create a class 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 CHANGES

=head2 Version 1.01 (dpkg 1.17.11)

New argument: $fh->ensure_open() accepts an %opts argument.

=head2 Version 1.00 (dpkg 1.15.6)

Mark the module as public.

=cut
4731;