view release on metacpan or  search on metacpan

lib/Cache/MemcachedBinary.pm  view on Meta::CPAN

        sysread($socket, $data{KeyLength}, 2);
        sysread($socket, $data{ExtrasLength}, 1);
        sysread($socket, $data{DataType}, 1);
        sysread($socket, $data{Status}, 2);
        sysread($socket, $data{TotalBodyLength}, 4);
        sysread($socket, $data{Opaque}, 4);
        sysread($socket, $data{CAS}, 8);

        $data{Key}    = '';
        $data{Extras} = '';
        $data{Value}  = '';

        my $len_key    = sprintf('%d', unpack( 'H*', $data{KeyLength} ));
        my $len_extras = hex(unpack( 'H*', $data{ExtrasLength} ));
        my $len_total  = unpack('N*', $data{TotalBodyLength}) || 0;
        my $len_value  = $len_total - $len_extras - $len_key;

        if ($len_extras) {
            sysread($socket, $data{Extras}, $len_extras);
        }

        if ($len_key) {
            sysread($socket, $data{Key}, $len_key);
        }

        if ($len_value) {
            sysread($socket, $data{Value}, $len_value);
        }

        $data{MagicUnpack}  = hex(unpack('H*', $data{Magic}));
        $data{OpcodeUnpack} = hex(unpack('H*', $data{Opcode}));
        $data{StatusUnpack} = unpack('n1', $data{Status});
        $data{ValueUnpack}  = unpack('A*', $data{Value});

        alarm 0;
    };

    $self->_log("<< " . ( join "", map { unpack('H*', $data{$_}) } (qw(Magic Opcode KeyLength ExtrasLength DataType Status TotalBodyLength Opaque CAS Extras Key Value)) ));

    if ( $data{OpcodeUnpack} == PROTOCOL_BINARY_CMD_GET ) { # clean binary data from Value section, maybe big data
        $data{Value} = '';
    }

    return \%data;
}

sub _get_socket {
    my $self = shift;

    return $self->socket if $self->socket && $self->socket->connected();
    return $self->_connect();
}

sub _connect {
    my $self = shift;

    my $socket = IO::Socket::INET->new(
        PeerAddr => $self->host,
        PeerPort => $self->port,
        Proto    => 'tcp',
        Timeout  => $self->timeout,
        Type     => SOCK_STREAM
    );

    my $error = $!;
    if ($error) {Encode::_utf8_on($error);}

    $self->_log( sprintf "Connect to host: %s, port: %s, timeout: %s", $self->host, $self->port, $self->timeout );
    $self->_log("result: " . ($socket ? 'success' : 'error: ' . $error));

    if ($socket) {
        binmode $socket;
        $self->set_socket($socket);
        return $socket;
    }

    $self->set_err($!);
    $self->_log( sprintf("Don't connect to %s:%s, error: %s", $self->host, $self->port, $error), ERROR_FLAG );
    return;
}

sub _socket_destroy {
    my $self = shift;
    $self->_log("socket destroy " . $self->socket);
    close($self->socket) if $self->socket;
    $self->set_socket(undef);
    return;
}

sub _log {
    my ($self, $str, $flag) = @_;
    return unless $str;

    $flag //= 0;

    if (! $self->logger) {
        $self->set_logger( sub { print STDERR shift() . "\n" } );
    }

    if (ref $self->logger ne 'CODE') {
        print STDERR "param 'logger' has type of reference not function\n";
        return;
    }

    if ($self->debug || $flag == ERROR_FLAG) {
        $self->logger->($str);
    }

    return;
}

sub host     {return $_[0]->{host}}
sub port     {return $_[0]->{port}}
sub timeout  {return $_[0]->{timeout}}
sub login    {return $_[0]->{login}}
sub password {return $_[0]->{password}}
sub socket   {return $_[0]->{socket}}
sub debug    {return $_[0]->{debug}}
sub logger   {return $_[0]->{logger}}
sub err      {return $_[0]->{err}}