File Coverage

blib/lib/IO/Compress/Adapter/Deflate.pm
Criterion Covered Total %
statement 55 73 75.3
branch 7 14 50.0
condition 2 3 66.6
subroutine 12 16 75.0
pod 0 11 0.0
total 76 117 64.9


line stmt bran cond sub pod time code
1             package IO::Compress::Adapter::Deflate ;
2              
3 66     66   3236 use strict;
  66         122  
  66         1758  
4 66     66   285 use warnings;
  66         170  
  66         1410  
5 66     66   302 use bytes;
  66         129  
  66         312  
6              
7 66     66   2005 use IO::Compress::Base::Common 2.204 qw(:Status);
  66         1026  
  66         6533  
8 66     66   21533 use Compress::Raw::Zlib 2.204 qw( !crc32 !adler32 ) ;
  66         167744  
  66         72446  
9              
10             require Exporter;
11             our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS);
12              
13             $VERSION = '2.204';
14             @ISA = qw(Exporter);
15             @EXPORT_OK = @Compress::Raw::Zlib::DEFLATE_CONSTANTS;
16             %EXPORT_TAGS = %Compress::Raw::Zlib::DEFLATE_CONSTANTS;
17             @EXPORT = @EXPORT_OK;
18             %DEFLATE_CONSTANTS = %EXPORT_TAGS ;
19              
20             sub mkCompObject
21             {
22 1046     1046 0 1692 my $crc32 = shift ;
23 1046         1533 my $adler32 = shift ;
24 1046         1476 my $level = shift ;
25 1046         1486 my $strategy = shift ;
26              
27 1046         3077 my ($def, $status) = Compress::Raw::Zlib::Deflate->new(
28             -AppendOutput => 1,
29             -CRC32 => $crc32,
30             -ADLER32 => $adler32,
31             -Level => $level,
32             -Strategy => $strategy,
33             -WindowBits => - MAX_WBITS);
34              
35 1046 50       735101 return (undef, "Cannot create Deflate object: $status", $status)
36             if $status != Z_OK;
37              
38 1046         9510 return bless {'Def' => $def,
39             'Error' => '',
40             } ;
41             }
42              
43             sub mkCompObject1
44             {
45 299     299 0 449 my $crc32 = shift ;
46 299         459 my $adler32 = shift ;
47 299         392 my $level = shift ;
48 299         457 my $strategy = shift ;
49              
50 299         928 my ($def, $status) = Compress::Raw::Zlib::Deflate->new(
51             -AppendOutput => 1,
52             -CRC32 => $crc32,
53             -ADLER32 => $adler32,
54             -Level => $level,
55             -Strategy => $strategy,
56             -WindowBits => MAX_WBITS);
57              
58 299 50       214642 return (undef, "Cannot create Deflate object: $status", $status)
59             if $status != Z_OK;
60              
61 299         2765 return bless {'Def' => $def,
62             'Error' => '',
63             } ;
64             }
65              
66             sub compr
67             {
68 1318     1318 0 2039 my $self = shift ;
69              
70 1318         2122 my $def = $self->{Def};
71              
72 1318         52322 my $status = $def->deflate($_[0], $_[1]) ;
73 1318         3315 $self->{ErrorNo} = $status;
74              
75 1318 50       3790 if ($status != Z_OK)
76             {
77 0         0 $self->{Error} = "Deflate Error: $status";
78 0         0 return STATUS_ERROR;
79             }
80              
81 1318         6096 return STATUS_OK;
82             }
83              
84             sub flush
85             {
86 31     31 0 50 my $self = shift ;
87              
88 31         51 my $def = $self->{Def};
89              
90 31   66     120 my $opt = $_[1] || Z_FINISH;
91 31         813 my $status = $def->flush($_[0], $opt);
92 31         83 $self->{ErrorNo} = $status;
93              
94 31 100       83 if ($status != Z_OK)
95             {
96 1         6 $self->{Error} = "Deflate Error: $status";
97 1         3 return STATUS_ERROR;
98             }
99              
100 30         165 return STATUS_OK;
101             }
102              
103             sub close
104             {
105 1400     1400 0 2186 my $self = shift ;
106              
107 1400         2330 my $def = $self->{Def};
108              
109 1400 50       7774 $def->flush($_[0], Z_FINISH)
110             if defined $def ;
111             }
112              
113             sub reset
114             {
115 0     0 0 0 my $self = shift ;
116              
117 0         0 my $def = $self->{Def};
118              
119 0         0 my $status = $def->deflateReset() ;
120 0         0 $self->{ErrorNo} = $status;
121 0 0       0 if ($status != Z_OK)
122             {
123 0         0 $self->{Error} = "Deflate Error: $status";
124 0         0 return STATUS_ERROR;
125             }
126              
127 0         0 return STATUS_OK;
128             }
129              
130             sub deflateParams
131             {
132 4     4 0 5 my $self = shift ;
133              
134 4         7 my $def = $self->{Def};
135              
136 4         16 my $status = $def->deflateParams(@_);
137 4         1024 $self->{ErrorNo} = $status;
138 4 50       13 if ($status != Z_OK)
139             {
140 0         0 $self->{Error} = "deflateParams Error: $status";
141 0         0 return STATUS_ERROR;
142             }
143              
144 4         25 return STATUS_OK;
145             }
146              
147              
148              
149             #sub total_out
150             #{
151             # my $self = shift ;
152             # $self->{Def}->total_out();
153             #}
154             #
155             #sub total_in
156             #{
157             # my $self = shift ;
158             # $self->{Def}->total_in();
159             #}
160              
161             sub compressedBytes
162             {
163 0     0 0 0 my $self = shift ;
164              
165 0         0 $self->{Def}->compressedBytes();
166             }
167              
168             sub uncompressedBytes
169             {
170 0     0 0 0 my $self = shift ;
171 0         0 $self->{Def}->uncompressedBytes();
172             }
173              
174              
175              
176              
177             sub crc32
178             {
179 1085     1085 0 1671 my $self = shift ;
180 1085         5134 $self->{Def}->crc32();
181             }
182              
183             sub adler32
184             {
185 0     0 0   my $self = shift ;
186 0           $self->{Def}->adler32();
187             }
188              
189              
190             1;
191              
192             __END__