1 package PerlIO
::via
::File
::KDBX
::Compression
;
2 # ABSTRACT: [De]compressor PerlIO layer
9 use File
::KDBX
::Util
qw(:io load_optional);
13 our $VERSION = '999.999'; # VERSION
14 our $BUFFER_SIZE = 8192;
19 PerlIO
::via
::File
::KDBX
::Compression-
>push($fh);
20 PerlIO
::via
::File
::KDBX
::Compression-
>push($fh, %options);
22 Push a compression
or decompression layer onto a filehandle
. Data
read from the handle
is decompressed
, and
23 data written to a handle
is compressed
.
25 Any arguments are passed along to the Inflate
or Deflate constructors of C
<Compress
::Raw
::Zlib
>.
29 binmode($fh, ':via(File::KDBX::Compression)');
31 except this allows you to specify compression options
.
33 B
<WARNING
:> When writing
, you mustn
't close the filehandle before popping this layer (using
34 C<binmode($fh, ':pop')>) or the stream will be truncated. The layer needs to know when there is no more data
35 before the filehandle closes so it can finish the compression correctly, and the way to indicate that is by
42 @PUSHED_ARGS and throw 'Pushing Compression layer would stomp existing arguments
';
46 binmode($fh, ':via
(' . __PACKAGE__ . ')');
50 my ($class, $mode) = @_;
52 $ENV{DEBUG_STREAM} and print STDERR "PUSHED\t$class (mode: $mode)\n";
55 buffer => \(my $buf = ''),
57 is_readable($mode) ? (inflator => _inflator(@PUSHED_ARGS)) : (),
58 is_writable($mode) ? (deflator => _deflator(@PUSHED_ARGS)) : (),
67 $ENV{DEBUG_STREAM} and print STDERR "FILL\t$self\n";
68 return if $self->EOF($fh);
70 $fh->read(my $buf, $BUFFER_SIZE);
71 if (0 < length($buf)) {
72 my $status = $self->inflator->inflate($buf, my $out);
73 $status == Compress::Raw::Zlib::Z_OK() || $status == Compress::Raw::Zlib::Z_STREAM_END() or do {
74 $self->_set_error("Failed to uncompress: $status", status => $status);
80 delete $self->{inflator};
81 delete $self->{deflator};
86 my ($self, $buf, $fh) = @_;
88 $ENV{DEBUG_STREAM} and print STDERR "WRITE\t$self\n";
89 return 0 if $self->EOF($fh) || !$self->deflator;
91 my $status = $self->deflator->deflate($buf, my $out);
92 $status == Compress::Raw::Zlib::Z_OK() or do {
93 $self->_set_error("Failed to compress: $status", status => $status);
97 ${$self->buffer} .= $out;
102 my ($self, $fh) = @_;
104 $ENV{DEBUG_STREAM} and print STDERR "POPPED\t$self\n";
105 return if $self->EOF($fh) || !is_writable($self->mode);
108 my $status = $self->deflator->flush(my $out, Compress::Raw::Zlib::Z_FINISH());
109 delete $self->{inflator};
110 delete $self->{deflator};
111 $status == Compress::Raw::Zlib::Z_OK() or do {
112 $self->_set_error("Failed to compress: $status", status => $status);
116 ${$self->buffer} .= $out;
121 my ($self, $fh) = @_;
123 $ENV{DEBUG_STREAM} and print STDERR "FLUSH\t$self\n";
124 return 0 if !ref $self;
126 my $buf = $self->buffer;
127 print $fh $$buf or return -1 if 0 < length($$buf);
133 $ENV{DEBUG_STREAM} and print STDERR "EOF\t$_[0]\n";
134 !($_[0]->{inflator} || $_[0]->{deflator}) || $_[0]->ERROR($_[1]);
137 $ENV{DEBUG_STREAM} and print STDERR "ERROR\t$_[0] : ", $_[0]->{error} // 'ok
', "\n";
138 $ERROR = $_[0]->{error} if $_[0]->{error};
139 $_[0]->{error} ? 1 : 0;
142 $ENV{DEBUG_STREAM} and print STDERR "CLEARERR\t$_[0]\n";
143 # delete $_[0]->{error};
146 sub inflator { $_[0]->{inflator} }
147 sub deflator { $_[0]->{deflator} }
148 sub mode { $_[0]->{mode} }
149 sub buffer { $_[0]->{buffer} }
152 load_optional('Compress
::Raw
::Zlib
');
153 my ($inflator, $status)
154 = Compress::Raw::Zlib::Inflate->new(-WindowBits => Compress::Raw::Zlib::WANT_GZIP(), @_);
155 $status == Compress::Raw::Zlib::Z_OK()
156 or throw 'Failed to initialize inflator
', status => $status;
161 load_optional('Compress
::Raw
::Zlib
');
162 my ($deflator, $status)
163 = Compress::Raw::Zlib::Deflate->new(-WindowBits => Compress::Raw::Zlib::WANT_GZIP(), @_);
164 $status == Compress::Raw::Zlib::Z_OK()
165 or throw 'Failed to initialize deflator
', status => $status;
171 $ENV{DEBUG_STREAM} and print STDERR "err\t$self\n";
172 delete $self->{inflator};
173 delete $self->{deflator};
174 if (exists &Errno::EPROTO) {
177 elsif (exists &Errno::EIO) {
180 $self->{error} = $ERROR = File::KDBX::Error->new(@_);