File Coverage

blib/lib/Compress/Zlib.pm
Criterion Covered Total %
statement 240 250 96.0
branch 118 128 92.2
condition 29 35 82.9
subroutine 41 43 95.3
pod 7 7 100.0
total 435 463 94.0


line stmt bran cond sub pod time code
1              
2             package Compress::Zlib;
3              
4             require 5.004 ;
5             require Exporter;
6 6     6   96 use AutoLoader;
  6         55  
  6         97  
7 6     6   99 use Carp ;
  6         56  
  6         146  
8 6     6   118 use IO::Handle ;
  6         58  
  6         127  
9 6     6   91 use Scalar::Util qw(dualvar);
  6         59  
  6         104  
10              
11 6     6   118 use IO::Compress::Base::Common 2.004 ;
  6         159  
  6         92  
12 6     6   126 use Compress::Raw::Zlib 2.004 ;
  6         125  
  6         89  
13 6     6   197 use IO::Compress::Gzip 2.004 ;
  6         204  
  6         104  
14 6     6   117 use IO::Uncompress::Gunzip 2.004 ;
  6         186  
  6         89  
15              
16 6     6   94 use strict ;
  6         55  
  6         86  
17 6     6   111 use warnings ;
  6         52  
  6         87  
18 6     6   120 use bytes ;
  6         56  
  6         1859  
19             our ($VERSION, $XS_VERSION, @ISA, @EXPORT, $AUTOLOAD);
20              
21             $VERSION = '2.004';
22             $XS_VERSION = $VERSION;
23             $VERSION = eval $VERSION;
24              
25             @ISA = qw(Exporter);
26             # Items to export into callers namespace by default. Note: do not export
27             # names by default without a very good reason. Use EXPORT_OK instead.
28             # Do not simply export all your public functions/methods/constants.
29             @EXPORT = qw(
30             deflateInit inflateInit
31            
32             compress uncompress
33            
34             gzopen $gzerrno
35             );
36              
37             push @EXPORT, @Compress::Raw::Zlib::EXPORT ;
38              
39             BEGIN
40             {
41 6     6   106     *zlib_version = \&Compress::Raw::Zlib::zlib_version;
42             }
43              
44             sub AUTOLOAD {
45 0     0   0     my($constname);
46 0         0     ($constname = $AUTOLOAD) =~ s/.*:://;
47 0         0     my ($error, $val) = Compress::Raw::Zlib::constant($constname);
48 0 0       0     Carp::croak $error if $error;
49 6     6   101     no strict 'refs';
  6         57  
  6         79  
50 0     0   0     *{$AUTOLOAD} = sub { $val };
  0         0  
  0         0  
51 0         0     goto &{$AUTOLOAD};
  0         0  
52             }
53              
54 6     6   94 use constant FLAG_APPEND => 1 ;
  6         55  
  6         109  
55 6     6   248 use constant FLAG_CRC => 2 ;
  6         56  
  6         85  
56 6     6   91 use constant FLAG_ADLER => 4 ;
  6         55  
  6         75  
57 6     6   136 use constant FLAG_CONSUME_INPUT => 8 ;
  6         57  
  6         75  
