pgbackrest/test/lib/pgBackRestTest/Common/Io/Buffered.pm

####################################################################################################################################
# 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;