File: //usr/share/perl5/vendor_perl/Amavis/IO/Zlib.pm
# SPDX-License-Identifier: GPL-2.0-or-later
package Amavis::IO::Zlib;
# A simple IO::File -compatible wrapper around Compress::Zlib,
# much like IO::Zlib but simpler: does only what we need and does it carefully
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.412';
@ISA = qw(Exporter);
}
use Errno qw(EIO);
use Compress::Zlib;
sub new {
my $class = shift; my $self = bless {}, $class;
if (@_) { $self->open(@_) or return }
$self;
}
sub close {
my $self = $_[0];
my $status; my $eval_stat; local($1,$2);
eval { $status = $self->{fh}->gzclose; 1 }
or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
delete $self->{fh};
if (defined $eval_stat) {
chomp $eval_stat;
die $eval_stat if $eval_stat =~ /^timed out\b/; # resignal timeout
# can't stash arbitrary text into $!
die "gzclose error: $eval_stat, $gzerrno";
$! = EIO; return; # not reached
} elsif ($status != Z_OK) {
die "gzclose error: $gzerrno"; # can't stash arbitrary text into $!
$! = EIO; return; # not reached
}
1;
}
sub DESTROY {
my $self = $_[0]; local($@,$!,$_);
# ignore failure, make perlcritic happy
if ($self && $self->{fh}) { eval { $self->close } or 1 }
}
sub open {
my($self,$fname,$mode) = @_;
# ignore failure, make perlcritic happy
if (exists($self->{fh})) { eval { $self->close } or 1; delete $self->{fh} }
$self->{fname} = $fname; $self->{mode} = $mode; $self->{pos} = 0;
my $gz = gzopen($fname,$mode);
if ($gz) {
$self->{fh} = $gz;
} else {
die "gzopen error: $gzerrno"; # can't stash arbitrary text into $!
$! = EIO; undef $gz; # not reached
}
$gz;
}
sub seek {
my($self,$pos,$whence) = @_;
$whence == 0 or die "Only absolute seek is supported on gzipped file";
$pos >= 0 or die "Can't seek to a negative absolute position";
$self->{mode} eq 'rb'
or die "Seek to $whence,$pos on gzipped file only supported for 'rb' mode";
if ($pos < $self->{pos}) {
$self->close or die "seek: can't close gzipped file: $!";
$self->open($self->{fname},$self->{mode})
or die "seek: can't reopen gzipped file: $!";
}
my $skip = $pos - $self->{pos};
while ($skip > 0) {
my $s; my $nbytes = $self->read($s,$skip); # acceptable for small skips
defined $nbytes && $nbytes > 0
or die "seek: error skipping $skip bytes on gzipped file: $!";
$skip -= $nbytes;
}
1; # seek is supposed to return 1 upon success, 0 otherwise
}
sub read { # SCALAR,LENGTH,OFFSET
my $self = shift; my $len = $_[1]; my $offset = $_[2];
defined $len or die "Amavis::IO::Zlib::read: length argument undefined";
my $nbytes;
if (!defined($offset) || $offset == 0) {
$nbytes = $self->{fh}->gzread($_[0], $len);
} else {
my $buff;
$nbytes = $self->{fh}->gzread($buff, $len);
substr($_[0],$offset) = $buff;
}
if ($nbytes < 0) {
die "gzread error: $gzerrno"; # can't stash arbitrary text into $!
$! = EIO; undef $nbytes; # not reached
} else {
$self->{pos} += $nbytes;
}
$nbytes; # eof: 0; error: undef
}
sub getline {
my $self = $_[0]; my($nbytes,$line);
$nbytes = $self->{fh}->gzreadline($line);
if ($nbytes <= 0) { # eof (0) or error (-1)
$! = 0; $line = undef;
if ($nbytes < 0 && $gzerrno != Z_STREAM_END) {
die "gzreadline error: $gzerrno"; # can't stash arbitrary text into $!
$! = EIO; # not reached
}
} else {
$self->{pos} += $nbytes;
}
$line; # eof: undef, $! zero; error: undef, $! nonzero
}
sub print {
my $self = shift;
my $buff_ref = @_ == 1 ? \$_[0] : \join('',@_);
my $nbytes; my $len = length($$buff_ref);
if ($len <= 0) {
$nbytes = "0 but true";
} else {
$nbytes = $self->{fh}->gzwrite($$buff_ref); $self->{pos} += $len;
if ($nbytes <= 0) {
die "gzwrite error: $gzerrno"; # can't stash arbitrary text into $!
$! = EIO; undef $nbytes; # not reached
}
}
$nbytes;
}
sub printf { shift->print(sprintf(shift,@_)) }
1;