line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package IO::Compress::Gzip ; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
require 5.006 ; |
4
|
|
|
|
|
|
|
|
5
|
24
|
|
|
24
|
|
44556
|
use strict ; |
|
24
|
|
|
|
|
109
|
|
|
24
|
|
|
|
|
688
|
|
6
|
24
|
|
|
24
|
|
116
|
use warnings; |
|
24
|
|
|
|
|
44
|
|
|
24
|
|
|
|
|
579
|
|
7
|
24
|
|
|
24
|
|
5802
|
use bytes; |
|
24
|
|
|
|
|
169
|
|
|
24
|
|
|
|
|
122
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
require Exporter ; |
10
|
|
|
|
|
|
|
|
11
|
24
|
|
|
24
|
|
11991
|
use IO::Compress::RawDeflate 2.206 () ; |
|
24
|
|
|
|
|
492
|
|
|
24
|
|
|
|
|
832
|
|
12
|
24
|
|
|
24
|
|
147
|
use IO::Compress::Adapter::Deflate 2.206 ; |
|
24
|
|
|
|
|
268
|
|
|
24
|
|
|
|
|
4124
|
|
13
|
|
|
|
|
|
|
|
14
|
24
|
|
|
24
|
|
169
|
use IO::Compress::Base::Common 2.206 qw(:Status ); |
|
24
|
|
|
|
|
294
|
|
|
24
|
|
|
|
|
2531
|
|
15
|
24
|
|
|
24
|
|
5266
|
use IO::Compress::Gzip::Constants 2.206 ; |
|
24
|
|
|
|
|
393
|
|
|
24
|
|
|
|
|
4381
|
|
16
|
24
|
|
|
24
|
|
5332
|
use IO::Compress::Zlib::Extra 2.206 ; |
|
24
|
|
|
|
|
363
|
|
|
24
|
|
|
|
|
1574
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
BEGIN |
19
|
|
|
|
|
|
|
{ |
20
|
24
|
50
|
|
24
|
|
132
|
if (defined &utf8::downgrade ) |
21
|
24
|
|
|
|
|
18169
|
{ *noUTF8 = \&utf8::downgrade } |
22
|
|
|
|
|
|
|
else |
23
|
0
|
|
|
|
|
0
|
{ *noUTF8 = sub {} } |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $GzipError); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
$VERSION = '2.206'; |
29
|
|
|
|
|
|
|
$GzipError = '' ; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
@ISA = qw(IO::Compress::RawDeflate Exporter); |
32
|
|
|
|
|
|
|
@EXPORT_OK = qw( $GzipError gzip ) ; |
33
|
|
|
|
|
|
|
%EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; |
36
|
|
|
|
|
|
|
Exporter::export_ok_tags('all'); |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub new |
39
|
|
|
|
|
|
|
{ |
40
|
314
|
|
|
314
|
1
|
230965
|
my $class = shift ; |
41
|
|
|
|
|
|
|
|
42
|
314
|
|
|
|
|
1092
|
my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$GzipError); |
43
|
|
|
|
|
|
|
|
44
|
314
|
|
|
|
|
1133
|
$obj->_create(undef, @_); |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub gzip |
49
|
|
|
|
|
|
|
{ |
50
|
161
|
|
|
161
|
1
|
9192721
|
my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$GzipError); |
51
|
161
|
|
|
|
|
593
|
return $obj->_def(@_); |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
#sub newHeader |
55
|
|
|
|
|
|
|
#{ |
56
|
|
|
|
|
|
|
# my $self = shift ; |
57
|
|
|
|
|
|
|
# #return GZIP_MINIMUM_HEADER ; |
58
|
|
|
|
|
|
|
# return $self->mkHeader(*$self->{Got}); |
59
|
|
|
|
|
|
|
#} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub getExtraParams |
62
|
|
|
|
|
|
|
{ |
63
|
474
|
|
|
474
|
0
|
760
|
my $self = shift ; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
return ( |
66
|
|
|
|
|
|
|
# zlib behaviour |
67
|
474
|
|
|
|
|
1395
|
$self->getZlibParams(), |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# Gzip header fields |
70
|
|
|
|
|
|
|
'minimal' => [IO::Compress::Base::Common::Parse_boolean, 0], |
71
|
|
|
|
|
|
|
'comment' => [IO::Compress::Base::Common::Parse_any, undef], |
72
|
|
|
|
|
|
|
'name' => [IO::Compress::Base::Common::Parse_any, undef], |
73
|
|
|
|
|
|
|
'time' => [IO::Compress::Base::Common::Parse_any, undef], |
74
|
|
|
|
|
|
|
'textflag' => [IO::Compress::Base::Common::Parse_boolean, 0], |
75
|
|
|
|
|
|
|
'headercrc' => [IO::Compress::Base::Common::Parse_boolean, 0], |
76
|
|
|
|
|
|
|
'os_code' => [IO::Compress::Base::Common::Parse_unsigned, $Compress::Raw::Zlib::gzip_os_code], |
77
|
|
|
|
|
|
|
'extrafield'=> [IO::Compress::Base::Common::Parse_any, undef], |
78
|
|
|
|
|
|
|
'extraflags'=> [IO::Compress::Base::Common::Parse_any, undef], |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
); |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub ckParams |
85
|
|
|
|
|
|
|
{ |
86
|
470
|
|
|
470
|
0
|
764
|
my $self = shift ; |
87
|
470
|
|
|
|
|
722
|
my $got = shift ; |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
# gzip always needs crc32 |
90
|
470
|
|
|
|
|
1566
|
$got->setValue('crc32' => 1); |
91
|
|
|
|
|
|
|
|
92
|
470
|
100
|
|
|
|
936
|
return 1 |
93
|
|
|
|
|
|
|
if $got->getValue('merge') ; |
94
|
|
|
|
|
|
|
|
95
|
443
|
|
|
|
|
939
|
my $strict = $got->getValue('strict') ; |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
{ |
99
|
443
|
100
|
|
|
|
643
|
if (! $got->parsed('time') ) { |
|
443
|
|
|
|
|
922
|
|
100
|
|
|
|
|
|
|
# Modification time defaults to now. |
101
|
377
|
|
|
|
|
911
|
$got->setValue(time => time) ; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
# Check that the Name & Comment don't have embedded NULLs |
105
|
|
|
|
|
|
|
# Also check that they only contain ISO 8859-1 chars. |
106
|
443
|
100
|
100
|
|
|
983
|
if ($got->parsed('name') && defined $got->getValue('name')) { |
107
|
80
|
|
|
|
|
186
|
my $name = $got->getValue('name'); |
108
|
|
|
|
|
|
|
|
109
|
80
|
100
|
100
|
|
|
440
|
return $self->saveErrorString(undef, "Null Character found in Name", |
110
|
|
|
|
|
|
|
Z_DATA_ERROR) |
111
|
|
|
|
|
|
|
if $strict && $name =~ /\x00/ ; |
112
|
|
|
|
|
|
|
|
113
|
78
|
100
|
100
|
|
|
491
|
return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Name", |
114
|
|
|
|
|
|
|
Z_DATA_ERROR) |
115
|
|
|
|
|
|
|
if $strict && $name =~ /$GZIP_FNAME_INVALID_CHAR_RE/o ; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
440
|
100
|
100
|
|
|
1034
|
if ($got->parsed('comment') && defined $got->getValue('comment')) { |
119
|
38
|
|
|
|
|
83
|
my $comment = $got->getValue('comment'); |
120
|
|
|
|
|
|
|
|
121
|
38
|
100
|
100
|
|
|
174
|
return $self->saveErrorString(undef, "Null Character found in Comment", |
122
|
|
|
|
|
|
|
Z_DATA_ERROR) |
123
|
|
|
|
|
|
|
if $strict && $comment =~ /\x00/ ; |
124
|
|
|
|
|
|
|
|
125
|
36
|
100
|
100
|
|
|
227
|
return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Comment", |
126
|
|
|
|
|
|
|
Z_DATA_ERROR) |
127
|
|
|
|
|
|
|
if $strict && $comment =~ /$GZIP_FCOMMENT_INVALID_CHAR_RE/o; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
437
|
100
|
|
|
|
944
|
if ($got->parsed('os_code') ) { |
131
|
6
|
|
|
|
|
15
|
my $value = $got->getValue('os_code'); |
132
|
|
|
|
|
|
|
|
133
|
6
|
100
|
66
|
|
|
38
|
return $self->saveErrorString(undef, "OS_Code must be between 0 and 255, got '$value'") |
134
|
|
|
|
|
|
|
if $value < 0 || $value > 255 ; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# gzip only supports Deflate at present |
139
|
436
|
|
|
|
|
1360
|
$got->setValue('method' => Z_DEFLATED) ; |
140
|
|
|
|
|
|
|
|
141
|
436
|
100
|
|
|
|
933
|
if ( ! $got->parsed('extraflags')) { |
142
|
435
|
100
|
|
|
|
920
|
$got->setValue('extraflags' => 2) |
143
|
|
|
|
|
|
|
if $got->getValue('level') == Z_BEST_COMPRESSION ; |
144
|
435
|
100
|
|
|
|
2432
|
$got->setValue('extraflags' => 4) |
145
|
|
|
|
|
|
|
if $got->getValue('level') == Z_BEST_SPEED ; |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
436
|
|
|
|
|
2201
|
my $data = $got->getValue('extrafield') ; |
149
|
436
|
100
|
|
|
|
1074
|
if (defined $data) { |
150
|
82
|
|
|
|
|
355
|
my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, $strict, 1) ; |
151
|
82
|
100
|
|
|
|
215
|
return $self->saveErrorString(undef, "Error with ExtraField Parameter: $bad", Z_DATA_ERROR) |
152
|
|
|
|
|
|
|
if $bad ; |
153
|
|
|
|
|
|
|
|
154
|
62
|
|
|
|
|
152
|
$got->setValue('extrafield' => $data) ; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
416
|
|
|
|
|
1133
|
return 1; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub mkTrailer |
162
|
|
|
|
|
|
|
{ |
163
|
438
|
|
|
438
|
0
|
703
|
my $self = shift ; |
164
|
|
|
|
|
|
|
return pack("V V", *$self->{Compress}->crc32(), |
165
|
438
|
|
|
|
|
1367
|
*$self->{UnCompSize}->get32bit()); |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub getInverseClass |
169
|
|
|
|
|
|
|
{ |
170
|
24
|
|
|
24
|
|
224
|
no warnings 'once'; |
|
24
|
|
|
|
|
113
|
|
|
24
|
|
|
|
|
12956
|
|
171
|
23
|
|
|
23
|
0
|
75
|
return ('IO::Uncompress::Gunzip', |
172
|
|
|
|
|
|
|
\$IO::Uncompress::Gunzip::GunzipError); |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
sub getFileInfo |
176
|
|
|
|
|
|
|
{ |
177
|
110
|
|
|
110
|
0
|
198
|
my $self = shift ; |
178
|
110
|
|
|
|
|
154
|
my $params = shift; |
179
|
110
|
|
|
|
|
178
|
my $filename = shift ; |
180
|
|
|
|
|
|
|
|
181
|
110
|
100
|
|
|
|
233
|
return if IO::Compress::Base::Common::isaScalar($filename); |
182
|
|
|
|
|
|
|
|
183
|
66
|
|
|
|
|
1046
|
my $defaultTime = (stat($filename))[9] ; |
184
|
|
|
|
|
|
|
|
185
|
66
|
100
|
|
|
|
342
|
$params->setValue('name' => $filename) |
186
|
|
|
|
|
|
|
if ! $params->parsed('name') ; |
187
|
|
|
|
|
|
|
|
188
|
66
|
100
|
|
|
|
168
|
$params->setValue('time' => $defaultTime) |
189
|
|
|
|
|
|
|
if ! $params->parsed('time') ; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
sub mkHeader |
194
|
|
|
|
|
|
|
{ |
195
|
418
|
|
|
418
|
0
|
657
|
my $self = shift ; |
196
|
418
|
|
|
|
|
647
|
my $param = shift ; |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
# short-circuit if a minimal header is requested. |
199
|
418
|
100
|
|
|
|
1062
|
return GZIP_MINIMUM_HEADER if $param->getValue('minimal') ; |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
# METHOD |
202
|
383
|
|
|
|
|
1003
|
my $method = $param->valueOrDefault('method', GZIP_CM_DEFLATED) ; |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
# FLAGS |
205
|
383
|
|
|
|
|
585
|
my $flags = GZIP_FLG_DEFAULT ; |
206
|
383
|
100
|
|
|
|
772
|
$flags |= GZIP_FLG_FTEXT if $param->getValue('textflag') ; |
207
|
383
|
100
|
|
|
|
870
|
$flags |= GZIP_FLG_FHCRC if $param->getValue('headercrc') ; |
208
|
383
|
100
|
|
|
|
957
|
$flags |= GZIP_FLG_FEXTRA if $param->wantValue('extrafield') ; |
209
|
383
|
100
|
|
|
|
917
|
$flags |= GZIP_FLG_FNAME if $param->wantValue('name') ; |
210
|
383
|
100
|
|
|
|
849
|
$flags |= GZIP_FLG_FCOMMENT if $param->wantValue('comment') ; |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
# MTIME |
213
|
383
|
|
|
|
|
880
|
my $time = $param->valueOrDefault('time', GZIP_MTIME_DEFAULT) ; |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
# EXTRA FLAGS |
216
|
383
|
|
|
|
|
807
|
my $extra_flags = $param->valueOrDefault('extraflags', GZIP_XFL_DEFAULT); |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# OS CODE |
219
|
383
|
|
|
|
|
837
|
my $os_code = $param->valueOrDefault('os_code', GZIP_OS_DEFAULT) ; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
|
222
|
383
|
|
|
|
|
1770
|
my $out = pack("C4 V C C", |
223
|
|
|
|
|
|
|
GZIP_ID1, # ID1 |
224
|
|
|
|
|
|
|
GZIP_ID2, # ID2 |
225
|
|
|
|
|
|
|
$method, # Compression Method |
226
|
|
|
|
|
|
|
$flags, # Flags |
227
|
|
|
|
|
|
|
$time, # Modification Time |
228
|
|
|
|
|
|
|
$extra_flags, # Extra Flags |
229
|
|
|
|
|
|
|
$os_code, # Operating System Code |
230
|
|
|
|
|
|
|
) ; |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# EXTRA |
233
|
383
|
100
|
|
|
|
890
|
if ($flags & GZIP_FLG_FEXTRA) { |
234
|
62
|
|
|
|
|
139
|
my $extra = $param->getValue('extrafield') ; |
235
|
62
|
|
|
|
|
438
|
$out .= pack("v", length $extra) . $extra ; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
# NAME |
239
|
383
|
100
|
|
|
|
803
|
if ($flags & GZIP_FLG_FNAME) { |
240
|
86
|
|
|
|
|
204
|
my $name .= $param->getValue('name') ; |
241
|
86
|
|
|
|
|
245
|
$name =~ s/\x00.*$//; |
242
|
86
|
|
|
|
|
192
|
$out .= $name ; |
243
|
|
|
|
|
|
|
# Terminate the filename with NULL unless it already is |
244
|
86
|
50
|
66
|
|
|
499
|
$out .= GZIP_NULL_BYTE |
245
|
|
|
|
|
|
|
if !length $name or |
246
|
|
|
|
|
|
|
substr($name, 1, -1) ne GZIP_NULL_BYTE ; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
# COMMENT |
250
|
383
|
100
|
|
|
|
783
|
if ($flags & GZIP_FLG_FCOMMENT) { |
251
|
53
|
|
|
|
|
107
|
my $comment .= $param->getValue('comment') ; |
252
|
53
|
|
|
|
|
122
|
$comment =~ s/\x00.*$//; |
253
|
53
|
|
|
|
|
102
|
$out .= $comment ; |
254
|
|
|
|
|
|
|
# Terminate the comment with NULL unless it already is |
255
|
53
|
50
|
66
|
|
|
257
|
$out .= GZIP_NULL_BYTE |
256
|
|
|
|
|
|
|
if ! length $comment or |
257
|
|
|
|
|
|
|
substr($comment, 1, -1) ne GZIP_NULL_BYTE; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
# HEADER CRC |
261
|
383
|
100
|
|
|
|
819
|
$out .= pack("v", Compress::Raw::Zlib::crc32($out) & 0x00FF ) |
262
|
|
|
|
|
|
|
if $param->getValue('headercrc') ; |
263
|
|
|
|
|
|
|
|
264
|
383
|
|
|
|
|
1119
|
noUTF8($out); |
265
|
|
|
|
|
|
|
|
266
|
383
|
|
|
|
|
1133
|
return $out ; |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
sub mkFinalTrailer |
270
|
|
|
|
|
|
|
{ |
271
|
411
|
|
|
411
|
0
|
987
|
return ''; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
1; |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
__END__ |