#
# Module Generated by Template::Tiny on [% date %]
#
package ZMQ::FFI::ZMQ2::Socket;
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::ErrorHandler
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 $_;
};
# ensure clean edge state
while ( $self->has_pollin ) {
$self->recv();
}
}
### 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];
use bytes;
($data_ptr, $data_size) = scalar_to_buffer($data);
no bytes;
my $msg_ptr = malloc(zmq_msg_t_size);
if ( -1 == zmq_msg_init_size($msg_ptr, $data_size) ) {
$_[0]->fatal('zmq_msg_init_size');
}
my $msg_data_ptr = zmq_msg_data($msg_ptr);
memcpy($msg_data_ptr, $data_ptr, $data_size);
if ( -1 == zmq_send($_[0]->_socket, $msg_ptr, $_[2] // 0) ) {
$_[0]->fatal('zmq_send');
}
zmq_msg_close($msg_ptr);
}
sub recv {
# 0: self
# 1: flags
my $msg_ptr = malloc(zmq_msg_t_size);
if ( -1 == zmq_msg_init($msg_ptr) ) {
$_[0]->fatal('zmq_msg_init');
}
if ( -1 == zmq_recv($_[0]->_socket, $msg_ptr, $_[1] // 0) ) {
$_[0]->fatal('zmq_recv');
}
my $data_ptr = zmq_msg_data($msg_ptr);
my $data_size = zmq_msg_size($msg_ptr);
if ( -1 == $data_size ) {
$_[0]->fatal('zmq_msg_size');
}
my $rv = '';
if ($data_size) {
$rv = buffer_to_scalar($data_ptr, $data_size);
}
zmq_msg_close($msg_ptr);
return $rv;
}
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 %]
1;