File Coverage

blib/lib/IO/Uncompress/Inflate.pm
Criterion Covered Total %
statement 68 70 97.1
branch 14 20 70.0
condition 3 3 100.0
subroutine 16 16 100.0
pod 2 9 22.2
total 103 118 87.2


line stmt bran cond sub pod time code
1             package IO::Uncompress::Inflate ;
2             # for RFC1950
3              
4 83     83   6106 use strict ;
  83         152  
  83         2320  
5 83     83   380 use warnings;
  83         156  
  83         1724  
6 83     83   367 use bytes;
  83         171  
  83         378  
7              
8 83     83   2560 use IO::Compress::Base::Common 2.206 qw(:Status );
  83         1391  
  83         8873  
9 83     83   29081 use IO::Compress::Zlib::Constants 2.206 ;
  83         1359  
  83         7187  
10              
11 83     83   5027 use IO::Uncompress::RawInflate 2.206 ;
  83         1192  
  83         73122  
12              
13             require Exporter ;
14             our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $InflateError);
15              
16             $VERSION = '2.206';
17             $InflateError = '';
18              
19             @ISA = qw(IO::Uncompress::RawInflate Exporter);
20             @EXPORT_OK = qw( $InflateError inflate ) ;
21             %EXPORT_TAGS = %IO::Uncompress::RawInflate::DEFLATE_CONSTANTS ;
22             push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
23             Exporter::export_ok_tags('all');
24              
25              
26             sub new
27             {
28 289     289 1 42339 my $class = shift ;
29 289         890 my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$InflateError);
30              
31 289         993 $obj->_create(undef, 0, @_);
32             }
33              
34             sub inflate
35             {
36 66     66 1 38007 my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$InflateError);
37 66         205 return $obj->_inf(@_);
38             }
39              
40             sub getExtraParams
41             {
42 338     338 0 2026 return ();
43             }
44              
45             sub ckParams
46             {
47 346     346 0 521 my $self = shift ;
48 346         459 my $got = shift ;
49              
50             # gunzip always needs adler32
51 346         898 $got->setValue('adler32' => 1);
52              
53 346         732 return 1;
54             }
55              
56             sub ckMagic
57             {
58 1830     1830 0 2752 my $self = shift;
59              
60 1830         2222 my $magic ;
61 1830         5531 $self->smartReadExact(\$magic, ZLIB_HEADER_SIZE);
62              
63 1830         3409 *$self->{HeaderPending} = $magic ;
64              
65 1830 100       3770 return $self->HeaderError("Header size is " .
66             ZLIB_HEADER_SIZE . " bytes")
67             if length $magic != ZLIB_HEADER_SIZE;
68              
69             #return $self->HeaderError("CRC mismatch.")
70             return undef
71 1794 100       3870 if ! $self->isZlibMagic($magic) ;
72              
73 897         1500 *$self->{Type} = 'rfc1950';
74 897         2404 return $magic;
75             }
76              
77             sub readHeader
78             {
79 897     897 0 1145 my $self = shift;
80 897         1233 my $magic = shift ;
81              
82 897         1641 return $self->_readDeflateHeader($magic) ;
83             }
84              
85             sub chkTrailer
86             {
87 864     864 0 1253 my $self = shift;
88 864         1148 my $trailer = shift;
89              
90 864         1958 my $ADLER32 = unpack("N", $trailer) ;
91 864         1570 *$self->{Info}{ADLER32} = $ADLER32;
92             return $self->TrailerError("CRC mismatch")
93 864 100 100     2391 if *$self->{Strict} && $ADLER32 != *$self->{Uncomp}->adler32() ;
94              
95 863         2165 return STATUS_OK;
96             }
97              
98              
99              
100             sub isZlibMagic
101             {
102 1794     1794 0 2536 my $self = shift;
103 1794         2449 my $buffer = shift ;
104              
105 1794 50       4223 return 0
106             if length $buffer < ZLIB_HEADER_SIZE ;
107              
108 1794         4755 my $hdr = unpack("n", $buffer) ;
109             #return 0 if $hdr % 31 != 0 ;
110 1794 100       5162 return $self->HeaderError("CRC mismatch.")
111             if $hdr % 31 != 0 ;
112              
113 899         2071 my ($CMF, $FLG) = unpack "C C", $buffer;
114 899         1717 my $cm = bits($CMF, ZLIB_CMF_CM_OFFSET, ZLIB_CMF_CM_BITS) ;
115              
116             # Only Deflate supported
117 899 100       1700 return $self->HeaderError("Not Deflate (CM is $cm)")
118             if $cm != ZLIB_CMF_CM_DEFLATED ;
119              
120             # Max window value is 7 for Deflate.
121 897         1397 my $cinfo = bits($CMF, ZLIB_CMF_CINFO_OFFSET, ZLIB_CMF_CINFO_BITS) ;
122 897 50       1568 return $self->HeaderError("CINFO > " . ZLIB_CMF_CINFO_MAX .
123             " (CINFO is $cinfo)")
124             if $cinfo > ZLIB_CMF_CINFO_MAX ;
125              
126 897         1792 return 1;
127             }
128              
129             sub bits
130             {
131 8075     8075 0 9303 my $data = shift ;
132 8075         8830 my $offset = shift ;
133 8075         9011 my $mask = shift ;
134              
135 8075         19102 ($data >> $offset ) & $mask & 0xFF ;
136             }
137              
138              
139             sub _readDeflateHeader
140             {
141 897     897   1533 my ($self, $buffer) = @_ ;
142              
143             # if (! $buffer) {
144             # $self->smartReadExact(\$buffer, ZLIB_HEADER_SIZE);
145             #
146             # *$self->{HeaderPending} = $buffer ;
147             #
148             # return $self->HeaderError("Header size is " .
149             # ZLIB_HEADER_SIZE . " bytes")
150             # if length $buffer != ZLIB_HEADER_SIZE;
151             #
152             # return $self->HeaderError("CRC mismatch.")
153             # if ! isZlibMagic($buffer) ;
154             # }
155              
156 897         1729 my ($CMF, $FLG) = unpack "C C", $buffer;
157 897         2220 my $FDICT = bits($FLG, ZLIB_FLG_FDICT_OFFSET, ZLIB_FLG_FDICT_BITS ),
158              
159             my $cm = bits($CMF, ZLIB_CMF_CM_OFFSET, ZLIB_CMF_CM_BITS) ;
160 897 50       1666 $cm == ZLIB_CMF_CM_DEFLATED
161             or return $self->HeaderError("Not Deflate (CM is $cm)") ;
162              
163 897         1055 my $DICTID;
164 897 50       1473 if ($FDICT) {
165 0 0       0 $self->smartReadExact(\$buffer, ZLIB_FDICT_SIZE)
166             or return $self->TruncatedHeader("FDICT");
167              
168 0         0 $DICTID = unpack("N", $buffer) ;
169             }
170              
171 897         1359 *$self->{Type} = 'rfc1950';
172              
173             return {
174 897         1590 'Type' => 'rfc1950',
175             'FingerprintLength' => ZLIB_HEADER_SIZE,
176             'HeaderLength' => ZLIB_HEADER_SIZE,
177             'TrailerLength' => ZLIB_TRAILER_SIZE,
178             'Header' => $buffer,
179              
180             CMF => $CMF ,
181             CM => bits($CMF, ZLIB_CMF_CM_OFFSET, ZLIB_CMF_CM_BITS ),
182             CINFO => bits($CMF, ZLIB_CMF_CINFO_OFFSET, ZLIB_CMF_CINFO_BITS ),
183             FLG => $FLG ,
184             FCHECK => bits($FLG, ZLIB_FLG_FCHECK_OFFSET, ZLIB_FLG_FCHECK_BITS),
185             FDICT => bits($FLG, ZLIB_FLG_FDICT_OFFSET, ZLIB_FLG_FDICT_BITS ),
186             FLEVEL => bits($FLG, ZLIB_FLG_LEVEL_OFFSET, ZLIB_FLG_LEVEL_BITS ),
187             DICTID => $DICTID ,
188              
189             };
190             }
191              
192              
193              
194              
195             1 ;
196              
197             __END__