#
# Module Generated by Template::Tiny on Sat Sep 19 17:38:34 UTC 2015
#

package ZMQ::FFI::ZMQ2::Socket;
$ZMQ::FFI::ZMQ2::Socket::VERSION = '1.07';
use FFI::Platypus;
use FFI::Platypus::Buffer;
use FFI::Platypus::Memory qw(malloc free memcpy);
use ZMQ::FFI::Constants qw(:all);
use Carp;
use Try::Tiny;

use Moo;
use namespace::clean;

no if $] >= 5.018, warnings => "experimental";
use feature 'switch';

with qw(
    ZMQ::FFI::SocketRole
    ZMQ::FFI::ErrorHelper
    ZMQ::FFI::Versioner
);

my $FFI_LOADED;

sub BUILD {
    my ($self) = @_;

    unless ($FFI_LOADED) {
        _load_common_ffi($self->soname);
        _load_zmq2_ffi($self->soname);
        $FFI_LOADED = 1;
    }

    try {
        # XXX
        # not clear why this is necessary, but the setter doesn't actually
        # take affect if you directly nest the zmq_socket call in the _socket
        # call... some Class::XSAccessor weirdness/bug? Need to investigate.
        my $s = zmq_socket($self->ctx->_ctx, $self->type);
        $self->_socket($s);
        $self->check_null('zmq_socket', $self->_socket);
    }
    catch {
        $self->_socket(-1);
        die $_;
    };

    # force init zmq_msg_t
    $self->_zmq_msg_t;

    # ensure clean edge state
    while ( $self->has_pollin ) {
        $self->recv();
    }

    # set default linger
    $self->set_linger(0);
}

### ZMQ2 API ###

sub _load_zmq2_ffi {
    my ($soname) = @_;

    my $ffi = FFI::Platypus->new( lib => $soname );

    $ffi->attach(
        # int zmq_send(void *socket, zmq_msg_t *msg, int flags)
        'zmq_send' => ['pointer', 'pointer', 'int'] => 'int'
    );

    $ffi->attach(
        # int zmq_recv(void *socket, zmq_msg_t *msg, int flags)
        'zmq_recv' => ['pointer', 'pointer', 'int'] => 'int'
    );
}

#
# send/recv are hot spots, so sacrificing some readability for performance
#