58              
59             our (@my_z_errmsg);
60              
61             @my_z_errmsg = (
62                 "need dictionary", # Z_NEED_DICT 2
63                 "stream end", # Z_STREAM_END 1
64                 "", # Z_OK 0
65                 "file error", # Z_ERRNO (-1)
66                 "stream error", # Z_STREAM_ERROR (-2)
67                 "data error", # Z_DATA_ERROR (-3)
68                 "insufficient memory", # Z_MEM_ERROR (-4)
69                 "buffer error", # Z_BUF_ERROR (-5)
70                 "incompatible version",# Z_VERSION_ERROR(-6)
71                 );
72              
73              
74             sub _set_gzerr
75             {
76 261     261   2620     my $value = shift ;
77              
78 261 100 33     4730     if ($value == 0) {
    50          
79 181         1923         $Compress::Zlib::gzerrno = 0 ;
80                 }
81                 elsif ($value == Z_ERRNO() || $value > 2) {
82 0         0         $Compress::Zlib::gzerrno = $! ;
83                 }
84                 else {
85 80         2433         $Compress::Zlib::gzerrno = dualvar($value+0, $my_z_errmsg[2 - $value]);
86                 }
87              
88 261         3297     return $value ;
89             }
90              
91             sub _save_gzerr
92             {
93 200     200   2252     my $gz = shift ;
94 200         2077     my $test_eof = shift ;
95              
96 200   100     3594     my $value = $gz->errorNo() || 0 ;
97              
98 200 100       5639     if ($test_eof) {
99             #my $gz = $self->[0] ;
100             # gzread uses Z_STREAM_END to denote a successful end
101 36 100 100     440         $value = Z_STREAM_END() if $gz->eof() && $value == 0 ;
102                 }
103              
104 200         4381     _set_gzerr($value) ;
105             }
106              
107             sub gzopen($$)
108             {
109 60     60 1 2029     my ($file, $mode) = @_ ;
110              
111 60         1520     my $gz ;
112 60         977     my %defOpts = (Level => Z_DEFAULT_COMPRESSION(),
113                                Strategy => Z_DEFAULT_STRATEGY(),
114                               );
115              
116 60         535     my $writing ;
117 60         779     $writing = ! ($mode =~ /r/i) ;
118 60         642     $writing = ($mode =~ /[wa]/i) ;
119              
120 60 100       2817     $defOpts{Level} = $1 if $mode =~ /(\d)/;
121 60 100       804     $defOpts{Strategy} = Z_FILTERED() if $mode =~ /f/i;
122 60 100       873     $defOpts{Strategy} = Z_HUFFMAN_ONLY() if $mode =~ /h/i;
123 60 100       3882     $defOpts{Append} = 1 if $mode =~ /a/i;
124              
125 60 100       3347     my $infDef = $writing ? 'deflate' : 'inflate';
126 60         589     my @params = () ;
127              
128 60 100 100     804     croak "gzopen: file parameter is not a filehandle or filename"
      33        
      66        
129                     unless isaFilehandle $file || isaFilename $file ||
130                            (ref $file && ref $file eq 'SCALAR');
131              
132 59 100       1182     return undef unless $mode =~ /[rwa]/i ;
133              
134 58         604     _set_gzerr(0) ;
135              
136 58 100       672     if ($writing) {
137 29 100       656         $gz = new IO::Compress::Gzip($file, Minimal => 1, AutoClose => 1,
138                                                  %defOpts)
139                         or $Compress::Zlib::gzerrno = $IO::Compress::Gzip::GzipError;
140                 }
141                 else {
142 29 100       970         $gz = new IO::Uncompress::Gunzip($file,
143                                                      Transparent => 1,
144                                                      Append => 0,
145                                                      AutoClose => 1,
146                                                      MultiStream => 1,
147                                                      Strict => 0)
148                         or $Compress::Zlib::gzerrno = $IO::Uncompress::Gunzip::GunzipError;
149                 }
150              
151                 return undef
152 58 100       69329         if ! defined $gz ;
153              
154 56         1796     bless [$gz, $infDef], 'Compress::Zlib::gzFile';
155             }
156              
157             sub Compress::Zlib::gzFile::gzread
158             {
159 34     34   2651     my $self = shift ;
160              
161 34 100       456     return _set_gzerr(Z_STREAM_ERROR())
162                     if $self->[1] ne 'inflate';
163              
164 33 100       342     my $len = defined $_[1] ? $_[1] : 4096 ;
165              
166 33 100 100     373     if ($self->gzeof() || $len == 0) {
167             # Zap the output buffer to match ver 1 behaviour.
168 9         129         $_[0] = "" ;
169 9         126         return 0 ;
170                 }
171              
172 24         233     my $gz = $self->[0] ;
173 24         394     my $status = $gz->read($_[0], $len) ;
174 24         25118     _save_gzerr($gz, 1);
175 24         530     return $status ;
176             }
177              
178             sub Compress::Zlib::gzFile::gzreadline
179             {
180 12     12   107     my $self = shift ;
181              
182 12         142     my $gz = $self->[0] ;
183 12         202     $_[0] = $gz->getline() ;
184 12         4618     _save_gzerr($gz, 1);
185 12 100       171     return defined $_[0] ? length $_[0] : 0 ;
186             }
187              
188             sub Compress::Zlib::gzFile::gzwrite
189             {
190 26     26   574     my $self = shift ;
191 26         241     my $gz = $self->[0] ;
192              
193 26 100       370     return _set_gzerr(Z_STREAM_ERROR())
194                     if $self->[1] ne 'deflate';
195              
196 25         742     my $status = $gz->write($_[0]) ;
197 25         21960     _save_gzerr($gz);
198 25         376     return $status ;
199             }
200              
201             sub Compress::Zlib::gzFile::gztell
202             {
203 16     16   157     my $self = shift ;
204 16         144     my $gz = $self->[0] ;
205 16         393     my $status = $gz->tell() ;
206 16         586     _save_gzerr($gz);
207 16         230     return $status ;
208             }
209              
210             sub Compress::Zlib::gzFile::gzseek
211             {
212 11     11   324     my $self = shift ;
213 11         99     my $offset = shift ;
214 11         95     my $whence = shift ;
215              
216 11         102     my $gz = $self->[0] ;
217 11         90     my $status ;
218 11         94     eval { $status = $gz->seek($offset, $whence) ; };
  11         212  
219 11 100       1929     if ($@)
220                 {
221 5         47         my $error = $@;
222 5         82         $error =~ s/^.*: /gzseek: /;
223 5         66         $error =~ s/ at .* line \d+\s*$//;
224 5         57         croak $error;
225                 }
226 6         59     _save_gzerr($gz);
227 6         84     return $status ;
228             }
229              
230             sub Compress::Zlib::gzFile::gzflush
231             {
232 1     1   19     my $self = shift ;
233 1         10     my $f = shift ;
234              
235 1         262     my $gz = $self->[0] ;
236 1         50     my $status = $gz->flush($f) ;
237 1         396     _save_gzerr($gz);
238 1         17     return $status ;
239             }
240              
241             sub Compress::Zlib::gzFile::gzclose
242             {
243 48     48   504     my $self = shift ;
244 48         488     my $gz = $self->[0] ;
245              
246 48         944     my $status = $gz->close() ;
247 48         6024     _save_gzerr($gz);
248 48         827     return ! $status ;
249             }
250              
251             sub Compress::Zlib::gzFile::gzeof
252             {
253 68     68   715     my $self = shift ;
254 68         774     my $gz = $self->[0] ;
255              
256 68 100       901     return 0
257                     if $self->[1] ne 'inflate';
258              
259 67         1250     my $status = $gz->eof() ;
260 67         4127     _save_gzerr($gz);
261 67         1077     return $status ;
262             }
263              
264             sub Compress::Zlib::gzFile::gzsetparams
265             {
266 3     3   29     my $self = shift ;
267 3 100       42     croak "Usage: Compress::Zlib::gzFile::gzsetparams(file, level, strategy)"
268                     unless @_ eq 2 ;
269              
270 2         20     my $gz = $self->[0] ;
271 2         18     my $level = shift ;
272 2         17     my $strategy = shift;
273              
274 2 100       32     return _set_gzerr(Z_STREAM_ERROR())
275                     if $self->[1] ne 'deflate';
276              
277 1         180     my $status = *$gz->{Compress}->deflateParams(-Level => $level,
278                                                             -Strategy => $strategy);
279 1         42     _save_gzerr($gz);
280 1         13     return $status ;
281             }
282              
283             sub Compress::Zlib::gzFile::gzerror
284             {
285 4     4   37     my $self = shift ;
286 4         38     my $gz = $self->[0] ;
287                 
288 4         60     return $Compress::Zlib::gzerrno ;
289             }
290              
291              
292             sub compress($;$)
293             {
294 9     9 1 17818     my ($x, $output, $err, $in) =('', '', '', '') ;
295              
296 9 100       109     if (ref $_[0] ) {
297 3         610         $in = $_[0] ;
298 3 100       47         croak "not a scalar reference" unless ref $in eq 'SCALAR' ;
299                 }
300                 else {
301 6         61         $in = \$_[0] ;
302                 }
303              
304 8 100       121     my $level = (@_ == 2 ? $_[1] : Z_DEFAULT_COMPRESSION() );
305              
306 8 100       200     $x = new Compress::Raw::Zlib::Deflate -AppendOutput => 1, -Level => $level
307                         or return undef ;
308              
309 7         14935     $err = $x->deflate($in, $output) ;
310 7 50       102     return undef unless $err == Z_OK() ;
311              
312 7         1019     $err = $x->flush($output) ;
313 7 50       161     return undef unless $err == Z_OK() ;
314                 
315 7         1301 <