← Back to branch summary

~ubuntu-branches/ubuntu/trusty/freeguide/trusty

« back to all changes in this revision

Viewing changes to xmltv/share/perl/5.8.8/XMLTV/Gunzip.pm

  • Committer: Bazaar Package Importer
  • Author(s): Shaun Jackman
  • Date: 2007-09-11 16:52:59 UTC
  • mfrom: (1.2.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20070911165259-4r32oke21i1ezbmv
Tags: 0.10.5-1
http://bugs.debian.org/441762
* New upstream release.
* Update the watch file.
* Change Debian policy to version 3.7.2.2. No changes necessary.
* Add ant-optional to build dependencies. Closes: #441762.

Show diffs side-by-side

added added

removed removed

Lines of Context:
xmltv/share/perl/5.8.8/XMLTV/Gunzip.pm
 
1
# $Id: Gunzip.pm,v 1.6 2004/01/03 14:52:53 epaepa Exp $
 
2
 
 
3
=pod
 
4
 
 
5
=head1 NAME
 
6
 
 
7
    XMLTV::Gunzip - wrapper to Compress::Zlib or gzip(1)
 
8
 
 
9
=head1 SYNOPSIS
 
10
 
 
11
    use XMLTV::Gunzip;
 
12
    my $decompressed = gunzip($gzdata);
 
13
    my $fh = gunzip_open('file.gz') or die;
 
14
    while (<$fh>) { print }
 
15
 
 
16
Compress::Zlib will be used if installed, otherwise an external gzip
 
17
will be spawned.  gunzip() returns the decompressed data and throws an
 
18
exception if things go wrong; gunzip_open() returns a filehandle, or
 
19
undef.
 
20
 
 
21
=head1 AUTHOR
 
22
 
 
23
Ed Avis, ed@membled.com.  Distributed as part of the xmltv package.
 
24
 
 
25
=head1 SEE ALSO
 
26
 
 
27
L<Compress::Zlib>, L<gzip(1)>, L<XMLTV>.
 
28
 
 
29
=cut
 
30
 
 
31
use warnings;
 
32
use strict;
 
33
 
 
34
package XMLTV::Gunzip;
 
35
use base 'Exporter';
 
36
our @EXPORT; @EXPORT = qw(gunzip gunzip_open);
 
37
use File::Temp;
 
38
 
 
39
# Implementations of gunzip().
 
40
#
 
41
sub zlib_gunzip( $ ) {
 
42
    for (Compress::Zlib::memGunzip(shift)) {
 
43
        die 'memGunzip() failed' if not defined;
 
44
        return $_;
 
45
    }
 
46
}
 
47
sub external_gunzip( $ ) {
 
48
    my ($fh, $fname) = File::Temp::tempfile();
 
49
    print $fh shift or die "cannot write to $fname: $!";
 
50
    close $fh or die "cannot close $fname: $!";
 
51
    open(GZIP, "gzip -d <$fname |") or die "cannot run gzip: $!";
 
52
    local $/ = undef;
 
53
    my $r = <GZIP>;
 
54
    close GZIP or die "cannot close pipe from gzip: $!";
 
55
    unlink $fname or die "cannot unlink $fname: $!";
 
56
    return $r;
 
57
}
 
58
my $gunzip_f;
 
59
sub gunzip( $ ) { return $gunzip_f->(shift) }
 
60
 
 
61
 
 
62
# Implementations of gunzip_open().
 
63
#
 
64
sub perlio_gunzip_open( $ ) {
 
65
    my $fname = shift;
 
66
    # Use PerlIO::gzip.
 
67
    local *FH;
 
68
    open FH, '<:gzip', $fname
 
69
      or die "cannot open $fname via PerlIO::gzip: $!";
 
70
    return *FH;
 
71
}
 
72
sub zlib_gunzip_open( $ ) {
 
73
    my $fname = shift;
 
74
    # Use the XMLTV::Zlib_handle package defined later in this file.
 
75
    local *FH;
 
76
    tie *FH, 'XMLTV::Zlib_handle', $fname, 'r'
 
77
      or die "cannot open $fname using XMLTV::Zlib_handle: $!";
 
78
    return *FH;
 
79
}
 
80
sub external_gunzip_open( $ ) {
 
81
    my $fname = shift;
 
82
    local *FH;
 
83
    if (not open(FH, "gzip -d <$fname |")) {
 
84
        warn "cannot run gzip: $!";
 
85
        return undef;
 
86
    }
 
87
    return *FH;
 
88
}
 
89
my $gunzip_open_f;
 
90
sub gunzip_open( $ ) { return $gunzip_open_f->(shift) }
 
91
 
 
92
 
 
93
# Switch between implementations depending on whether Compress::Zlib
 
94
# is available.
 
95
#
 
96
BEGIN {
 
97
    eval { require Compress::Zlib }; my $have_zlib = not $@;
 
98
    eval { require PerlIO::gzip }; my $have_perlio = not $@;
 
99
 
 
100
    if (not $have_zlib and not $have_perlio) {
 
101
        $gunzip_f = \&external_gunzip;
 
102
        $gunzip_open_f = \&external_gunzip_open;
 
103
    }
 
104
    elsif (not $have_zlib and $have_perlio) {
 
105
        # Could gunzip by writing to a file and reading that with
 
106
        # PerlIO, but won't bother yet.
 
107
        #
 
108
        $gunzip_f = \&external_gunzip;
 
109
        $gunzip_open_f = \&perlio_gunzip_open;
 
110
    }
 
111
    elsif ($have_zlib and not $have_perlio) {
 
112
        $gunzip_f = \&zlib_gunzip;
 
113
        $gunzip_open_f = \&zlib_gunzip_open;
 
114
    }
 
115
    elsif ($have_zlib and $have_perlio) {
 
116
        $gunzip_f = \&zlib_gunzip;
 
117
        $gunzip_open_f = \&perlio_gunzip_open;
 
118
    }
 
119
    else { die }
 
120
}
 
121
 
 
122
 
 
123
####
 
124
# This is a filehandle wrapper around Compress::Zlib, but supporting
 
125
# only read at the moment.
 
126
#
 
127
package XMLTV::Zlib_handle;
 
128
require Tie::Handle; use base 'Tie::Handle';
 
129
use Carp;
 
130
 
 
131
sub TIEHANDLE {
 
132
    croak 'usage: package->TIEHANDLE(file, mode)' if @_ != 3;
 
133
    my ($pkg, $file, $mode) = @_;
 
134
 
 
135
    croak "only mode 'r' is supported" if $mode ne 'r';
 
136
 
 
137
    # This object is a reference to a Compress::Zlib handle.  I did
 
138
    # try to inherit directly from Compress::Zlib, but got weird
 
139
    # errors of '(in cleanup) gzclose is not a valid Zlib macro'.
 
140
    #
 
141
    my $fh = Compress::Zlib::gzopen($file, $mode);
 
142
    if (not $fh) {
 
143
        warn "could not gzopen $file";
 
144
        return undef;
 
145
    }
 
146
    return bless(\$fh, $pkg);
 
147
}
 
148
 
 
149
# Assuming that WRITE() is like print(), not like syswrite().
 
150
sub WRITE {
 
151
    my ($self, $scalar, $length, $offset) = @_;
 
152
    return 1 if not $length;
 
153
    my $r = $$self->gzwrite(substr($scalar, $offset, $length));
 
154
    if ($r == 0) {
 
155
        warn "gzwrite() failed";
 
156
        return 0;
 
157
    }
 
158
    elsif (0 < $r and $r < $length) {
 
159
        warn "gzwrite() wrote only $r of $length bytes";
 
160
        return 0;
 
161
    }
 
162
    elsif ($r == $length) {
 
163
        return 1;
 
164
    }
 
165
    else { die }
 
166
}
 
167
 
 
168
# PRINT(), PRINTF() inherited from Tie::Handle
 
169
 
 
170
sub READ {
 
171
    my ($self, $scalar, $length, $offset) = @_;
 
172
    local $_;
 
173
    my $n = $$self->gzread($_, $length);
 
174
    if ($n == -1) {
 
175
        warn 'gzread() failed';
 
176
        return undef;
 
177
    }
 
178
    elsif ($n == 0) {
 
179
        # EOF.
 
180
        return 0;
 
181
    }
 
182
    elsif (0 < $n and $n <= $length) {
 
183
        die if $n != length;
 
184
        substr($scalar, $offset, $n) = $_;
 
185
        return $n;
 
186
    }
 
187
    else { die }
 
188
}
 
189
 
 
190
sub READLINE {
 
191
    my $self = shift;
 
192
 
 
193
    # When gzreadline() uses $/, this can be removed.
 
194
    die '$/ not supported' if $/ ne "\n";
 
195
 
 
196
    local $_;
 
197
    my $r = $$self->gzreadline($_);
 
198
    if ($r == -1) {
 
199
        warn 'gzreadline() failed';
 
200
        return undef;
 
201
    }
 
202
    elsif ($r == 0) {
 
203
        # EOF.
 
204
        die if length;
 
205
        return undef;
 
206
    }
 
207
    else {
 
208
        # Number of bytes read.
 
209
        die if $r != length;
 
210
        return $_;
 
211
    }
 
212
}
 
213
 
 
214
# GETC inherited from Tie::Handle
 
215
 
 
216
# This seems to segfault in my perl installation.
 
217
sub CLOSE {
 
218
    my $self = shift;
 
219
    gzclose $$self; # no meaningful return value?
 
220
    return 1;
 
221
}
 
222
 
 
223
sub OPEN {
 
224
    # Compress::Zlib doesn't support reopening.
 
225
    my $self = shift;
 
226
    die 'not yet implemented';
 
227
}
 
228
 
 
229
sub BINMODE {}
 
230
 
 
231
sub EOF {
 
232
    my $self = shift;
 
233
    return $$self->gzeof();
 
234
}
 
235
 
 
236
sub TELL {
 
237
    # Could track position manually.  But Compress::Zlib should do it.
 
238
    die 'not implemented';
 
239
}
 
240
 
 
241
sub SEEK {
 
242
    # Argh, fairly impossible.  Could simulate, but probably better to
 
243
    # throw.
 
244
    #
 
245
    die 'not implemented';
 
246
}
 
247
 
 
248
sub DESTROY { &CLOSE }
 
249
 
 
250
1;