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
17=encoding utf8
18
19 - 71
=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 behavior with the method 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 set_filename() method).

Once a file has been opened, the filehandle must be closed before being
able to open another file.

=cut
72
73package Dpkg::Compression::FileHandle 1.01;
74
75
75
75
75
3036
175
1452
use strict;
76
75
75
75
138
59
1897
use warnings;
77
78
75
75
75
152
59
2306
use Carp;
79
80
75
75
75
17888
87
4159
use Dpkg::Compression;
81
75
75
75
20461
97
1613
use Dpkg::Compression::Process;
82
75
75
75
215
60
2165
use Dpkg::Gettext;
83
75
75
75
168
55
2513
use Dpkg::ErrorHandling;
84
85
75
75
75
157
61
357
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 - 122
=head1 STANDARD FUNCTIONS

The standard functions acting on filehandles should accept a
Dpkg::Compression::FileHandle object transparently including
open() (only when using the variant with 3 parameters), close(),
binmode(), eof(), fileno(), getc(), print(), printf(), read(),
sysread(), say(), write(), syswrite(), seek(), sysseek(), tell().

Note however that seek() and 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 L<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
528
1
889
    my ($this, %args) = @_;
127
528
2052
    my $class = ref($this) || $this;
128
528
2165
    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
528
16391
    tie *$self, $class, $self; ## no critic (Miscellanea::ProhibitTies)
132
528
659
    bless $self, $class;
133    # Initializations
134
528
1419
    *$self->{compression} = 'auto';
135
528
2049
    *$self->{compressor} = Dpkg::Compression::Process->new();
136    *$self->{add_comp_ext} = $args{add_compression_extension} ||
137
528
2779
        $args{add_comp_ext} || 0;
138
528
707
    *$self->{allow_sigpipe} = 0;
139
528
831
    if (exists $args{filename}) {
140
69
125
        $self->set_filename($args{filename});
141    }
142
528
743
    if (exists $args{compression}) {
143
0
0
        $self->set_compression($args{compression});
144    }
145
528
729
    if (exists $args{compression_level}) {
146
0
0
        $self->set_compression_level($args{compression_level});
147    }
148
528
1284
    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
44757
1
37174
    my ($self, $mode, %opts) = @_;