sub send {
    # 0: self
    # 1: data
    # 2: flags

    my $data_ptr;
    my $data_size;
    my $data = $_[1];

    $_[0]->{last_errno} = 0;

    use bytes;
    ($data_ptr, $data_size) = scalar_to_buffer($data);
    no bytes;

    if ( -1 == zmq_msg_init_size($_[0]->{"_zmq_msg_t"}, $data_size) ) {
        $_[0]->{last_errno} = zmq_errno();

        if ($_[0]->die_on_error) {
            $_[0]->fatal('zmq_msg_init_size');
        }

        return;
    }

    my $msg_data_ptr = zmq_msg_data($_[0]->{"_zmq_msg_t"});
    memcpy($msg_data_ptr, $data_ptr, $data_size);

    if ( -1 == zmq_send($_[0]->_socket, $_[0]->{"_zmq_msg_t"}, $_[2] // 0) ) {
        $_[0]->{last_errno} = zmq_errno();

        if ($_[0]->die_on_error) {
            $_[0]->fatal('zmq_send');
        }

        return;
    }
}

sub recv {
    # 0: self
    # 1: flags

    $_[0]->{last_errno} = 0;

    if ( -1 == zmq_recv($_[0]->_socket, $_[0]->{"_zmq_msg_t"}, $_[1] // 0) ) {
        $_[0]->{last_errno} = zmq_errno();

        if ($_[0]->die_on_error) {
            $_[0]->fatal('zmq_recv');
        }

        return;
    }

    # retval = msg size
    my $retval = zmq_msg_size($_[0]->{"_zmq_msg_t"});

    if ($retval) {
        return buffer_to_scalar(zmq_msg_data($_[0]->{"_zmq_msg_t"}), $retval);
    }

    return '';
}

sub disconnect {
    my ($self) = @_;

    $self->bad_version(
        $self->verstr,
        "disconnect not available in zmq 2.x"
    );
}

sub unbind {
    my ($self) = @_;

    $self->bad_version(
        $self->verstr,
        "unbind not available in zmq 2.x"
    );
}


### ZMQ COMMON API ###

sub connect {
    my ($self, $endpoint) = @_;

    unless ($endpoint) {
        croak 'usage: $socket->connect($endpoint)';
    }

    $self->check_error(
        'zmq_connect',
        zmq_connect($self->_socket, $endpoint)
    );
}

sub bind {
    my ($self, $endpoint) = @_;

    unless ($endpoint) {
        croak 'usage: $socket->bind($endpoint)'
    }

    $self->check_error(
        'zmq_bind',
        zmq_bind($self->_socket, $endpoint)
    );
}

#
# send/recv are hot spots, so sacrificing some readability for performance
#

sub send_multipart {
    # 0: self
    # 1: partsref
    # 2: flags

    my @parts = @{$_[1] // []};
    unless (@parts) {
        croak 'usage: send_multipart($parts, $flags)';
    }

    for my $i (0..$#parts-1) {
        $_[0]->send($parts[$i], ($_[2] // 0) | ZMQ_SNDMORE);

        # don't need to explicitly check die_on_error
        # since send would have exploded if it was true
        if ($_[0]->has_error) {
            return;
        }
    }

    $_[0]->send($parts[$#parts], $_[2] // 0);
}

sub recv_multipart {
    # 0: self
    # 1: flags

    my @parts = ( $_[0]->recv($_[1]) );

    if ($_[0]->has_error) {
        return;
    }

    my $type = ($_[0]->version)[0] == 2 ? 'int64_t' : 'int';

    while ( $_[0]->get(ZMQ_RCVMORE, $type) ){
        push @parts, $_[0]->recv($_[1] // 0);

        # don't need to explicitly check die_on_error
        # since recv would have exploded if it was true
        if ($_[0]->has_error) {
            return;
        }
    }

    return @parts;
}

sub get_fd {
    return $_[0]->get(ZMQ_FD, 'int');
}

sub set_linger {
    my ($self, $linger) = @_;

    $self->set(ZMQ_LINGER, 'int', $linger);
}

sub get_linger {
    return $_[0]->get(ZMQ_LINGER, 'int');
}

sub set_identity {
    my ($self, $id) = @_;

    $self->set(ZMQ_IDENTITY, 'binary', $id);
}

sub get_identity {
    return $_[0]->get(ZMQ_IDENTITY, 'binary');
}

sub subscribe {
    my ($self, $topic) = @_;

    $self->set(ZMQ_SUBSCRIBE, 'binary', $topic);
}

sub unsubscribe {
    my ($self, $topic) = @_;

    $self->set(ZMQ_UNSUBSCRIBE, 'binary', $topic);
}

sub has_pollin {
    return $_[0]->get(ZMQ_EVENTS, 'int') & ZMQ_POLLIN;
}

sub has_pollout {
    return $_[0]->get(ZMQ_EVENTS, 'int') & ZMQ_POLLOUT;
}

sub get {
    my ($self, $opt, $opt_type) = @_;

    my $optval;
    my $optval_len;

    for ($opt_type) {
        when (/^(binary|string)$/) {
            # ZMQ_IDENTITY uses binary type and can be at most 255 bytes long
            #
            # ZMQ_LAST_ENDPOINT uses string type and expects a buffer large
            # enough to hold an endpoint string
            #
            # So for these cases 256 should be sufficient (including \0).
            # Other binary/string opts are being added all the time, and
            # hopefully this value scales, but we can always increase it if
            # necessary
            my $optval_ptr = malloc(256);
            $optval_len    = 256;

            $self->check_error(
                'zmq_getsockopt',
                zmq_getsockopt_binary(
                    $self->_socket,
                    $opt,
                    $optval_ptr,
                    \$optval_len
                )
            );

            if ($self->has_error) {
                free($optval_ptr);
                return;
            }

            if ($opt_type eq 'binary') {
                $optval = buffer_to_scalar($optval_ptr, $optval_len);
                free($optval_ptr);
            }
            else { # string
                # FFI::Platypus already appends a null terminating byte for
                # strings, so strip the one included by zeromq (otherwise test
                # comparisons fail due to the extra NUL)
                $optval = buffer_to_scalar($optval_ptr, $optval_len-1);
                free($optval_ptr);
            }
        }

        when (/^int$/) {
            $optval_len = $self->sockopt_sizes->{'int'};
            $self->check_error(
                'zmq_getsockopt',
                zmq_getsockopt_int(
                    $self->_socket,
                    $opt,
                    \$optval,
                    \$optval_len
                )
            );
        }

        when (/^int64_t$/) {
            $optval_len = $self->sockopt_sizes->{'sint64'};
            $self->check_error(
                'zmq_getsockopt',
                zmq_getsockopt_int64(
                    $self->_socket,
                    $opt,
                    \$optval,
                    \$optval_len
                )
            );
        }

        when (/^uint64_t$/) {
            $optval_len = $self->sockopt_sizes->{'uint64'};
            $self->check_error(
                'zmq_getsockopt',
                zmq_getsockopt_uint64(
                    $self->_socket,
                    $opt,
                    \$optval,
                    \$optval_len
                )
            );
        }

        default {
            croak "unknown type $opt_type";
        }
    }

    if ($optval ne '') {
        return $optval;
    }

    return;
}

sub set {
    my ($self, $opt, $opt_type, $optval) = @_;

    for ($opt_type) {
        when (/^(binary|string)$/) {
            my ($optval_ptr, $optval_len) = scalar_to_buffer($optval);
            $self->check_error(
                'zmq_setsockopt',
                zmq_setsockopt_binary(
                    $self->_socket,
                    $opt,
                    $optval_ptr,
                    $optval_len
                )
            );
        }

        when (/^int$/) {
            $self->check_error(
                'zmq_setsockopt',
                zmq_setsockopt_int(
                    $self->_socket,
                    $opt,
                    \$optval,
                    $self->sockopt_sizes->{'int'}
                )
            );
        }

        when (/^int64_t$/) {
            $self->check_error(
                'zmq_setsockopt',
                zmq_setsockopt_int64(
                    $self->_socket,
                    $opt,
                    \$optval,
                    $self->sockopt_sizes->{'sint64'}
                )
            );
        }

        when (/^uint64_t$/) {
            $self->check_error(
                'zmq_setsockopt',
                zmq_setsockopt_uint64(
                    $self->_socket,
                    $opt,
                    \$optval,
                    $self->sockopt_sizes->{'uint64'}
                )
            );
        }

        default {
            croak "unknown type $opt_type";
        }
    }

    return;
}

sub close {
    my ($self) = @_;

    # don't try to cleanup socket cloned from another process (fork)
    return unless $self->_pid == $$;

    $self->check_error(
        'zmq_close',
        zmq_close($self->_socket)
    );

    $self->_socket(-1);
}

sub DEMOLISH {
    my ($self) = @_;

    unless ($self->_socket == -1) {
        $self->check_error(
            'zmq_msg_close',
            zmq_msg_close($self->_zmq_msg_t)
        );

        $self->close();
    }
};

sub _load_common_ffi {
    my ($soname) = @_;

    my $ffi   = FFI::Platypus->new( lib => $soname );
    my $class = caller;

    $ffi->attach(
        # void *zmq_socket(void *context, int type)
        ['zmq_socket' => "${class}::zmq_socket"]
            => ['pointer', 'int'] => 'pointer'
    );

    # for get/set sockopt create ffi functions for each possible opt type

    # int zmq_getsockopt(void *sock, int opt, void *val, size_t *len)

    $ffi->attach(
        ['zmq_getsockopt' => "${class}::zmq_getsockopt_binary"]
            => ['pointer', 'int', 'pointer', 'size_t*'] => 'int'
    );

    $ffi->attach(
        ['zmq_getsockopt' => "${class}::zmq_getsockopt_int"]
            => ['pointer', 'int', 'int*', 'size_t*'] => 'int'
    );

    $ffi->attach(
        ['zmq_getsockopt' => "${class}::zmq_getsockopt_int64"]
            => ['pointer', 'int', 'sint64*', 'size_t*'] => 'int'
    );

    $ffi->attach(
        ['zmq_getsockopt' => "${class}::zmq_getsockopt_uint64"]
            => ['pointer', 'int', 'uint64*', 'size_t*'] => 'int'
    );


    # int zmq_setsockopt(void *sock, int opt, const void *val, size_t len)

    $ffi->attach(
        ['zmq_setsockopt' => "${class}::zmq_setsockopt_binary"]
            => ['pointer', 'int', 'pointer', 'size_t'] => 'int'
    );

    $ffi->attach(
        ['zmq_setsockopt' => "${class}::zmq_setsockopt_int"]
            => ['pointer', 'int', 'int*', 'size_t'] => 'int'
    );

    $ffi->attach(
        ['zmq_setsockopt' => "${class}::zmq_setsockopt_int64"]
            => ['pointer', 'int', 'sint64*', 'size_t'] => 'int'
    );

    $ffi->attach(
        ['zmq_setsockopt' => "${class}::zmq_setsockopt_uint64"]
            => ['pointer', 'int', 'uint64*', 'size_t'] => 'int'
    );


    $ffi->attach(
        # int zmq_connect(void *socket, const char *endpoint)
        ['zmq_connect' => "${class}::zmq_connect"]
            => ['pointer', 'string'] => 'int'
    );

    $ffi->attach(
        # int zmq_bind(void *socket, const char *endpoint)
        ['zmq_bind' => "${class}::zmq_bind"]
            => ['pointer', 'string'] => 'int'
    );

    $ffi->attach(
        # int zmq_msg_init(zmq_msg_t *msg)
        ['zmq_msg_init' => "${class}::zmq_msg_init"]
            => ['pointer'] => 'int'
    );

    $ffi->attach(
        # int zmq_msg_init_size(zmq_msg_t *msg, size_t size)
        ['zmq_msg_init_size' => "${class}::zmq_msg_init_size"]
            => ['pointer', 'int'] => 'int'
    );

    $ffi->attach(
        # size_t zmq_msg_size(zmq_msg_t *msg)
        ['zmq_msg_size' => "${class}::zmq_msg_size"]
            => ['pointer'] => 'int'
    );

    $ffi->attach(
        # void *zmq_msg_data(zmq_msg_t *msg)
        ['zmq_msg_data' => "${class}::zmq_msg_data"]
            => ['pointer'] => 'pointer'
    );

    $ffi->attach(
        # int zmq_msg_close(zmq_msg_t *msg)
        ['zmq_msg_close' => "${class}::zmq_msg_close"]
            => ['pointer'] => 'int'
    );

    $ffi->attach(
        # int zmq_close(void *socket)
        ['zmq_close' => "${class}::zmq_close"]
            => ['pointer'] => 'int'
    );

    $ffi->attach(
        # const char *zmq_strerror(int errnum)
        ['zmq_strerror' => "${class}::zmq_strerror"]
            => ['int'] => 'string'
    );

    $ffi->attach(
        # int zmq_errno(void)
        ['zmq_errno' => "${class}::zmq_errno"]
            => [] => 'int'
    );
}


1;

__END__

=pod

=encoding UTF-8

=head1 NAME

ZMQ::FFI::ZMQ2::Socket

=head1 VERSION

version 1.07

=head1 AUTHOR

Dylan Cali <calid1984@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by Dylan Cali.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
