File Coverage

blib/lib/XAS/Lib/Net/Client.pm

Criterion	Covered	Total	%
statement	12	120	10.0
branch	0	36	0.0
condition			n/a
subroutine	4	16	25.0
pod	10	11	90.9
total	26	183	14.2

package XAS::Lib::Net::Client;

our $VERSION = '0.03';

use IO::Socket;
use IO::Select;
use Errno ':POSIX';

use XAS::Class
  debug     => 0,
  version   => $VERSION,
  base      => 'XAS::Base',
  mixin     => 'XAS::Lib::Mixins::Bufops',
  utils     => ':validation dotid trim',
  accessors => 'handle select attempts',
  mutators  => 'timeout',
  import    => 'class',
  vars => {
    PARAMS => {
      -port    => 1,
      -host    => 1,
      -timeout => { optional => 1, default => 60 },
      -eol     => { optional => 1, default => "\015\012" },
    },
    ERRNO  => 0,
    ERRSTR => '',
  }
;


#use Data::Hexdumper;

# ----------------------------------------------------------------------
# Public Methods
# ----------------------------------------------------------------------

sub connect {
    my $self = shift;

    $self->class->var('ERRNO', 0);
    $self->class->var('ERRSTR', '');

    $self->{'handle'} = IO::Socket::INET->new(
        Proto    => 'tcp',
        PeerPort => $self->port,
        PeerAddr => $self->host,
        Timeout  => $self->timeout,
    ) or do {

        my $errno  = $! + 0;
        my $errstr = $!;

        $self->class->var('ERRNO', $errno);
        $self->class->var('ERRSTR', $errstr);

        $self->throw_msg(
            dotid($self->class) . '.connect.noconnect',
            'net_client_noconnect',
            $self->host,
            $self->port,
            $errstr
        );

    };

    $self->handle->blocking(0);
    $self->{'select'} = IO::Select->new($self->handle);

}

sub pending {
    my $self = shift;

    return length($self->{'buffer'});

}

sub disconnect {
    my $self = shift;

    if ($self->handle->connected) {

        $self->handle->close();

    }

}

sub get {
    my $self = shift;
    my ($length) = validate_params(\@_, [
        { optional => 1, default => 512 }
    ]);

    my $output;

    if ($self->pending > $length) {

        $output = $self->buf_slurp(\$self->{'buffer'}, $length);

    } else {

        $self->_fill_buffer();

        my $l = ($self->pending > $length) ? $length : $self->pending;
        $output = $self->buf_slurp(\$self->{'buffer'}, $l);

    }

    return $output;

}

sub gets {
    my $self = shift;

    my $buffer;
    my $output = '';

    while (my $buf = $self->get()) {

        $buffer .= $buf;

        if ($output = $self->buf_get_line(\$buffer, $self->eol)) {

            $self->{'buffer'} = $buffer . $self->{'buffer'};
            last;

        }

    }

    return trim($output);

}

sub put {
    my $self = shift;
    my ($buffer) = validate_params(\@_, [1]);

    my $counter = 0;
    my $working = 1;
    my $written = 0;
    my $timeout = $self->timeout;
    my $bufsize = length($buffer);

    $self->class->var('ERRNO', 0);
    $self->class->var('ERRSTR', '');

    while ($working) {

        $self->handle->clearerr();

        if ($self->select->can_write($timeout)) {

            if (my $bytes = $self->handle->syswrite($buffer, $bufsize)) {

                $written += $bytes;
                $buffer = substr($buffer, $bytes);
                $working = 0 if ($written >= $bufsize);

            } else {

                if ($self->handle->error) {

                    my $errno  = $! + 0;
                    my $errstr = $!;

                    if ($errno == EAGAIN) {

                        $counter++;
                        $working = 0 if ($counter > $self->attempts);

                    } else {

                        $self->class->var('ERRNO', $errno);
                        $self->class->var('ERRSTR', $errstr);

                        $self->throw_msg(
                            dotid($self->class) . '.put',
                            'net_client_network',
                            $errstr
                        );

                    }

                }

            }

        } else {

            $working = 0;

        }

    }

    return $written;

}

sub puts {
    my $self = shift;
    my ($buffer) = validate_params(\@_, [1]);

    my $data = sprintf("%s%s", trim($buffer), $self->eol);
    my $written = $self->put($data);

    return $written;

}

sub errno {
    my $class = shift;
    my ($value) = validate_params(\@_, [
        { optional => 1, default => undef }
    ]);

    class->var('ERRNO', $value) if (defined($value));

    return class->var('ERRNO');

}

sub errstr {
    my $class = shift;
    my ($value) = validate_params(\@_, [
        { optional => 1, default => undef }
    ]);

    class->var('ERRSTR', $value) if (defined($value));

    return class->var('ERRSTR');

}

sub setup {
    my $self = shift;

}

# ----------------------------------------------------------------------
# Private Methods
# ----------------------------------------------------------------------

sub init {
    my $class = shift;

    my $self = $class->SUPER::init(@_);

    $self->{'attempts'} = 5;
    $self->{'buffer'}   = '';

    return $self;

}

sub _fill_buffer {
    my $self = shift;

    my $counter = 0;
    my $working = 1;
    my $read    = 0;
    my $timeout = $self->timeout;

    $self->class->var('ERRNO', 0);
    $self->class->var('ERRSTR', '');

    $self->handle->blocking(0);

    while ($working) {

        my $buf;

        $self->handle->clearerr();

        if ($self->select->can_read($timeout)) {

            if (my $bytes = $self->handle->sysread($buf, 512)) {

                $self->{'buffer'} .= $buf;
                $read += $bytes;

            } else {

                if ($self->handle->error) {

                    my $errno  = $! + 0;
                    my $errstr = $!;

                    $self->log->debug("fill_buffer: errno = $errno");

                    if ($errno == EAGAIN) {

                        $counter++;
                        $working = 0 if ($counter > $self->attempts);

                    } else {

                        $self->class->var('ERRNO', $errno);
                        $self->class->var('ERRSTR', $errstr);

                        $self->throw_msg(
                            dotid($self->class) . '.fill_buffer',
                            'net_client_network',
                            $errstr
                        );

                    }

                }

            }

        } else {

            $working = 0;

        }

    }

    $self->handle->blocking(1);

    return $read;

}

1;

__END__