162
44757
43613
    if (exists *$self->{mode}) {
163
44673
53630
        return if *$self->{mode} eq $mode;
164
0
0
        croak "ensure_open requested incompatible mode: $mode";
165    } else {
166        # Sanitize options.
167
84
61
        delete $opts{from_pipe};
168
84
57
        delete $opts{from_file};
169
84
41
        delete $opts{to_pipe};
170
84
58
        delete $opts{to_file};
171
172
84
117
        if ($mode eq 'w') {
173
0
0
            $self->_open_for_write(%opts);
174        } elsif ($mode eq 'r') {
175
84
115
            $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
528
820
    my ($class, $self) = @_;
187
528
945
    return $self;
188}
189
190sub WRITE {
191
14049
75280
    my ($self, $scalar, $length, $offset) = @_;
192
14049
16290
    $self->ensure_open('w');
193
14049
19028
    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
30687
22351
    my ($self) = shift;
204
30687
33123
    $self->ensure_open('r');
205
30687
3832128
    return *$self->{file}->getlines() if wantarray;
206
30660
74622
    return *$self->{file}->getline();
207}
208
209sub OPEN {
210
459
1774
    my ($self, @args) = @_;
211
212
459
757
    if (scalar @args == 2) {
213
459
711
        my ($mode, $filename) = @args;
214
459
905
        $self->set_filename($filename);
215
459
828
        if ($mode eq '>') {
216
75
153
            $self->_open_for_write();
217        } elsif ($mode eq '<') {
218
384
699
            $self->_open_for_read();
219        } else {
220
0
0
            croak 'Dpkg::Compression::FileHandle does not support ' .
221                  "open() mode $mode";
222        }
223    } else {
224
0
0
        croak 'Dpkg::Compression::FileHandle only supports open() ' .
225              'with 3 parameters';
226    }
227
447
1731
    return 1; # Always works (otherwise errors out)
228}
229
230sub CLOSE {
231
450
736
    my ($self, @args) = @_;
232
450
471
    my $ret = 1;
233
450
713
    if (defined *$self->{file}) {
234
450
1285
        $ret = *$self->{file}->close(@args) if *$self->{file}->opened();
235    } else {
236
0
0
        $ret = 0;
237    }
238
450
8058
    $self->_cleanup();
239
450
1161
    return $ret;
240}
241
242sub FILENO {
243
0
0
    my ($self, @args) = @_;
244
245
0
0
    return *$self->{file}->fileno(@args) if defined *$self->{file};
246
0
0
    return;
247}
248
249sub EOF {
250    # Since perl 5.12, an integer parameter is passed describing how the
251    # function got called, just ignore it.
252
15
15
    my ($self, $param, @args) = @_;
253
254
15
55
    return *$self->{file}->eof(@args) if defined *$self->{file};
255
0
0
    return 1;
256}
257
258sub SEEK {
259
0
0
    my ($self, @args) = @_;
260
261
0
0
    return *$self->{file}->seek(@args) if defined *$self->{file};
262
0
0
    return 0;
263}
264
265sub TELL {
266
0
0
    my ($self, @args) = @_;
267
268
0
0
    return *$self->{file}->tell(@args) if defined *$self->{file};
269
0
0
    return -1;
270}
271
272sub BINMODE {
273
36
28
    my ($self, @args) = @_;
274
275
36
79
    return *$self->{file}->binmode(@args) if defined *$self->{file};
276
0
0
    return;
277}
278
279##
280## NORMAL METHODS
281##
282
283 - 290
=item $fh->set_compression($comp)

Defines the compression method used. $comp should one of the methods supported by
L<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
291
292sub set_compression {
293
0
1
0
    my ($self, $method) = @_;
294
0
0
    if ($method ne 'none' and $method ne 'auto') {
295
0
0
        *$self->{compressor}->set_compression($method);
296    }
297
0
0
    *$self->{compression} = $method;
298}
299
300 - 305
=item $fh->set_compression_level($level)

Indicate the desired compression level. It should be a value accepted
by the function compression_is_valid_level() of L<Dpkg::Compression>.

=cut
306
307sub set_compression_level {
308
0
1
0
    my ($self, $level) = @_;
309
0
0
    *$self->{compressor}->set_compression_level($level);
310}
311
312 - 319
=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
320
321sub set_filename {
322
528
1
670
    my ($self, $filename, $add_comp_ext) = @_;
323
528
791
    *$self->{filename} = $filename;
324    # Automatically add compression extension to filename
325
528
670
    if (defined($add_comp_ext)) {
326
0
0
        *$self->{add_comp_ext} = $add_comp_ext;
327    }
328
528
856
    my $comp_ext_regex = compression_get_file_extension_regex();
329
528
1079
    if (*$self->{add_comp_ext} and $filename =~ /\.$comp_ext_regex$/) {
330
0
0
        warning('filename %s already has an extension of a compressed file ' .
331                'and add_comp_ext is active', $filename);
332    }
333}
334
335 - 343
=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
344
345sub get_filename {
346
1158
1
920
    my $self = shift;
347
1158
1024
    my $comp = *$self->{compression};
348
1158
1189
    if (*$self->{add_comp_ext}) {
349
0
0
        if ($comp eq 'auto') {
350
0
0
            croak 'automatic detection of compression is ' .
351                  'incompatible with add_comp_ext';
352        } elsif ($comp eq 'none') {
353
0
0
            return *$self->{filename};
354        } else {
355
0
0
            return *$self->{filename} . '.' .
356                   compression_get_file_extension($comp);
357        }
358    } else {
359
1158
10197
        return *$self->{filename};
360    }
361}
362
363 - 370
=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 get_filename()
method.

=cut
371
372sub use_compression {
373
543
1
460
    my $self = shift;
374
543
637
    my $comp = *$self->{compression};
375
543
989
    if ($comp eq 'none') {
376
0
0
        return 0;
377    } elsif ($comp eq 'auto') {
378
543
770
        $comp = compression_guess_from_filename($self->get_filename());
379
543
825
        *$self->{compressor}->set_compression($comp) if $comp;
380    }
381
543
754
    return $comp;
382}
383
384 - 389
=item $real_fh = $fh->get_filehandle()

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

=cut
390
391sub get_filehandle {
392
21
1
16
    my $self = shift;
393
21
87
    return *$self->{file} if exists *$self->{file};
394}
395
396## INTERNAL METHODS
397
398sub _open_for_write {
399
75
86
    my ($self, %opts) = @_;
400
75
53
    my $filehandle;
401
402    croak 'cannot reopen an already opened compressed file'
403
75
99
        if exists *$self->{mode};
404
405
75
99
    if ($self->use_compression()) {
406
27
45
        *$self->{compressor}->compress(from_pipe => \$filehandle,
407            to_file => $self->get_filename(), %opts);
408    } else {
409
48
123
        CORE::open($filehandle, '>', $self->get_filename)
410            or syserr(g_('cannot write %s'), $self->get_filename());
411    }
412
69
327
    *$self->{mode} = 'w';
413
69
441
    *$self->{file} = $filehandle;
414}
415
416sub _open_for_read {
417
468
500
    my ($self, %opts) = @_;
418
468
368
    my $filehandle;
419
420    croak 'cannot reopen an already opened compressed file'
421
468
630
        if exists *$self->{mode};
422
423
468
764
    if ($self->use_compression()) {
424
15
27
        *$self->{compressor}->uncompress(to_pipe => \$filehandle,
425                from_file => $self->get_filename(), %opts);
426
9
28
        *$self->{allow_sigpipe} = 1;
427    } else {
428
453
1267
        CORE::open($filehandle, '<', $self->get_filename)
429            or syserr(g_('cannot read %s'), $self->get_filename());
430    }
431
462
1002
    *$self->{mode} = 'r';
432
462
958
    *$self->{file} = $filehandle;
433}
434
435sub _cleanup {
436
450
452
    my $self = shift;
437
450
1678
    my $cmdline = *$self->{compressor}{cmdline} // '';
438
450
1414
    *$self->{compressor}->wait_end_process(nocheck => *$self->{allow_sigpipe});
439
450
648
    if (*$self->{allow_sigpipe}) {
440
9
65
        require POSIX;
441
9
42
        unless (($? == 0) || (POSIX::WIFSIGNALED($?) &&
442                              (POSIX::WTERMSIG($?) == POSIX::SIGPIPE()))) {
443
0
0
            subprocerr($cmdline);
444        }
445
9
11
        *$self->{allow_sigpipe} = 0;
446    }
447
450
782
    delete *$self->{mode};
448
450
1295
    delete *$self->{file};
449}
450
451=back
452
453 - 478
=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
4791;