xref: /openbsd-src/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
1package IO::Compress::Adapter::Deflate ;
2
3use strict;
4use warnings;
5use bytes;
6
7use IO::Compress::Base::Common 2.212 qw(:Status);
8use Compress::Raw::Zlib  2.212 qw( !crc32 !adler32 ) ;
9
10require Exporter;
11our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS);
12
13$VERSION = '2.212';
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
20sub mkCompObject
21{
22    my $crc32    = shift ;
23    my $adler32  = shift ;
24    my $level    = shift ;
25    my $strategy = shift ;
26
27    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    return (undef, "Cannot create Deflate object: $status", $status)
36        if $status != Z_OK;
37
38    return bless {'Def'        => $def,
39                  'Error'      => '',
40                 } ;
41}
42
43sub mkCompObject1
44{
45    my $crc32    = shift ;
46    my $adler32  = shift ;
47    my $level    = shift ;
48    my $strategy = shift ;
49
50    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    return (undef, "Cannot create Deflate object: $status", $status)
59        if $status != Z_OK;
60
61    return bless {'Def'        => $def,
62                  'Error'      => '',
63                 } ;
64}
65
66sub compr
67{
68    my $self = shift ;
69
70    my $def   = $self->{Def};
71
72    my $status = $def->deflate($_[0], $_[1]) ;
73    $self->{ErrorNo} = $status;
74
75    if ($status != Z_OK)
76    {
77        $self->{Error} = "Deflate Error: $status";
78        return STATUS_ERROR;
79    }
80
81    return STATUS_OK;
82}
83
84sub flush
85{
86    my $self = shift ;
87
88    my $def   = $self->{Def};
89
90    my $opt = $_[1] || Z_FINISH;
91    my $status = $def->flush($_[0], $opt);
92    $self->{ErrorNo} = $status;
93
94    if ($status != Z_OK)
95    {
96        $self->{Error} = "Deflate Error: $status";
97        return STATUS_ERROR;
98    }
99
100    return STATUS_OK;
101}
102
103sub close
104{
105    my $self = shift ;
106
107    my $def   = $self->{Def};
108
109    $def->flush($_[0], Z_FINISH)
110        if defined $def ;
111}
112
113sub reset
114{
115    my $self = shift ;
116
117    my $def   = $self->{Def};
118
119    my $status = $def->deflateReset() ;
120    $self->{ErrorNo} = $status;
121    if ($status != Z_OK)
122    {
123        $self->{Error} = "Deflate Error: $status";
124        return STATUS_ERROR;
125    }
126
127    return STATUS_OK;
128}
129
130sub deflateParams
131{
132    my $self = shift ;
133
134    my $def   = $self->{Def};
135
136    my $status = $def->deflateParams(@_);
137    $self->{ErrorNo} = $status;
138    if ($status != Z_OK)
139    {
140        $self->{Error} = "deflateParams Error: $status";
141        return STATUS_ERROR;
142    }
143
144    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
161sub compressedBytes
162{
163    my $self = shift ;
164
165    $self->{Def}->compressedBytes();
166}
167
168sub uncompressedBytes
169{
170    my $self = shift ;
171    $self->{Def}->uncompressedBytes();
172}
173
174
175
176
177sub crc32
178{
179    my $self = shift ;
180    $self->{Def}->crc32();
181}
182
183sub adler32
184{
185    my $self = shift ;
186    $self->{Def}->adler32();
187}
188
189
1901;
191
192__END__
193