1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281
|
####################################################################################################################################
# Buffered Handle IO
####################################################################################################################################
package pgBackRestTest::Common::Io::Buffered;
use parent 'pgBackRestTest::Common::Io::Filter';
use strict;
use warnings FATAL => qw(all);
use Carp qw(confess);
use English '-no_match_vars';
use Exporter qw(import);
our @EXPORT = qw();
use IO::Select;
use Time::HiRes qw(gettimeofday);
use pgBackRestDoc::Common::Exception;
use pgBackRestDoc::Common::Log;
use pgBackRestTest::Common::Io::Base;
use pgBackRestTest::Common::Io::Handle;
use pgBackRestTest::Common::Wait;
####################################################################################################################################
# Package name constant
####################################################################################################################################
use constant COMMON_IO_BUFFERED => __PACKAGE__;
push @EXPORT, qw(COMMON_IO_BUFFERED);
####################################################################################################################################
# CONSTRUCTOR
####################################################################################################################################
sub new
{
my $class = shift;
# Assign function parameters, defaults, and log debug info
my
(
$strOperation,
$oParent,
$iTimeout,
$lBufferMax,
) =
logDebugParam
(
__PACKAGE__ . '->new', \@_,
{name => 'oParent', trace => true},
{name => 'iTimeout', default => 0, trace => true},
{name => 'lBufferMax', default => COMMON_IO_BUFFER_MAX, trace => true},
);
# Bless with new class
my $self = $class->SUPER::new($oParent);
bless $self, $class;
# Set read handle so select object is created
$self->handleReadSet($self->handleRead());
# Set variables
$self->{iTimeout} = $iTimeout;
$self->{lBufferMax} = $lBufferMax;
# Initialize buffer
$self->{tBuffer} = '';
$self->{lBufferSize} = 0;
$self->{lBufferPos} = 0;
# Return from function and log return values if any
return logDebugReturn
(
$strOperation,
{name => 'self', value => $self}
);
}
####################################################################################################################################
# read - buffered read from a handle with optional blocking
####################################################################################################################################
sub read
{
my $self = shift;
my $tBufferRef = shift;
my $iRequestSize = shift;
my $bBlock = shift;
# Set working variables
my $iRemainingSize = $iRequestSize;
# If there is data left over in the buffer from lineRead then use it
my $lBufferRemaining = $self->{lBufferSize} - $self->{lBufferPos};
if ($lBufferRemaining > 0)
{
my $iReadSize = $iRequestSize < $lBufferRemaining ? $iRequestSize : $lBufferRemaining;
$$tBufferRef .= substr($self->{tBuffer}, $self->{lBufferPos}, $iReadSize);
$self->{lBufferPos} += $iReadSize;
$iRemainingSize -= $iReadSize;
}
# If this is a blocking read then loop until all bytes have been read, else error. If not blocking read until the request size
# has been met or EOF.
my $fTimeStart = gettimeofday();
my $fRemaining = $self->timeout();
while ($iRemainingSize > 0 && $fRemaining > 0)
{
# Check if the sysread call will block
if ($self->pending() || $self->{oReadSelect}->can_read($fRemaining))
{
# Read data into the buffer
my $iReadSize = $self->parent()->read($tBufferRef, $iRemainingSize);
# Check for EOF
if ($iReadSize == 0)
{
if ($bBlock)
{
$self->error(ERROR_FILE_READ, "unable to read ${iRequestSize} byte(s) due to EOF from " . $self->id());
}
else
{
return $iRequestSize - $iRemainingSize;
}
}
# Update remaining size and return when it reaches 0
$iRemainingSize -= $iReadSize;
}
# Calculate time remaining before timeout
$fRemaining = $self->timeout() - (gettimeofday() - $fTimeStart);
};
# Throw an error if timeout happened before required bytes were read
if ($iRemainingSize != 0 && $bBlock)
{
$self->error(
ERROR_FILE_READ, "unable to read ${iRequestSize} byte(s) after " . $self->timeout() . ' second(s) from ' . $self->id());
}
return $iRequestSize - $iRemainingSize;
}
####################################################################################################################################
# readLine - read the next lf-terminated line.
####################################################################################################################################
sub readLine
{
my $self = shift;
my $bIgnoreEOF = shift;
my $bError = shift;
# Try to find the next linefeed
my $iLineFeedPos = index($self->{tBuffer}, "\n", $self->{lBufferPos});
# If no linefeed was found then load more data
if ($iLineFeedPos == -1)
{
my $fRemaining = $self->timeout();
my $fTimeStart = gettimeofday();
# Load data
do
{
# If the buffer already has data and the buffer position is not 0 then trim it so there's room for more data
if ($self->{lBufferPos} != 0)
{
$self->{tBuffer} = substr($self->{tBuffer}, $self->{lBufferPos});
$self->{lBufferSize} = $self->{lBufferSize} - $self->{lBufferPos};
$self->{lBufferPos} = 0;
}
# Load data into the buffer
my $iBufferRead = 0;
if ($self->pending() || $self->{oReadSelect}->can_read($fRemaining))
{
$iBufferRead = $self->parent()->read(
\$self->{tBuffer},
$self->{lBufferSize} >= $self->bufferMax() ? $self->bufferMax() : $self->bufferMax() - $self->{lBufferSize});
# Check for EOF
if ($iBufferRead == 0)
{
# Return undef if EOF is ignored
if (defined($bIgnoreEOF) && $bIgnoreEOF)
{
return;
}
# Else throw an error
$self->error(ERROR_FILE_READ, 'unexpected EOF reading line from ' . $self->id());
}
}
# If data was read then check for a linefeed
if ($iBufferRead > 0)
{
$self->{lBufferSize} += $iBufferRead;
$iLineFeedPos = index($self->{tBuffer}, "\n");
}
# Calculate time remaining before timeout
if ($iLineFeedPos == -1)
{
$fRemaining = $self->timeout() - (gettimeofday() - $fTimeStart);
}
}
while ($iLineFeedPos == -1 && $fRemaining > 0);
# If not linefeed was found within the timeout throw error
if ($iLineFeedPos == -1)
{
if (!defined($bError) || $bError)
{
$self->error(
ERROR_FILE_READ, 'unable to read line after ' . $self->timeout() . ' second(s) from ' . $self->id());
}
return;
}
}
# Return the line that was found and adjust the buffer position
my $strLine = substr($self->{tBuffer}, $self->{lBufferPos}, $iLineFeedPos - $self->{lBufferPos});
$self->{lBufferPos} = $iLineFeedPos + 1;
return $strLine;
}
####################################################################################################################################
# writeLine - write a string and \n terminate it
####################################################################################################################################
sub writeLine
{
my $self = shift;
my $strBuffer = shift;
$strBuffer .= "\n";
return $self->parent()->write(\$strBuffer);
}
####################################################################################################################################
# Getters/Setters
####################################################################################################################################
sub timeout {shift->{iTimeout}};
sub bufferMax {shift->{lBufferMax}};
####################################################################################################################################
# handleReadSet - create a select object when read handle is set
####################################################################################################################################
sub handleReadSet
{
my $self = shift;
my $fhRead = shift;
$self->parent()->handleReadSet($fhRead);
# Create select object to make IO waits more efficient
$self->{oReadSelect} = IO::Select->new();
$self->{oReadSelect}->add($self->handleRead());
# Check if the read handle has a pending method. This should be checked before can_read for SSL sockets.
$self->{bPending} = defined($fhRead) && $fhRead->can('pending') ? true : false;
}
####################################################################################################################################
# Are bytes pending that won't show up in select?
####################################################################################################################################
sub pending
{
my $self = shift;
return ($self->{bPending} && $self->handleRead()->pending() ? true : false);
}
1;
|